Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
CogSci2018
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Packages
Packages
Container Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
AI-CogSci-Group
CogSci2018
Commits
e20a329d
Commit
e20a329d
authored
Mar 01, 2018
by
root
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Wrong/outdated model file in this repo, updating
parent
04b7a049
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
138 additions
and
171 deletions
+138
-171
Models/Subtraction_Model_Fixed.lisp
Models/Subtraction_Model_Fixed.lisp
+138
-171
No files found.
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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment