diff --git a/Models/Subtraction_Model_Fixed.lisp b/Models/Subtraction_Model_Fixed.lisp index c317f01d12d92e67353529e76f760812f506f78c..51f2d6241e22d54cd3bb24dda1eec23192214973 100644 --- a/Models/Subtraction_Model_Fixed.lisp +++ b/Models/Subtraction_Model_Fixed.lisp @@ -242,12 +242,13 @@ TBD (dotimes (i blocks) (let ((sub (if (evenp i) 7 13));7));13)) (val (nth i '(9095 6233 8185 5245)))) - ;;Deep slow breathing - (start-slow-breathing) - ;;Schedule an event to advance 15s (of slow breathing) - (schedule-event-relative 0.027 'advance-phys :module :physio :priority :max :params (list 0.25)) - ;;Back to spontaneous breathing - (stop-slow-breathing) + (when (phys-module-enabled (get-module physio)) + ;;Deep slow breathing + (start-slow-breathing) + ;;Schedule an event to advance 15s (of slow breathing) + (schedule-event-relative 0.027 'advance-phys :module :physio :priority :max :params (list 0.25)) + ;;Back to spontaneous breathing + (stop-slow-breathing)) (log-event (make-sub-log-exp :event 'block :tm (get-internal-real-time) :subj-id subj-id :cnd cnd :subtrahend sub :start-val val :blk i)) (setf prev-num-resp (run-m-staticANS trial-time :block i :val val :sub sub :cnd cnd :syl syl @@ -293,23 +294,24 @@ TBD (ensure-directories-exist "C:/Users/Phys-Cog/") (dotimes (i num-times) ;;Schedule an event to advance the physiology system a day to stabilize params - (schedule-event-relative 0.015 'advance-phys :module :physio :priority :max :params (list 1440)) - ;;Turn on daily planner so that sleep schedule and sleep homeostasis can cause deprivation - (create-stress) - (print "Stressed....") - ;;Schedule an event to advance the physiology system 15 mins to sim stress - (schedule-event-relative 0.024 'advance-phys :module :physio :priority :max :params (list 15)) - ;;Turn off stress vars - (de-stress) + (when (phys-module-enabled (get-module physio)) + (schedule-event-relative 0.015 'advance-phys :module :physio :priority :max :params (list 1440)) + ;;Turn on daily planner so that sleep schedule and sleep homeostasis can cause deprivation + (create-stress) + (print "Stressed....") + ;;Schedule an event to advance the physiology system 15 mins to sim stress + (schedule-event-relative 0.024 'advance-phys :module :physio :priority :max :params (list 15)) + ;;Turn off stress vars + (de-stress)) (run-exp :blocks 4 :runNum i :lCount 0) - (let ((boldData (predict-bold-response))) + #|(let ((boldData (predict-bold-response))) (loop for bD in boldData do (with-open-file (mStream (concatenate 'string "C:/Users/Phys-Cog/BoldLog.txt") :direction :output :if-exists :append :if-does-not-exist :create) (format mStream "~S ~&" (write-to-string bD))))) - (reset))) + |#(reset))) (setf fileID (write-to-string (get-universal-time))) @@ -358,7 +360,7 @@ TBD (- (length rs) p-n-r) (* 100.0 (/ (count-if #'(lambda (x) (and (= (sub-log-response-block x) (sub-block subobj)) (= (sub-log-response-diff x) 0))) rs) - (- (length rs) p-n-r))))) + (- (length rs) p-n-r)))))) (length rs)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -372,82 +374,80 @@ TBD ;; create process-response in a lexical closure -(let ( - (problem-vals nil)) - -(defun set-problem-vals (v) (setq problem-vals v)) - -(defun process-response (&rest nums) - (let* ((subobj (get-sub)) +(let ((problem-vals nil)) + + (defun set-problem-vals (v) (setq problem-vals v)) + + (defun process-response (&rest nums) + (let* ((subobj (get-sub)) + (rnums (reverse nums)) + (sub-val (sub-problem-subtrahend subobj)) + (res 0) + (correct-resp nil)) + (dotimes (i (length rnums)) ;;convert from symbols to integer + (setq res (+ res (* (chunk-slot-value-fct (nth i rnums) 'value) (expt 10 i))))) + ; (when (< res (sub-start-value subobj)) ;;log response ?????? + (let ((correct-response (- (sub-last-value subobj) sub-val))) + + (incf (sub-num-tried subobj)) + + (if (zerop (- correct-response res)) + (progn + (incf (sub-num-correct subobj)) + (setf correct-resp t)) + ;(create-stress) + ) + (log-event (make-sub-log-response :event 'response :tm (get-internal-real-time) :model-tm (mp-time) + :diff (- correct-response res) :correct correct-response :subject res :block (sub-block subobj))) + (cond ((check-block-done) + (incf (sub-done-flag (get-sub))) + (if correct-resp + (progn + (setf (sub-last-value subobj) correct-response) + 'start-next-sub) + 'redo-sub)) + (correct-resp + (setf (sub-last-value subobj) correct-response) + 'start-next-sub) + (t + 'redo-sub))))) + + (defun compose-response ( part &rest nums) + (let ((subobj (get-sub)) (rnums (reverse nums)) - (sub-val (sub-problem-subtrahend subobj)) (res 0) ) - (dotimes (i (length rnums)) ;;convert from symbols to integer - (setq res (+ res (* (chunk-slot-value-fct (nth i rnums) 'value) (expt 10 i))))) -; (when (< res (sub-start-value subobj)) ;;log response ?????? - (let ((correct-response (- (sub-last-value subobj) sub-val))) - - (incf (sub-num-tried subobj)) - - (if (zerop (- correct-response res)) - (incf (sub-num-correct subobj)) - (progn - ;(create-stress) - (print "Incorrect!~%"))) #|(with-open-file - (mStream "C:\\Users\\In-Sight\\Dropbox\\ACT-R6\\TestOut.txt" - :direction :output :if-exists :append :if-does-not-exist :create) - (format mStream "Correct: ~S Response: ~S C-R: ~S ~&" correct-response res (- correct-response res)))))|# - (log-event (make-sub-log-response :event 'response :tm (get-internal-real-time) :model-tm (mp-time) - :diff (- correct-response res) :correct correct-response :subject res :block (sub-block subobj))) - (cond ((check-block-done) - (setf (sub-last-value subobj) correct-response) - 'block-done) - ((zerop (- correct-response res)) - (setf (sub-last-value subobj) correct-response) - 'start-next-sub) - (t - 'redo-sub))))) - -(defun compose-response ( part &rest nums) - (let ((subobj (get-sub)) - (rnums (reverse nums)) - (res 0) ) - (dotimes (i (length rnums)) ;;convert from symbols to integer - (setq res (+ res (* (chunk-slot-value-fct (nth i rnums) 'value) (expt 10 i)))) ) - (case (sub-strategy subobj) - (basic - (case (sub-problem-cnd subobj) ;;;generate string to speak - (chunk - (multiple-value-bind (upper lower) (floor res 100) (format nil "~R ~R" upper lower))) - (digit - (multiple-value-bind (u l) (floor 6153 1000) - (multiple-value-bind (u1 l1) (floor l 100) - (multiple-value-bind (u2 l2) (floor l1 10) (format nil "~S ~S ~S ~S" u u1 u2 l2 )))) ) - (spelled-out - (format nil "~R" res)))) - (calc-and-speak - (if (eql part 'end) - (concatenate 'string "and " (format nil "~R" (rem res 100))) - (format nil "~R" (* 100 res))))))) -;; -fer 1000 -> 100 - -;;Modified so that we no longer save unless we are at the very beginning of subtraction -(defun save-for-restart (&rest nums) - (print (car (last nums))) - (when (eq (car (last nums)) 'ONES) - (setq problem-vals (butlast nums)))) - -(defun restart-problem () - (destructuring-bind (p1 p10 p100 p1000) problem-vals - (let ((name (gensym)) - (sub (sub-problem-subtrahend (get-sub)))) - (if (eql sub 7) - (add-dm-fct `((,name isa subtract-problem ones ,p1 tens ,p10 hunds ,p100 thous ,p1000 subtractor seven ))) - (add-dm-fct `((,name isa subtract-problem ones ,p1 tens ,p10 hunds ,p100 thous ,p1000 subtractor thirteen )))) - (goal-focus-fct name)))) -;(defun mem-activ-out (dm) -; ) - + (dotimes (i (length rnums)) ;;convert from symbols to integer + (setq res (+ res (* (chunk-slot-value-fct (nth i rnums) 'value) (expt 10 i)))) ) + (case (sub-strategy subobj) + (basic + (case (sub-problem-cnd subobj) ;;;generate string to speak + (chunk + (multiple-value-bind (upper lower) (floor res 100) (format nil "~R ~R" upper lower))) + (digit + (multiple-value-bind (u l) (floor 6153 1000) + (multiple-value-bind (u1 l1) (floor l 100) + (multiple-value-bind (u2 l2) (floor l1 10) (format nil "~S ~S ~S ~S" u u1 u2 l2 )))) ) + (spelled-out + (format nil "~R" res)))) + (calc-and-speak + (if (eql part 'end) + (concatenate 'string "and " (format nil "~R" (rem res 100))) + (format nil "~R" (* 100 res))))))) + ;; -fer 1000 -> 100 + + ;;Modified so that we no longer save unless we are at the very beginning of subtraction + (defun save-for-restart (&rest nums) + (when (eq (car (last nums)) 'ONES) + (setq problem-vals (butlast nums)))) + + (defun restart-problem () + (destructuring-bind (p1 p10 p100 p1000) problem-vals + (let ((name (gensym)) + (sub (sub-problem-subtrahend (get-sub)))) + (if (eql sub 7) + (add-dm-fct `((,name isa subtract-problem ones ,p1 tens ,p10 hunds ,p100 thous ,p1000 subtractor seven ))) + (add-dm-fct `((,name isa subtract-problem ones ,p1 tens ,p10 hunds ,p100 thous ,p1000 subtractor thirteen )))) + (goal-focus-fct name)))) ) @@ -455,63 +455,9 @@ TBD (defun set-base-levels-by-type (typ v1 v2) (dolist (item (no-output (sdm-fct `(isa ,typ)))) (set-base-levels-fct `((,item ,v1 ,v2))))) - (defvar *cp* nil) -#| -#+:lispworks (load (setq *cp* (current-pathname "subtract-model-v1-6.lsp")) :verbose nil) -#+:mcl (load (setq *cp* (make-pathname :directory (directory-namestring (namestring *load-pathname*)) :name "subtract-model-v1-6" :type "lsp") - :external-format :unix :verbose nil)) -#+:cmu (load (setq *cp* (make-pathname :directory (directory-namestring (namestring *load-pathname*)) :name "subtract-model-v1-6" :type "lsp") - :external-format :unix :verbose nil)) - -#| -The function multi-run-exp allows the modeler to run the model with different parameter values for -syllable-rate (:syllable-rate), activation noise (:ans) and base-level-constanst (:blc). The performance measures collected are -percent correct and number of attempts. If specified the results are saved in a tab delimited file -in the SS-data folder. - -The function has 4 key words: - :save-result t means write results to a file, nil means no file created - :ans-vals a list of 4 values. Value 1 - starting value for :ans - Value 2 - number of iterations to run with different values of :ans - Value 3 - the operation to be performed on the starting value with - each iteration (+ or -) - Value 4 - the amount to be added or subtracted - :blc-vals a list of 4 values. Value 1 - starting value for :blc - Value 2 - number of iterations to run with different values of :blc - Value 3 - the operation to be performed on the starting value with - each iteration (+ or -) - Value 4 - the amount to be added or subtracted - :syl-vals a list of 4 values. Value 1 - starting value for :syllable-rate - Value 2 - number of iterations to run with different values of :syllable-rate - Value 3 - the operation to be performed on the starting value with - each iteration (+ or -) - Value 4 - the amount to be added or subtracted - - -The default values are given by the following lambda list -(&key (save-results t) (ans-vals '(.30 10 - 0.02 )) (blc-vals '(1.0 10 + 0.1)) (syl-vals '(0.15 20 + 0.2))) - -To run with default values, enter (multi-run-exp). -To change values, and example run would be (multi-run-exp :ans-vals (.4 15 + .1)) -Note: if enter a value for the keywords :syl-vals:ans-vals and :blc-vals the entire list must be entered. - -The file created is named SS-Results-xxx.lisp where xxx is a randomly generated number. - -The columns of the file are -run-number ans-value blc-value num-attempts %-correct. - -|# -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - - - (defun set-base-levels-by-type (typ v1 v2) - (dolist (item (no-output (sdm-fct `(isa ,typ)))) - (set-base-levels-fct `((,item ,v1 ,v2))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; IV. The Model - setup ;;; @@ -534,24 +480,25 @@ run-number ans-value blc-value num-attempts %-correct. ;;; Parameters - Currently Set at "09 Placebo All Condition" values (sgp :v "c:/Users/Phys-Cog/model-trace.txt") -(sgp :esc t :blc 2.65 :ans .71 :trace-detail medium :bll .5) +(sgp :esc t :blc 2.38 :ans .71 :trace-detail medium :bll .5) +;(sgp :ol nil) (sgp :do-not-harvest imaginal) (sgp :syllable-rate 0.55) ;;default .15 -(sgp :save-buffer-trace t :traced-buffers (retrieval production goal visual-location visual manual)) -(sgp :phys-delay 1 :phys-enabled nil) -(sgp :sact t) -(sgp :seed 99) +;(sgp :save-buffer-trace t :traced-buffers (retrieval production goal visual-location visual manual)) +;(sgp :phys-delay 1 :phys-enabled nil) +;(sgp :sact t) +(sgp :seed '(12345 13)) ;;--CogSci18 -(sgp :phys-delay 1 :phys-enabled t) -(sgp :AA-enabled t) -(sgp :AA-dm-noise-switch t) -(sgp :AA-util-noise-switch nil) -(sgp :AA-chunk-arousal-switch nil) -(sgp :AA-max-util-thresh -20) -(sgp :AA-nom-util-thresh -50) -(sgp :AA-max-dm-noise 1) +;(sgp :phys-delay 1 :phys-enabled t) +;(sgp :AA-enabled t) +;(sgp :AA-dm-noise-switch t) +;(sgp :AA-util-noise-switch nil) +;(sgp :AA-chunk-arousal-switch nil) +;(sgp :AA-max-util-thresh -20) +;(sgp :AA-nom-util-thresh -50) +;(sgp :AA-max-dm-noise 1) ;; ;(sgp :phys-delay 0.25 :epi-ans nil) @@ -564,11 +511,6 @@ run-number ans-value blc-value num-attempts %-correct. ;;; Type Declarations -;;;Physio -;;Create a chunk-type that specifies which (HumMod) vars you will be changing -;; -We change the CNS nerve value (via the clamp swicth & level) that effects sympathetic and parasympathetic nervous system representations. -(chunk-type (sympcns (:include phys-var)) SympsCNS.ClampSwitch SympsCNS.ClampLevel) - ;;; Goals (chunk-type subtract state strategy current-col current-sub) ;;main task goal (chunk-type (borrow (:include subtract)) parent) ;;the borrow subgoal @@ -579,8 +521,6 @@ run-number ans-value blc-value num-attempts %-correct. (chunk-type subtrahend num ones tens hunds thous) -(chunk-type attend-sound) - ;;; Initialize Declarative Memory #| ;;; Load into Declarative Memory the integers, addition-facts, subtraction-facts, multiplication-facts, and comparison facts. @@ -643,6 +583,8 @@ run-number ans-value blc-value num-attempts %-correct. (defvar *wme-list* nil) +(defvar *threes* nil) + ;; To change the boundaries of the set of integers or the addition ;; or multiplication table, just set these variables to the proper ;; values and call (arithmetic-setup) @@ -761,14 +703,15 @@ run-number ans-value blc-value num-attempts %-correct. (do ((j *subtraction-table-lower-bound* (+ j 1))) ((> j *subtraction-table-upper-bound*)) (if (>= i j) - (push `(,(subtraction-name i j) + (progn + (push `(,(subtraction-name i j) isa subtraction-fact arg1 ,(integer-name i) arg2 ,(integer-name j) diff ,(integer-name (- i j))) *wme-list*) - ) - )) + (when (= j 3) + (push (subtraction-name i j) *threes*)))))) (when extra-sub (dolist (pair extra-sub) @@ -830,13 +773,15 @@ run-number ans-value blc-value num-attempts %-correct. "To generate the integers and addition and multiplication tables. To generate additional ones not in the standard list, use keyword args." (setf *wme-list* nil) + (setf *tens&above* nil) (generate-integers extra-int) (generate-addition-table extra-add) (generate-multiplication-table extra-mul) (generate-subtraction-table extra-sub) (setf *wme-list* (nreverse *wme-list*)) - (add-dm-fct *wme-list*)) - + (setf *tens&above* (nreverse *tens&above*)) + (add-dm-fct *wme-list*) + (dolist (dm-name *threes*) (set-base-levels-fct (list (list dm-name 3.28))))) (arithmetic-setup) ;;; @@ -998,10 +943,15 @@ run-number ans-value blc-value num-attempts %-correct. !output! (Response =thous =hunds =tens =ones) +vocal> isa speak ;;begin speaking the response string =val - =goal> state =result ;; either 'block-done, 'start-next-sub or 'redo-sub + =goal> state =result ;; either 'start-next-sub or 'redo-sub current-col ones ;;reset ) +#|-Chris Dancy- +This rule isn't used anymore (process-response no longer returns 'block-done + and the sub-done-flag is incremented in the process-response). + Will likely remove rule in future iterations, but keeping for now +|# (p subtract-block-done =goal> isa subtract state block-done @@ -1014,6 +964,7 @@ run-number ans-value blc-value num-attempts %-correct. =goal> isa subtract state start-next-sub current-sub =sub + ?vocal> state free ==> +retrieval> isa subtrahend num =sub @@ -1024,6 +975,7 @@ run-number ans-value blc-value num-attempts %-correct. (p subtract-wrong-answer =goal> isa subtract state redo-sub + ?vocal> state free ==> !output! (restating problem) !eval! (restart-problem)) @@ -1196,7 +1148,22 @@ run-number ans-value blc-value num-attempts %-correct. =goal> state say-answer) +#| + ;Make another rule to allow us to sometimes retry the retrieval instead of giving up and just saying an answer +(p* subtract-retrieve-subfact-fail +"Harvest the subtracton fact" + =goal> isa subtract + state subtract-column + current-col =col + ?retrieval> state error ;;subtraction failure + =imaginal> isa subtract-problem + ?vocal> state free +==> + !output!(subtraction failure =col ) + + =goal> state say-answer) +|# (p subtract-get-next-column ;;return here from sub goal or successful harvest of subtracton fact