;;;;;;;;;;;;;;;;;;;;<pre><xmp>
(defvar *p1-wins* 0)
(defvar *p2-wins* 0)
(defvar *user-move* 'paper) ; 'paper, 'rock 'scissors
(defvar *history*)

(defvar *local-symbols*)

(setf *local-symbols*
      '(*p1-wins*
        *p2-wins*
        *user-move*
        *history*
))

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "ACT-R model that plays Rock Paper Scissors" 2)
        (:new-para)
	(:heading "Model currently unavailable")
#|

        "Press your choice"
        (:new-para)
        (:button "Rock" "(progn
                           (setf *user-move* 'rock)
                           (experiment-rps-rw)
 (push (- *p1-wins* *p2-wins*) *history*))")
        
        (:button "Paper" "(progn
                           (setf *user-move* 'paper)
                           (experiment-rps-rw)
(push (- *p1-wins* *p2-wins*) *history*))")
        
        (:button "Scissors" "(progn
                           (setf *user-move* 'scissors)
                           (experiment-rps-rw)
(push (- *p1-wins* *p2-wins*) *history*))")
        
        (:new-para)
        "Or choose one of the following"
        (:new-para)
        (:button "Reset model and score" "(progn
                           (setf *history* nil)
                           (setf *p1-wins* 0)
                           (setf *p2-wins* 0)
                           (reset)
                           (format *standard-output* \"~%******* Model Reset *******~%~%\"))")
         (:button "display graph of score" "
                           (if *history*
                           (display-rps-rw-graph)
                           (format *standard-output* \"~%No games played~%~%\"))")
|#
))

(defun read-move-rps-rw ()
  (format *standard-output*  "~%Your move is   : ~S~%" *user-move*)
  (unless (numberp *p1-wins*)
    (setf *p1-wins* 0)
    (setf *p2-wins* 0))
  *user-move*)

(defun report-rps (p1 p2)
  #|(with-open-file (x "Macintosh_HD1:Desktop Folder:rpslogs" :direction :output :if-exists :append :if-does-not-exist :create)
    (format x "p1: ~A~%p2: ~A~%~%    Current score~%   YOU       ACT-R~% ~5D       ~5D~%" p1 p2 *p1-wins* *p2-wins*))|#
  (format *standard-output* "~%    Current score~%   YOU       ACT-R~% ~5D       ~5D~%" *p1-wins* *p2-wins*))

(defun experiment-rps-rw ()
  (let ((p1 (first (no-output (sdm isa p1 current nil))))
        (p2 (first (no-output (sdm isa p2 current nil)))))
    (eval `(goal-focus ,p1))
    (run 1)
    (eval `(goal-focus ,p2))
    (run 1)
    (eval `(goal-focus ,p1))
    (run 1)
    (eval `(goal-focus ,p2))
    (run 1)
    (goal-focus play)
    (run 1)))

(defun display-rps-rw-graph ()
    
    (format *standard-output* " 
        <applet 
         code = \"DansGraphs.class\" 
         width = 500 
         height = 400> 
        <PARAM name=\"title\" value=\"Score history\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"~S\">
        <PARAM name=\"ymax\" value=\"~S\">
        <PARAM name=\"ymin\" value=\"~S\">
        <PARAM name=\"longestline\" value=\"~S\">
        <PARAM name=\"numlines\" value=\"1\">
        <PARAM name=\"xspacing\" value=\"~S\">
        <PARAM name=\"yspacing\" value=\"~S\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"6553\">
        <PARAM name=\"xval0\" value=\"" 
            (1- (length *history*))
            (apply #'max *history*)
            (apply #'min *history*)
            (length *history*)
            (1- (length *history*))
            (- (apply #'max *history*) (apply #'min *history*))

            )
    (dotimes (i (length *history*))
      (format *standard-output* "~S;" i)) 
    
    (format *standard-output* "\">
        <PARAM name=\"xname\" value=\"Move number\">
        <PARAM name=\"yname\" value=\"Score\">
        <PARAM name=\"name0\" value=\"Your score minus ACT-R's score\">
        <PARAM name=\"yval0\" value=\"
        ")

   (dolist (x (reverse *history*))
      (format *standard-output* "~S;" x))
 
    (format *standard-output* "\">
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; The ACT-R model

(clear-all)
(setf *history* nil)

(sgp 
   :ANS 0.25
   :RT -10.0
   :BLL 0.5
   :OL NIL
   :ERA T
)
(sgp
   :CT nil
   :LT NIL
   :v nil
   :ot nil
)

(chunk-type move beaten)

(chunk-type play p1 p2)

(chunk-type p1 current play)

(chunk-type p2 l3 l2 l1 current play)

(add-dm
 (none isa move)
 (paper isa move beaten scissors)
 (scissors isa move beaten rock)
 (rock isa move beaten paper)
 (play isa play)
 (p1 isa p1 play play)
 (p2 isa p2 l2 none l1 none play play))

;;; p1 productions

(p p1-random
   =goal>
      isa p1
      current nil
      play =play
==>
   !bind! =move (read-move-rps-rw)
   =play>
      isa play
      p1 =move
   =goal>
      current none)

(p p1-next
   =goal>
      isa p1
      current =current
      play =play
   =play>
      isa play
      p2 =p2
==>
   =goal>
      current =p2
   =subgoal>
      isa p1
      play =play
   !focus-on! =subgoal)
  
;;; p2 productions - computer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p p2-play
   =goal>
      isa p2
      l1 =l1
      l2 =l2
      current nil
      play =play
    =trial>
      isa p2
      l1 =l1
      l2 =l2
      current =l0
   =l0>
      isa move
      beaten =move
==>
   !eval! (format *standard-output* "ACT-R's move is: ~S~%" =move)
   =play>
      isa play
      p2 =move
   =goal>
      current none)

(p p2-random
   =goal>
      isa p2
      current nil
      play =play
   =l0>
      isa move
      beaten =move
==>
   !eval! (format *standard-output* "ACT-R's move is: ~S~%" =move)
   =play>
      isa play
      p2 =move
   =goal>
      current none)

(p p2-next
   =goal>
      isa p2
      l1 =l1
      l2 =l2
      current =current
      play =play
   =play>
      isa play
      p1 =p1
==>
   =goal>
      current =p1
   =subgoal>
      isa p2
      l2 =l1
      l1 =p1
      play =play
   !focus-on! =subgoal)
  
;;; play productions

(p tie
   =goal>
      isa play
      p1 =move
      p2 =move
==>
   !eval! (report-rps =move =move)
   =goal>
      p1 nil
      p2 nil)

(p p1-wins
   =goal>
      isa play
      p1 =p1
      p2 =p2
   =p2>
      isa move
      beaten =p1
==>
   !eval! (incf *p1-wins*)
   !eval! (report-rps =p1 =p2)
   =goal>
      p1 nil
      p2 nil)

(p p2-wins
   =goal>
      isa play
      p1 =p1
      p2 =p2
   =p1>
      isa move
      beaten =p2
==>
   !eval! (incf *p2-wins*)
   !eval! (report-rps =p1 =p2)
   =goal>
      p1 nil
      p2 nil)