Competing productions

Alex Petrov apetrov+ at andrew.cmu.edu
Sun Apr 11 23:57:39 EDT 1999


Folks,

A month ago there was a discussion on the list about
random production firing. Jim Davies wrote:
> I have 2 productions that I want to fire at random. That
> is, approximately 50% of the time p1 fires, and 50% of 
> the time p2 fires.

I came across a more general problem.  Working on it, I
developed a small experimental model and ran some
simulations.  I think the results are of general interest
and therefore post them to the list.

In a nutshell, I needed a mechanism for rehearsing a given
chunk a few times.  One solution would be to set explicit
counters and push-and-pop the chunk a fixed number of times. 
This solution, however, does not have the right flavor for
me.  Therefore, I decided to have two productions: REHEARSE
and STOP-REHEARSING.  REHEARSE rehearses once and leaves 
the stack intact, thus opening the possibility for more
rehearsals.  STOP-REHEARSING pops the goal and terminates
the process.

If the probability for REHEARSE is P and for STOP-REHEARSING
is 1-P, the number of rehearsals will follow a geometric
distribution with mean M=p/(1-p).  Thus, when P=0.5 the mean
number of rehearsals is M=1.  This in effect is the 50/50
competition of the previous messages.  To have more 
rehearsals one must establish a higher value for P.

So, the problem boils down to having two productions that
have unequal chances to fire.  One way to do that is the
following:
  Enable rational analysis        --  (sgp :era T)
  Turn on the expected-gain noise --  (sgp :egs 0.25)
  Leave the Q parameter of the REHEARSE production at
     its default value of 1.
  Set Q for STOP-REHEARSING to some value less than 1 --
     (spp (stop-rehearsing :q 0.995)).  
     Note that this parameter is very sensitive.

This setting entails that the two competing productions
have unequal expected gain E=PG-C.  The conflict resolution
mechanism favors the production with higher exp.gain, thus
firing them with unequal probabilities.  

The question of course is to calculate the value of Q that 
yields the desired probabilities.  A little algebra and the 
Conflict Resolution Equation 3.4 (page 65 in "The Atomic 
Components of Thought") give the following relationship:

  E2 - E1 = s * sqrt2 * [log(P2) - log(P1)]   or
  delta_E = s * sqrt2 * log(M)                ,

  where  P1 is the probability that STOP-REHEARSING fires,
         P2 is the prob. that REHEARSE fires, P1+P2=1,
         E1 and E2 are the expected gains,
         s  is the noise parameter,
         M=P2/P1  is the mean number of rehearsals, and
         sqrt2  is the square root of 2.


Given that  E = P*G-C = Q*R*G - C   and assuming that
R1=R2=1, C1=C2, and Q2=1, we can calculate Q1 from M:

                       s * sqrt2
   Q-stop = 1 - log(M) ---------
                          G

Note that when G=20 (the default) and s=0.25 (a recommended
value), the factor  s*sqrt2/G  is 0.01768.  This makes the
Q parameter very sensitive -- changes in the second decimal
place have dramatic effects:

    P2      M    delta-E  Q-stop
---------------------------------
   0.50    1.00   0.000   1.0000
   0.60    1.50   0.143   0.9928
   0.67    2.00   0.245   0.9877
   0.75    3.00   0.388   0.9806
   0.80    4.00   0.490   0.9755
   0.90    9.00   0.777   0.9612
   0.95   19.00   1.041   0.9479
   0.99   99.00   1.625   0.9188


I wrote a small model to test all this.  Some transcripts
are listed below.  The runnable LISP file is appended to 
the end of this message.  Just load it into the LISP environment
(after loading ACT-R, of course).  The main function is
DO-EXPERIMENT.

Best,

  Alex

-------------------------------------------------------------
Alexander Alexandrov Petrov   apetrov+ at andrew.cmu.edu
                              apetrov at cogs.nbu.acad.bg
Graduate student
Dept of Psychology, CMU       Baker Hall 455A, (412) 268-8112

In your practice always keep in your thoughts the interaction 
of heaven and earth, water and fire, yin and yang.
              Morihei Ueshiba O-Sensei, The Founder of Aikido
-------------------------------------------------------------


? (do-experiment 1000 :M 1)     ; i.e. 50/50 competition
 2017 production firings total.
 1017 REHEARSE        firings; p = 0.504
 1000 STOP-REHEARSING firings; p = 0.496
 Mean number of rehearsals  1.02, variance  2.02, std.dev 1.422
 Distribution:     0    1    2    3    4    5    6    7    8    9   10+
                 494  250  128   64   34   17    1    6    4    2    0

? (do-experiment 1000 :p 0.6)
 2565 production firings total.
 1565 REHEARSE        firings; p = 0.610
 1000 STOP-REHEARSING firings; p = 0.390
 Mean number of rehearsals  1.56, variance  3.87, std.dev 1.968
 Distribution:     0    1    2    3    4    5    6    7    8    9   10+
                 385  231  155   97   53   33   16    9    9    4    8

? (do-experiment 1000 :M 2)
 2905 production firings total.
 1905 REHEARSE        firings; p = 0.656
 1000 STOP-REHEARSING firings; p = 0.344
 Mean number of rehearsals  1.91, variance  5.58, std.dev 2.363
 Distribution:     0    1    2    3    4    5    6    7    8    9   10+
                 339  228  143  110   65   39   26   15   17    9    9

? (do-experiment 1000 :Q-stop 0.95  :bins 15)
 18471 production firings total.
 17471 REHEARSE        firings; p = 0.946
 1000 STOP-REHEARSING firings; p = 0.054
 Mean number of rehearsals 17.47, variance 354.66, std.dev 18.832
 Distribution:     0    1    2    3    4    5    6    7    8    9   10   11
12   13   14+
                  59   56   44   44   49   39   39   37   33   34   39   31
24   26  446

===========================================================================
==========================

;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-User; Base: 10 -*-

;;; FILE:       prod_competn.act
;;; VERSION:    1.0
;;; PURPOSE:    Explore production competition in ACT-R.
;;; DEPENDS-ON: ACT-R.lisp
;;; PROGRAMMER: Alexander Alexandrov Petrov  (apetrov+ at andrew.cmu.edu)
;;; CREATED:    10-Apr-99 [1.0]
;;; UPDATED:    ...

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;                                                        ;;;;
  ;;;;      P R O D U C T I O N   C O M P E T I T I O N       ;;;;
  ;;;;                                                        ;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;  Counters   --------------------------------------------------

(defvar *stop-count*  0  "Total number of STOP-REHEARSING firings." )
(defvar *reh-count*   0  "Total number of REHEARSE firings." )

(defvar *rehearsals*  0  "Number of rehearsals on the current trial." )

(defun reset-all-counters ()
  (setq *stop-count* 0  *reh-count* 0  *rehearsals* 0 ))


;;;  ACT-R global parameters    ----------------------------------

(clear-all)

(sgp :era  t      ; Enable rational analysis.
     :G    20.0   ; Value of the top-level goal (default=20.0).
     :egs  0.25   ; Expected gain noise.
     :ut   0.0    ; Utility threshold  (default=0.0).
)

;;;  Chunks    ---------------------------------------------------

(chunk-type rehearsal-goal
  )  ; no slots

(add-DM  (rehearsal-goal isa rehearsal-goal))


;;;  Production definitions    -----------------------------------

(p stop-rehearsing
   =goal>
     isa   rehearsal-goal
 ==>
   !eval!  (incf *stop-count*)
   !pop!
)

(p rehearse
   =goal>
     isa   rehearsal-goal
 ==>
   !eval!  (incf *reh-count*)
   !eval!  (incf *rehearsals*)
)

;;;  Production parameters     -----------------------------------

(spp (rehearse         :q 1.0  :r 1.0 ))
(spp (stop-rehearsing  :q 1.0  :r 1.0 ))   ; Q modified below

;;;  Parameter-setting functions     -----------------------------

(defconstant sqrt2 (sqrt 2.0)  "Square root of 2" )

(defun delta-E-for-M (M)
  "Expected-gain difference that will generate M rehearsals on average."
  (let ((s (no-output (first (sgp :egs)))))
    (* s sqrt2 (log M)) ))

(defun delta-E-for-p (p)
  "Expected-gain difference that will fire REHEARSE with probability P."
  ;; The number of rehearsals has a geometric distribution.
  ;; Expected mean value is M = p/q, where q=1-p.  Variance is p/(q^2).
  (assert (and (numberp p) (< 0.0 p 1.0)))
  (let ((M (/ p (- 1.0 p))))
    (delta-E-for-M M) ))

(defun q-stop (delta-E)
  "Q parameter for STOP-REHEARSING that entails DELTA-E."
  ;; E = PG - C = (q*r)*G - (a+b)
  ;; delta-E = delta-Q * G , assuming all Rs are 1 and the costs are equal.
  (let ((G (no-output (first (sgp :G))))
        (q-rehearse (no-output (first (first (spp (rehearse :q)))))) )
    (- q-rehearse
       (/ delta-E G)) ))

(defun set-Q-stop (q-stop)
  "Set the Q parameter of the production STOP-REHEARSING."
  (assert (and (numberp q-stop) (<= 0.0 q-stop 1.0)))
  (let ((result (spp-fct (list 'stop-rehearsing :q q-stop))))
    (first (first result)) ))


;;;  Simulation experiment          ------------------------------

(defun do-trial ()
  "Push REHEARSAL-GOAL, run the model, and return the number of rehearsals."
  (setq *rehearsals* 0)
  (goal-focus rehearsal-goal)
  (no-output (run))
  *rehearsals* )


(defun do-experiment (trials &key (M nil) (p nil) (delta-E nil) (q-stop nil)
                                    (s nil) (G nil) (reload nil)  
                                    (bins 11) (report T) )
  "Initialize parameters, run ACT-R model, and print summary statistics."
  (initialize-experiment reload s G M p delta-E q-stop)
  (let ((results (do-experiment-aux trials bins)))     ; list of 6 values
    (if report 
        (report-experiment results)    ; returns no values
        results) ))

(defun do-experiment-aux (trials bins)
  (let ((sum   0)
        (sumsq 0)
        (distr (make-array bins :initial-element 0))
        (last-bin (- bins 1))
        (verbose (no-output (first (sgp :v)))) )
    (sgp :v nil)                  ; turn VERBOSE switch off
    (dotimes (trial trials)
      (let ((reh (do-trial)))
        (incf sum   reh)
        (incf sumsq (* reh reh))
        (incf (svref distr (min reh last-bin))) ))
    (sgp-fct (list :v verbose))   ; restore VERBOSE to its original value
    (list trials
          *stop-count*  *reh-count*
          sum  sumsq  distr )))


(defun initialize-experiment (reload s G M p delta-E q-stop)
  "Prepare for DO-EXPERIMENT."
  (cond (reload  (reload) )
        (t       (seed) (setq *time* 0.0)) )
  (reset-all-counters)
  (when s         ; noise level stated explicitly
    (sgp-fct (list :egs s)) )
  (when G         ; Goal value stated explicitly
    (sgp-fct (list :G G)) )
  (cond (q-stop   ; Q for STOP-REHEARSING stated explicitly
            (set-Q-stop q-stop))      ; ignore DELTA-E, M, and p
        (delta-E  ; DELTA-E stated explicitly
            (set-Q-stop (q-stop delta-E)))      ; ignore M and p
        (M        ; M stated explicitly
            (set-Q-stop (q-stop (delta-E-for-M M))))  ; ignore p
        (p        ; p stated explicitly
            (set-Q-stop (q-stop (delta-E-for-p p))))
        (t  (error "One of M, P, DELTA-E, or P must be specified.")) ))


(defun report-experiment (results)
  (let* ((trials     (first  results))
         (stop-count (second results))
         (reh-count  (third  results))
         (sum        (fourth results))
         (sumsq      (fifth  results))
         (distrib    (sixth  results))
         (P-stop     (/ stop-count (+ stop-count reh-count)))
         (P-reh      (/ reh-count  (+ stop-count reh-count)))
         (mean-reh   (/ sum trials))
         (var-reh    (variance trials sum sumsq)) )
    (unless (eq trials stop-count)
      (warn "TRIALS (=~S) not equal to STOP-COUNT (=~S)." trials stop-count
))
    (format t "~& ~4D production firings total.~%"  (+ stop-count
reh-count))
    (format t " ~4D REHEARSE        firings; p = ~5,3F~%"  reh-count  P-reh
)
    (format t " ~4D STOP-REHEARSING firings; p = ~5,3F~%"  stop-count
P-stop)
    (format t " Mean number of rehearsals ~5,2F, variance ~5,2F, std.dev
~5,3F~%"
              mean-reh  var-reh  (sqrt var-reh))
    (report-distribution distrib)
    (values) ))

(defun report-distribution (distrib)
  "DISTRIB is an array of frequencies."
  (let ((bins (length distrib)))
    (format t    " Distribution: ")
    (dotimes (bin bins) (format t "~5D" bin))
    (format t "+~%               ")
    (dotimes (bin bins) (format t "~5D" (svref distrib bin)))
    (terpri) ))

(defun variance (N sum sumsq)
  (/ (- sumsq (/ (* sum sum) N))
     N ))

;;;;;;;  End of file ACT-R/Examples/prod_competn.act







More information about the ACT-R-users mailing list