Commit 042f288d authored by Chris Dancy's avatar Chris Dancy

Merge branch 'master' of

parents 9364f131 b8a4fe10
......@@ -30,7 +30,7 @@
(defvar *START-TIME* (write-to-string (get-internal-real-time)))
(defun add-aa-to-chunks ()
;(defun add-aa-to-chunks ()
(extend-chunks fValue :default-value 0 :merge-function merge-chunks-fValue)
(extend-chunks fFunction :default-value nil :merge-function merge-chunks-fFunction)
......@@ -41,9 +41,9 @@
(extend-productions sValue :default-value 0)
(extend-productions fFunction :default-value nil)
(extend-productions fValue :default-value 0)
;;Set of functions used when chunks are merged that make sure the correct
(defun merge-chunks-fValue (c1 c2)
(/ (+ (chunk-fValue c1) (chunk-fValue c2)) 2))
......@@ -284,8 +284,8 @@
;; The value output is in the range from 0.0001 to 1
(defun compute-homeostatic-arousal-factor (&optional test)
(let* ((LA (if (cadar (car (get-phys-vals nil (list '("Status.LastAsleep")))))
(cadar (car (get-phys-vals nil (list '("Status.LastAsleep")))))
(cadar (car (get-phys-vals nil (list '("Status.LastAsleep")))))
(currT (if (cadar (car (get-phys-vals nil (list '("System.X")))))
(cadar (car (get-phys-vals nil (list '("System.X")))))
......@@ -945,7 +945,8 @@
(setf (AA-dm-SEEKING-hash AA) (make-hash-table))
(setf (AA-vis-SEEKING-hash AA) (make-hash-table))
(setf (AA-aur-SEEKING-hash AA) (make-hash-table))
(schedule-event 0.001 'schedule-AA-events :params (list AA) :priority :max :module 'Affective-Associations :maintenance t))
(schedule-event 0.001 'schedule-AA-events :params (list AA) :priority :max :module 'Affective-Associations :maintenance t :output nil)
(defun AA-module-query (AA buff slot val)
(case slot
<windowtop> 505 </windowtop>
<windowleft> 1105 </windowleft>
<windowtop> 383 </windowtop>
<windowleft> 837 </windowleft>
<windowhigh> 302 </windowhigh>
<windowwide> 424 </windowwide>
<windowstate> 0 </windowstate>
......@@ -344,7 +344,16 @@ t)
(solverOutputFile (concatenate 'string *HumModDir* "SolverOut" (phys-module-pipeID phys)))
(init-vals-msg "\"<solverin>")
(setf old-dir
#+:ccl (ccl::current-directory-name)
#+:sbcl (sb-posix:getcwd)
#+:ccl (ccl::cwd *HumModDir*)
#+:ccl (ccl::cwd "../")
#+:sbcl (sb-posix:chdir *HumModDir*)
#+:sbcl (sb-posix:chdir "../")
(setf ics-val-list (s-xml:parse-xml-file init-filename))
(setf init-vals-msg (concatenate 'string init-vals-msg (list #\newline) "<sending_current_values>" (list #\newline)))
......@@ -390,7 +399,9 @@ t)
(while (and (not (probe-file solverOutputFile))
(< (- (get-universal-time) currTime) 55))))
(while (and (probe-file solverOutputFile) (not (handler-case (delete-file solverOutputFile)
(error () nil)))))|#))
(error () nil)))))|#
#+:ccl (ccl::cwd old-dir)
#+:sbcl (sb-posix:chdir old-dir)))
;;Generate hash-table of physiological variables & Hash-Table of the order of the variables
;; and default values
......@@ -421,6 +432,7 @@ t)
(physValueList nil))
;;Send restart message to solver
;; *This is needed for solver to correctly process messages sent*
(messageStream solverInputFile
......@@ -431,20 +443,24 @@ t)
#+:sbcl sb-impl::simple-file-error
simple-error) () (go resetCreate)))
(while (probe-file solverInputFile))
(let ((currTime (get-universal-time)))
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) 20))))
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) 5))))
(when (not (probe-file solverOutputFile))(go resetCreate))
;Should output two files on the reset
(while (and (probe-file solverOutputFile) (not (handler-case (delete-file solverOutputFile)
(error () nil)))))
(let ((currTime (get-universal-time)))
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) 20))))
;Delete the output file after restart
(while (and (probe-file solverOutputFile) (not (handler-case (delete-file solverOutputFile)
(error () nil)))))
;We should only need this on the 1st run (helps us avoid having to waste time)
(if (phys-module-first-run phys)
(let ((currTime (get-universal-time)))
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) 5))))
;Delete the output file after restart
(while (and (probe-file solverOutputFile) (not (handler-case (delete-file solverOutputFile)
(error () nil))))))
;; Initialize with stable values (obtained from running sim 1 week)
(load-HumMod-ICs (phys-module-ics-file phys))
(sleep 0.05)
;Create input file for hummod to give us a list of variables and digest the output file created by HumMod (w/ the variables). Loop back around if there is an error
(tagbody getVars
......@@ -470,6 +486,7 @@ t)
(delete-file solverOutputFile)
(error () nil))
(go getVars))
;;Parse the list of variables output by the ModelSolver
(let ((parseStart (get-universal-time)))
(tagbody parseVarList
......@@ -720,7 +737,10 @@ t)
(if (not (phys-module-HProc phys))
;;Start HumMod
(start-HumMod phys))
(start-HumMod phys)
(setf (phys-module-first-run phys) t))
(setf (phys-module-first-run phys) nil))
;;All chunk-types used in the efferent buffer should be a subtype of phys-var
(chunk-type phys-var)
(setf (phys-module-physValList phys) nil)
......@@ -781,15 +801,15 @@ t)
(defun de-stress ()
"Turn stress-based params back to normal"
(setf *stress-on* nil)
(schedule-event-relative 0.020 'set-phys-vals :module 'physio
(schedule-event-relative 0.001 'set-phys-vals :module 'physio
(list (list (list "Sympathetics-Adrenal.ClampSwitch" 0)))
:priority :max :details "Turn stress off")
(schedule-event-relative 0.021 'set-phys-vals :module 'physio
(schedule-event-relative 0.002 'set-phys-vals :module 'physio
(list (list (list "Sympathetics-General.EssentialEffect" 0)))
:priority :max :details "Turn stress off")
(schedule-event-relative 0.022 'set-phys-vals :module 'physio
(schedule-event-relative 0.003 'set-phys-vals :module 'physio
(list (list (list "CorticotropinReleasingFactor.Stress" 2)))
:priority :max :details "Turn stress off"))
......@@ -1124,6 +1144,8 @@ t)
(de-stress nil)
;Hold the next de-stress event (if there is one in the mp queue)
(de-stress-evt nil)
;Tells us whether this is the 1st run of the module (i.e., it was reset once)
(first-run nil)
;Create module everytime new model is defined
......@@ -75,21 +75,21 @@
(eq checkOsmoVal-base nil) (eq (cadar checkOsmoVal-base) nil)) 0
(read-from-string (cadar checkOsmoVal-base))))
(tVal nil)
(subjMult (SEEKING-subj-thirst SEEKING))
(tMult (if (SEEKING-thirst-multiplier SEEKING) (SEEKING-thirst-multiplier SEEKING) 1))
(max-reward (if (SEEKING-max-seeking-val SEEKING) (SEEKING-max-seeking-val SEEKING) 1))
(noise-val (if (SEEKING-hom-noise SEEKING) (act-r-noise (* (SEEKING-hom-noise SEEKING) max-reward)) 0)))
(subjMult (SEEKING-subj-thirst S))
(tMult (if (SEEKING-thirst-multiplier S) (SEEKING-thirst-multiplier S) 1))
(max-reward (if (SEEKING-max-seeking-val S) (SEEKING-max-seeking-val S) 1))
(noise-val (if (SEEKING-hom-noise S) (act-r-noise (* (SEEKING-hom-noise S) max-reward)) 0)))
(declare (ignore tMult))
(declare (ignore subjMult))
;(print checkOsmoVal)
(if (> osmoVal (SEEKING-thirst-max SEEKING))
(if (> osmoVal (SEEKING-thirst-max S))
(setf tVal 1)
(if (< osmoVal (SEEKING-thirst-min SEEKING))
(if (< osmoVal (SEEKING-thirst-min S))
(setf tVal -1)
(if (<= osmoVal base-osmoVal)
(setf tVal (/ (- osmoVal base-osmoVal) (- base-osmoVal (SEEKING-thirst-min SEEKING))))
(setf tVal (/ (- osmoVal base-osmoVal) (- (SEEKING-thirst-max SEEKING) base-osmoVal))))))
(setf tVal (/ (- osmoVal base-osmoVal) (- base-osmoVal (SEEKING-thirst-min S))))
(setf tVal (/ (- osmoVal base-osmoVal) (- (SEEKING-thirst-max S) base-osmoVal))))))
;(print (list base-osmoVal osmoVal (* subjMult tVal)))
;;Could use log-type curve to convert tVal to thirst, however I will just make a linear conversion w/ added noise for now
......@@ -104,9 +104,9 @@
(setf tVal (exp (* (- tval 1) max-reward)))
(when (> tVal max-reward) (setf tVal max-reward))
(when (< tVal (SEEKING-max-neg-incentive SEEKING)) (setf tVal (SEEKING-max-neg-incentive SEEKING)))
(when (< tVal (SEEKING-max-neg-incentive S)) (setf tVal (SEEKING-max-neg-incentive S)))
(setf (gethash 'thirstVal (SEEKING-S-vals SEEKING)) tVal)
(setf (gethash 'thirstVal (SEEKING-S-vals S)) tVal)
......@@ -411,4 +411,3 @@
:request 'SEEKING-requests
:params 'SEEKING-params
:query 'SEEKING-query)
This diff is collapsed.
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