Commit 50ecf905 authored by CD's avatar CD
Browse files

Added some helper functions to physio module file

parent e547b3e6
# Port settings for ACT-R server started at 06:58:20 11/03/2020 # Port settings for ACT-R server started at 12:06:06 11/15/2020
set actr_port 2671 set actr_port 2650
set actr_address "192.168.1.118" set actr_address "10.0.243.15"
...@@ -85,7 +85,7 @@ ...@@ -85,7 +85,7 @@
(progn (progn
(setf noise-val (/ (+ (* arous-dm-noise (AA-nom-dm-noise aa)) (* (- arous-mid arous-dm-noise) (AA-max-dm-noise aa))) arous-mid)) (setf noise-val (/ (+ (* arous-dm-noise (AA-nom-dm-noise aa)) (* (- arous-mid arous-dm-noise) (AA-max-dm-noise aa))) arous-mid))
;We only record every 5 seconds ;We only record every 5 seconds
(when (eq (mod (mp-time) 5) 0) (when (eq (mod (mp-time) 2) 0)
(with-open-file (with-open-file
(n-stream (format nil "Phys-data/ans-log~a.txt" (phys-module-pipeID (get-module physio))) :direction :output :if-exists :append :if-does-not-exist :create) (n-stream (format nil "Phys-data/ans-log~a.txt" (phys-module-pipeID (get-module physio))) :direction :output :if-exists :append :if-does-not-exist :create)
(format n-stream "~5$,~10$~&" (mp-time-ms) noise-val))) (format n-stream "~5$,~10$~&" (mp-time-ms) noise-val)))
...@@ -94,7 +94,7 @@ ...@@ -94,7 +94,7 @@
(progn (progn
(setf noise-val (/ (+ (* (- (AA-max-arous aa) arous-dm-noise) (AA-nom-dm-noise aa)) (* (- arous-dm-noise arous-mid) (AA-max-dm-noise aa))) arous-mid)) (setf noise-val (/ (+ (* (- (AA-max-arous aa) arous-dm-noise) (AA-nom-dm-noise aa)) (* (- arous-dm-noise arous-mid) (AA-max-dm-noise aa))) arous-mid))
;(when (and (>= (mod (mp-time) 5) 0) (<= (mod (mp-time) 5) 1)) ;(when (and (>= (mod (mp-time) 5) 0) (<= (mod (mp-time) 5) 1))
(when (eq (mod (mp-time) 5) 0) (when (eq (mod (mp-time) 2) 0)
(with-open-file (with-open-file
(n-stream (format nil "Phys-data/ans-log~a.txt" (phys-module-pipeID (get-module physio))) :direction :output :if-exists :append :if-does-not-exist :create) (n-stream (format nil "Phys-data/ans-log~a.txt" (phys-module-pipeID (get-module physio))) :direction :output :if-exists :append :if-does-not-exist :create)
(format n-stream "~5$,~10$~&" (mp-time-ms) noise-val))) (format n-stream "~5$,~10$~&" (mp-time-ms) noise-val)))
...@@ -255,8 +255,8 @@ ...@@ -255,8 +255,8 @@
(with-open-file (with-open-file
(msgStream (concatenate 'string "Phys-data/CEC-Arous" (phys-module-pipeID phys) ".txt") (msgStream (concatenate 'string "Phys-data/CEC-Arous" (phys-module-pipeID phys) ".txt")
:direction :output :if-exists :append :if-does-not-exist :create) :direction :output :if-exists :append :if-does-not-exist :create)
(format msgStream "~$,~5$,~5$,~5$,~5$~&" (format msgStream "~$,~5$,~5$,~5$,~5$,~5$~&"
(mp-time-ms) (compute-cort test) (compute-epi-arousal test) (compute-crh-arousal test) (mp-time-ms) (compute-homeostatic-arousal-factor) (compute-cort test) (compute-epi-arousal test) (compute-crh-arousal test)
(* (compute-homeostatic-arousal-factor) (* (compute-homeostatic-arousal-factor)
(compute-cort test) (compute-cort test)
(+ (* (AA-epi-arous-ratio aa) (+ (* (AA-epi-arous-ratio aa)
...@@ -265,7 +265,7 @@ ...@@ -265,7 +265,7 @@
(with-open-file (with-open-file
(msgStream (concatenate 'string "Phys-data/CEC-Arous" (phys-module-pipeID phys) ".txt") (msgStream (concatenate 'string "Phys-data/CEC-Arous" (phys-module-pipeID phys) ".txt")
:direction :output :if-exists :overwrite :if-does-not-exist :create) :direction :output :if-exists :overwrite :if-does-not-exist :create)
(format msgStream "time (ms),f(Cortisol),g(Epinephrine),h(CRH),Arousal~&")))) (format msgStream "time (ms),Homeostatic-Arousal-Factor,f(Cortisol),g(Epinephrine),h(CRH),Arousal~&"))))
(* (compute-homeostatic-arousal-factor) (compute-cort) (* (compute-homeostatic-arousal-factor) (compute-cort)
(+ (+
(if (and (get-module physio) (phys-module-enabled phys)) (if (and (get-module physio) (phys-module-enabled phys))
......
#| Copyright 2017 Christopher L. Dancy II #| Copyright 2020 Christopher L. Dancy II
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or the Free Software Foundation, either version 3 of the License, or
...@@ -13,9 +13,9 @@ ...@@ -13,9 +13,9 @@
along with this program. If not, see <http://www.gnu.org/licenses/>. along with this program. If not, see <http://www.gnu.org/licenses/>.
|# |#
;;;By Christopher L. Dancy II ;;;By Christopher L. Dancy
;;;Dept of Computer Science, Bucknell University ;;;Dept of Computer Science, Bucknell University
;;;Made to be used with HumMod v1.6.2 - Modular ;;;Made to be used with ModelSolver v1.0.16 (which comes with HumMod v3.1)
;;;--------------- ;;;---------------
;;; ---For any nerve activity related to heart-rate, HR shouldn't go above : 208-(0.7*age) : (from H Tanaka, KD Monahan 2001). ;;; ---For any nerve activity related to heart-rate, HR shouldn't go above : 208-(0.7*age) : (from H Tanaka, KD Monahan 2001).
...@@ -23,6 +23,10 @@ ...@@ -23,6 +23,10 @@
;;; Should theoretically work with sbcl ;;; Should theoretically work with sbcl
;;; (*features* stil need to be tested for all implementation specific functions) ;;; (*features* stil need to be tested for all implementation specific functions)
#|---Todos---|#
;;; Consider getting baseline by moving ahead ~1 day with larger step & averaging those values output from that day
#|------|#
;;Thread library ;;Thread library
;(eval-when (:compile-toplevel :load-toplevel :execute) ;(eval-when (:compile-toplevel :load-toplevel :execute)
...@@ -248,7 +252,7 @@ t) ...@@ -248,7 +252,7 @@ t)
;(format t "Changing the following physiology: ~a~&" varValList) ;(format t "Changing the following physiology: ~a~&" varValList)
(let ((phys (get-module physio)) (let ((phys (get-module physio))
(setPhysMessage "<solverin>") (setPhysMessage "<solverin>")
(timeOut 6) (timeOut 12)
(num-param-changes 0)) (num-param-changes 0))
;;Construct message to be sent to new HumMod Solver Process ;;Construct message to be sent to new HumMod Solver Process
;; -We must find the chunk in the hash-table because the request to HumMod is case sensitive ;; -We must find the chunk in the hash-table because the request to HumMod is case sensitive
...@@ -640,6 +644,74 @@ t) ...@@ -640,6 +644,74 @@ t)
(setf (phys-module-vars-baseLine-init phys) t)))) (setf (phys-module-vars-baseLine-init phys) t))))
(clear-phys-files)) (clear-phys-files))
(defun update-phys-baseline (&optional (phys-module nil) (timeout 120))
"Allows us to update baseline (e.g., after moving ahead in time at beginning of experiment)
@param phys-module: [ACT-R Module] should be the Physio ACT-R module (which is what is defined within the physiology_thread.lisp file!
@param timeout: [int] The maximum amount of time in which the function should wait for the ModelSolver to output the file we need"
(let* ((phys
(if phys-module phys-module (get-module physio)))
(pipeID (phys-module-pipeID phys))
;;Set the name of the files used to input to model solver stream and to which solver outputs results
(solverInputFile (concatenate 'string *SolverPipeFileDir* "SolverIn" pipeID))
(solverOutputFile (concatenate 'string *SolverPipeFileDir* "SolverOut" pipeID))
(initial-advance-time (format nil "~10,$" (phys-module-initial-advance phys)))
(getValsMessage
(concatenate 'string
"<solverin><gofor><solutionint>" initial-advance-time
"</solutionint><displayint>" initial-advance-time
"</displayint></gofor></solverin>~&"))
(physValueList nil))
(tagbody startGetVals
;;Get new value list output by the ModelSolver
(handler-case
(with-open-file
(messageStream solverInputFile
:direction :output :if-exists :overwrite :if-does-not-exist :create)
(format messageStream getValsMessage))
((or
#+:ccl ccl::simple-file-error
#+:sbcl sb-impl::simple-file-error
simple-error) ()
(progn
(handler-case
(progn (delete-file solverInputFile) (delete-file solverOutputFile))
(error () nil))
(go startGetVals))))
(while (probe-file solverInputFile)) ;Wait for input file to be digested
(let ((currTime (get-universal-time)))
;;We only wait so long for the file to be created
(handler-case
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) timeout)))
(error () nil)))
;;When we ran out of time, start this section of the code over
(when (not (probe-file solverOutputFile)) (go startGetVals))
;;Parse the list of values output by ModelSolver
(let ((parseStart (get-universal-time)))
(tagbody parseValList
;If we've been stuck in this block for 4 secs or more, go back to the beginning of the function
(when (> (- (get-universal-time) parseStart) 4) (go startGetVals))
(handler-case
(setf physValueList (s-xml:parse-xml-file solverOutputFile))
((or file-error s-xml::xml-parser-error type-error) () (go parseValList)))
;;If parsing the output file didn't error, but physValList is still nil
;; (Can this actually happen?
;; May want to explore in the future to see if I need to do this)
(when (not physValueList)
(go parseValList))
;;If the modelsolver happens to give us a variable roster
;; instead of list, delete and redo this section of code
(when (equal (caadr physValueList) ':|varroster|)
(while (not (handler-case (delete-file solverOutputFile)
(error () nil))))
(go parseValList)))))
(while (not (handler-case (delete-file solverOutputFile) (error () nil))))
;;Set our current values
(setf (phys-module-physValList-baseline phys) physValueList)
(setf (phys-module-vars-baseLine-init phys) t)))
;;Record values for variables specified by model ;;Record values for variables specified by model
(defun record-phys-vals (recVarList allValList savedValList) (defun record-phys-vals (recVarList allValList savedValList)
(let ((valNumbers nil) (let ((valNumbers nil)
...@@ -946,6 +1018,37 @@ t) ...@@ -946,6 +1018,37 @@ t)
"Move to spontaneous breath" "Move to spontaneous breath"
(set-phys-vals (list (list "ControlledBreathing.ControlledBreathing" 0)))) (set-phys-vals (list (list "ControlledBreathing.ControlledBreathing" 0))))
(defun start-sleep-dep ()
"Make all changes needed for sleep deprivation (and full enactment of circadian rhythms)"
;;Turn on daily planner so that sleep schedule and sleep homeostasis can cause deprivation
(schedule-event-relative 0.023 'set-phys-vals :module 'physio
:params (list (list (list "DailyPlannerControl.Switch" 1) ;Start daily planner
(list "DailyPlannerSchedule.Hour12AM-1AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour1AM-2AM" 4) ;Eat
(list "DailyPlannerSchedule.Hour2AM-3AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour3AM-4AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour4AM-5AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour5AM-6AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour6AM-7AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour7AM-8AM" 4) ;Eat
(list "DailyPlannerSchedule.Hour8AM-9AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour9AM-10AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour10AM-11AM" 1) ;Rest
(list "DailyPlannerSchedule.Hour11AM-12PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour12PM-1PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour1PM-2PM" 4) ;Eat
(list "DailyPlannerSchedule.Hour2PM-3PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour3PM-4PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour4PM-5PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour5PM-6PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour6PM-7PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour7PM-8PM" 4) ;Eat
(list "DailyPlannerSchedule.Hour8PM-9PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour9PM-10PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour10PM-11PM" 1) ;Rest
(list "DailyPlannerSchedule.Hour11PM-12AM" 1))) ;Rest
:priority :max :details "Start Daily Control Cycle & change daily planner"))
;;;Set food intake (eating) variable to a value ;;;Set food intake (eating) variable to a value
(defun set-food-intake (value) (defun set-food-intake (value)
(set-phys-vals (list (list "DietIntakeNutrition.Fixed?" 1) (list "DietIntakeNutrition.FixedIntake(xGoal)" value))) (set-phys-vals (list (list "DietIntakeNutrition.Fixed?" 1) (list "DietIntakeNutrition.FixedIntake(xGoal)" value)))
......
"<solverin><gofor><solutionint>0.0166666680</solutionint><displayint>0.0166666680</displayint></gofor></solverin>"
\ No newline at end of file
Supports Markdown
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