(in-package "CL-USER")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;        name:   tolglue
;;;;     version:   1.2
;;;;        date:   8.1.2001
;;;;
;;;;      author:   sashank varma
;;;;       email:   sashank@vuse.vanderbilt.edu
;;;; organization:  center for cognitive brain imaging (ccbi)
;;;;                carnegie mellon university
;;;;
;;;; bugs:
;;;;
;;;; history:
;;;;
;;;; 6.4.2001 sv: (v0.1) wrote the initial version during the entire month.
;;;;                contains top-level commands to automate the simulation
;;;;                of individual TOL problems as well as the entire sets of
;;;;                problems used in the old and new studies.
;;;;
;;;; 8.1.2001 sv: (v1.0) froze the version used to generate the model's fit
;;;;                to "old" (reichle-collected data) which has been written
;;;;                up.  this file also contains functions pertaining to the
;;;;                problems of the new study.
;;;;
;;;;^^^^ Changed SIM to make use of the new MAP-CENTERS and CENTER-RESET
;;;;^^^^ functions, which just reflect the new naming convention.
;;;;
;;;;^^^^ Upped the number of cycles run by SIM from 60 to 100 to allow
;;;;^^^^ completion of all the problems from the "new" experiment.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;;
;;;


;;

(defun sim (start-state-num end-state-num &key preserve-history-p
                                               suppress-tracing-p)
  (let ((old-tracing-p (tracing-p)))
    (impl-set-tracing-p (not suppress-tracing-p))
    (unless suppress-tracing-p
      (format t "~2%Solve TOL problem with start state ~A and end state ~A.~1%"
              start-state-num end-state-num))
    (cond (preserve-history-p
           (setq *dm* nil)
           (setq *dme-counter* 0)
           (setq *modifies* nil)
           (setq *spews* nil)

           ;;^^ Changed from -COMPS and COMP- to be consistent with the new
           ;;^^ 4caps naming conventions.
           (map-centers #'center-reset))
          (t
           (reset)))
    (let ((start-state (get-state start-state-num))
          (end-state (get-state end-state-num))
          (start-pockets (make-pockets))
          (end-pockets (make-pockets)))
      (dolist (pocket-name *pocket-names*)
        (let ((col (position pocket-name *pocket-names*))
              (depth (cdr (assoc pocket-name *pocket-depths*))))
          (dotimes (row depth)
            (setf (aref start-pockets row col)
                  (aref (slot-value start-state pocket-name) row))
            (setf (aref end-pockets row col)
                  (aref (slot-value end-state pocket-name) row)))))
      (initialize-model)
      (spew t (puzzle :contents start-pockets)
            1.0)
      (spew t (end-puzzle :contents end-pockets)
            1.0))
    (run 100)
    (impl-set-tracing-p old-tracing-p))
  (unless suppress-tracing-p
    (dm))
  (if (find (contents (first (dme-list '(end-puzzle)))) (dme-list '(puzzle))
            :test #'internal-pockets-equal
            :key #'contents)
    (values 'succ (1- (length (dme-list '(puzzle)))))
    'fail))

(defun sims (problems moves blocked)
  (setq *macro-cycs* 0)
  (init-act-history)
  (init-segment-history)
  (format t "~&START~AEND~ARESULT~AMIN?~AMINMOV~AMODMOV~ABLOPOS~ACYCS"
          #\tab #\tab #\tab #\tab #\tab #\tab #\tab)
  (let ((successes 0)
        (min-successes 0)
        (failures 0))
    (mapc #'(lambda (problem)
              (let ((start-state-num (first problem))
                    (end-state-num (second problem))
                    (num-moves (third problem))
                    (num-blocked (fourth problem)))
                (when (or (and (not moves)
                               (not blocked))
                          (and moves
                               (not blocked)
                               (if (numberp moves)
                                 (= num-moves moves)
                                 (member num-moves moves)))
                          (and (not moves)
                               blocked
                               (if (numberp blocked)
                                 (eql num-blocked blocked)
                                 (member num-blocked blocked)))
                          (and moves
                               blocked
                               (if (numberp moves)
                                 (= num-moves moves)
                                 (member num-moves moves))
                               (if (numberp blocked)
                                 (eql num-blocked blocked)
                                 (member num-blocked blocked))))
                  (let* ((start-mcyc *macro-cycs*)
                         (model-response (or (ignore-errors
                                              (sim start-state-num end-state-num
                                                   :preserve-history-p t
                                                   :suppress-tracing-p t
                                                   ))
                                             'fail))
                         (mod-moves (1- (length (dme-list '(puzzle))))))
                    (if (eq model-response 'succ)
                      (incf successes)
                      (incf failures))
                    (format t "~%~A~A~A~A~A~A"
                              start-state-num #\tab
                              end-state-num #\tab
                              model-response #\tab)
                    (when (eq model-response 'succ)
                      (let ((min-success-p (= num-moves mod-moves)))
                        (format t "~A" min-success-p)
                        (when min-success-p
                          (incf min-successes))))
                    (format t "~A~A~A~A~A~A~A~A"
                              #\tab num-moves
                              #\tab mod-moves
                              #\tab (or num-blocked '?)
                              #\tab (- *macro-cycs* start-mcyc))))))
          problems)
    (cond ((and (zerop successes) (zerop failures))
           (format t "~%No simulations run."))
          (t
           (format t "~%Minimum Successes: ~A" min-successes)
           (format t "~%Total Successes:   ~A" successes)
           (format t "~%Failures:          ~A" failures)
           (format t "~%Avg Macrocycles:   ~,2F" (/ *macro-cycs*
                                                    (+ successes failures))))))
  (values))



;;;
;;;
;;;

;;

(defparameter *old-problems* '((29	33	1)
                               (6	4	1)
                               (7	8	1)
                               (32	28	1)
                               (9	3	1)
                               (5	11	1)
                               (8	17	1)
                               (20	16	1)
                               (26	27	1)
                               (31	30	1)
                               (21	22	1)
                               (16	20	1)
                               (19	18	1)
                               (11	14	1)
                               (33	29	1)
                               (23	22	1)
                               (14	15	1)
                               (22	21	1)
                               (1	17	2)
                               (36	34	2)
                               (3	5	2)
                               (28	11	2)
                               (24	22	2)
                               (34	32	2)
                               (17	2	2)
                               (4	11	2)
                               (25	18	2)
                               (30	23	2)
                               (35	29	3)
                               (2	18	3)
                               (27	24	3)
                               (10	6	3)
                               (15	31	3)
                               (13	5	3)
                               (18	2	3)
                               (12	3	3)
                               (27	35	4)
                               (31	12	4)
                               (14	6	4)
                               (7	1	4)
                               (3	13	4)
                               (5	35	4)
                               (2	19	4)
                               (12	31	4)
                               (33	10	5)
                               (25	28	5)
                               (1	23	5)
                               (20	10	5)
                               (36	1	6)
                               (11	18	6)
                               (24	2	6)
                               (4	25	6)
                               ))

(defun old-sims (&key moves blocked)
  (sims *old-problems* moves blocked))


;;

(defparameter *new-problems* '((5	1	4	0)
                               (9	15	4	0)
                               (18	24	4	0)
                               (21	7	4	0)
                               (31	13	4	0)
                               (34	26	4	0)
                               (3	13	4	1)
                               (4	13	4	1)
                               (27	17	4	4)
                               (28	4	4	4)
                               (29	20	4	4)
                               (31	11	4	4)
                               (32	25	4	4)
                               (33	12	4	4)
                               (34	22	4	4)
                               (36	3	4	4)
                               (2	13	5	3)
                               (6	15	5	3)
                               (8	26	5	3)
                               (12	1	5	3)
                               (14	7	5	3)
                               (16	24	5	3)
                               (23	1	5	3)
                               (25	7	5	3)
                               (4	19	5	7)
                               (19	32	5	7)
                               (20	10	5	7)
                               (25	6	5	7)
                               (28	25	5	7)
                               (29	12	5	7)
                               (32	4	5	7)
                               (33	20	5	7)
                               (2	24	6	5)
                               (6	26	6	5)
                               (8	15	6	5)
                               (12	24	6	5)
                               (16	13	6	5)
                               (25	15	6	5)
                               (29	1	6	5)
                               (36	1	6	5)
                               (18	32	6	9)
                               (2	29	6	9)
                               (5	19	6	9)
                               (14	25	6	9)
                               (21	10	6	9)
                               (23	12	6	9)
                               (27	6	6	9)
                               (34	20	6	9)
                               (3	24	7	6)
                               (17	15	7	6)
                               (25	11	7	11)

                               ; model current fails to optimally solve this.
                               (33	3	7	11)

                               ))

(defun new-sims (&key moves blocked)
  (sims *new-problems* moves blocked))


;;

(defun all-sims (&key moves blocked)
  (old-sims :moves moves :blocked blocked)
  (new-sims :moves moves :blocked blocked))


;;

(defun fig-old-sims ()
  (old-sims :moves 1)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg)
  (old-sims :moves 2)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg)
  (old-sims :moves 3)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg)
  (old-sims :moves 4)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg)
  (old-sims :moves 5)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg)
  (old-sims :moves 6)
  (history@ (lh-executive rh-executive
             lh-spatial rh-spatial)
            :measure prop
            :combination avg))

(defun fig-new-sims (&optional by-blocked-p)
  (cond (by-blocked-p
         (new-sims :moves 4 :blocked '(0 1))
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 4 :blocked 4)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 5 :blocked 3)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 5 :blocked 7)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 6 :blocked 5)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 6 :blocked 9)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 7 :blocked 6)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 7 :blocked 11)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg))
        (t
         (new-sims :moves 4)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 5)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 6)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)
         (new-sims :moves 7)
         (history@ (lh-executive rh-executive
                                 lh-spatial rh-spatial)
                   :measure prop
                   :combination avg)))
  (values))


;;

(defun dme-old-sims ()
  (old-sims :moves 1)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (old-sims :moves 2)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (old-sims :moves 3)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (old-sims :moves 4)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (old-sims :moves 5)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (old-sims :moves 6)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg))

(defun dme-new-sims ()
  (new-sims :moves 4)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (new-sims :moves 5)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (new-sims :moves 6)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg)
  (new-sims :moves 7)
  (history@ ()
            :dmes (puzzle-mixin
                   preference
                   preferred-move
                   goal
                   solve-puzzle-goal
                   unblock-goal
                   unblock-ball-goal
                   unblock-pocket-goal
                   move
                   direct-move
                   indirect-move
                   unblock-ball-move
                   unblock-pocket-move*
                   unblock-pocket-move
                   buffer-unblock-pocket-move)
            :measure prop
            :combination avg))