Commit 7a5fda9c authored by CD's avatar CD
Browse files

Some ACT-R7 related updates

parent 14364076
File mode changed from 100644 to 100755
......@@ -282,6 +282,9 @@
;;; : * Fixed a couple typos from the previous update.
;;; 2018.12.17 Dan
;;; : * The remote whynot-dm wasn't using the external version.
;;; 2019.04.04 Dan
;;; : * Cache the result of chunk-spec-slots in the retrieval
;;; : request since that's costly don't want to do it twice.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
......@@ -1510,7 +1513,8 @@
(print-warning x))
(return-from simulate-retrieval-request-plus-seed-fct)))
(when (member :recently-retrieved (chunk-spec-slots request))
(let ((requested-slots (chunk-spec-slots request)))
(when (member :recently-retrieved requested-slots)
(let ((recent (chunk-spec-slot-spec request :recently-retrieved)))
(cond ((> (length recent) 1)
(invalid '("Invalid retrieval request." ":recently-retrieved parameter used more than once.")))
......@@ -1551,7 +1555,7 @@
t))
chunk-list))))))))))
(when (member :mp-value (chunk-spec-slots request))
(when (member :mp-value requested-slots)
(let ((mp-value (chunk-spec-slot-spec request :mp-value)))
(cond ((> (length mp-value) 1)
(invalid '("Invalid retrieval request." ":mp-value parameter used more than once.")))
......@@ -1561,7 +1565,7 @@
(invalid '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number.")))
(t ;; it's a valid request
(setf mp (third (car mp-value)))))))
(setf mp (third (car mp-value))))))))
......
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
......@@ -13,7 +13,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Filename : declarative-memory.lisp
;;; Version : 6.3
;;; Version : 6.4
;;;
;;; Description : Implements the declarative memory module.
;;;
......@@ -466,6 +466,18 @@
;;; : the if since it defaults to 0 thus no need to keep setting
;;; : it there if spreading-activation is off and that's a parameter
;;; : which shouldn't change during a run.
;;; 2019.04.02 Dan
;;; : * Have hash-chunk-contents use the underlying chunk info
;;; : instead of going through the accessors.
;;; 2019.04.04 Dan
;;; : * Cache the result of chunk-spec-slots in the retrieval
;;; : request since that's costly don't want to do it twice.
;;; 2019.04.15 Dan
;;; : * Depend on splice-into-position-des being destructive and
;;; : don't setf with the returned value.
;;; 2019.05.17 Dan [6.4]
;;; : * Allow the sim-hook cache to persist across a reset. Only
;;; : clear the table when a new hook function is set.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
......@@ -670,6 +682,8 @@
cache-sim-hook-results
(sim-hook-cache (make-hash-table :test 'equalp))
last-sim-hook
(chunk-lock (bt:make-lock "dm-chunks")) ;; chunks and chunk-hash-table
(param-lock (bt:make-lock "dm-params")) ;; things through sgp
(state-lock (bt:make-lock "dm-state")) ;; other slots
......@@ -813,13 +827,17 @@
;;; A function for converting a chunk to a list of its info
(defun hash-chunk-contents (chunk)
(cons (chunk-slots-vector chunk)
(let ((c (get-chunk chunk)))
(when c
(bt:with-recursive-lock-held ((act-r-chunk-lock c))
(cons (act-r-chunk-filled-slots c)
(mapcar (lambda (x)
(let ((val (fast-chunk-slot-value-fct chunk x)))
(let ((val (cdr x)))
(if (stringp val)
(string-upcase val)
(true-chunk-name-fct val))))
(chunk-filled-slots-list-fct chunk t))))
(sort (copy-list (act-r-chunk-slot-value-lists c))
#'< :key (lambda (x) (act-r-slot-index (car x))))))))))
(defun reset-dm-module (dm)
......@@ -851,9 +869,14 @@
(setf (dm-current-trace dm) nil))
#| Don't do that at reset
only when a new hook function gets
set so that results persist across a reset for
a given function.
(bt:with-lock-held ((dm-param-lock dm))
;; clear the sim-hook cache
(clrhash (dm-sim-hook-cache dm)))
|#
)
(defun secondary-reset-dm-module (dm)
......@@ -1050,7 +1073,8 @@
(print-warning x))
(return-from start-retrieval)))
(when (member :recently-retrieved (chunk-spec-slots request))
(let ((requested-slots (chunk-spec-slots request)))
(when (member :recently-retrieved requested-slots)
(let ((recent (chunk-spec-slot-spec request :recently-retrieved)))
(cond ((> (length recent) 1)
(invalid :too-many '("Invalid retrieval request." ":recently-retrieved parameter used more than once.")))
......@@ -1122,7 +1146,7 @@
(bt:release-lock (dm-state-lock dm))))))))))))
(when (member :mp-value (chunk-spec-slots request))
(when (member :mp-value requested-slots)
(let ((mp-value (chunk-spec-slot-spec request :mp-value)))
(cond ((> (length mp-value) 1)
(invalid :mp-multi '("Invalid retrieval request." ":mp-value parameter used more than once.")))
......@@ -1132,7 +1156,7 @@
(invalid :mp-not-num '("Invalid retrieval request." ":mp-value parameter's value can only be nil or a number.")))
(t ;; it's a valid request
(setf mp (third (car mp-value)))))))
(setf mp (third (car mp-value))))))))
(let ((best-val nil)
(best nil)
......@@ -1583,7 +1607,18 @@
(setf (dm-finst-span dm) (safe-seconds->ms (cdr param) 'sgp))
(cdr param))
(:sim-hook (setf (dm-sim-hook dm) (cdr param)))
(:sim-hook
;; If a different sim-hook is set clear the cache
(when (cdr param)
(when (and (dm-last-sim-hook dm)
(cdr param)
(not (equalp (cdr param) (dm-last-sim-hook dm))))
(clrhash (dm-sim-hook-cache dm)))
(setf (dm-last-sim-hook dm) (cdr param)))
(setf (dm-sim-hook dm) (cdr param)))
(:sji-hook (setf (dm-sji-hook dm) (cdr param)))
(:w-hook (setf (dm-w-hook dm) (cdr param)))
......@@ -1637,7 +1672,8 @@
(push (cdr param) (dm-chunk-add-hook dm)))
(setf (dm-chunk-add-hook dm) nil)))
(:nsji (setf (dm-nsji dm) (cdr param)))
(:cache-sim-hook-results (setf (dm-cache-sim-hook-results dm) (cdr param)))))
(:cache-sim-hook-results
(setf (dm-cache-sim-hook-results dm) (cdr param)))))
(t
(case param
......@@ -1923,7 +1959,7 @@
(let ((result nil))
(dolist (x ordering result)
(aif (position-if (lambda (y) (find (car x) (cdr y))) result)
(setf result (splice-into-position-des result it x))
(splice-into-position-des result it x)
(push-last x result)))))
......@@ -2060,7 +2096,7 @@
(define-parameter :cache-sim-hook-results :valid-test 'tornil :default-value nil
:warning "T or nil" :documentation "Whether the results of calling a sim-hook function should be cached to avoid future calls to the hook function"))
:version "6.3"
:version "6.4"
:documentation "The declarative memory module stores chunks from the buffers for retrieval"
;; The creation function returns a new dm structure
......
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
......@@ -404,6 +404,9 @@
;;; : the result which is wrong:
;;; : 1[5]: (DIRECTION= -2.7610862 2.8501358)
;;; : 1[5]: returned NIL
;;; 2019.04.23 Dan
;;; : * Create the chunk-type definition for motor extensions when
;;; : they're added instead of at every reset.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#+:packaged-actr (in-package :act-r)
......@@ -1176,9 +1179,13 @@
(bt:with-lock-held ((requests-table-lock dummy-module))
(if (gethash ct-name (new-requests-table dummy-module))
(print-warning "Request ~s is already an extension of the manual buffer. To redefine you must remove it first with remove-manual-request." ct-name)
(progn
(let ((type-list
(if (listp (first chunk-type))
(append chunk-type (list (list 'cmd ct-name)))
(append (list (list ct-name '(:include motor-command))) (rest chunk-type) (list (list 'cmd ct-name))))))
(setf (gethash ct-name (new-requests-table dummy-module))
(cons (copy-list chunk-type) function-name))
(cons type-list function-name))
t)))))))
(defmacro remove-manual-request (chunk-type)
......@@ -1297,15 +1304,12 @@
;; Define the chunk-types for the specified extensions
(maphash (lambda (name value)
(let* ((chunk-type-list (car value))
(type (chunk-type-fct (if (listp (first chunk-type-list))
(append chunk-type-list `((cmd ,name)))
(append `((,(first chunk-type-list) (:include motor-command))) (rest chunk-type-list) `((cmd ,name)))))))
(let ((type (chunk-type-fct (car value))))
(if type
(unless (chunk-p-fct name)
(define-chunks-fct (list (list name 'isa name)))
(make-chunk-immutable name))
(print-warning "Failed to extend motor capabilities with chunk-type definition: ~s" chunk-type-list))))
(print-warning "Failed to extend motor capabilities with chunk-type definition: ~s" (car value)))))
(bt:with-lock-held ((requests-table-lock instance)) (new-requests-table instance)))
)
......
......@@ -809,6 +809,15 @@
;;; : slot.
;;; 2019.03.06 Dan
;;; : * Use valid-slot-index instead of valid-slot-name.
;;; 2019.05.03 Dan
;;; : * Can't use the length of (buffers) to set the lookup array
;;; : because if a buffer is removed and added back it'll get a
;;; : new index that's outside that range. Using the new max-
;;; : buffer-index command instead.
;;; 2019.05.16 Dan
;;; : * Fixed production-statement-text for the @ actions because
;;; : it assumed only the old style of '@buffer> chunk' was
;;; : possible.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
......@@ -1093,7 +1102,7 @@
(setf (procedural-delayed-resolution prod) nil)
(setf (procedural-buffer-indices prod) nil)
(setf (procedural-buffer-lookup prod) nil)
(setf (procedural-buffer-lookup-size prod) (length (buffers)))
(setf (procedural-buffer-lookup-size prod) (1+ (max-buffer-index)))
(setf (procedural-last-cr-time prod) nil)
(setf (procedural-search-buffer-table prod) (make-hash-table))
......@@ -2176,7 +2185,14 @@
;; there's only one thing in the definition but leave it flexible...
(format s " ~c~a> ~{~s~^ ~}~%" op target (replace-variables definition bindings))))
(#\@
(format s " @~a> ~s~%" target (replace-variables (car definition) bindings)))
(cond ((null definition)
(format s " @~a>~%" target))
((= (length definition) 1)
(format s " @~a> ~s~%" target (first (replace-variables definition bindings))))
(t
(format s " @~a>~%" target)
(dolist (slot (replace-variables (chunk-spec-slot-spec spec) bindings))
(format s " ~s ~s~%" (spec-slot-name slot) (spec-slot-value slot))))))
(#\!
(format s " !~a! ~{~s~^ ~}~%" target (replace-variables definition bindings)))
(#\+
......
File mode changed from 100644 to 100755
......@@ -1148,6 +1148,21 @@
;;; : given point along the z axis. Both are simplifications to
;;; : avoid having to know head and eye geometry as well as head
;;; : position.
;;; 2019.03.22 Dan
;;; : * Changed add-visicon-features to not use valid-vis-loc-chunk
;;; : since it can do the tests while processing other things and
;;; : save the chunk lookups.
;;; 2019.04.12 Dan
;;; : * Changed set-default-vis-loc-slots to a macro and made a -fct
;;; : and remote command for it, added some safety checks to attend-
;;; : visual-coordinate, and made chunk-to-visual-position return
;;; : just nil for 'bad' chunks.
;;; 2019.04.15 Dan
;;; : * Depend on splice-into-position-des being destructive and
;;; : don't setf with the returned value.
;;; 2019.05.21 Dan
;;; : * When checking to unstuff the vis-loc buffer, don't unstuff
;;; : it if the chunk is being tracked.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......@@ -1339,17 +1354,25 @@
(fast-chunk-slot-value-fct chunk (first slots))
(fast-chunk-slot-value-fct chunk (second slots))))
(defmacro set-default-vis-loc-slots (x y z)
`(set-default-vis-loc-slots-fct ',x ',y ',z))
(defun set-default-vis-loc-slots (x y z)
(defun set-default-vis-loc-slots-fct (x y z)
(let ((vis-m (get-module :vision)))
(if vis-m
(if (every 'valid-slot-name (list x y z))
(bt:with-lock-held ((vis-loc-lock vis-m)) (setf (vis-loc-slots vis-m) (list x y z)))
(if (or (eq x y) (eq y z) (eq x z))
(print-warning "Duplicate slot names provided for set-default-vis-loc-slots: ~s, ~s, ~s" x y z)
(bt:with-lock-held ((vis-loc-lock vis-m)) (setf (vis-loc-slots vis-m) (list x y z))))
(dolist (name (list x y z))
(unless (valid-slot-name name)
(print-warning "Slot ~s is not valid in call to set-default-vis-loc-slots." name))))
(print-warning "No vision module available in call to set-default-vis-loc-slots."))))
(defun remote-set-default-vis-loc-slots-fct (x y z)
(set-default-vis-loc-slots-fct (string->name x) (string->name y) (string->name z)))
(add-act-r-command "set-default-vis-loc-slots" 'remote-set-default-vis-loc-slots-fct "Change the names of the default location slots for visual locations. Params: x-slot y-slot z-slot.")
(defmethod set-current-marker ((vis-mod vision-module) marker &optional lof)
(let ((old-clof (clof vis-mod)))
......@@ -1466,7 +1489,7 @@
((zerop pos)
(push chunk (visicon vis-mod)))
(t
(setf (visicon vis-mod) (splice-into-position-des (visicon vis-mod) pos chunk)))))))))
(splice-into-position-des (visicon vis-mod) pos chunk))))))))
......@@ -1698,10 +1721,13 @@
(defun chunk-to-visual-position (chunk)
(verify-current-model
"chunk-to-visual-position requires a current model."
(when (chunk-p-fct chunk)
(let* ((screen-pos (chunk-slot-value-fct chunk 'screen-pos))
(pos-chunk (and (chunk-p-fct screen-pos) screen-pos)))
(coerce (xyz-loc (or pos-chunk chunk)) 'list))))
(pos-chunk (and (chunk-p-fct screen-pos) screen-pos))
(loc (coerce (xyz-loc (or pos-chunk chunk)) 'list)))
(when (every 'numberp loc) loc)))))
(defun external-chunk-to-visual-position (chunk)
(chunk-to-visual-position (string->name chunk)))
......@@ -1799,7 +1825,11 @@
(declare (ignore copy))
(and was-copy ;; unchanged
(eq chunk (chunk-visicon-entry current)) ;; matches the stuffed entry
(query-buffer buffer '(buffer unrequested))))))) ;; and was actually stuffed
(query-buffer buffer '(buffer unrequested)) ;; and was actually stuffed
(let ((tracked (bt:with-lock-held ((marker-lock module))
(tracked-obj-lastloc module))))
(or (null tracked)
(not (eq current tracked)))))))))
(defun convert-visicon-chunk-to-vis-loc (chunk)
......@@ -3666,8 +3696,15 @@ Whenever there's a change to the display the buffers will be updated as follows:
e))))
(push-last (list (first od) nil (second od)) chunk-specs))))))
(let* ((loc-spec (mapcan (lambda (x)
(when (second x) (list (first x) (second x))))
(let* ((has-x nil)
(has-y nil)
(loc-spec (mapcan (lambda (x)
(when (second x)
(if (eq (first x) (first loc-slots))
(setf has-x (numberp (second x)))
(when (eq (first x) (second loc-slots))
(setf has-y (numberp (second x)))))
(list (first x) (second x))))
chunk-specs))
(obj-spec (mapcan (lambda (x)
(unless (find (first x) loc-slots)
......@@ -3683,8 +3720,7 @@ Whenever there's a change to the display the buffers will be updated as follows:
(visicon-chunk (car (define-chunks-fct (list (push (new-name "visicon-id") visicon-spec))))))
(if (and (valid-vis-loc-chunk visicon-chunk vis-mod loc-slots)
(valid-vis-loc-chunk loc-chunk vis-mod loc-slots))
(if (and loc-chunk visicon-chunk has-x has-y)
(progn
(setf (chunk-vis-loc-slots loc-chunk) loc-slots)
......@@ -4036,15 +4072,20 @@ Whenever there's a change to the display the buffers will be updated as follows:
(defun attend-visual-coordinates (x y &optional distance)
"Tells the Vision Module to start with attention at a certain location."
(aif (get-module :vision)
(if (and (numberp x) (numberp y) (or (null distance) (numberp distance)))
(let ((vis-loc-slots (bt:with-lock-held ((vis-loc-lock it)) (vis-loc-slots it))))
(bt:with-lock-held ((marker-lock it))
(set-current-marker it
(car (define-chunks-fct `((isa visual-location
,(first vis-loc-slots) ,x
,(second vis-loc-slots) ,y
,(third vis-loc-slots) ,(if (numberp distance) distance (bt:with-recursive-lock-held ((param-lock it)) (view-dist it))))))))))
,(third vis-loc-slots) ,(if (numberp distance) distance (bt:with-recursive-lock-held ((param-lock it)) (view-dist it)))))))))
t)
(print-warning "Invalid position value in call to attend-visual-coordinates: ~s ~s ~s" x y distance))
(print-warning "No vision module found. Cannot set visual coordinates.")))
(add-act-r-command "attend-visual-coordinates" 'attend-visual-coordinates "Set the current position of the model's visual attention. Params: x y {z}.")
(defun remove-visual-finsts (&optional set-new restuff)
(let ((vis-m (get-module :vision)))
(if vis-m
......
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
No preview for this file type
No preview for this file type
File mode changed from 100644 to 100755
Here is some very basic information on how to start running ACT-R 7 from
sources, but the recommendation now is to use the standalone version
instead of the sources.
As of version 7.6, using the ACT-R sources requires that QuickLisp be
installed for the Lisp being used because ACT-R now uses some external
libraries for network communication and threading. QuickLisp isa available
from: <https://www.quicklisp.org>.
Here is the basic information on how to start running ACT-R 7 from sources.
If you want to run the standalone version you will need to consult the
readme file which was included with it instead.
1) Get the source code either from the software page of the ACT-R website
......@@ -16,20 +11,26 @@ is recommended because it has been more thoroughly tested and should be
consistent with the documentation whereas the repository may contain updates
that have not been as thoroughly tested or documented.
2a) If you want to use the ACT-R Environment or interact with the ACT-R
software through the remote interface:
You will also need to have QuickLisp installed for the Lisp being used to
get the external libraries for network communication and threading. QuickLisp
isa available from: <https://www.quicklisp.org>.
2) In your Lisp application, load the load-act-r.lisp file which is found at
the top level of the ACT-R sources. That will load all of the necessary ACT-R
In your Lisp application, load the load-act-r.lisp file which is found at the
top level of the ACT-R sources. That will load all of the necessary ACT-R
files, get and load the necessary libraries through QuickLisp, and start the
remote interface server.
ACT-R remote interface server.
Once the ACT-R version information is printed it is ready to use.
If you would like to use the ACT-R Environment GUI then you can run the
appropriate application for your OS in the environment directory of the sources
("Start Environment.exe", "Start Environment OSX", or "start environment Linux").
Once the buttons appear in the "Control Panel" window the ACT-R Environment
is ready to use. When you are done with the ACT-R Environment, closing the
"Control Panel" window will exit the application.
("Start Environment.exe", "Start Environment OSX", or "start environment
Linux"). Once the buttons appear in the "Control Panel" window the ACT-R
Environment is ready to use. When you are done with the ACT-R Environment,
closing the "Control Panel" window will exit the application.
If you are using LispWorks or Allegro Common Lisp with either Mac OS X or
Windows or using Clozure Common Lisp with Windows, Mac OS X, or Linux, then you
......@@ -40,7 +41,21 @@ run-environment does not start the Environment application you will have to
run the application explicitly.
-----------------------------------------------------------------------------------
2b) If you do not need any of the remote interface capabilities, will be
working entirely within Lisp, and will only access ACT-R from the initial Lisp
"listener" thread, then you can load a "Lisp only" version of the software:
The "Lisp only" version does not include the remote interface, does not
require QuickLisp, and is often significantly faster for running models.
In your Lisp application, load the load-single-threaded-act-r.lisp file which
is found at the top level of the ACT-R sources. That will load all of the
necessary ACT-R files.
Once the ACT-R version information is printed it is ready to use.
-------------------------------------------------------------------------------
If you have any questions, problems, or comments please send them to
Dan (db30@andrew.cmu.edu).
No preview for this file type
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