;;; ---------------------------------------------------------------------------
;;
;; Clock Time Naming task
;;
;; Hedderik van Rijn, 080418 
;;
;; This file contains an implementation of the clock time naming model
;; described in Sprenger & Van Rijn (submitted) Thinking for Speaking:
;; A Dual-Route Model of Clock Time Naming
;;
;; The typical behaviors of the model can be explored by inspecting
;; the following runs:
;;
;;   (do-trial 24) (do-trial 15) (do-trial 10)
;;
;; These runs most probably show the "three distinct" behaviors, that is:
;;
;; 24: calcultation of proper utterance: "zes voor half"
;; 15: retrieval of superlemma, utterance based on superlemma: "kwart over"
;; 10: retrieval of superlemma, but calculation is finished earlier: "tien over"
;;
;; How to run this code:
;; - load ACT-R
;; - install the lexical module, e.g., (load "lexical.lisp")
;; - load this file
;; - run experiment: (one-exp "outputfile.dat")
;;
;; This call will run 10 times all 60 minute terms, and save the model
;; outcomes in the specified ouput file.
;;
;; ---------------------------------------------------------------------------

(defun one-exp (file)
  (trace-off)
  (setf *starting-seed* (no-output (sgp :seed)))
  (do-sets 10)
  (write-results file) ;; save results to model-results.txt file
)

(defun write-results-line (result filehandle)
  (format filehandle "~A ~A ~A ~A~%" 
	  (response-hour result)
	  (response-min result)
	  (response-resptime result)
	  (response-method result)))

(defun write-results (filename)
  (with-open-file (filehandle filename
			      :direction :OUTPUT
			      :if-exists :RENAME
			      :if-does-not-exist :CREATE)
    (format filehandle ";; seed: ~A~%" *starting-seed*)
    (format filehandle "hour min rt method~%")
    (mapcar (lambda (result) (write-results-line result filehandle)) *results* )))

;;; ===========================================================================

(clear-all)

(defvar *results* nil)

(defvar *min* "00")
(defvar *hour* nil)
(defvar *start-time* nil)
(defvar *method* nil)

(defvar *exp-list* nil)

(defvar *visible* nil)
(defvar *audible* nil)

;; Show clock time in experiment window
(defun display-time (hour min) 
  (clear-exp-window)
  (add-text-to-exp-window :text (format nil "~A:~A" hour min) :x 150 :y 125)
  (setf *start-time* (get-time))
  (proc-display)
  )

;; Show fixation point in experiment window
(defun display-fixation ()
  (clear-exp-window)
  (add-text-to-exp-window :text "+" :x 160 :y 125)
  (proc-display)
  )

;; Clear experiment window
(defun prepare-for-next-trial ()
  (clear-exp-window)
  (proc-display)
  (pop *exp-list*)
  (when *exp-list*
    (schedule-event-relative 3 'setup-trial))
  )

;; Prepare everything for the experimental presentation.
(defun setup-trial ()
  (setf *min* (first *exp-list*))
  (setf *hour* (format nil "~d" (1+ (act-r-random 9))))
    
  (install-device (open-exp-window "Clock Time Naming" :visible *visible*))

  ;; Start of experimental trial
  (display-fixation)

  ;; Schedule onset of clock time display; start time is set in display-time
  (schedule-event-relative .5 'display-time :params (list *hour* *min*))

  (proc-display :clear t))

;; Do a single trial, "human visible and audible".
(defun do-trial (min &optional (runtime 5))
  (setf *exp-list* (list (format nil "~02d" min)))
  (setf *audible* t)
  (setf *visible* t)
  (setup-trial)
  (run runtime :real-time t))
  
;; Present all 60 minutes.
(defun do-set (reset)
  (if t
    (setq *exp-list* (permute-list '("00" "01" "02" "03" "04" "05" "06" "07" "08" "09" 
				     "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" 
				     "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" 
				     "30" "31" "32" "33" "34" "35" "36" "37" "38" "39" 
				     "40" "41" "42" "43" "44" "45" "46" "47" "48" "49" 
				     "50" "51" "52" "53" "54" "55" "56" "57" "58" "59")))
    (setf *exp-list* '("30" "24" "54")))

  (when reset
    (setf *results* nil))

  (setup-trial)
  (setf *audible* nil)
  (setf *visible* nil)
  (run 3000 :real-time nil))

(defun do-sets (num &optional (reset t))
  (do-set reset)
  (decf num)
  (if (> num 0)
      (do-sets num nil)))

;; Hook to show the production rule's name in the Notes window.
(defun note-production-names (x)
  (when (eq (evt-action x) 'production-fired)
    (add-buffer-trace-notes 'production
			    (princ-to-string (production-name (car (evt-params x)))))))
(add-pre-event-hook 'note-production-names)

;; Voice-key hook
(defstruct response hour min resptime method)

(defun voice-key (x)
  ;; -450: After issuing the "+speech", it takes another 450 ms before
  ;; the sound buffer is stuffed. However, the "is" could have
  ;; completely be prepared, and the preparations for the minute
  ;; utterence will have started during the processing of the hour.
  ;; So, assume that no delay is necessary, and subtract 450 from the
  ;; estimated time.

  ;; -100: Now, it is assumed that the eyes first need to focus on the
  ;; minutes term, whereis it seems more likely that the participants
  ;; learns to focus directly on the minute term. So, subtract the 100
  ;; ms associated with this move of attention.
  (when (eq (evt-action x) 'stuff-sound-buffer)
    (progn
      (push (make-response :hour *hour* 
			   :min *min* 
			   :resptime (- (get-time) *start-time* 450 100)
			   :method *method*) *results*))
    (prepare-for-next-trial)))

(add-pre-event-hook 'voice-key)

;; And for fun:

(defmethod device-speak-string ((win rpm-window) text)
;;  (when *audible* 
;;    (progn
;;      (system:run-shell-command (format nil "say ~A" text) :wait nil)))
  )


(defun sji-hook-function (chunk1 chunk2)
  (when (eq (chunk-chunk-type-fct chunk2) 'comparison)
    (let ((source (parse-integer *min*))
	  (cur (parse-integer (chunk-slot-value-fct chunk2 'minute))))
      (format t "---> ~D :: ~D  : ~D~%" source cur (- source cur)))))

(defun bl-hook-function (chunk)
  (let ((power1 2) (power2 2) (power3 2) (power4 5)
	(maxact1 3.5) (maxact2 2.5) (maxact3 8) (maxact4 10)
	(minute (parse-integer *min*)))
    (if (eq (chunk-chunk-type-fct chunk) 'comparison)
	;;; Distance effect + encoding correct formula
	(if (<= minute 20)
	    (+ (/ (expt (- 20 minute) power1) (/ (expt 20 power1) maxact1))  .5)
	  (if (<= minute 30)
	      (let ((curmin (- minute 20)))
		(+ (/ (expt curmin power2) (/ (expt 10 power2) maxact2)) 1))
	    (if (<= minute 40)
		(let ((curmin (- 40 minute)))
		  (+ (/ (expt curmin power3) (/ (expt 10 power3) maxact3)) 1))
	      (let ((curmin (- minute 40)))
		  (+ (/ (expt curmin power4) (/ (expt 20 power4) maxact4)) 1)))))
      nil)))

;;; ============================================================================

(defun matching-symbols (test symbols)
  "Return a list containing those symbols whose names start with test"
  (cond
   ((null symbols) nil)
   ((eq (search test (symbol-name (first symbols))) 0)
    (cons (first symbols) (matching-symbols test (rest symbols))))
   (t (matching-symbols test (rest symbols)))))

(defun trace-off () 
  (sgp :save-buffer-trace nil)
  (sgp :v nil))

(defun trace-on () 
  (sgp :save-buffer-trace t)
  (sgp :v t))


(define-model ctn
    
;;; -[Set Global Parameters]------------------------------------------

(sgp :v t 				     ;; Verbose 
     :show-focus nil 			     ;; Visual indication of visual focus?
     :needs-mouse nil 			     ;; Is mouse input required?
     :trace-detail low			     ;; Trace level
     :save-buffer-trace t		     ;; Store info for visual tracing
     :traced-buffers (PRODUCTION IMAGINAL RETRIEVAL LEXICAL VISUAL VISUAL-LOCATION VOCAL AURAL-LOCATION)
     :buffer-trace nil			     ;; Vertical ASCII graphical trace
     :egs 1				     ;; Expected Gain/Utility Noise
     :ul t				     ;; Turn on utility learning
     :esc t				     ;; Enable Subsymbolic Computations
     :bll .5				     ;; Base level learning: d=.5
     :ans .2				     ;; Activation noise
     :lf .3				     ;; Latency multiplier
     :seed (12537410 0)			     ;; Random seed
     :bl-hook bl-hook-function		     ;; to determine activation (-> latency) of reference points based on distance
     :rt -3				     ;; Retrieval treshold 
)

;;; -[chunk types]----------------------------------------------------

(chunk-type ctn filler)
(chunk-type focus-on-fixation)
(chunk-type ctn-task minute hour reference rel-minute rel-hour superlemma state)

;;; -[DM chunks]------------------------------------------------------

(add-dm
 (fixation isa focus-on-fixation)
 (perceiving-minutes isa chunk)
 (start-minutes isa chunk)
 (process-minutes isa chunk)
 (process-hour isa chunk)
 (to-enable-spreading-activation isa chunk)
)

;;; -[Clock Time Naming facts]----------------------------------------


;;; -[Time Reference]-------------------------------------------------

(chunk-type comparison minute reference)
(chunk-type ref-chunk)

(add-dm
  (ref-full isa ref-chunk)		     ; :00
  (ref-prev-full isa ref-chunk)		     ; :01 - :19
  (ref-next-half isa ref-chunk)		     ; :20 - :29
  (ref-half isa ref-chunk)		     ; :30
  (ref-prev-half isa ref-chunk)		     ; :31 - :40
  (ref-next-full isa ref-chunk)		     ; :41 - :59

 (comp0 isa comparison minute "00" reference ref-full)
 (comp1 isa comparison minute "01" reference ref-prev-full)
 (comp2 isa comparison minute "02" reference ref-prev-full)
 (comp3 isa comparison minute "03" reference ref-prev-full)
 (comp4 isa comparison minute "04" reference ref-prev-full)
 (comp5 isa comparison minute "05" reference ref-prev-full)
 (comp6 isa comparison minute "06" reference ref-prev-full)
 (comp7 isa comparison minute "07" reference ref-prev-full)
 (comp8 isa comparison minute "08" reference ref-prev-full)
 (comp9 isa comparison minute "09" reference ref-prev-full)

 (comp10 isa comparison minute "10" reference ref-prev-full)
 (comp11 isa comparison minute "11" reference ref-prev-full)
 (comp12 isa comparison minute "12" reference ref-prev-full)
 (comp13 isa comparison minute "13" reference ref-prev-full)
 (comp14 isa comparison minute "14" reference ref-prev-full)
 (comp15 isa comparison minute "15" reference ref-prev-full)
 (comp16 isa comparison minute "16" reference ref-prev-full)
 (comp17 isa comparison minute "17" reference ref-prev-full)
 (comp18 isa comparison minute "18" reference ref-prev-full)
 (comp19 isa comparison minute "19" reference ref-prev-full)

 (comp20 isa comparison minute "20" reference ref-next-half)
 (comp21 isa comparison minute "21" reference ref-next-half)
 (comp22 isa comparison minute "22" reference ref-next-half)
 (comp23 isa comparison minute "23" reference ref-next-half)
 (comp24 isa comparison minute "24" reference ref-next-half)
 (comp25 isa comparison minute "25" reference ref-next-half)
 (comp26 isa comparison minute "26" reference ref-next-half)
 (comp27 isa comparison minute "27" reference ref-next-half)
 (comp28 isa comparison minute "28" reference ref-next-half)
 (comp29 isa comparison minute "29" reference ref-next-half)

 (comp30 isa comparison minute "30" reference ref-half)

 (comp31 isa comparison minute "31" reference ref-prev-half)
 (comp32 isa comparison minute "32" reference ref-prev-half)
 (comp33 isa comparison minute "33" reference ref-prev-half)
 (comp34 isa comparison minute "34" reference ref-prev-half)
 (comp35 isa comparison minute "35" reference ref-prev-half)
 (comp36 isa comparison minute "36" reference ref-prev-half)
 (comp37 isa comparison minute "37" reference ref-prev-half)
 (comp38 isa comparison minute "38" reference ref-prev-half)
 (comp39 isa comparison minute "39" reference ref-prev-half)
 (comp40 isa comparison minute "40" reference ref-prev-half)

 (comp41 isa comparison minute "41" reference ref-next-full)
 (comp42 isa comparison minute "42" reference ref-next-full)
 (comp43 isa comparison minute "43" reference ref-next-full)
 (comp44 isa comparison minute "44" reference ref-next-full)
 (comp45 isa comparison minute "45" reference ref-next-full)
 (comp46 isa comparison minute "46" reference ref-next-full)
 (comp47 isa comparison minute "47" reference ref-next-full)
 (comp48 isa comparison minute "48" reference ref-next-full)
 (comp49 isa comparison minute "49" reference ref-next-full)


 (comp50 isa comparison minute "50" reference ref-next-full)
 (comp51 isa comparison minute "51" reference ref-next-full)
 (comp52 isa comparison minute "52" reference ref-next-full)
 (comp53 isa comparison minute "53" reference ref-next-full)
 (comp54 isa comparison minute "54" reference ref-next-full)
 (comp55 isa comparison minute "55" reference ref-next-full)
 (comp56 isa comparison minute "56" reference ref-next-full)
 (comp57 isa comparison minute "57" reference ref-next-full)
 (comp58 isa comparison minute "58" reference ref-next-full)
 (comp59 isa comparison minute "59" reference ref-next-full)
)

(set-all-base-levels 100000 -1000)

;;; -[Clock Arithmetic Facts]-----------------------------------------

(chunk-type add-fact add1 add2 sum)

(add-dm
 ;; Hours
 (add1-2 isa add-fact add1 "1" add2 "1" sum "2")
 (add2-3 isa add-fact add1 "2" add2 "1" sum "3")
 (add3-4 isa add-fact add1 "3" add2 "1" sum "4")
 (add4-5 isa add-fact add1 "4" add2 "1" sum "5")
 (add5-6 isa add-fact add1 "5" add2 "1" sum "6")
 (add6-7 isa add-fact add1 "6" add2 "1" sum "7")
 (add7-8 isa add-fact add1 "7" add2 "1" sum "8")
 (add8-9 isa add-fact add1 "8" add2 "1" sum "9")
 (add9-10 isa add-fact add1 "9" add2 "1" sum "10")

 ;; Minutes from full
 (add0-1 isa add-fact add1 "01" add2 "0" sum "1")
 (add0-2 isa add-fact add1 "02" add2 "0" sum "2")
 (add0-3 isa add-fact add1 "03" add2 "0" sum "3")
 (add0-4 isa add-fact add1 "04" add2 "0" sum "4")
 (add0-5 isa add-fact add1 "05" add2 "0" sum "5")
 (add0-6 isa add-fact add1 "06" add2 "0" sum "6")
 (add0-7 isa add-fact add1 "07" add2 "0" sum "7")
 (add0-8 isa add-fact add1 "08" add2 "0" sum "8")
 (add0-9 isa add-fact add1 "09" add2 "0" sum "9")
 (add0-10 isa add-fact add1 "10" add2 "0" sum "10")
 (add0-11 isa add-fact add1 "11" add2 "0" sum "11")
 (add0-12 isa add-fact add1 "12" add2 "0" sum "12")
 (add0-13 isa add-fact add1 "13" add2 "0" sum "13")
 (add0-14 isa add-fact add1 "14" add2 "0" sum "14")

 (add0-16 isa add-fact add1 "16" add2 "0" sum "16")
 (add0-17 isa add-fact add1 "17" add2 "0" sum "17")
 (add0-18 isa add-fact add1 "18" add2 "0" sum "18")
 (add0-19 isa add-fact add1 "19" add2 "0" sum "19")

 ;; Minutes to half
 (add20-30 isa add-fact add1 "20" add2 "10" sum "30")
 (add21-30 isa add-fact add1 "21" add2 "9" sum "30")
 (add22-30 isa add-fact add1 "22" add2 "8" sum "30")
 (add23-30 isa add-fact add1 "23" add2 "7" sum "30")
 (add24-30 isa add-fact add1 "24" add2 "6" sum "30")
 (add25-30 isa add-fact add1 "25" add2 "5" sum "30")
 (add26-30 isa add-fact add1 "26" add2 "4" sum "30")
 (add27-30 isa add-fact add1 "27" add2 "3" sum "30")
 (add28-30 isa add-fact add1 "28" add2 "2" sum "30")
 (add29-30 isa add-fact add1 "29" add2 "1" sum "30")
;; (add30-30 isa add-fact add1 "30" add2 "0" sum "30")

 ;; Minutes from half
 (add30-31 isa add-fact add1 "30" add2 "1" sum "31")
 (add30-32 isa add-fact add1 "30" add2 "2" sum "32")
 (add30-33 isa add-fact add1 "30" add2 "3" sum "33")
 (add30-34 isa add-fact add1 "30" add2 "4" sum "34")
 (add30-35 isa add-fact add1 "30" add2 "5" sum "35")
 (add30-36 isa add-fact add1 "30" add2 "6" sum "36")
 (add30-37 isa add-fact add1 "30" add2 "7" sum "37")
 (add30-38 isa add-fact add1 "30" add2 "8" sum "38")
 (add30-39 isa add-fact add1 "30" add2 "9" sum "39")
 (add30-40 isa add-fact add1 "30" add2 "10" sum "40")

 ;; Minutes to full
 (add40-60 isa add-fact add1 "40" add2 "20" sum "60")
 (add41-60 isa add-fact add1 "41" add2 "19" sum "60")
 (add42-60 isa add-fact add1 "42" add2 "18" sum "60")
 (add43-60 isa add-fact add1 "43" add2 "17" sum "60")
 (add44-60 isa add-fact add1 "44" add2 "16" sum "60")
 (add45-60 isa add-fact add1 "45" add2 "15" sum "60")
 (add46-60 isa add-fact add1 "46" add2 "14" sum "60")
 (add47-60 isa add-fact add1 "47" add2 "13" sum "60")
 (add48-60 isa add-fact add1 "48" add2 "12" sum "60")
 (add49-60 isa add-fact add1 "49" add2 "11" sum "60")
 (add50-60 isa add-fact add1 "50" add2 "10" sum "60")
 (add51-60 isa add-fact add1 "51" add2 "9" sum "60")
 (add52-60 isa add-fact add1 "52" add2 "8" sum "60")
 (add53-60 isa add-fact add1 "53" add2 "7" sum "60")
 (add54-60 isa add-fact add1 "54" add2 "6" sum "60")
 (add55-60 isa add-fact add1 "55" add2 "5" sum "60")
 (add56-60 isa add-fact add1 "56" add2 "4" sum "60")
 (add57-60 isa add-fact add1 "57" add2 "3" sum "60")
 (add58-60 isa add-fact add1 "58" add2 "2" sum "60")
 (add59-60 isa add-fact add1 "59" add2 "1" sum "60")
)

(sdp add1-2 :creation-time -100000 :reference-count 5000)
(sdp add2-3  :creation-time -100000 :reference-count 5000)
(sdp add3-4  :creation-time -100000 :reference-count 5000)
(sdp add4-5  :creation-time -100000 :reference-count 5000)
(sdp add5-6  :creation-time -100000 :reference-count 5000)
(sdp add6-7  :creation-time -100000 :reference-count 5000)
(sdp add7-8  :creation-time -100000 :reference-count 5000)
(sdp add8-9  :creation-time -100000 :reference-count 5000)
(sdp add9-10 :creation-time -100000 :reference-count 5000)

;; file automatically generated by calc-frequencies.r

(sdp add0-1 :creation-time -100000 :reference-count 398)
(sdp add0-2 :creation-time -100000 :reference-count 413)
(sdp add0-3 :creation-time -100000 :reference-count 430)
(sdp add0-4 :creation-time -100000 :reference-count 412)
(sdp add0-5 :creation-time -100000 :reference-count 433)
(sdp add0-6 :creation-time -100000 :reference-count 405)
(sdp add0-7 :creation-time -100000 :reference-count 422)
(sdp add0-8 :creation-time -100000 :reference-count 402)
(sdp add0-9 :creation-time -100000 :reference-count 399)
(sdp add0-10 :creation-time -100000 :reference-count 410)
(sdp add0-11 :creation-time -100000 :reference-count 385)
(sdp add0-12 :creation-time -100000 :reference-count 409)
(sdp add0-13 :creation-time -100000 :reference-count 390)
(sdp add0-14 :creation-time -100000 :reference-count 386)
(sdp add0-16 :creation-time -100000 :reference-count 374)
(sdp add0-17 :creation-time -100000 :reference-count 377)
(sdp add0-18 :creation-time -100000 :reference-count 375)
(sdp add0-19 :creation-time -100000 :reference-count 344)
(sdp add20-30 :creation-time -100000 :reference-count 324)
(sdp add21-30 :creation-time -100000 :reference-count 214)
(sdp add22-30 :creation-time -100000 :reference-count 227)
(sdp add23-30 :creation-time -100000 :reference-count 212)
(sdp add24-30 :creation-time -100000 :reference-count 232)
(sdp add25-30 :creation-time -100000 :reference-count 263)
(sdp add26-30 :creation-time -100000 :reference-count 226)
(sdp add27-30 :creation-time -100000 :reference-count 267)
(sdp add28-30 :creation-time -100000 :reference-count 263)
(sdp add29-30 :creation-time -100000 :reference-count 233)
(sdp add30-31 :creation-time -100000 :reference-count 242)
(sdp add30-32 :creation-time -100000 :reference-count 250)
(sdp add30-33 :creation-time -100000 :reference-count 268)
(sdp add30-34 :creation-time -100000 :reference-count 232)
(sdp add30-35 :creation-time -100000 :reference-count 243)
(sdp add30-36 :creation-time -100000 :reference-count 229)
(sdp add30-37 :creation-time -100000 :reference-count 246)
(sdp add30-38 :creation-time -100000 :reference-count 250)
(sdp add30-39 :creation-time -100000 :reference-count 232)
(sdp add30-40 :creation-time -100000 :reference-count 315)
(sdp add41-60 :creation-time -100000 :reference-count 172)
(sdp add42-60 :creation-time -100000 :reference-count 180)
(sdp add43-60 :creation-time -100000 :reference-count 179)
(sdp add44-60 :creation-time -100000 :reference-count 173)
(sdp add46-60 :creation-time -100000 :reference-count 171)
(sdp add47-60 :creation-time -100000 :reference-count 195)
(sdp add48-60 :creation-time -100000 :reference-count 198)
(sdp add49-60 :creation-time -100000 :reference-count 184)
(sdp add50-60 :creation-time -100000 :reference-count 314)
(sdp add51-60 :creation-time -100000 :reference-count 220)
(sdp add52-60 :creation-time -100000 :reference-count 230)
(sdp add53-60 :creation-time -100000 :reference-count 209)
(sdp add54-60 :creation-time -100000 :reference-count 217)
(sdp add55-60 :creation-time -100000 :reference-count 264)
(sdp add56-60 :creation-time -100000 :reference-count 233)
(sdp add57-60 :creation-time -100000 :reference-count 261)
(sdp add58-60 :creation-time -100000 :reference-count 251)
(sdp add59-60 :creation-time -100000 :reference-count 256)

;; Mental lexicon for the Clock Time Naming task

;; Frequencies derived from hand-checked Google queries

(add-dm
 (lemma0 isa lexicon-entry concept "00" lemma "X uur" frequency 4758.5775 reference ref-full)
 (lemma1 isa lexicon-entry concept "01" lemma "een over" frequency 8.18 reference ref-prev-full)
 (lemma2 isa lexicon-entry concept "02" lemma "twee over" frequency 24.15 reference ref-prev-full)
 (lemma3 isa lexicon-entry concept "03" lemma "drie over" frequency 23.52 reference ref-prev-full)
 (lemma4 isa lexicon-entry concept "04" lemma "vier over" frequency 15.24 reference ref-prev-full)
 (lemma5 isa lexicon-entry concept "05" lemma "vijf over" frequency 421.88 reference ref-prev-full)
 (lemma6 isa lexicon-entry concept "06" lemma "zes over" frequency 62.66 reference ref-prev-full)
 (lemma7 isa lexicon-entry concept "07" lemma "zeven over" frequency 78.3 reference ref-prev-full)
 (lemma8 isa lexicon-entry concept "08" lemma "acht over" frequency 35.77 reference ref-prev-full)
 (lemma9 isa lexicon-entry concept "09" lemma "negen over" frequency 40.6 reference ref-prev-full)
 (lemma10 isa lexicon-entry concept "10" lemma "tien over" frequency 632.79 reference ref-prev-full)
 (lemma11 isa lexicon-entry concept "11" lemma "elf over" frequency 73.64 reference ref-prev-full)
 (lemma12 isa lexicon-entry concept "12" lemma "twaalf over" frequency 41.04 reference ref-prev-full)
 (lemma13 isa lexicon-entry concept "13" lemma "dertien over" frequency 35.35 reference ref-prev-full)
 (lemma14 isa lexicon-entry concept "14" lemma "veertien over" frequency 13.8 reference ref-prev-full)
 (lemma15 isa lexicon-entry concept "15" lemma "kwart over" frequency 808.01 reference ref-prev-full)
 (lemma16 isa lexicon-entry concept "16" lemma "zestien over" frequency 10.56 reference ref-prev-full)
 (lemma17 isa lexicon-entry concept "17" lemma "zeventien over" frequency 12.35 reference ref-prev-full)
 (lemma18 isa lexicon-entry concept "18" lemma "achtien over" frequency 9.36 reference ref-prev-full)
 (lemma19 isa lexicon-entry concept "19" lemma "negentien over" frequency 2.48 reference ref-prev-full)
; (lemma20 isa lexicon-entry concept "20" lemma "twintig over" frequency 440.82 reference ref-prev-full)

 (lemma16b isa lexicon-entry concept "16" lemma "veertien voor half" frequency 0 reference ref-next-half)
 (lemma17b isa lexicon-entry concept "17" lemma "dertien voor half" frequency 0.04 reference ref-next-half)
 (lemma18b isa lexicon-entry concept "18" lemma "twaalf voor half" frequency 0.04 reference ref-next-half)
 (lemma19b isa lexicon-entry concept "19" lemma "elf voor half" frequency 0.06 reference ref-next-half)
 (lemma20b isa lexicon-entry concept "20" lemma "tien voor half" frequency 681.91 reference ref-next-half)

 (lemma21 isa lexicon-entry concept "21" lemma "negen voor half" frequency 1.2 reference ref-next-half)
 (lemma22 isa lexicon-entry concept "22" lemma "acht voor half" frequency 1.1 reference ref-next-half)
 (lemma23 isa lexicon-entry concept "23" lemma "zeven voor half" frequency 3.24 reference ref-next-half)
 (lemma24 isa lexicon-entry concept "24" lemma "zes voor half" frequency 0.16 reference ref-next-half)
 (lemma25 isa lexicon-entry concept "25" lemma "vijf voor half" frequency 478.08 reference ref-next-half)
 (lemma26 isa lexicon-entry concept "26" lemma "vier voor half" frequency 1 reference ref-next-half)
 (lemma27 isa lexicon-entry concept "27" lemma "drie voor half" frequency 3.8 reference ref-next-half)
 (lemma28 isa lexicon-entry concept "28" lemma "twee voor half" frequency 2.4 reference ref-next-half)
 (lemma29 isa lexicon-entry concept "29" lemma "een voor half" frequency 0.33 reference ref-next-half)
 (lemma30 isa lexicon-entry concept "30" lemma "half" frequency 9689.255625 reference ref-half)
 (lemma31 isa lexicon-entry concept "31" lemma "een over half" frequency 1.1 reference ref-prev-half)
 (lemma32 isa lexicon-entry concept "32" lemma "twee over half" frequency 1.96 reference ref-prev-half)
 (lemma33 isa lexicon-entry concept "33" lemma "drie over half" frequency 2.89 reference ref-prev-half)
 (lemma34 isa lexicon-entry concept "34" lemma "vier over half" frequency 0.64 reference ref-prev-half)
 (lemma35 isa lexicon-entry concept "35" lemma "vijf over half" frequency 332.22 reference ref-prev-half)
 (lemma36 isa lexicon-entry concept "36" lemma "zes over half" frequency 4 reference ref-prev-half)
 (lemma37 isa lexicon-entry concept "37" lemma "zeven over half" frequency 14.04 reference ref-prev-half)
 (lemma38 isa lexicon-entry concept "38" lemma "acht over half" frequency 1.96 reference ref-prev-half)
 (lemma39 isa lexicon-entry concept "39" lemma "negen over half" frequency 1 reference ref-prev-half)
 (lemma40 isa lexicon-entry concept "40" lemma "tien over half" frequency 417 reference ref-prev-half)

 (lemma41b isa lexicon-entry concept "41" lemma "elf over half" frequency 0.81 reference ref-prev-half)
 (lemma42b isa lexicon-entry concept "42" lemma "twaalf over half" frequency 0.25 reference ref-prev-half)
 (lemma43b isa lexicon-entry concept "43" lemma "dertien over half" frequency 0.16 reference ref-prev-half)
 (lemma44b isa lexicon-entry concept "44" lemma "veertien over half" frequency 0.01 reference ref-prev-half)

; (lemma40b isa lexicon-entry concept "40" lemma "twintig voor" frequency 182.52 reference ref-next-full)
 (lemma41 isa lexicon-entry concept "41" lemma "negentien voor" frequency 0 reference ref-next-full)
 (lemma42 isa lexicon-entry concept "42" lemma "achtien voor" frequency 0.25 reference ref-next-full)
 (lemma43 isa lexicon-entry concept "43" lemma "zeventien voor" frequency 2.64 reference ref-next-full)
 (lemma44 isa lexicon-entry concept "44" lemma "zestien voor" frequency 0 reference ref-next-full)
 (lemma45 isa lexicon-entry concept "45" lemma "kwart voor" frequency 815.77 reference ref-next-full)
 (lemma46 isa lexicon-entry concept "46" lemma "veertien voor" frequency 5.44 reference ref-next-full)
 (lemma47 isa lexicon-entry concept "47" lemma "dertien voor" frequency 7.12 reference ref-next-full)
 (lemma48 isa lexicon-entry concept "48" lemma "twaalf voor" frequency 7 reference ref-next-full)
 (lemma49 isa lexicon-entry concept "49" lemma "elf voor" frequency 28.75 reference ref-next-full)
 (lemma50 isa lexicon-entry concept "50" lemma "tien voor" frequency 323.7 reference ref-next-full)
 (lemma51 isa lexicon-entry concept "51" lemma "negen voor" frequency 14.61 reference ref-next-full)
 (lemma52 isa lexicon-entry concept "52" lemma "acht voor" frequency 7.7 reference ref-next-full)
 (lemma53 isa lexicon-entry concept "53" lemma "zeven voor" frequency 12.96 reference ref-next-full)
 (lemma54 isa lexicon-entry concept "54" lemma "zes voor" frequency 7.67 reference ref-next-full)
 (lemma55 isa lexicon-entry concept "55" lemma "vijf voor" frequency 349.16 reference ref-next-full)
 (lemma56 isa lexicon-entry concept "56" lemma "vier voor" frequency 16.12 reference ref-next-full)
 (lemma57 isa lexicon-entry concept "57" lemma "drie voor" frequency 8 reference ref-next-full)
 (lemma58 isa lexicon-entry concept "58" lemma "twee voor" frequency 8.05 reference ref-next-full)
 (lemma59 isa lexicon-entry concept "59" lemma "een voor" frequency 6.57 reference ref-next-full)


)

;;; -[Production rules]-----------------------------------------------

(p focus-on-visual-location
    "Always focus on a new visual-location"
  =visual-location>
    ISA         visual-location
  ?visual>
    state        free
 ==>
  +visual>
    ISA         move-attention
    screen-pos  =visual-location
)

;;; -[Fixation point processing]--------------------------------------

(p prepare-for-stimulus
  =visual>
    ISA         text
    value       "+"
 ==>
  +goal>
    ISA           ctn
  +imaginal>
    ISA           ctn-task
    state         perceiving-minutes
  +lexical>
    ISA           clear
)

;;; -[Clock Time Naming]----------------------------------------------

(p M-check-visloc
   =goal>
      ISA         ctn
   =imaginal>
      isa         ctn-task
      minute      nil
      state       perceiving-minutes
   =visual-location>
    ISA visual-location
    < screen-x  165
==>
  +visual-location>
    ISA           visual-location
    screen-x      highest
    :attended     nil
  +visual>
    ISA           clear
  =imaginal>
)

(p M-initiate-harvest
   =goal>
      ISA         ctn
   =imaginal>
      isa         ctn-task
      minute      nil
      state       perceiving-minutes
   =visual-location>
    ISA visual-location
    > screen-x  165
==>
  +visual>
    isa           move-attention
    screen-pos    =visual-location
  =imaginal>
)

(p M-harvest
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        nil
    state         perceiving-minutes
  =visual>
    isa           text
    value         =minutes
 ==>
  +visual-location>
    ISA           visual-location
    screen-x      lowest
    :attended      nil
  =imaginal>
    minute        =minutes
    state         start-minutes
  =goal>
    filler        to-enable-spreading-activation		     ;; For spreading activation
)

;; Hier begint dual task, de minuten zijn opgehaald, en nu moet er _of_ een
;; superlemma worden opgehaald, _of_ een "algoritme" in werking worden gezet.

(p M-initiate-comparison-and-superlemma
   =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =minutes
    reference     nil
    state         start-minutes
 ==>
  =imaginal>
    state         process-minutes
  +retrieval>
    isa           comparison
    minute        =minutes
  +lexical>	
    isa           lexicon-entry
    concept       =minutes
)

(p M-harvest-comparison
  =goal>
    ISA           ctn
  =retrieval>
    isa           comparison
    reference     =reference
  =imaginal>
    isa           ctn-task
    state         process-minutes
    reference     nil
 ==>
  =imaginal>
    reference     =reference)

(p M-initiate-calc-PF
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =min
    rel-minute    nil
    state         process-minutes
    reference     ref-prev-full
  ?lexical>
    state         busy
  ?retrieval>
    state         free
    buffer        empty
 ==>
  =imaginal>
  +retrieval>
    isa           add-fact
    add1          =min
    add2          "0"
)

(p M-initiate-calc-HF
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    state         process-minutes
    minute        =min
    rel-minute    nil
    reference     ref-next-half
  ?lexical>
    state         busy
  ?retrieval>
    state         free
    buffer        empty
 ==>
  =imaginal>
  +retrieval>
    isa           add-fact
    add1          =min
    sum           "30"
)

(p M-initiate-calc-PH
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    state         process-minutes
    minute        =min
    rel-minute    nil
    reference     ref-prev-half
  ?lexical>
    state         busy
  ?retrieval>
    state         free
    buffer        empty
 ==>
  =imaginal>
  +retrieval>
    isa           add-fact
    add1          "30"
    sum           =min
)

(p M-initiate-calc-NF
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    state         process-minutes
    minute        =min
    rel-minute    nil
    reference     ref-next-full
  ?lexical>
    state         busy
  ?retrieval>
    state         free
    buffer        empty
 ==>
  =imaginal>
  +retrieval>
    isa           add-fact
    add1          =min
    sum           "60"
)


;; ===========================================================================

(p M-harvest-calc-1
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    rel-minute    nil
    state         process-minutes
  =retrieval>
    isa           add-fact
    add2          =rel-min
  - add2          "0"
  !eval! (setq *method* 'calc)
 ==>
  =imaginal>
    rel-minute    =rel-min
    state         process-hour
  +lexical>
    ISA           clear
)

(p M-harvest-calc-2
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    rel-minute    nil
    state         process-minutes
  =retrieval>
    isa           add-fact
    sum           =rel-min
    add2          "0"
  !eval! (setq *method* 'calc)
 ==>
  =imaginal>
    rel-minute    =rel-min
    state         process-hour
  +lexical>
    isa           clear
)

(p M-harvest-superlemma
  =goal>
    isa           ctn
  =lexical>
    isa           lexicon-entry
    lemma         =lemma
  =imaginal>
    isa           ctn-task
    state         process-minutes
  !eval! (setq *method* 'superlemma)
 ==>
  =imaginal>
    state         process-hour
    superlemma    =lemma
  +lexical>
    isa           clear
)
    

(spp 
 (M-harvest-superlemma :reward 10)
 (M-harvest-calc-1 :reward 10)
 (M-harvest-calc-2 :reward 10)
)

;; ---------------------------------------------------------------------------

(p H-check-visloc
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =min
    hour          nil
    state         process-hour
  =visual-location>	
    ISA           visual-location
  > screen-x	  160
==>
  +visual-location>
    ISA           visual-location
    screen-x      lowest
    :attended     nil
  +visual>
    ISA           clear
  =imaginal>
)

(p H-initiate-visual
   =goal>
      ISA         ctn
   =imaginal>
      isa         ctn-task
      minute      =min
      hour        nil
      state       process-hour
  =visual-location>
    ISA visual-location
    < screen-x  160
==>
  +visual>
    isa           move-attention
    screen-pos    =visual-location
  =imaginal>
)

(p H-harvest-visual-initiate-hour-adjustment
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =min
    hour          nil
    state         process-hour
  - reference     ref-full
  - reference     ref-prev-full
  =visual>
    isa           text
    value         =hour
 ==>
  =imaginal>
    hour          =hour
  +retrieval>
    isa           add-fact
    add1          =hour
    add2          "1"
)

(p H-harvest-visual-FH
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =min
    hour          nil
    state         process-hour
    reference     ref-full
  =visual>
    isa           text
    value         =hour
 ==>
  =imaginal>
    hour          =hour
    rel-hour      =hour
)

(p H-harvest-visual-PF
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    minute        =min
    hour          nil
    state         process-hour
    reference     ref-prev-full
  =visual>
    isa           text
    value         =hour
 ==>
  =imaginal>
    hour          =hour
    rel-hour      =hour
)

;; ===========================================================================

(p H-harvest-hour-adjustment-failure-retry
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    hour          =hour
    rel-hour      nil
    state         process-hour
  ?retrieval>
    state         error
 ==>
  =imaginal>
  +retrieval>
    isa           add-fact
    add1          =hour
    add2          "1"
)

(p H-harvest-hour-adjustment
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    hour          =hour
    rel-hour      nil
    state         process-hour
  =retrieval>
    isa           add-fact
    add1          =hour
    sum           =ref-hour
 ==>
  =imaginal>
    rel-hour      =ref-hour)

(p H-respond-relminutes
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    rel-hour      =rel-hour
    rel-minute    =rel-minute
    reference     =ref
  !bind! =utterance (format nil "~A: ~A ... ~A" =ref =rel-minute =rel-hour)
 ==>
  +vocal>
    isa           speak
    string        =utterance
  !output!        =utterance
  -goal>
)

(p H-respond-lemma
  =goal>
    ISA           ctn
  =imaginal>
    isa           ctn-task
    rel-hour      =rel-hour
    superlemma    =lemma
  !bind! =utterance (format nil "Lemma: ~A ... ~A" =lemma =rel-hour)
 ==>
  +vocal>
    isa           speak
    string        =utterance
  !output!        =utterance
  -goal>
)


(spp (H-respond-relminutes :reward 10))

;;; ---------------------------------------------------------------------------

(mapcar (lambda (p) (setf (production-color p) "#0000FF")) (MATCHING-SYMBOLS "M-RESPOND-MINUTE" (ALL-PRODUCTIONS)))
(mapcar (lambda (p) (setf (production-color p) "#FF0000")) (MATCHING-SYMBOLS "M-RESPOND-SUPER" (ALL-PRODUCTIONS)))
(mapcar (lambda (p) (setf (production-color p) "#FFd700")) (MATCHING-SYMBOLS "H-" (ALL-PRODUCTIONS)))
(mapcar (lambda (p) (setf (production-color p) "#FFa700")) (MATCHING-SYMBOLS "H-RESPOND" (ALL-PRODUCTIONS)))

;;; ---------------------------------------------------------------------------
 

)