(in-package "CL-USER") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Name: mental rotation ;;;; Version: 0.3 ;;;; Date: 10.1.2003 ;;;; ;;;; Author: Sashank Varma ;;;; Email: sashank@vanderbilt.edu ;;;; Organization: Center for Cognitive Brain Imaging (CCBI) ;;;; Carnegie Mellon University ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; History: ;;;; ;;;; 9.3.2002 sv: (v0.1.1) First version just implements the representational ;;;; scheme of Marr & Nishihara (1978) and Marr (1982) for ;;;; 3D models and adjunct relations between nested 3D models. ;;;; No productions written yet. ;;;; ;;;; 9.4.2002 sv: (v0.1.2) Changed representational scheme from a combination ;;;; of cylindrical and spherical coordinates (a la Marr) to ;;;; one that uses rectangular coordinates exlcusively. This ;;;; enabled the straightforward implementation of rotational ;;;; primitives. ;;;; ;;;; 10.1.2002 sv: (v0.1.3) Implemented the first version of the Iinitial ;;;; search phase. Still deciding which heuristics apply ;;;; during the initial proposal of matching segments by RH- ;;;; SPATIAL and which apply during the adjudication between ;;;; possible matches. ;;;; ;;;; 10.2.2002 sv: (v0.1.4) Finished implementing the initial search phase. ;;;; Adapted the default executive logic of LH-EXECUTIVE to ;;;; select the next operator not just based on perfectly ;;;; resolvable and discrete binary preferences, but also ;;;; based on the graded accrual of activation based on ;;;; soft preferential heuristics. ;;;; ;;;; 10.3.2002 sv: (v0.1.5) Finished implementing the second, transformation ;;;; phase. ;;;; ;;;; 10.4.2002 sv: (v0.1.6) Finished implementing the third and fourth ;;;; phases, subsequent search and confirmation. This ;;;; completes the first version of the model. It works ;;;; correctly for all Shepard-Metzler stimuli where the ;;;; rotations are around the Z axis only. ;;;; ;;;; 11.2.2002 sv: (v0.1.7) Found resource settings for the four centers that ;;;; enable simulation of the dual task study (Just, ;;;; Carpenter, Keller, Emery, Zajac, & Thulborn, 2001). ;;;; ;;;; 11.3.2002 sv: (v0.1.8) Found resource settings for the four centers that ;;;; enable simulation of the mental rotation study ;;;; (Carpenter, Just, Keller, Eddy, & Thulborn, 1999). ;;;; ;;;; 10.1.2003 sv: (v0.2) Adapted model so that it can be run in dual-task ;;;; mode. This required two modifications. ;;;; ;;;; First, defined a global variable *DUAL-TASK*. If bound ;;;; and non-NIL, the Mental Rotation Model does not define ;;;; certain things assumed to be defined in the already- ;;;; loaded Sentence Comprehension Model. It also undefines ;;;; certain other things defined in the Sentence Comprehension ;;;; model that must be defined differently by the Mental ;;;; Rotation Model; this eliminates innocuous warnings that ;;;; may otherwise scare users. ;;;; ;;;; Second, created a new abstract dme class MR-DME from ;;;; which all classes specific to the Mental Rotation ;;;; Model now inherit. This allows multiple models that ;;;; use the general Executive Model to coexist in dual-task ;;;; mode. ;;;; ;;;; Standardized the General Executive model productions across the TOL, ;;;; mental rotation, driving, and TOH models. ;;;; Renamed the TOP-LEVEL-GOAL class to TASK-GOAL in all models that instantiate ;;;; the General Executive model. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Bugs: ;;;; ;;;; 11.2002 sv: (v0.1.6) The SUPPRESS-ARBITRARILY-CHOSEN-PREFERRED-OPERATOR- ;;;; MARKER production is troublesome in two ways. First, the ;;;; choice between preferred operators is made arbitrarily, ;;;; but systematically. It realy should be made randomly. ;;;; Second, the arbitrariness is not as arbitrary as first ;;;; appears. Specifically, if the > is changed to a <, then ;;;; the model fails. ;;;; ;;;; 11.2002 sv: (v0.1.6) Doesn't perform the 0 degrees same trial correctly. ;;;; ;;;; 11.2002 sv: (v0.1.8) Somehow partially broke the model. No longer ;;;; solves the 40 degrees different nor the 120 degrees ;;;; different trial correctly. Am hiding this at the moment ;;;; by wrapping simulations in IGNORE-ERRORS. ;;;; ;;;; 10.1.2003 sv: (v0.2) Just squashed the weirdest freaking bug. Switched ;;;; the general Executive Model productions so that they assert ;;;; MR-PREFERENCEs, but mistakenly left the Mental Rotation ;;;; Model productions asserting plain PREFERENCEs. This ;;;; exposed a bug in the spew RHS action. Spew takes a ;;;; a template and spews the specified activation to all ;;;; dmes that fit the template. Therefore had productions ;;;; spewing to the same unary preferenced expressed as both ;;;; a PREFERENCE and MR-PREFERENCE, which is to say to two ;;;; different dmes since spew does not coalesce across ;;;; classes, even when one class is a subclass of the other. ;;;; *Maybe* this was the right behavior, and users should ;;;; be warned when they instantiate both a class and its ;;;; superclass. Or maybe this was a bug, and users should ;;;; not be allowed to instantiate both a class and its ;;;; superclass. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Design Decisions: ;;;; ;;;; 9.4.2002 sv: (v0.1.2) Consider standardizing the hook for users to ;;;; supply pretty print methods for dm classes. For ;;;; example, the built-in 4caps machinery could (optionally) ;;;; print the activation, a colon, a #\tab, and then call a ;;;; hook method which defaults to the current behavior. ;;;; This would replace the ad hoc "trees" mechanism of ;;;; the sentence comprehension model. ;;;; ;;;; 11.2002 sv: (v0.1.6) Consider defining MORE-RECENT-P on the BASE-DME ;;;; class and eliminating specializations such as MORE- ;;;; RECENT-STATE-P. ;;;; ;;;; 11.2002 sv: (v0.1.6) Consider proposing rotations during the ;;;; Transformation phase around axes besides Z. This will be ;;;; necessary for full generality. ;;;; ;;;; 11.2002 sv: (v0.1.6) Must specialize the following default methods of ;;;; the Executive model that are currently bluntly overriden: ;;;; HILL-CLIMBING-OPERATOR-P ;;;; STEEPER-CLIMBING-OPERATOR-P ;;;; PERFORM-OPERATOR ;;;; SATISFIED-P ;;;; ;;;; 11.2002 sv: (v0.1.6) Must specialize these default methods of the ;;;; Executive model that are currently bluntly overriden so ;;;; that adjunct-relations can now be the contents of states. ;;;; CONTENTS-EQUAL ;;;; COMPONENTS ;;;; STANDS-IN ;;;; NAME ;;;; ;;;; 11.2002 sv: (v0.1.6) Determine whether the PARENT slot of the ROTATE- ;;;; COMPONENT class can be eliminated. ;;;; ;;;; 11.2002 sv: (v0.1.6) The following productions of the Executive model ;;;; have been changed in the Mental Rotation Model. Ensure ;;;; these changed versions work in the TOL and TOH models too. ;;;; UNARY-PREFERENCE ;;;; BINARY-PREFERENCE ;;;; SELECT-AMONG-OPERATORS ;;;; SUPPRESS-PREFERENCE ;;;; PERFORM-MOVE ;;;; SUPPRESS-UNPREFERRED-OPERATOR ;;;; SELECT-AMONG-UNARY-OPERATORS ;;;; ;;;; 11.2002 sv: (v0.1.6) The (kind-of-hacky) SUPPRESS-REDUNDANT-SELECTION ;;;; production of the Executive model had to be commented out ;;;; for the Mental Rotation Model to work. See if it can be ;;;; commented out in the TOL and TOH models too or fixed so ;;;; that it can be part of the mental imagery model. ;;;; ;;;; 11.2002 sv: (v0.1.6) The following productions contain hacks that should ;;;; be eliminatable. ;;;; PROPOSE-SUBSEQUENT-SEARCH-GOAL ;;;; SUPPRESS-DURING-CONFIRMATION ;;;; PROPOSE-INITIAL-MATCHED-COMPONENTS ;;;; ;;;; 11.2002 sv: (v0.1.6) It may be possible to fold the PREFER-HILL- ;;;; CLIMIBING-ROTATIONS production into a special case of the ;;;; BINARY-PREFERENCE production. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; Contents ;;;; ;;;; (1) Initialization. ;;;; (2) DM Classes. ;;;; (3) Centers. ;;;; (4) The LH-Executive Center. ;;;; (5) The RH-Executive Center. ;;;; (6) The LH-Spatial Center. ;;;; (7) The RH-Spatial Center. ;;;; (8) Support Code. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (A) Commented out the productions that suppress the goals corresponding ;;;; to completed phases of mental rotation. This was done solely to make ;;;; the model's fit to the data more aesthetically pleasing. In point of ;;;; fact, Carpenter et al. (1999) did not find a linear relation between ;;;; angular disparity and right frontal activation. This is the "result" ;;;; that the model with all productions models. Superficially (and ;;;; intuitively), such a relation appears to exist. When the goal ;;;; suppression productions are commented out, the model also produces a ;;;; modest linear relation. See the new capacities as well. ;;;; ;;;; (4) During the transformation and confirmation phases, added productions ;;;; that propose rotation operators around the (incorrect) X and Y axes. ;;;; These compete for selection, producing resource demands in LH- ;;;; Executive. These productions and the rotation operators they propose ;;;; still need to be fleshed out, but the placeholders (and more ;;;; importantly, the resource consumption profiles) are now in place. ;;;; ;;;; ;;;; IN PROGRESS (5) Do the same during CONFIRMATION. ;;;; ;;;; 11.2.2004: Standardize General Executive model productions across the ;;;; TOL, mental rotation, driving, and TOH models. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (1) Initialization. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 4caps. ;;; ;; Set 4caps switches. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (set-default-dme-thresh 0.099) (set-tracing-p nil) (set-tracing-dm-p nil) ) ;;; ;;; Executive Model. ;;; ;; Standard spew weight and rate. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (defparameter *weight* 1.0) (defparameter *spew-rate* 1.0) ) ;; Spew weight associated with the various preference-asserting productions ;; of the General Executive model. The magnitude represents the heuristic ;; goodness in activating the most preferred operator. (defparameter *default-preference-weight* 0.1) ;;; ;;; Mental Rotation Model. ;;; ;; Spew weights associated with the various preference-asserting productions ;; of the Mental Rotation Model. Their magnitude represents their heuristic ;; goodness in activating the most preferred operator. (defparameter *length-weight* 0.1) (defparameter *end-weight* 0.2) ;; Rotation. ;;; Rotation rate (in degrees). ;;; ;;; NOTE: Instead of making this up, could estimate it from the behavioral ;;; data. (defparameter *rotation-rate* 10) ;;; Compare the orientations of the vectors VECT1 and VECT2 to determine ;;; whether they are close enough to be considered equal. The tolerance is ;;; a function of the rotation rate such that two vectors can always be ;;; brought into approximate alignment. (defun =approx-orients (vect1 vect2) (< (abs (real-angle vect1 vect2)) (1+ (/ *rotation-rate* 2)))) ;; Advanced vector operations. ;;; Rotate a vector VECT by DEG degrees around the z axis. ;;; ;;; NOTE: For complete generality, modify this so the rotation can be ;;; around any axis. Perhaps tolerate oblique rotations as well ;;; by allowing the caller to specify the axis as an arbitrary ;;; vector. (defun rotate-z (vect deg) (let ((rad (rads deg))) (pretty-up (vector (- (* (elt vect 0) (cos rad)) (* (elt vect 1) (sin rad))) (+ (* (elt vect 0) (sin rad)) (* (elt vect 1) (cos rad))) (elt vect 2))))) ;;; Reverse the direction of a vector VECT by rotating it 180 degree around ;;; all three axes. (defun flip-vector (vect) (vector (- (elt vect 0)) (- (elt vect 1)) (- (elt vect 2)))) ;;; Translate a vector OLD by the distance specified by the vector TRANS. (defun translate (old trans) (add-vects old trans)) ;;; Compute the unit vector with the same orientation as vector VECT. (defun unit-vector (vect) (let ((mag (magnitude vect))) (vector (/ (elt vect 0) mag) (/ (elt vect 1) mag) (/ (elt vect 2) mag)))) ;;; Determine whether vectors VECT1 and VECT2 are perpendicular to one ;;; another. (defun perpendicular-p (vect1 vect2) (=approx (dot-product vect1 vect2) 0)) ;;; Determine whether vectors VECT1 and VECT2 are parallel to one another. (defun parallel-p (vect1 vect2) (=approx (dot-product vect1 vect2) (* (magnitude vect1) (magnitude vect2)))) ;; Basic vector operations. ;;; The vector that results from adding the vectors VECT1 and VECT2. (defun add-vects (vect1 vect2) (vector (+ (elt vect1 0) (elt vect2 0)) (+ (elt vect1 1) (elt vect2 1)) (+ (elt vect1 2) (elt vect2 2)))) ;;; The dot product of two vectors VECT1 and VECT2. (defun dot-product (vect1 vect2) (+ (* (elt vect1 0) (elt vect2 0)) (* (elt vect1 1) (elt vect2 1)) (* (elt vect1 2) (elt vect2 2)))) ;;; The magnitude of vector VECT. (defun magnitude (vect) (sqrt (+ (expt (elt vect 0) 2) (expt (elt vect 1) 2) (expt (elt vect 2) 2)))) ;;; The angle between the vectors VECT1 and VECT2. (defun real-angle (vect1 vect2) (realpart (degs (acos (/ (dot-product vect1 vect2) (* (magnitude vect1) (magnitude vect2))))))) ;; Converting between different units for angles. ;;; The radians of an angle of DEGS degrees. (defun rads (degs) (* degs pi 1/180)) ;;; The degrees of an angle of RADS radians. (defun degs (rads) (* rads 180 (/ 1 pi))) ;; Support functions for finessing floating point ugliness. (defparameter *default-tolerance* .0001) ;; Compare numberswith a tolerance that hides floating point ghosts. (defun =approx (num1 num2 &optional (tolerance *default-tolerance*)) (<= 0 (abs (- num1 num2)) tolerance)) ;; Compare vectors with a tolerance that hides floating point ghosts. (defun =approx-vects (vect1 vect2 &optional (tolerance *default-tolerance*)) (and (=approx (elt vect1 0) (elt vect2 0) tolerance) (=approx (elt vect1 1) (elt vect2 1) tolerance) (=approx (elt vect1 2) (elt vect2 2) tolerance))) ;;; Pretty-up a vector for human consumption. (defun pretty-up (vect) (dotimes (i (length vect)) (let ((elem (elt vect i))) (when (=approx elem 0) (setf (elt vect i) 0.0)) (unless (floatp elem) (setf (elt vect i) (float elem))))) vect) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (2) DM classes. ;;;; ;;;; The dm class hierarchy is schematically represented below. "A: B" means ;;;; that class A is a superclass of class B. "A: B (+C)" means that class A ;;;; is a superclass of class B, and is mixed with class C to produce class B. ;;;; in this case, class C is called a "mixin" class, and it is common to ;;;; suffix mixin class names with "-mi". ;;;; ;;;; MR-DME: 3D-MODEL ;;;; ;;;; ADJUNCT-RELATION: EXTERNAL-ADJUNCT-RELATION ;;;; INTERNAL-ADJUNCT-RELATION ;;;; ;;;; SM-FIGURE-MIXIN ;;;; ;;;; BASE-STATE: STATE: MR-STATE (+ MR-DME): SM-FIGURE (+ SM-FIGURE-MI) ;;;; END-STATE: MR-END-STATE (+ MR-DME): END-SM-FIGURE (+ SM-FIGURE-MI) ;;;; ;;;; OPERATOR: MR-OPERATOR (+ MR-DME): MATCH-COMPONENTS: INITIAL-MATCH-COMPONENTS ;;;; SUBSEQUENT-MATCH-COMPONENTS ;;;; ROTATE-COMPONENT ;;;; DUMMY-ROTATE-COMPONENT ;;;; ;;;; PREFERENCE: MR-PREFERENCE (+ MR-DME) ;;;; ;;;; PREFERRED-OPERATOR MR-PREFERRED-OPERATOR (+ MR-DME) ;;;; ;;;; BASE-GOAL: TASK-GOAL: MR-TASK-GOAL (+ MR-DME) ;;;; GOAL: MR-GOAL (+ MR-DME): INITIAL-SEARCH-GOAL ;;;; TRANSFORMATION-GOAL ;;;; SUBSEQUENT-SEARCH-GOAL ;;;; CONFIRMATION-GOAL ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Executive Model classes. ;;; ;; STATE-related classes and methods. ; The BASE-STATE class from which all others inherit. This is a convenient ; abstraction because STATE and END-STATE classes typically share the same ; contents, which can be defined once, here. (defdmclass base-state () contents) ; The STATE class, instances of which are the bread and butter of Newell and ; Simon's (1972) view of problem solving as search through state spaces. (defdmclass state (base-state)) (defmethod more-recent-state-p ((s1 state) (s2 state)) (> (id s1) (id s2))) ; The END-STATE class, which encodes the state of affairs that signals task ; completion. (defdmclass end-state (base-state)) ;; STATE-related multimethods. These methods apply across different STATE ;; classes. ;;; Are the two states C1 and C2 the same? This method must be explicitly ;;; defined when the general Executive Model is applied to a particular domain ;;; to reflect the content of states in that domain: puzzle configurations, ;;; Shepard-Metzler figures in particular orientations, etc. (defmethod contents-equal ((c1 t) (c2 t)) (error "The CONTENTS-EQUAL multimethod must be specialized for the task at hand.")) ;;; Is the state S, typically the current state, the same as end state ES? ;;; This determines whether the current task has been completed. ;;; ;;; NOTE: Change name to NOT-COMPLETED-P; while "solved" works for the TOH ;;; and TOL domains, it works less well for mental rotation and driving. (defmethod not-solved-p ((s state) (es end-state)) (not (contents-equal (contents s) (contents es)))) ;; The OPERATOR class. In Newell and Simon's (1972) view of problem solving, ;; when an instance of this class is applied to the current state, the ;; next currrent state is generated. (defdmclass operator () state) ;; The PREFERENCE class. In Newell's (1990) Soar theory, when multiple ;; operators can be applied to the current state, this ambiguity must be ;; eliminated. Instances of this class represent local (pairwise) ;; orderings of operators. They are combined and sorted to determine the ;; most preferred operator, which is selected for application. (defdmclass preference () better-operator worse-operator) ;; The PREFERRED-OPERATOR class. In Newell's (1990) Soar theory, when ;; preferences have been asserted over the possible operators and the most ;; preferred operator selected, its identity must be noted in some way. ;; Instances of this class serve this purpose. (defdmclass preferred-operator () operator) ;; GOAL-related classes and methods. ; The BASE-GOAL class from which all others inherit. This is SOMETIMES ; a convenient abstraction -- when the GOAL and TASK-GOAL classes share ; structure, it can be defined once, here -- but not typically. ; ; NOTE: Eliminate this abstraction. (defdmclass base-goal ()) (defmethod more-recent-goal-p ((bg1 base-goal) (bg2 base-goal)) (> (id bg1) (id bg2))) ; The TASK-GOAL class, instances of which encode the task being performed. (defdmclass task-goal (base-goal)) ; The base GOAL class. Instances are subgoals that are proposed to ; resolve impasses in the selection between operators and the application ; operators to states. They can also be spawned recursively to generate ; goal-subgoal hierarchies. They are central to Newell and Simon's (1972) ; theory of problem solving, and its revision in Soar (Newell, 1990). (defdmclass goal (base-goal) operator) ;; General multimethods that apply acrosses classes. #| ;;;^^^ Commented out this method. The General Executive model only uses it ;;;^^^ in a production that also calls STEEPER-HILL-CLIMBING-OPERATOR-P, ;;;^^^ which means that its logic can be shifted wlog to that method. I have ;;;^^^ done this; let's see if it works for this model and for the other ;;;^^^ instantations of the General Executive Model. ;;; Does the operator OP make direct progress towards the end-state ES? This ;;; method must be defined when the general Executive Model is applied to a ;;; particular domain to reflect what counts as direct progress in that ;;; domain, e.g., moving a ball to its pocket position in the end TOL ;;; configuration, ;;; ;;; NOTE: This method is bluntly overriden in the Mental Rotation Model so ;;; that it always returns NIL. In other words, there is no sense in ;;; which a particular rotation by *ROTATION-RATE* degrees achieves ;;; the desired orientation. Think of a more elegant way to do this. ;;; For example, now that an abstract MR-OPERATOR class is defined, ;;; can specialize this method for that class, overriding it through ;;; pure inheritance to return NIL. (defmethod hill-climbing-operator-p ((op operator) (es end-state)) ; (error "The HILL-CLIMBING-OPERATOR-P multimethod must be specialized for the task.") nil ) |# ;;;^^^ Must specialize this default method of the Executive model that is ;;;^^^ currently bluntly overriden: ;;; Does the operator OP1 make faster progress towards the end state ES than ;;; the operator OP2? This method must be defined when the general Executive ;;; Model is applied to a particular domain to reflect what counts as direct ;;; progress in that domain, e.g., moving a ball to its pocket position in ;;; the end TOL configuration, ;;; ;;; NOTE: This method is bluntly overriden in the Mental Rotation Model so ;;; that it always returns NIL. In other words, there is no sense in ;;; which one rotation by *ROTATION-RATE* degree achieves the desired ;;; orientation and faster than another rotation by the same amount. ;;; Think of a more elegant way to do this. For example, now that an ;;; abstract MR-OPERATOR class is defined, can specialize this method ;;; for that class, overriding it through pure inheritance to return NIL. (defmethod steeper-climbing-operator-p ((op1 operator) (op2 operator) (es end-state)) ; (error "The STEEPER-CLIMBING-OPERATOR-P multimethod must be specialized for the task.") nil ) ;;;^^^ Must specialize this default method of the Executive model that is ;;;^^^ currently bluntly overriden: ;;; Perform the operator OP on the state S, yielding the contents of the new, ;;; successor state. This method must be defined when the general Executive ;;; Model is applied to a particular domain to reflect how the contents of ;;; states are represented in that domain, e.g., by a list of lists, one for ;;; each pocket, in the TOL domain. ;;; ;;; NOTE: This method is bluntly overriden in the Mental Rotation Model so ;;; that it always returns NIL. This is because the contents of states ;;; are not jam-packed into the CONTENTS slot, but are more fully ;;; elaborated. This is a fundamental incompatibility, and the ;;; Executive Model must be generalized in the future to easily ;;; allow both choices. (defmethod perform-operator ((op operator) (s state)) ; (error "The PERFORM-OPERATOR multimethod must be specialized for the task.") nil ) ;;;^^^ Must specialize this default method of the Executive model that is ;;;^^^ currently bluntly overriden: ;;; Does the state S represent satisfaction of the goal G? This method must ;;; be defined when the general Executive Model is applied to a particular ;;; domain to reflect the vagaries of goals and how goals are represented in ;;; that domain. ;;; ;;; NOTE: This method is bluntly overriden in the Mental Rotation Model so ;;; that it always returns NIL. (defmethod satisfied-p ((g goal) (s state)) ; (error "The SATISFIED-P multimethod must be specialized for the task.") nil ) ;;; ;;; Mental Rotation Model classes. ;;; ;; Mixin classes. Often, two classes derived in different parts of the ;; inheritance hierarchy will share structure. It is useful in these cases ;; to extract the shared structure into a separate "mixin" class. ;;; The base mixin class of the Mental Rotation Model. When the generic ;;; classes of the general Executive Model are specialized for the Mental ;;; Rotation domain, this class is "mixed in" via multiple inheritance. ;;; This is useful when simulating dual-task performance with two models ;;; that both derive from the general Executive Model. It allows the user ;;; and the system to separately track, for example, states in the Mental ;;; Rotation model versus states in the Driving model. (defdmclass mr-dme ()) (defdmclass sm-figure-mixin (mr-dme)) ;; STATE-related classes and methods. ; Specialize the STATE-related classes of the General Executive Model ; for the domain of mental rotation. These are trivial specialization; ; the mixin class mr-dme is simply mixed in to both. (defdmclass mr-state (state mr-dme)) (defdmclass mr-end-state (end-state mr-dme)) ; Specialize the new mr-state and mr-end-state classes further. ; ; NOTE: This seems entirely superfluous. Along the same lines, the mr-dme ; class has now been mixed in twice (once through mr-(end)-state and ; once through sm-figure-mixin. The truth be told, the mr-state and ; and mr-end-state classes seem vestigial. (defdmclass sm-figure (mr-state sm-figure-mixin)) (defdmclass end-sm-figure (mr-end-state sm-figure-mixin)) ; The real heart of states in the Mental Rotation Model is defined here. ; They are complex, based on the visuo-spatial representations of Marr and ; Nishihara (1978) and Marr (1982, chapter 5). ;;; A basic object containing a local coordinate system. In Marr' scheme, ;;; a generalized cyclinder. However, this level of detail is unnecessary ;;; for Shepard-Metzler figures. The principal axis of the object is given ;;; in the adjunct-relation that connects it to its superordinate object. (defdmclass 3d-model (mr-dme) name components) ;;; Specifies the relation between a superordinate 3d-model (PARENT) and ;;; a subordinate 3d-model (COMPONENT). Specifically, the principal axis ;;; of the latter begins at position POS on the principal axis of the former, ;;; and extends at an orientation ORIENT. ;;; ;;; NOTE: Rename the PARENT slot? (defdmclass adjunct-relation (mr-dme) parent component pos orient) ;;; Does the adjunct relation AR link the superordinate 3d-model PAR to its ;;; subordinate 3d-model COMP? (defmethod stands-in ((par 3d-model) (comp 3d-model) (ar adjunct-relation)) (and (equal (name par) (parent ar)) (equal (name comp) (component ar)))) ;;; Are the (principal axes of the) component 3d-models of AR1 and AR2 the ;;; same length? (defmethod equal-length ((ar1 adjunct-relation) (ar2 adjunct-relation)) (=approx (magnitude (orient ar1)) (magnitude (orient ar2)))) ;;; Are the (principal axes of the) component 3d-models of AR1 and AR ;;; adjacent to one another? (defmethod contiguous-p ((ar1 adjunct-relation) (ar2 adjunct-relation)) (or (=approx-vects (pos ar1) (add-vects (pos ar2) (orient ar2))) (=approx-vects (pos ar2) (add-vects (pos ar1) (orient ar1))))) ;;; Was the AR1 adjunct-relation created before the AR2 adjunct-relation? (defmethod more-recent-adjunct-relation-p ((ar1 adjunct-relation) (ar2 adjunct-relation)) (> (id ar1) (id ar2))) ;;;^^^ (defdmclass external-adjunct-relation (adjunct-relation)) ;;;^^^ (defdmclass internal-adjunct-relation (adjunct-relation)) ; Miscellaneous multimethods and methods related to the specialized state ; representations of the Mental Rotation Model. (defmethod left-figure-p ((self sm-figure-mixin)) (equal (name (contents self)) 'left)) (defmethod right-figure-p ((self sm-figure-mixin)) (equal (name (contents self)) 'right)) (defmethod component-of ((comp 3D-model) (smfmi sm-figure-mixin)) (member (name comp) (components (contents smfmi)))) (defmethod component-of ((comp-name symbol) (smfmi sm-figure-mixin)) (member comp-name (components (contents smfmi)))) ; The multimethods below are defined in the general Executive Model and ; are supposed to be overriden for the specialized state reprsentations ; of the domain model. However, states are complex in the Mental Rotation ; Model, and include component representations that are not themselves ; states. (In OOP speak, they do not stand in the isa relation, but in ; the has-a relation.) These multimethods must be defined for the non- ; state representations, and overridden to simply return NIL. ; ; NOTE: Surely this can all be cleaned up. (defmethod contents-equal ((m1 3d-model) (m2 3d-model)) nil) (defmethod contents-equal ((ar1 adjunct-relation) (ar2 adjunct-relation)) nil) (defmethod contents-equal ((m 3d-model) (ar adjunct-relation)) nil) (defmethod contents-equal ((ar adjunct-relation) (m 3d-model)) nil) (defmethod components ((ar adjunct-relation)) nil) (defmethod stands-in ((ar adjunct-relation) (arg2 t) (arg3 t)) nil) (defmethod name ((ar adjunct-relation)) nil) ;; OPERATOR-related classes. ; Specialize the operator class of the General Executive Model for the domain ; of mental rotation. This is a trivial specialization; the mixin class ; mr-dme is simply mixed. (defdmclass mr-operator (operator mr-dme)) ; Operators of the Mental Rotation Model. ;;; Operator representing a possible match between the subordinate 3d-model ;;; LEFT-COMPONENT of the figure LEFT-SM-FIGURE and the subordinate 3d-model ;;; RIGHT-COMPONENT of the figure RIGHT-SM-FIGURE. (defdmclass match-components (mr-operator) left-sm-figure left-component right-sm-figure right-component) ;;; Operator representing... (defdmclass initial-match-components (match-components)) ;;; Operator representing... (defdmclass subsequent-match-components (match-components)) ;;; Operator specifying the rotation of a 3d-model COMPONENT by an amount ;;; ORIENT relative to the principal axis of its superordinate 3d-model ;;; PARENT. (defdmclass rotate-component (mr-operator) parent component orient) (defdmclass dummy-rotate-component (mr-operator) parent component orient) ;; PREFERENCE-related classes. ; Specialize the preference class of the General Executive Model for the ; domain of mental rotation. This is a trivial specialization; the mixin ; class mr-dme is simply mixed. (defdmclass mr-preference (preference mr-dme)) ;; PREFERED-OPERATOR-related classes. ; Specialize the preference class of the General Executive Model for the ; domain of mental rotation. This is a trivial specialization; the mixin ; class mr-dme is simply mixed. (defdmclass mr-preferred-operator (preferred-operator mr-dme)) ;; GOAL-related classes. ; Specialize the goal classes of the General Executive Model for the ; domain of mental rotation. These are trivial specializations; the mixin ; class mr-dme is simply mixed. (defdmclass mr-task-goal (task-goal mr-dme)) (defdmclass mr-goal (goal mr-dme)) ; Specialized goals representing the four phases of mental rotation according ; to the theory of Just and Carpenter (1976) and the computation model of ; Just and Carpenter (1985). ;;; First, identify the same segment in each Shepard-Metzler figure. (defdmclass initial-search-goal (mr-goal)) ;;; Second, rotate the segment of the left figure until it is in the ;;; orientation as its match in the right figure. This established a ;;; rotation path. (defdmclass transformation-goal (mr-goal) left-sm-figure left-component right-sm-figure right-component) (defdmclass subsequent-search-goal (mr-goal) left-sm-figure left-component right-sm-figure right-component) ;;; Finally, rotate the other segments of the left figure through the ;;; established rotation path. (Then, compare the rotated left figure ;;; with the original right figure to see if they are exactly the same ;;; or not.) (defdmclass confirmation-goal (mr-goal) left-sm-figure left-component right-sm-figure right-component) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (3) Centers. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Define centers. ;;; ;; Delete existing centers. This flushes the residue of any old models ;; that may be inadvertantly hanging around. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (del-centers) ) ;; Define model centers. ; A support center used to hold representations and perform processing ; outside the scope of the current model, e.g., visual and perceptual ; processing. ; ; NOTE: This center is actually not need by the Mental Rotation Model, ; but is part of the general Executive Model, and so is retained here. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (add-center support) ) ;;; The LH-Executive center corresponds to left DLPFC. (add-center lh-executive) ;;; The LH-Executive center corresponds to left DLPFC. (add-center rh-executive) ;;; The LH-Spatial center corrresponds to left parietal cortex (SPL and IPS). (add-center lh-spatial) ;;; The RH-Spatial center corrresponds to right parietal cortex (SPL and IPS). (add-center rh-spatial) ;; Set the specializations of each center according to the general ;; Executive Model. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (set-specs@ support base-dme nil) ) ;;; The LH-Executive center is primarily specialized for preferences and ;;; preferred-operators, but has access to other representational types ;;; (e.g., states). (set-specs@ lh-executive base-dme nil base-state t operator t preference 1 preferred-operator 1 base-goal t) ;;;^^^ WAS USEFUL WHEN THE SCM DID INDEED DEFINE A RH-EXECUTIVE CENTER. NO ;;;^^^ LONGER DOES, SO ELIMINATE THIS. ;;;^^^ ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (set-specs@ rh-executive base-dme nil) ) ;;; The RH-Executive center is primarily specialized for goals, but has ;;; access to other representational types (e.g., states). (set-specs@ rh-executive base-dme nil base-state t operator t preference t preferred-operator t base-goal 1) ;;; The LH-Spatial center is primarily specialized for states, but has access ;;; to other representational types (e.g., operators). (set-specs@ lh-spatial base-dme nil base-state 1 operator t preference t preferred-operator t base-goal t) ;;; The RH-Spatial center is primarily specialized for operators, but has ;;; access to other representational types (e.g., states). (set-specs@ rh-spatial base-dme nil base-state t operator 1 preference t preferred-operator t base-goal t) ;; Set the specializations of each center according to the Mental Rotation ;; Model. ;;; Recall that Shepard-Metzler figures are complex, not full encapsulated ;;; in state representations. The LH-Spatial center, which is specialzed ;;; for states, must also be specialized for these related classes. (set-specs@ lh-spatial 3d-model 1 internal-adjunct-relation 1 external-adjunct-relation 1) ;;; Symmetrically, the centers besided LH-Spatial must be granted access ;;; to these related classes. (set-specs@ (lh-executive rh-executive rh-spatial) 3d-model t adjunct-relation t) ;;; Setting the specialization of RH-Spatial from 1.0 to 1.01 for ;;; dummy-rotate-components causes the model to lose these first when ;;; multicenter constraints kick in. As these are "dummy" rotations ;;; in the sense of not being around the z axis, their loss does not ;;; affect the model's ultimate accuracy. (when (and (boundp '*dual-task*) *dual-task*) (set-specs@ rh-spatial dummy-rotate-component 1.01)) ;; Set the resource capacities of each center. ;;; Check if the Sentence Comprehension Model has already done this. (unless (and (boundp '*dual-task*) *dual-task*) (set-caps@ support nil) ) (set-caps@ lh-executive 16.0) (set-caps@ rh-executive 18.0) (set-caps@ lh-spatial 100.0) (set-caps@ rh-spatial 24.0) #| ;; Optimal for simulating the voxel and % signal change data of MR1999. (set-caps@ lh-executive 12.0) (set-caps@ rh-executive 12.0) (set-caps@ lh-spatial 90.0) (set-caps@ rh-spatial 26.0) |# #| ;; Alternate capacities for simulating the % signal change data of MR1999. ;; Fits mean center CUs better, but does worse predicting the condition to ;; condition data. (set-caps@ lh-executive 10.0) (set-caps@ rh-executive 12.0) (set-caps@ lh-spatial 155.0) (set-caps@ rh-spatial 45.0) |# #| ;; Optimal for DT2001. (set-caps@ lh-executive 84.0) (set-caps@ rh-executive 40.0) (set-caps@ lh-spatial 60.0) (set-caps@ rh-spatial 16.0) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (4) The LH-Executive Center. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; General Executive Model productions. ;;; ;; Assert default preferences among operators. ;;; When an operator has been proposed, asserts a so-called unary preference, ;;; likely in LH-Executive, that serves as its proxy during contention ;;; scheduling. It will accumulate activation via the assertion of preferences ;;; by other productions, and if it reaches threshold first, it will be ;;; selected as the preferred-operator. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERENCE, not generic PREFERENCE ;;; dme is created. This is necessary to get the Mental Rotation model ;;; to work in dual-task mode. (p@ lh-executive unary-preference ((s state) (es end-state) (op operator)) (not-solved-p s es) (equal s (state op)) (*no ((~s state)) (more-recent-state-p ~s s)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) s)) (*no ((~pr preference)) (equal (better-operator ~pr) op) (null (worse-operator ~pr))) --> (spew t (mr-preference :better-operator op) (* *default-preference-weight* *spew-rate*)) ) ;;; When two operators are being considered and, if applied to the current ;;; state, one would bring us close to the end-state than the other, then ;;; prefer this operator. ;;; ;;; NOTE: Whether this production fires in the a model depends on whether ;;; contention scheduling is through Soar-like binary selection or ;;; through connectionist-like activation accrual. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERENCE, not generic PREFERENCE dme ;;; is created. This is necessary to get the Mental Rotation Model to ;;; work in dual-task mode. (p@ lh-executive binary-preference ((s state) (es end-state) (op1 operator) (op2 operator)) (not-solved-p s es) (equals s (state op1) (state op2)) #| ;; Commented out because I think that HILL-CLIMBING-OPERATOR-P can be ;; folded into STEEPER-HILL-CLIMBING-OPERATOR-P in this and the other ;; instantiations of the General Executive model. (hill-climbing-operator-p op1 es) (hill-climbing-operator-p op2 es) |# (steeper-climbing-operator-p op1 op2 es) (*no ((~s state)) (more-recent-state-p ~s s)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) s)) (*no ((~pr preference)) (equal (better-operator ~pr) op1) (equal (worse-operator ~pr) op2)) --> (spew t (mr-preference :better-operator op1 :worse-operator op2) (* *default-preference-weight* *spew-rate*)) ) ;; Select preferred operator among contenders given preferences. ;; ;; NOTE: Consider subclassing the PREFERENCE class into separate UNARY- ;; PREFERENCE and BINARY-PREFERENCE classes. ;;; Select the best operator through consideration of unary preferences. Such ;;; competitions are horse races, and thus the selected operator's preference ;;; must achieve an activation level above threshold. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERRED-OPERATOR, not generic ;;; PREFERRED-OPERATOR dme is created. This is necessary to get the ;;; Mental Rotation Model to work in dual-task mode. ;;; ;;; NOTE: This production sneaks in the assumption that binary preferences ;;; also exist in its second absence test. (p@ lh-executive select-among-unary-preferences ((s state) (es end-state) (op operator) (pr preference 0.95)) (not-solved-p s es) (equal s (state op)) (equal (better-operator pr) op) (*whole (null (worse-operator pr))) (*no ((~s state)) (more-recent-state-p ~s s)) (*no ((~pr preference)) (equal (worse-operator ~pr) op)) (*no ((~pop preferred-operator)) (equal (operator ~pop) op)) --> (spew t (mr-preferred-operator :operator op) (* *weight* *spew-rate*)) ) ;;; Select the best operator through consideration of binary preferences. ;;; ;;; NOTE: This production fires in some models, doesn't fire in others, and ;;; in still others must be completely commented out. Need to document ;;; its exact status in each model and, down the road, generalize it to ;;; work in the same way in each one. ;;; ;;; NOTE: Changed the RHS so that an MR-PREERRED-OPERATOR, not a generic ;;; PREFERRED-OPERATOR dme is created. This is necessary to get the ;;; Mental Rotation model to work in dual-task mode. ;;; ;;; NOTE: Shouldn't the absence test be modified to test for an MR-PREFERRED- ;;; OPERATOR as it is in the Driving model? (p@ lh-executive select-among-binary-preferences ((s state) (es end-state) (op1 operator) (op2 operator) (pr preference)) (not-solved-p s es) (equal s (state op1)) (equal (better-operator pr) op1) (equal (worse-operator pr) op2) (*no ((~s state)) (more-recent-state-p ~s s)) (*no ((~pr preference)) (equal (worse-operator ~pr) op1)) (*no ((~pr preference)) (equal (better-operator ~pr) op1) (worse-operator ~pr) (> (id (worse-operator ~pr)) (id op2))) (*no ((~pop preferred-operator)) (equal (operator ~pop) op1)) --> (spew t (mr-preferred-operator :operator op1) (* *weight* *spew-rate*)) ) #| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This production is necessary because Soar requires multiple macrocycles ;;; to fully elaborate all preferences, but in early versions of the Executive ;;; model, which used binary preferences rather than graded unary preferences, ;;; only one macrocycle was available for the decision procedure. However, ;;; this production will likely prove useful for the more general case when ;;; multiple preferred operators arise at the same time (through parallel ;;; processing), and must be reconciled. ;;; ;;; NOTE: For the Mental Rotation model, where unary preferences accrue ;;; activation consecutive cycles, this production must be commented out. ;;; ;;; NOTE: This production fires in some models, doesn't fire in others, and in ;;; still others must be completely commented out. Need to generalize it ;;; to work in the same way in each one. (p@ lh-executive suppress-redundant-selection ((s state) (es end-state) (op1 operator) (pr1 preference) (op2 operator) (pr2 preference)) (not-solved-p s es) (equals s (state op1) (state op2)) (< (id op1) (id op2)) (equal (better-operator pr1) op1) (equal (better-operator pr2) op2) (*whole (null (worse-operator pr1))) (*whole (null (worse-operator pr2))) (*no ((~s state)) (more-recent-state-p ~s s)) (*no ((~pr preference)) (equal (worse-operator ~pr) op1)) (*no ((~pr preference)) (equal (worse-operator ~pr) op2)) (*no ((~pop preferred-operator)) (equal (operator ~pop) op1)) --> (spew t (preferred-operator :operator op2) (- (* *weight* *spew-rate*))) ) |# ;; Suppress preferences after a preferred operator has been selected. ;;; Suppress preferences once an operator has been selected. (p@ lh-executive suppress-preferrence ((pop preferred-operator) (pr preference)) (equal (state (operator pop)) (state (better-operator pr))) (*no ((~pop preferred-operator)) (> (id ~pop) (id pop))) --> (spew t pr (- (* *weight* *spew-rate*))) ) ;; Suppress a preferred operator marker... ;;; ...after it is performed. (p@ lh-executive suppress-preferred-operator-marker ((pop preferred-operator) (op operator) (bs state) (as state)) (equal (operator pop) op) (equal (state op) bs) (contents-equal (perform-operator op bs) (contents as)) --> (spew t pop (- (* *weight* *spew-rate*))) ) ;;; ...if it cannot be performed, and thus caused an impasse, and thus led to ;;; the activation of a goal. (p@ lh-executive suppress-preempted-preferred-operator-marker ((g goal) (pop preferred-operator) (op operator)) (equals (operator g) (operator pop) op) --> (spew t pop (- (* *weight* *spew-rate*))) ) ;; Choose arbitrarily between multiple preferred operators. ;;; Two (or more) operators can emerge as preferred when unary preferences and ;;; pure activation dynamics are relied upon. Must therefore choose between ;;; the contenders (again). ;;; ;;; NOTE: This production fires in some models, doesn't fire in others, and in ;;; still others must be completely commented out. It originated with ;;; the Mental Rotation model and does not appear to fire when binary ;;; preferences are used. Need to generalize it to work in the same way ;;; in all models. ;;; ;;; Note: The choice between preferred operators, though seemingly arbitrary, ;;; actually is not because when the > is switched to < the Mental ;;; Rotation model fails. (p@ lh-executive suppress-arbitrarily-chosen-preferred-operator-marker ((pop1 preferred-operator) (pop2 preferred-operator)) (not-equal pop1 pop2) (*no ((~pop preferred-operator)) (> (id (operator ~pop)) (id (operator pop1)))) --> (spew t pop2 (- (* *weight* *spew-rate*))) ) ;;; ;;; Mental Rotation model productions. ;;; ;; Direct activation towards the unary preferences of competing operators. ; During the initial search and subsequent search phases. ;;; When a match-components operator is competing to be selected and its ;;; two segments are the same length, then increment the activation of the ;;; corresponding unary preference. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERENCE, not generic PREFERENCE ;;; dme is created. This is necessary to get the Mental Rotation Model ;;; to work in dual-task mode. (p@ lh-executive prefer-matching-lengths ((mc match-components) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equal (state mc) lf) (equal (left-sm-figure mc) lf) (equal (left-component mc) lc) (stands-in (contents lf) lc lar) (equal (right-sm-figure mc) rf) (equal (right-component mc) rc) (stands-in (contents rf) rc rar) (equal-length lar rar) (*no ((~pop preferred-operator)) (equal (state (operator ~pop)) lf)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~pr preference 0.95)) (equal (better-operator ~pr) mc) (null (worse-operator ~pr))) --> (spew t (mr-preference :better-operator mc) (* *length-weight* *spew-rate*)) ) ;;; When a match-components operator is competing to be selected and its ;;; two segments are both end segments (and thus capable of matching in a ;;; structural sense, as opposed to if one is an end segment and the other ;;; an internal segment), then increment the activation of the corresponding ;;; unary preference. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERENCE, not generic PREFERENCE ;;; dme is created. This is necessary to get the Mental Rotation Model ;;; to work in dual-task mode. (p@ lh-executive prefer-matching-ends ((mc match-components) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (lar2 adjunct-relation) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation) (rar2 adjunct-relation)) (equal (state mc) lf) (equal (left-sm-figure mc) lf) (equal (left-component mc) lc) (stands-in (contents lf) lc lar) (equal (right-sm-figure mc) rf) (equal (right-component mc) rc) (stands-in (contents rf) rc rar) (component-of (component lar2) lf) (contiguous-p lar2 lar) (component-of (component rar2) rf) (contiguous-p rar2 rar) (*no ((~lar adjunct-relation)) (not-equal ~lar lar2) (component-of (component ~lar) lf) (contiguous-p ~lar lar)) (*no ((~rar adjunct-relation)) (not-equal ~rar rar2) (component-of (component ~rar) rf) (contiguous-p ~rar rar)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) lf)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~pr preference 0.95)) (equal (better-operator ~pr) mc) (null (worse-operator ~pr))) --> (spew t (mr-preference :better-operator mc) (* *end-weight* *spew-rate*)) ) ; During the transformation phase. ;;; When deciding between two rotations for a segment, prefer the one ;;; that decreases by more the angular disparity between it and its ;;; matching segment in the other figure. ;;; ;;; NOTE: This production is analogous to the binary-preference production ;;; of the general Executive Model. This suggests that it should ;;; either be folded into that production (i.e., by appropriately ;;; defining hill-climbing-operator-p and steeper-climbing-operator-p) ;;; or, better yet, I solve the more general problem of allowing ;;; unary and binary preferences to co-exist. For example, binary ;;; preferences might be implemented as two activation flows, one ;;; positive and one negative, or one positive and one 0. ;;; ;;; NOTE: One reason this production exists alongside binary-preference is ;;; because in the Mental Rotation Model alone, the end-state is ;;; representened by multiple dmes. ;;; ;;; NOTE: Changed the RHS so that an MR-PREFERENCE, not generic PREFERENCE ;;; dme is created. This is necessary to get the Mental Rotation Model ;;; to work in dual-task mode. (p@ lh-executive prefer-hill-climbing-rotations ((g transformation-goal) (lf sm-figure) (rc1 rotate-component) (rc2 rotate-component) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equals lf (state rc1) (state rc2)) (equals (component rc1) (component rc2)) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (< (real-angle (orient rc1) (orient rar)) (real-angle (orient rc2) (orient rar))) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) lf)) (*no ((~pr preference)) (equal (better-operator ~pr) rc1) (equal (worse-operator ~pr) rc2)) --> (spew t (mr-preference :better-operator rc1 :worse-operator rc2) (* *weight* *spew-rate*)) ) ;;;^^^ (p@ lh-executive prefer-z-axis-rotations ((g transformation-goal) (lf sm-figure) (rc1 rotate-component) (drc2 dummy-rotate-component) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equals lf (state rc1) (state drc2)) (equals (component rc1) (component drc2)) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (vectorp (orient rc1)) (symbolp (orient drc2)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) lf)) (*no ((~pr preference)) (equal (better-operator ~pr) rc1) (equal (worse-operator ~pr) drc2)) --> (spew t (mr-preference :better-operator rc1 :worse-operator drc2) (* *weight* *spew-rate*)) ) ; During the confirmation phase. (p@ lh-executive prefer-z-axis-path-rotation ((g confirmation-goal) (lf sm-figure) (rc rotate-component) (drc dummy-rotate-component)) (id g) (equals lf (state rc) (state drc)) (vectorp (orient rc)) (symbolp (orient drc)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~pop preferred-operator)) (equals (state (operator ~pop)) lf)) (*no ((~pr preference)) (equal (better-operator ~pr) rc) (equal (worse-operator ~pr) drc)) --> (spew t (mr-preference :better-operator rc :worse-operator drc) (* *weight* *spew-rate*)) ) ;; Suppress preferred-operators (and some hacky residual representations) ;; during phases of mental rotation involving the rotation of segments. ;; ;; NOTE: This is hacky code in two ways. First, why aren't preferred- ;; operators suppressed via the generic productions of the general ;; Executive Model during these two phases? Second, must separate ;; the suppression of preferred-operators, which belongs in LH-Executive, ;; from the suppression of state and operator representations, which ;; does not. ; During the transformation phase. ;;; Suppress the preferred-operator and the old adjunct-relation, i.e., ;;; the one that held before the preferred-operator was applied, rotating ;;; a segment and generating a new adjunct-relation. (p@ lh-executive suppress-during-transformation ((g transformation-goal) (pop preferred-operator) (rc rotate-component) (ar adjunct-relation) (af sm-figure)) (id g) (equal (operator pop) rc) (equals (component rc) (component ar)) (=approx-vects (orient rc) (orient ar)) (equal (state rc) af) #| (contents-equal (perform-operator op bs) (contents as)) |# (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent ar)) (equal (component ~ar) (component ar)) (more-recent-adjunct-relation-p ~ar ar)) (*no ((~g confirmation-goal)) (id ~g)) --> (spew t pop (- (* *weight* *spew-rate*))) ;;^^ HACK. SEPARATE THIS CODE OUT WITH THE HACKY CODE IN ;;^^ PROPOSE-SUBSEQUENT-SEARCH-GOAL. (spew t af (- (* *weight* *spew-rate*))) ) ;; During the confirmation phase. ;;; Suppress the preferred-operator, the operator RC, and the old ;;; adjunct-relation AR. The adjunct-relation AR is the one that held ;;; before the operator RC was applied to rotate a segment, generating a ;;; new adjunct-relation. Both RC and AR are also suppressed. (p@ lh-executive suppress-during-confirmation ((g confirmation-goal) (pop preferred-operator) (rc rotate-component) (ar adjunct-relation) (af sm-figure) ;;^^ HACK. (old-rc rotate-component) ) (id g) (equal (operator pop) rc) (equals (component rc) (component ar)) (=approx-vects (orient rc) (orient ar)) (equal (state rc) af) ;;^^ HACK. (not-equal (component rc) (component old-rc)) #| (contents-equal (perform-operator op bs) (contents as)) |# (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent ar)) (equal (component ~ar) (component ar)) (more-recent-adjunct-relation-p ~ar ar)) ;;^^ HACK. (*no ((~rc rotate-component)) (< (id ~rc) (id old-rc))) --> (spew t pop (- (* *weight* *spew-rate*))) ;;^^ HACK. SEPARATE THIS CODE OUT. (spew t af (- (* *weight* *spew-rate*))) ;;^^ HACK. WHEN ROTATIONS ARE LOGGED BY DLPFC/IFG, THEN THIS WILL ;;^^ NO LONGER BE NECESSARY. (spew t old-rc (- (* *weight* *spew-rate*))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (5) The RH-Executive Center. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; General Executive model productions. ;;; ;; ;;; When the most recent goal G is satisfied by the current state S, then ;;; suppress the completed goal. (p@ rh-executive suppress-satisfied-goal ((g goal) (s state)) (satisfied-p g s) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~s state)) (more-recent-state-p ~s s)) --> (spew t g (- (* *weight* *spew-rate*))) ) ;;; ;;; Mental Rotation model productions. ;;; ;;; These productions have a systematic form. ;;; ;;; There is a propose-*-goal production for each phase. It notices when the ;;; goal corresponding to the current phase has been satisfied, but not yet ;;; suppressed. It activates the goal * corresponding to the next phase of ;;; mental rotation. ;;; ;;; There is also a suppress-satisfied-*-goal production for each phase. It ;;; notices when the goal * corresponding to the current phase has been ;;; superseded by a goal corresponding to the next phase. In response, it ;;; suppresses the supseded goal. ;;; ;;; NOTE: The model activates the next goal before suppressing the previous ;;; one for robusteness. It is otherwise possible in a resource-limited ;;; environment to suppress the previous goal too quickly, before the ;;; the next one has been activated, and to thus break the continuity ;;; of processing. ;;; ;;; The first exception is that the model begins with a goal corresponding ;;; to the first phase, initial search, already active, and thus does not ;;; need to activate it itself. ;;; ;;; NOTE: Should change model so that the initial goal is activated based ;;; on the presence of an unsatisfied top-level goal. ;;; ;;; The second exception is that the model does not bother cleaning up after ;;; itself after the goal corresponding to the final phase has been satisfied. ;;; ;;; NOTE: Should change model so that when the final goal has been satisfied, ;;; the model explicitly outputs a response and suppresses this and ;;; the top-level goal. ;;; ;; During the initial search phase. #| ;;; When the second phase of mental rotation, transformation, has begun, ;;; suppress the (implicitly satisfied) goal to perform the first phase, ;;; initial search. (p@ rh-executive suppress-satisfied-initial-search-goal ((isg initial-search-goal) (tg transformation-goal) (imc initial-match-components) (lf sm-figure)) (id isg) (equals (state imc) (left-sm-figure imc) (left-sm-figure tg) lf) (equal (operator tg) imc) (*no ((~g goal)) (more-recent-goal-p ~g tg)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) --> (spew t isg (- (* *weight* *spew-rate*))) ) |# ;; During the transformation phase. ;;; When the first phase of mental rotation, initial search, has ended, ;;; activate a goal to perform the second phase, transformation. (p@ rh-executive propose-transformation-goal ((imc initial-match-components) (pop preferred-operator)) (equal (operator pop) imc) (*no ((~pop preferred-operator)) (not-equal ~pop pop)) (*no ((~g transformation-goal)) (equal (left-sm-figure ~g) (left-sm-figure imc)) (equal (left-component ~g) (left-component imc)) (equal (right-sm-figure ~g) (right-sm-figure imc)) (equal (right-component ~g) (right-component imc))) --> (spew t (transformation-goal :operator imc :left-sm-figure (left-sm-figure imc) :left-component (left-component imc) :right-sm-figure (right-sm-figure imc) :right-component (right-component imc)) (* *weight* *spew-rate*)) ) #| ;;; When the third phase of mental rotation, subsequent search, has begun, ;;; suppress the (implicitly satisfied) goal to perform the second phase, ;;; transformation. (p@ rh-executive suppress-satisfied-transformation-goal ((tg transformation-goal) (ssg subsequent-search-goal)) (equal (left-component tg) (left-component ssg)) (equal (right-component tg) (right-component ssg)) (*no ((~g goal)) (more-recent-goal-p ~g ssg)) --> (spew t tg (- (* *weight* *spew-rate*))) ) |# ;; During the subsequent search phase. ;;; When the second phase of mental rotation, transformation, has ended, ;;; activate a goal to perform the third phase, subsequent search. (p@ rh-executive propose-subsequent-search-goal ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation) (af sm-figure)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (=approx-orients (orient lar) (orient rar)) (equal (contents af) lar) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) --> (spew t (subsequent-search-goal :left-component lc :right-component rc) (* *weight* *spew-rate*)) ;;^^ HACK: SEPARATE THIS CODE OUT WITH THE HACKY CODE IN ;;^^ PROPOSE-SUBSEQUENT-SEARCH-GOAL. (spew t af (- (* *weight* *spew-rate*))) ) #| ;;; When the fourth phase of mental rotation, confirmation, has begun, ;;; suppress the (implicitly satisfied) goal to perform the third phase, ;;; subsequent search. (p@ rh-executive suppress-satisfied-subsequent-search-goal ((ssg subsequent-search-goal) (cg confirmation-goal) (smc subsequent-match-components) (lf sm-figure)) (id ssg) (equals (state smc) (left-sm-figure smc) (left-sm-figure cg) lf) (equal (operator cg) smc) (*no ((~g goal)) (more-recent-goal-p ~g cg)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) --> (spew t ssg (- (* *weight* *spew-rate*))) ) |# ;; During the confirmation phase. ;;; When the third phase of mental rotation, subsequent search, has ended, ;;; activate a goal to perform the fourth phase, confirmation. (p@ rh-executive propose-comfirmation-goal ((smc subsequent-match-components) (pop preferred-operator)) (equal (operator pop) smc) (*no ((~pop preferred-operator)) (not-equal ~pop pop)) (*no ((~g confirmation-goal)) (equal (left-sm-figure ~g) (left-sm-figure smc)) (equal (left-component ~g) (left-component smc)) (equal (right-sm-figure ~g) (right-sm-figure smc)) (equal (right-component ~g) (right-component smc))) --> (spew t (confirmation-goal :operator smc :left-sm-figure (left-sm-figure smc) :left-component (left-component smc) :right-sm-figure (right-sm-figure smc) :right-component (right-component smc)) (* *weight* *spew-rate*)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (6) The LH-Spatial Center. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; General Executive model productions. ;;; ;;; ;;; Mental Rotation model productions. ;;; ;; Perform rotations. ;;; Apply the selected rotation operator RC to the current state, producing ;;; a new state. Because states in the Mental Rotation Model are more complex ;;; than states in other models, two new representations are actually ;;; generated, the state proper (i.e., an sm-figure) and an adjunct-relation ;;; encoding the new, rotated orientation. ;;; ;;; NOTE: IF THIS PRODUCTION CAN BE WRITTEN TO MAKE USE OF THE PART THAT'S ;;; CURRENTLY COMMENTED OUT, THEN IT WILL FIT THE SAME TEMPLATE AS THE ;;; ANALOGOUS "PERFORM-MOVE" PRODUCTIONS IN THE TOL AND TOH MODELS, ;;; AND THIS TEMPLATE CAN THEN BE PROMOTED TO THE GENERAL EXECUTIVE ;;; MODEL. (p@ lh-spatial perform-rotation ((af sm-figure) (ar adjunct-relation) (rc rotate-component) (pop preferred-operator)) (equal (contents af) ar) (equal (operator pop) rc) (equal (state rc) af) (equal (parent rc) (parent ar)) (equal (component rc) (component ar)) #| (*no ((~smf sm-figure)) (contents-equal (contents ~smf) (perform-operator rc af))) |# (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent ar)) (equal (component ~ar) (component ar)) (more-recent-adjunct-relation-p ~ar ar)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent ar)) (equal (component ~ar) (component ar)) (=approx-vects (orient ~ar) (orient rc))) --> (let ((ar (first (spew t (internal-adjunct-relation :parent (parent ar) :component (component ar) :pos (pos ar) :orient (orient rc)) (* *weight* *spew-rate*))))) (spew t (sm-figure :contents ar) (* *weight* *spew-rate*)) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (7) The RH-Spatial Center. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; General Executive Model productions. ;;; ;; Suppress operators if... ;;; ...they are not selected. (p@ rh-spatial suppress-unpreferred-operator ((pop preferred-operator) (op1 operator) (op2 operator)) (equal (operator pop) op1) (not-equal op1 op2) (equal (state op1) (state op2)) (*no ((~pop preferred-operator)) (> (id ~pop) (id pop))) (*no ((~pop preferred-operator)) (equal (operator ~pop) op2)) --> (spew t op2 (- (* *weight* *spew-rate*))) ) ;;; ...they are selected and performed successfully. (p@ rh-spatial suppress-performed-preferred-operator ((pop preferred-operator) (op operator) (bs state) (as state)) (equal (operator pop) op) (equal (state op) bs) (contents-equal (perform-operator op bs) (contents as)) --> (spew t op (- (* *weight* *spew-rate*))) ) ;;; ...they cannot be performed, causing an impasse (which leads to a goal ;;; to resolve the impasse). (p@ rh-spatial suppress-preempted-preferred-operator ((g goal) (pop preferred-operator) (op operator)) (equals (operator g) (operator pop) op) --> (spew t op (- (* *weight* *spew-rate*))) ) ;;; ;;; Mental Rotation model productions. ;;; ;; During the initial search phase. ;;; Propose an initial-match-components operator pairing an arbitrary ;;; segment from the left sm-figure with an arbitrary segment from the ;;; right sm-figure. This is is sloppy, direct processing by a posterior ;;; center that will be sorted out downstream by the anterior, LH-Executive ;;; center. ;;; ;;; NOTE: ADDED A CONDITION TO ENSURE THAT THIS PRODUCTION DOES NOT FIRE ;;; AGAIN IF THERE IS A PREFERRED OPERATOR THAT APPLIES TO THE STATE. ;;; IS THIS IS THE ONLY OPERATOR PROPOSING PRODUCTION IN THIS OR ANY ;;; OTHER EXECUTIVE MODEL THAT HAS REQUIRED SUCH A CONDITION, NEED TO ;;; INVESTIGATE WHY AND WHETHER IT CAN BE CLEVERLY OMITTED. ;;; (*HINT*: THIS MAY BE THE ONLY CASE IN WHICH MORE THAN ONE PREFERRED ;;; OPERATOR IS EVER SELECTED, AND THUS ARBITRARILY ADJUDICATED.) (p@ rh-spatial propose-initial-matched-components ((g initial-search-goal) (lf sm-figure) (lc 3d-model) (rf end-sm-figure) (rc 3d-model)) (id g) (left-figure-p lf) (component-of lc lf) (right-figure-p rf) (component-of rc rf) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~imc initial-match-components)) (equal (state ~imc) lf) (equal (left-sm-figure ~imc) lf) (equal (left-component ~imc) lc) (equal (right-sm-figure ~imc) rf) (equal (right-component ~imc) rc)) (*no ((~pop preferred-operator)) (equal (state (operator ~pop)) lf)) --> (spew t (initial-match-components :state lf :left-sm-figure lf :left-component lc :right-sm-figure rf :right-component rc) (* *weight* *spew-rate*)) ) ;; During the transformation phase. ;;; (?) Before transforming the matching segments, must establish a new ;;; sm-figure to "house" the results of rotation. (p@ rh-spatial propose-new-state-for-transformation ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation)) (id g) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~smf sm-figure)) (equal (contents ~smf) lar)) --> (spew t (sm-figure :contents lar) (* *weight* *spew-rate*)) ) ;;; Propose rotating the matched segment of the left figure clockwise about ;;; the z axis. (p@ rh-spatial rotate-matched-components-clockwise-z ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (*whole (not (=approx-orients (orient lar) (orient rar)))) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~rc rotate-component)) (equal (state ~rc) af) (equal (parent ~rc) (parent lar)) (equal (component ~rc) (component lar)) (=approx-vects (orient ~rc) (rotate-z (orient lar) (- *rotation-rate*)))) --> (spew t (rotate-component :state af :parent (parent lar) :component (component lar) :orient (rotate-z (orient lar) (- *rotation-rate*))) (* *weight* *spew-rate*)) ) ;;; Propose rotating the matched segment of the left figure counter-clockwise ;;; about the z axis. (p@ rh-spatial rotate-matched-components-counter-clockwise-z ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (*whole (not (=approx-orients (orient lar) (orient rar)))) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~rc rotate-component)) (equal (state ~rc) af) (equal (parent ~rc) (parent lar)) (equal (component ~rc) (component lar)) (=approx-vects (orient ~rc) (rotate-z (orient lar) *rotation-rate*))) --> (spew t (rotate-component :state af :parent (parent lar) :component (component lar) :orient (rotate-z (orient lar) *rotation-rate*)) (* *weight* *spew-rate*)) ) (p@ rh-spatial dummy-rotate-matched-components-x ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (*whole (not (=approx-orients (orient lar) (orient rar)))) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~drc dummy-rotate-component)) (equal (state ~drc) af) (equal (parent ~drc) (parent lar)) (equal (component ~drc) (component lar)) (equal (orient ~drc) 'x-axis)) --> (spew t (dummy-rotate-component :state af :parent (parent lar) :component (component lar) :orient 'x-axis) (* *weight* *spew-rate*)) ) (p@ rh-spatial dummy-rotate-matched-components-y ((g transformation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (equal (right-sm-figure g) rf) (equal (right-component g) rc) (stands-in (contents rf) rc rar) (*whole (not (=approx-orients (orient lar) (orient rar)))) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~drc dummy-rotate-component)) (equal (state ~drc) af) (equal (parent ~drc) (parent lar)) (equal (component ~drc) (component lar)) (equal (orient ~drc) 'y-axis)) --> (spew t (dummy-rotate-component :state af :parent (parent lar) :component (component lar) :orient 'y-axis) (* *weight* *spew-rate*)) ) ;; During the subsequent search phase. ;;; Of the segments not initially matched and rotate, propose all possible ;;; pairs drawing one segment from the left figure and the other from the ;;; right. ;;; ;;; 5/2004: Modified in final fitting for the Just and Varma Theory paper. ;;; Now less promiscuous in the possible matches it proposes ;;; during Subsequent Search; the system is less naive than it ;;; is during Initial Search. In particular, only segments of ;;; the same length (and that aren't the segments identified ;;; initially, of course, as before) are proposed. (p@ rh-spatial propose-subsequent-matched-components ((g subsequent-search-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (rf end-sm-figure) (rc 3d-model) (rar adjunct-relation)) (left-figure-p lf) (component-of lc lf) (not-equal (left-component g) lc) (stands-in (contents lf) lc lar) (right-figure-p rf) (component-of rc rf) (not-equal (right-component g) rc) (stands-in (contents rf) rc rar) (equal-length lar rar) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smc subsequent-match-components)) (equal (state ~smc) lf) (equal (left-sm-figure ~smc) lf) (equal (left-component ~smc) lc) (equal (right-sm-figure ~smc) rf) (equal (right-component ~smc) rc)) --> (spew t (subsequent-match-components :state lf :left-sm-figure lf :left-component lc :right-sm-figure rf :right-component rc) (* *weight* *spew-rate*)) ) ;; During the confirmation phase. ;;; (?) Before rotating all other segments of the left figure, must create ;;; a newsm-figure to "house" the results. (p@ rh-spatial propose-new-state-for-confirmation ((g confirmation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation)) (id g) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf lf)) (*no ((~smf sm-figure)) (equal (contents ~smf) lar)) --> (spew t (sm-figure :contents lar) (* *weight* *spew-rate*)) ) ;;; Rotate each remaining segment of the left figure along the rotation ;;; path established during transformation of the initial pair of matched ;;; segments. (p@ rh-spatial rotate-matched-components-along-path-z ((g confirmation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rc1 rotate-component) (rc2 rotate-component)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (not-equal (component rc1) (name lc)) (equal (component rc1) (component rc2)) (not-equal rc1 rc2) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~rc rotate-component)) (< (id ~rc) (id rc1))) (*no ((~rc rotate-component)) (not-equal ~rc rc1) (< (id ~rc) (id rc2))) (*no ((~rc rotate-component)) (equal (state ~rc) af) (equal (parent ~rc) (parent lar)) (equal (component ~rc) (component lar)) (=approx-vects (orient ~rc) (rotate-z (orient lar) (real-angle (orient rc2) (orient rc1))))) --> (spew t (rotate-component :state af :parent (parent lar) :component (component lar) :orient (rotate-z (orient lar) (real-angle (orient rc2) (orient rc1)))) (* *weight* *spew-rate*)) ) (p@ rh-spatial dummy-rotate-matched-components-along-path-x ((g confirmation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rc1 rotate-component) (rc2 rotate-component)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (not-equal (component rc1) (name lc)) (equal (component rc1) (component rc2)) (not-equal rc1 rc2) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~rc rotate-component)) (< (id ~rc) (id rc1))) (*no ((~rc rotate-component)) (not-equal ~rc rc1) (< (id ~rc) (id rc2))) (*no ((~drc dummy-rotate-component)) (equal (state ~drc) af) (equal (parent ~drc) (parent lar)) (equal (component ~drc) (component lar)) (equal (orient ~drc) 'x-axis)) --> (spew t (dummy-rotate-component :state af :parent (parent lar) :component (component lar) :orient 'x-axis) (* *weight* *spew-rate*)) ) (p@ rh-spatial dummy-rotate-matched-components-along-path-y ((g confirmation-goal) (lf sm-figure) (lc 3d-model) (lar adjunct-relation) (af sm-figure) (rc1 rotate-component) (rc2 rotate-component)) (equal (left-sm-figure g) lf) (equal (left-component g) lc) (stands-in (contents lf) lc lar) (equal (contents af) lar) (not-equal (component rc1) (name lc)) (equal (component rc1) (component rc2)) (not-equal rc1 rc2) (*no ((~g goal)) (more-recent-goal-p ~g g)) (*no ((~smf sm-figure)) (more-recent-state-p ~smf af)) (*no ((~ar adjunct-relation)) (equal (parent ~ar) (parent lar)) (equal (component ~ar) (component lar)) (more-recent-adjunct-relation-p ~ar lar)) (*no ((~rc rotate-component)) (< (id ~rc) (id rc1))) (*no ((~rc rotate-component)) (not-equal ~rc rc1) (< (id ~rc) (id rc2))) (*no ((~drc dummy-rotate-component)) (equal (state ~drc) af) (equal (parent ~drc) (parent lar)) (equal (component ~drc) (component lar)) (equal (orient ~drc) 'y-axis)) --> (spew t (dummy-rotate-component :state af :parent (parent lar) :component (component lar) :orient 'y-axis) (* *weight* *spew-rate*)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; (8) Support Code. ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Top-level commands for running simulations. ;;; ;; Run a single simulation. ;;; Check if the Sentence Comprehension Model has already defined SIM and ;;; IMPL-SIM commands. If so, we must explicitly undefine them before ;;; redefining them for the user. Otherwise, the user may seem confusing ;;; (though harmless) warning. (when (and (boundp '*dual-task*) *dual-task*) (fmakunbound 'sim) (fmakunbound 'impl-sim) ) ;;; Interface to top-level command to run simulations of the Mental Rotation ;;; Model. Easy to use because the parameters are unevaluated, and therefore ;;; the user does not have to quote literal arguments. (defmacro sim (&rest args) `(impl-sim ,@args)) ;;; Function to run simulations of the Mental Rotation Model. Call this ;;; instead of SIM if arguments must be evaluated. Runs a test trial where ;;; the right figure is a rotation of the left figure by ANGLE degrees, ;;; possibly mirror-imaged. Rotation is around the corner of the figure at ;;; the origin #(0 0 0). The left figure itself is a standard Shepard-Metzler ;;; shape. A terse description: ;;; ;;; Arm Starting Point Length Orientation (Ending Point) ;;; --- -------------- ------ ----------- -------------- ;;; 1 (0, 0, 0) 3 + Y axis (0, 3, 0) ;;; 2 (0, 3, 0) 4 - Z axis (0, 3, -4) ;;; 3 (0, 3, -4) 4 + X axis (4, 3, -4) ;;; 4 (4, 3, -4) 2 + Y axis (4, 5, -4) ;;; ;;; To get a feel for the left figure, draw it as a sequence of adjacent ;;; vectors in a three dimensional space. ;;; ;;; The left figure is then rotated by ANGLE degrees, and mirror-imaged ;;; depending on the value of MIRROR-P, to produce the right figure. The two ;;; figures are combined into the problem stimulus, the task-goal to solve the ;;; problem is activated, the goal corresponding to the first phase of mental ;;; rotation is activated, and the model run. ;;; ;;; NOTE: The term "arm" should be changed to "segment," or vice versa, to ;;; ensure consistent terminology throughout the model. (defun impl-sim (&key (angle 40) mirror-p) (reset) (format t "~&Mental Rotation Trial: Rotation of ~A figure by ~A degrees." (if mirror-p "a mirror-image" "the same") angle) (format t "~%") (let* ((arm1-pos #(0 0 0)) (arm1-orient #(0 3 0)) (arm2-pos (add-vects arm1-pos arm1-orient)) (arm2-orient #(0 0 -4)) (arm3-pos (add-vects arm2-pos arm2-orient)) (arm3-orient #(4 0 0)) (arm4-pos (add-vects arm3-pos arm3-orient)) (arm4-orient #(0 2 0)) (arm5-pos #(0 0 0)) (arm5-orient (if (or (not mirror-p) (parallel-p arm1-orient arm3-orient)) (rotate-z arm1-orient angle) (flip-vector (rotate-z arm1-orient angle)))) (arm6-pos (add-vects arm5-pos arm5-orient)) (arm6-orient (rotate-z arm2-orient angle)) (arm7-pos (add-vects arm6-pos arm6-orient)) (arm7-orient (rotate-z arm3-orient angle)) (arm8-pos (add-vects arm7-pos arm7-orient)) (arm8-orient (if (or (not mirror-p) (parallel-p arm4-orient arm2-orient)) (rotate-z arm4-orient angle) (flip-vector (rotate-z arm4-orient angle))))) (reset) ;; Initialize left figure. | ;; - ;; / ;; | (let ((left-3d-model (first (spew t (3d-model :name 'left :components (list 'arm1 'arm2 'arm3 'arm4)) 1.0)))) (spew t (sm-figure :contents left-3d-model) 1.0)) (spew t (3d-model :name 'arm1) 1.0) (spew t (external-adjunct-relation :parent 'left :component 'arm1 :pos arm1-pos :orient arm1-orient) 1.0) (spew t (3d-model :name 'arm2) 1.0) (spew t (external-adjunct-relation :parent 'left :component 'arm2 :pos arm2-pos :orient arm2-orient) 1.0) (spew t (3d-model :name 'arm3) 1.0) (spew t (external-adjunct-relation :parent 'left :component 'arm3 :pos arm3-pos :orient arm3-orient) 1.0) (spew t (3d-model :name 'arm4) 1.0) (spew t (external-adjunct-relation :parent 'left :component 'arm4 :pos arm4-pos :orient arm4-orient) 1.0) ;; Initialize right figure. (let ((right-3d-model (first (spew t (3d-model :name 'right :components (list 'arm5 'arm6 'arm7 'arm8)) 1.0)))) (spew t (end-sm-figure :contents right-3d-model) 1.0)) (spew t (3d-model :name 'arm5) 1.0) (spew t (external-adjunct-relation :parent 'right :component 'arm5 :pos arm5-pos :orient arm5-orient) 1.0) (spew t (3d-model :name 'arm6) 1.0) (spew t (external-adjunct-relation :parent 'right :component 'arm6 :pos arm6-pos :orient arm6-orient) 1.0) (spew t (3d-model :name 'arm7) 1.0) (spew t (external-adjunct-relation :parent 'right :component 'arm7 :pos arm7-pos :orient arm7-orient) 1.0) (spew t (3d-model :name 'arm8) 1.0) (spew t (external-adjunct-relation :parent 'right :component 'arm8 :pos arm8-pos :orient arm8-orient) 1.0)) ;; Initialize the goals. (spew t (mr-task-goal) 1.0) (spew t (initial-search-goal) 1.0) ;; Run simulation. (run) (values)) ;; Summarize the results of running a simulation. ;;; Check if the Sentence Comprehension Model has already defined SUMM and ;;; IMPL-SUMM commands. If so, we must explicitly undefine them before ;;; redefining them for the user. Otherwise, the user may seem confusing ;;; (though harmless) warning. (when (and (boundp '*dual-task*) *dual-task*) (fmakunbound 'summ) (fmakunbound 'impl-summ) ) ;;; Interface to top-level command to summarize the results of running a ;;; simulation. Easy to use because the parameters are unevaluated, and ;;; therefore the user does not have to quote literal arguments. (defmacro summ () `(impl-summ)) ;;; Function to summarize the results of running a simulation. Call this ;;; instead of SUMM if arguments must be evaluated. ;;; ;;; NOTE: Horrible hacky expression used to determine the model's decision ;;; about whether the problem was "same" or "mirror image". (defun impl-summ () (format t "~&Time: ~A" *cycles*) ;;^^ HACK!!! ;;^^ Also: Must fix bug for the 0 degrees rotation, same case. (ignore-errors (let ((right-orient (orient (get-dme 20))) (left-orient (orient (first (sort (dme-list '(rotate-component)) #'> :key #'id))))) (format t "~%Result: ~A" (if (=approx-vects right-orient left-orient) "Same" "Mirror Image")))) (history@ (lh-executive rh-executive lh-spatial rh-spatial) :combination avg :measure prop ) (values)) ;; Run batch simulations. ;;; Simulate the Carpenter et al. (1999) Mental Rotation study by running ;;; model on the same problems. Of course, not all of the stimuli are used, ;;; but all combinations of rotations and mirror-imaging are present. ;;; ;;; NOTE: I have somehow broken the model and it does the wrong thing most ;;; of the time. Must fix this! (defun mr1999 () (format t "~&Simulation of the Carpenter et al. (1999) Mental Rotation study.~2%") (caps) (format t "~2%") (sim :angle 0) (summ) (format t "~2%") (sim :angle 40) (summ) (format t "~2%") (sim :angle 80) (summ) (format t "~2%") (sim :angle 120) (summ) #| (format t "~2%") (sim :angle 0 :mirror-p t) (summ) (format t "~2%") (sim :angle 40 :mirror-p t) (summ) (format t "~2%") (sim :angle 80 :mirror-p t) (summ) (format t "~2%") (sim :angle 120 :mirror-p t) (summ) |# (values))