'Sample simulation program from:
'Stout, S.C., & Miller, R.R. (in press). Sometimes competing retrieval (SOCR):
'A formalization of the comparator hypothesis. *Psychological Review*.
'This file supplants all previous implementations of the SOCR model
'Programmed in Microsoft QuickBasic 7.1
'program simulates response potential to X (target) stimulus alone

DECLARE SUB axes ()
SCREEN 12, 1

'*****************PARAMETERS
k1 = -.125 / (SQR(2) / 2)    'EXTINCTION RATE
k2 = .9                      'COMPARATOR WEIGHT
k3 = .1 / (SQR(2) / 2)       'OPERATOR CHANGE RATE
full = SQR(2) / 2            'FULL INTENSITY STIMULUS
weak = SQR(2) / 4            'WEAK STIMULUS



opxaus = -1 'INITIALIZE OPERATOR VALUES
opxcus = -1
opxca = -1
opacus = -1
opxac = -1
opcaus = -1
notimeslices = 5 'Timeslices 1 or 2 are used to set up events on a trial
'The remaining timeslices define the intertrial interval if context is left on.

'****************SET UP THE NUMBER OF PHASES
ph1end = 100 'end of phase 1
ph2end = ph1end + 5'end of phase 2
ph3end = ph2end + 0 'end of phase 3
ph4end = ph3end + 0 'end of phase 4


CALL axes

'********BEGIN TRIAL COUNTS****************************
FOR trial = 1 TO ph4end
xplot = trial * 630 / ph4end    'scales graph left-right for number of trials
FOR timeslice = 1 TO notimeslices

'*******************TRIAL SCHEDULE
'c = b in simulation, trial spacing assumed infinite

'Phase 1 events
IF trial <= ph1end THEN
	IF timeslice = 1 THEN  'timeslice 1
		us = full: x = 0: a = weak: C = full
	END IF

	IF timeslice = 2 THEN
	    us = 0: x = 0: a = 0: C = 0  'timeslice 2
	END IF

	IF timeslice > 2 THEN 'remaining ITI
	     us = 0: x = 0: a = 0: C = 0
	END IF

END IF

 
'phase 2 events
IF trial > ph1end AND trial <= ph2end THEN

	IF timeslice = 1 THEN  'timeslice 1
		us = full: x = weak: a = 0: C = 0

	END IF

	IF timeslice = 2 THEN  'timeslice 2
	    us = 0: x = 0: a = 0: C = 0  'timeslice 2
	END IF

	IF timeslice > 2 THEN 'remaining ITI
	     us = 0: x = 0: a = 0: C = 0
	END IF
END IF


'Phase 3 events
IF trial > ph2end AND trial <= ph3end THEN
	IF timeslice = 1 THEN  'timeslice 1
		us = 0: x = 0: a = 0: C = 0
	END IF

	IF timeslice = 2 THEN  'timeslice 2
	     us = 0: x = 0: a = 0: C = 0'timeslice 2
	END IF

	IF timeslice > 2 THEN 'remaining ITI
	     us = 0: x = 0: a = 0: C = 0
	END IF

END IF


'Phase 4 events
IF trial > ph3end AND trial <= ph4end THEN
	IF timeslice = 1 THEN  'timeslice 1
		us = 0: x = 0: a = 0: C = 0
	END IF

	IF timeslice = 2 THEN
	     us = 0: x = 0: a = 0: C = 0 'timeslice 2
	END IF

	IF timeslice > 2 THEN 'remaining ITI
	     us = 0: x = 0: a = 0: C = 0
	END IF

END IF


'*************LEARNING EQUATIONS
'Vxus
IF x > 0 AND us > 0 THEN xus = x * us * (1 - xus) + xus
IF x > 0 AND us = 0 THEN xus = k1 * x * xus + xus

'Vxa
IF x > 0 AND a > 0 THEN xa = x * a * (1 - xa) + xa
IF x > 0 AND a = 0 THEN xa = k1 * x * xa + xa

'Vaus
IF a > 0 AND us > 0 THEN aus = a * us * (1 - aus) + aus
IF a > 0 AND us = 0 THEN aus = k1 * a * aus + aus

'Vxc
IF x > 0 AND C > 0 THEN xc = x * C * (1 - xc) + xc
IF x > 0 AND C = 0 THEN xc = k1 * x * xc + xc

'Vca
IF C > 0 AND a > 0 THEN ca = C * a * (1 - ca) + ca
IF C > 0 AND a = 0 THEN ca = k1 * C * ca + ca

'Vac
IF a > 0 AND C > 0 THEN ac = a * C * (1 - ac) + ac
IF a > 0 AND C = 0 THEN ac = k1 * a * ac + ac

'Vcus
IF C > 0 AND us > 0 THEN cus = C * us * (1 - cus) + cus
IF C > 0 AND us = 0 THEN cus = k1 * C * cus + cus


'Operators

'opxaus
IF xus > 0 THEN
opxaus = 1
ELSE
opxaus = x * k3 * xa * aus * (1 - opxaus) + opxaus
END IF

'opxcus
IF xus > 0 THEN
opxcus = 1
ELSE
opxcus = x * k3 * xc * cus * (1 - opxcus) + opxcus
END IF

'opxca
IF xa > 0 THEN
opxca = 1
ELSE
opxca = x * k3 * xc * ca * (1 - opxca) + opxca
END IF

'opacus
IF aus > 0 THEN
opacus = 1
ELSE
opacus = a * k3 * ac * cus * (1 - opacus) + opacus
END IF

'opxac
IF xc > 0 THEN
opxac = 1
ELSE
opxac = x * k3 * xa * ac * (1 - opxac) + opxac
END IF

'opcaus
IF cus > 0 THEN
opcaus = 1
ELSE
opcaus = C * k3 * ca * aus * (1 - opcaus) + opcaus
END IF

NEXT timeslice

'****************PERFORMANCE EQUATIONS*********************

'The response potential of target at end of a trial

fxc = k2 * xa * ac * opxac      '2nd Order Comparator
exc = xc - fxc                  'EFFECTIVE Vxc

fcus = k2 * ca * aus * opcaus   '2nd Order Comparator
ecus = cus - fcus               'EFFECTIVE Vcus


fxa = k2 * xc * ca * opxca   '2nd Order Comparator
exa = xa - fxa               'EFFECTIVE Vxa

faus = k2 * ac * cus * opacus     '2nd Order Comparator
eaus = aus - faus                 'EFFECTIVE Vaus


total = opxaus * exa * eaus + opxcus * exc * ecus  'Total comparator adjustment
IF total > 1 THEN total = 1 'Capping total comparator adjustment
r = xus - k2 * total 'Effective Vxus

IF r > highest THEN highest = r 'highest r value encountered

'PLOT RESPONSE POTENTIALS in 640*480
LINE (xplot, 240)-(xplot + 10, 240 - 120 * r), 4, BF


'WRITE DATA FILE IF DESIRED
GOTO 10 'A quotation mark in front of GOTO will write data to current directory
IF opened = 0 THEN
OPEN "name.dat" FOR APPEND AS #1  'The file name is the label in quotes
opened = 1
END IF
IF opened = 1 THEN
WRITE #1, r
END IF
10

NEXT trial

PRINT "Final response = "; r
PRINT "Peak r = "; highest


END

SUB axes
      ' Set up X and Y-axes
      LINE (0, 240)-(640, 240)
      LINE (0, 0)-(0, 480)
      FOR I = 0 TO 640 STEP 32
      LINE (I, 244)-(I, 236) ' X-AXIS TICKS
      NEXT I
      FOR I = 0 TO 480 STEP 24
      LINE (0, I)-(4, I) ' Y-AXIS TICKS
      NEXT I
      LINE (0, 120)-(12, 120)
      LINE (0, 360)-(12, 360)
      LINE (320, 250)-(320, 230)
END SUB