(in-package :lol)


(setf *GENSYM-COUNTER* 1)


(defmethod full-jam ((situation situation))
  (let ((body (body situation))
         seta
         r
         )
    (loop for part in body
          do
          (let ((data (loop for d in (dimension part)
                            collect
                            (if (free d)
                              (values-set d)
                              (list (datum d)))))
                a)
           ; (print data)
            (setf a (apply #'cartesian data))
            (push (mapcar #'(lambda (x)
                              (make-instance (type-of part)
                                :name (name part)
                                :creation-date (get-universal-time)
                                :dimension-list (mapcar #'(lambda (y z)
                                                            (make-instance (type-of z)
                                                              :values-set (values-set z)
                                                              :datum y
                                                              :free (free z)))
                                                        x (dimension part))))
                          a)
                  seta)))
    (setf r (mapcar #'(lambda (x) (make-instance 'situation
                                    :name (concatenate 'string (name situation) "-jam")
                                    :danser (danser situation)
                                    :data (data situation)
                                    :dimension-list (dimension-list situation)
                                    :body x
                                    :color (color situation)
                                    :creation-date (get-universal-time)
                                    :ancestor (name situation)
                                    ))
                    (apply #'cartesian (nreverse seta))))
    (loop for s in r
          collect (read-from-string (name s)))
    ))

#|
(full-jam SITUATION-531)

(mapcar #'describe (full-jam SITUATION-1081))
|#




;****************
;filtre

(defun test1 (object criterium c-value descriptor function d-value)
  (when (or (equalp function 'equalp)
            (equalp function '=))
    (setf function 'equalp))
  (let* ((criterium-list (funcall (symbol-function criterium) object))
         (pos-criterium (position  c-value criterium-list :test #'equalp)))
    (if pos-criterium
      (when (funcall (symbol-function function)
                     (nth pos-criterium (funcall (symbol-function descriptor) object))
                     d-value)
        (values object))
      (format *standard-output* "No ~S found in ~S of ~S.~%" c-value criterium object) )))



#|
(support zz)
(test1 zz 'body "a" 'support 'equal 'yes)
(test1 zz 'body "a" 'support '= 'yes)
(test1 zz 'body "b" 'support 'equal 'no)

(test1 zz 'support 'no 'support 'equal 'no)

(and (test1 zz 'body "a" 'support 'equal 'yes)
    (test1 zz 'body "b" 'support 'equal 'no))

(or (test1 zz 'body "a" 'support 'equal 'no)
    (test1 zz 'body "b" 'support 'equal 'yes))
|#



(defmethod test ((object situation) (criterium t) (c-value t) (descriptor t) (function t) (d-value t))
  (test1 object criterium c-value descriptor function d-value))


(defmethod test ((object list) (criterium t) (c-value t) (descriptor t) (function t) (d-value t))
   (remove 'nil (mapcar #'(lambda (o)
                            (test o criterium c-value descriptor function d-value))
                        (mapcar #'eval object))))

(defmethod test ((object situation) (criterium t) (c-value list) (descriptor t) (function t) (d-value t))
   (let ((res (mapcar #'(lambda (c)
                          (test1 object criterium c descriptor function d-value))
                      c-value)))
     (eval `(and ,.res))))



#|
(direction zz)
(test zz 'body '("a" "b") 'support '= 'yes)
(test zz 'body '("a" "b") 'direction '> 0)
|#


(defmethod filtre-n ((situation situation) (dimension t) (critere t) (n integer) &key (test '=))
  (let* ((param (funcall dimension situation))
         (count (count critere param :test #'equalp)))
    (when (funcall test count n)
      (situation-name situation))))

(defmethod filtre-n ((situation list) (dimension t) (critere t) (n integer) &key (test #'equalp))
  (remove 'nil
          (mapcar #'(lambda (s) (filtre-n s dimension critere n :test test)) situation)))

(defmethod filtre-n ((situation symbol) (dimension t) (critere t) (n integer) &key (test #'equalp))
  (filtre-n (eval situation) dimension critere n :test test))

(defmethod filtre-n ((situation situation) (dimension t) (critere t) (n list) &key (test '=))
  (remove 'nil
  (mapcar #'(lambda (i) (filtre-n situation dimension critere i :test test)) n)))

(defmethod filtre-n ((situation symbol) (dimension t) (critere t) (n list) &key (test '=))
  (remove 'nil
  (mapcar #'(lambda (i) (filtre-n (eval situation) dimension critere i :test test)) n)))

(defmethod filtre-n ((situation list) (dimension t) (critere t) (n list) &key (test '=))
  (apply #'append
  (remove 'nil
  (mapcar #'(lambda (s) (filtre-n s dimension critere n :test test)) situation))))

#|
(filtre-n situation-y-567 'support 'yes '(1 2) :test '= 1 :test '>)

(filtre-n c1 'support 'yes '(1 2) :test '>)

(filtre-n c1 'support 'yes '(1 2) :test '>)
|#