(in-package :lol)



(defmethod scale-lol-dim ((self dimension) &key (min 0) (max 1) round)
   (case (type self)
     (:crispy
      (let ((values (values-set self))
            (x (datum self))
            step)
        (setf step (/ (- max min) (1- (length values))))
        (if round
          (cl-user::round1 (+ min (* step (position x values :test #'eq))) round)
          (+ min (* step (position x values :test #'eq))))))
     (:continuous
      (let ((values (values-set self)))
        (if round
          (cl-user::round1 (cl-user::scale (datum self) (car values) (cadr values) 0 1) round)
          (cl-user::scale (datum self) (car values) (cadr values) 0 1)
          )))
     ))

;(scale-lol-dim (car (dimension (second (body a-2)))))


(defmethod scale-lol-dim ((self bodypart) &key (min 0) (max 1) round)
  (loop for d in (dimension-list self)
        collect (scale-lol-dim d :min min :max max :round round)))

;(scale-lol-dim (second (body a-2)))


(defmethod scale-lol-dim ((self situation) &key (min 0) (max 1) round)
   (let ((body
          (loop for b in (body self)
                collect (scale-lol-dim b :min min :max max :round round)))
         (data
          (loop for d in (data self)
                collect (scale-lol-dim d :min min :max max :round round))))
     (list data body)))


(defmethod scale-lol-dim ((self symbol) &key (min 0) (max 1) round)
  (scale-lol-dim (eval self) :min min :max max :round round))

;(scale-lol-dim a-2)



(defmethod vectorize-lol-dim ((self dimension) &key (min 0) (max 1) round)
   (case (type self)
     (:crispy
      (let* ((values (values-set self))
            (x (datum self))
            (vector (coerce (make-list (1- (length values)) :initial-element 0) 'vector)))
        (when (not (eq 'w! x))
          (setf (elt vector (position x (remove 'w! values) :test #'eq)) 1))
        vector))
     (:continuous
      (let ((values (values-set self)))
        (if round
          (coerce (list (cl-user::round1 (cl-user::scale (datum self) (car values) (cadr values) min max) round))
                  'vector)
          (coerce (list (cl-user::scale (datum self) (car values) (cadr values) min max))
                  'vector)
          )))
     ))


(defmethod vectorize-lol-dim ((self bodypart) &key (min 0) (max 1) round)
  (loop for d in (dimension-list self)
        collect (vectorize-lol-dim d :min min :max max :round round)))

(defmethod vectorize-lol-dim ((self situation) &key (min 0) (max 1) round)
   (let ((body
          (loop for b in (body self)
                collect (vectorize-lol-dim b :min min :max max :round round)))
         (data
          (loop for d in (data self)
                collect (vectorize-lol-dim d :min min :max max :round round))))
     (list data body)))

(defmethod vectorize-lol-dim ((self symbol) &key (min 0) (max 1) round)
  (vectorize-lol-dim (eval self) :min min :max max :round round))



(defmethod loldescribe ((self bodypart) &key (scale nil) (min 0) (max 1) (round nil))
  (let ((dims (dimension-list self)))
    (if scale
      (mat-trans
       (list (mapcar #'(lambda (x) (class-name (class-of x))) dims)
             (scale-lol-dim self :min min :max max :round round)))
      (mapcar #'(lambda (x) (list (class-name (class-of x))
                                  (vectorize-lol-dim x :min min :max max :round round)))
              dims))))


(defmethod loldescribe ((self situation) &key (scale nil) (min 0) (max 1) (round nil))
   (if scale
     (append (mapcar #'(lambda (x) (append (list (class-name (class-of x)))
                                           (scale-lol-dim x :min min :max max :round round)
                                             ))
                     (data self))
           (mapcar #'(lambda (x) (append (list (class-name (class-of x)))
                                         (loldescribe x :scale scale :min min :max max :round round))) (body self)))
     (append (mapcar #'(lambda (x) (list (class-name (class-of x))
                                         (vectorize-lol-dim x :min min :max max :round round)))
                     (data self))
             (mapcar #'(lambda (x) (append (list (class-name (class-of x)))
                                           (loldescribe x :scale scale :min min :max max :round round)))
                     (body self)))))


(defmethod loldescribe ((self symbol) &key (scale nil) (min 0) (max 1) (round nil))
  (loldescribe (eval self) :scale scale :min min :max max :round round))




(defun eccarlate-elements ()
  (let ((obs (mapcar #'class-name
                     (find-subclasses 'old-part))))
    (remove-if #'(lambda (x) (member x (append obs (list 'old-part)) :test #'eq))
               (mapcar #'class-name
                       (find-subclasses 'BODYPART)))))

;(eccarlate-elements)

(defun eccarlate-dimensions ()
  (let ((obs (mapcar #'class-name
                     (find-subclasses 'old-dim))))
    (remove-if #'(lambda (x) (member x (append obs (list 'old-dim)) :test #'eq))
               (mapcar #'class-name
                       (find-subclasses 'dimension)))))

;(eccarlate-dimensions)

(defun format-situation-data-scale (sit &key elts dims code round)
  (when (not elts) (setf elts (eccarlate-elements)))
  (when (not dims) (setf dims (eccarlate-dimensions)))
  (let ((sit-data (loldescribe sit :scale t :round round))
        main-data
        body-data
        (d (mapcar #'class-name (find-subclasses 'laban-dimension))))
    (setf main-data (remove 'nil
                            (mapcar #'(lambda (x)
                                        (assoc x sit-data))
                                    (eccarlate-dimensions)))
          body-data
          (loop for e in elts
                collect
                (let ((data (assoc e sit-data)))
                  (if data data
                      (append (list e)
                              (mat-trans (list
                                          d
                                          (make-list (length d)
                                                     :initial-element 0))))
                      ))))
    (if code
      (apply #'append
             (loop for data in (append main-data body-data)
                   collect
                   (let ((value (cdr data)))
                     (if (atom value)
                       (list value)
                       (mapcar #'cadr value)))))
      (append main-data body-data))))

;(format-situation-data-scale (cadr (search-situations)) )
;(format-situation-data-scale (cadr (search-situations)) :code t)
;(format-situation-data-scale (cadr (search-situations)) :code t :round 2)
;(length (format-situation-data-scale (car (search-situations)) :code t))
#|
(mapcar #'(lambda (x) (list (read-from-string (name x))
                            (format-situation-data-scale x :code t :round 2)))
           (search-situations))
|#

(defun format-situation-data-vector (sit &key elts dims code round)
  (when (not elts) (setf elts (eccarlate-elements)))
  (when (not dims) (setf dims (eccarlate-dimensions)))
  (let ((sit-data (loldescribe sit :scale nil :round round))
        main-data
        body-data
        )
    (setf main-data (remove 'nil
                            (mapcar #'(lambda (x)
                                        (assoc x sit-data))
                                    (eccarlate-dimensions)))
          body-data
          (remove 'nil (loop for e in elts
                             collect
                             (assoc e sit-data))))
    (print body-data)
    (if code
      (list
       (apply #'concatenate 'vector (mapcar #'cadr main-data))
       (loop for data in body-data
             collect
             (list (car data) (apply #'concatenate 'vector (mapcar #'cadr (cdr data))))))
      (append main-data body-data))))


#|
(time
(format-situation-data-vector (cadr (search-situations)) ))
(vectorize-lol-dim (cadr (search-situations)) )
(loldescribe (cadr (search-situations)) )

(format-situation-data-vector (cadr (search-situations)) )
(format-situation-data-vector (car (search-situations)) :code t )

(setf f1005-1V nil)
(mapcar #'(lambda (x) (list (read-from-string (name x))
                            (format-situation-data-vector x :code t)))
           (search-situations))
)

|#