Skip to content

C
CogSci2018
Commit e20a329d authored by root's avatar root
Browse files
Options

Wrong/outdated model file in this repo, updating

parent 04b7a049
Hide whitespace changes
Inline Side-by-side
Showing with 138 additions and 171 deletions
Models/Subtraction_Model_Fixed.lisp
View file @ e20a329d
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment