Commit 7a5fda9c authored by CD's avatar CD

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,58 +1513,59 @@
(print-warning x))
(return-from simulate-retrieval-request-plus-seed-fct)))
(when (member :recently-retrieved (chunk-spec-slots request))
(let ((recent (chunk-spec-slot-spec request :recently-retrieved)))
(cond ((> (length recent) 1)
(invalid '("Invalid retrieval request." ":recently-retrieved parameter used more than once.")))
((not (or (eq '- (caar recent)) (eq '= (caar recent))))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -.")))
((not (or (eq t (third (car recent)))
(eq nil (third (car recent)))
(and (eq 'reset (third (car recent)))
(eq '= (caar recent)))))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset.")))
(t ;; it's a valid value for recently-retrieved
(if (eq 'reset (third (car recent)))
(bt:with-lock-held ((dm-state-lock dm))
(setf (dm-finsts dm) nil))
(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.")))
((not (or (eq '- (caar recent)) (eq '= (caar recent))))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's modifier can only be = or -.")))
((not (or (eq t (third (car recent)))
(eq nil (third (car recent)))
(and (eq 'reset (third (car recent)))
(eq '= (caar recent)))))
(invalid '("Invalid retrieval request." ":recently-retrieved parameter's value can only be t, nil, or reset.")))
(t ;; it's a valid value for recently-retrieved
(let ((finsts (remove-old-dm-finsts dm)))
(if (eq 'reset (third (car recent)))
(bt:with-lock-held ((dm-state-lock dm))
(setf (dm-finsts dm) nil))
(cond ((or (and (eq t (third (car recent))) ;; = request t
(eq (caar recent) '=))
(and (null (third (car recent))) ;; - request nil
(eq (caar recent) '-)))
;; only those chunks marked are available
(setf chunk-list (intersection (mapcar 'car finsts) chunk-list))
(command-output "Only recently retrieved chunks: ~s" chunk-list))
(t
(command-output "Removing recently retrieved chunks:")
(setf chunk-list
(remove-if (lambda (x)
(when (member x finsts :key 'car :test 'eq-chunks-fct)
(command-output "~s" x)
t))
chunk-list))))))))))
(when (member :mp-value (chunk-spec-slots request))
(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.")))
((not (eq '= (caar mp-value)))
(invalid '("Invalid retrieval request." ":mp-value parameter's modifier can only be =.")))
((not (numornil (third (car mp-value))))
(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)))))))
(let ((finsts (remove-old-dm-finsts dm)))
(cond ((or (and (eq t (third (car recent))) ;; = request t
(eq (caar recent) '=))
(and (null (third (car recent))) ;; - request nil
(eq (caar recent) '-)))
;; only those chunks marked are available
(setf chunk-list (intersection (mapcar 'car finsts) chunk-list))
(command-output "Only recently retrieved chunks: ~s" chunk-list))
(t
(command-output "Removing recently retrieved chunks:")
(setf chunk-list
(remove-if (lambda (x)
(when (member x finsts :key 'car :test 'eq-chunks-fct)
(command-output "~s" x)
t))
chunk-list))))))))))
(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.")))
((not (eq '= (caar mp-value)))
(invalid '("Invalid retrieval request." ":mp-value parameter's modifier can only be =.")))
((not (numornil (third (car mp-value))))
(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))))))))
......
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
This diff is collapsed.
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)
(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))))
(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))
(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)
(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))))))))))
(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)))))))))
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
No preview for this file type
No preview for this file type
File mode changed from 100644 to 100755
File mode changed from 100644 to 100755
......@@ -9,8 +9,8 @@
global copyrightlab30var
global copyrightlab30var
proc select_copyrights {} {
global got_actr_connection
global environment_socket
......@@ -34,10 +34,10 @@ proc select_copyrights {} {
label .copyright.lab22 -font intro_l_font -height 1 -text {ACT-R Environment} -anchor center
label .copyright.lab30 -font intro_l_font -height 2 -textvariable copyrightlab30var -anchor center
label .copyright.lab24 -font intro_s_font -height 1 -text { 2002-2017} -anchor center
label .copyright.lab33 -font intro_s_font -height 1 -anchor center -text {Dan Bothell}
label .copyright.lab43 -font intro_s_font -height 1 -anchor center -text {John R. Anderson}
label .copyright.lab35 -font intro_s_font -height 1 -anchor center -text {Department of Psychology, Carnegie Mellon University}
label .copyright.lab24 -font intro_s_font -height 1 -text {© 2002-2017} -anchor center
label .copyright.lab33 -font intro_s_font -height 1 -anchor center -text {Dan Bothell}
label .copyright.lab43 -font intro_s_font -height 1 -anchor center -text {John R. Anderson}
label .copyright.lab35 -font intro_s_font -height 1 -anchor center -text {Department of Psychology, Carnegie Mellon University}
global tcl_env_dir
......@@ -50,7 +50,7 @@ proc select_copyrights {} {
# SETTING GEOMETRY
###################
pack .copyright.lab22
pack .copyright.lab30
pack .copyright.lab30
pack .copyright.lab24
pack .copyright.lab33
pack .copyright.lab43
......@@ -58,21 +58,21 @@ proc select_copyrights {} {
pack .copyright.image
# get the version strings, but being careful because an
# overzelous clicker could clear the dialog before the
# overzelous clicker could clear the dialog before the
# register messages arrive, so make sure the update messages
# arrive (they're sent after the registers) before showing
# the window
global copyrightlab30var
global copyrightlab30var
set copyrightlab30var [call_act_r_command "act-r-version"]
# show the window if the user wants it
# sort of cheats because it still gets "built"
#if {$options_array(show_copyrights) == 1} {
# wm deiconify .copyright
#}
if {$options_array(show_copyrights) == 1} {
wm deiconify .copyright
}
}
}
......@@ -80,7 +80,7 @@ proc select_copyrights {} {
select_copyrights
# then if it's supposed to be shown
# then if it's supposed to be shown
if {$options_array(show_copyrights) == 1} {
......@@ -103,3 +103,4 @@ if {$options_array(show_copyrights) == 1} {
# close the window
destroy .copyright