\ Copyright (C) 2008 MED Associates, All Rights Reserved.

\ MedLab8 Fixed Ratio.mpc  Fixed Ratio Source Program for MED-PC Version IV

\ Constants Used in this Program
\ Compare the configurations below with the wiring chart supplied
\ with all system orders.  Edit Input and Output #'s if different
\ for your system or contact MED Associates for assistance.

\ Inputs
^LeftLever  = 1
^RightLever = 2
^RightResponse = 3

\ Outputs
^Pellet     = 3
^Dipper     = 3  \ If both Pellet and Dipper are ordered
                 \ It will be necessary to change one of these
^LeftLight  = 4
^RightLight = 5
^Fan        = 6
^HouseLight = 7
^Pump       = 8


\ Program Constants
^Left      = 1
^Right     = 2
^PrevTrial = -5
^NextTrial = 5


\ A() = Control Variables with Assigned Aliases as Defined
Var_Alias Correct Lever (Left=1  Right=2)             = A(0)  \ Default = Left Lever
Var_Alias Reinforcers (Pellet=1  Dipper=2  Drug=3)    = A(1)  \ Default = Pump/Light
Var_Alias Reinforcer Time (sec)                       = A(2)  \ Default = 5 seconds
Var_Alias Time Out Following Reinforcer (sec)         = A(3)  \ Default = 20 seconds
Var_Alias Session Time (min)                          = A(4)  \ Default = 240 minutes
Var_Alias Fixed Ratio Value                           = A(5)  \ Default = 1
Var_Alias Maximum Reinforcers                         = A(6)  \ Default = 100
Var_Alias SoftCR Data Array (Yes=1  No=0)             = A(7)  \ Default = Yes

\ Constants for Control Variables Array
^CorrectLev       = 0
^Reinforcer       = 1
^ReinfTime        = 2
^TimeOut          = 3
^SessionTime      = 4
^FRVal            = 5
^MaxReinf         = 6
^SoftCR           = 7
^ReinfTimeTicks   = 8
^TimeOutTicks     = 9


\ List Data Variables Here
\  B() = Trial Data
\  B(0)   = Total Responses
\  B(1)   = Total Correct Response Count
\  B(2)   = Total Incorrect Response Count
\  B(3)   = % Correct
\  B(4)   = % Incorrect
\  B(J)   = Trial Number
\  B(J+1) = Correct Response
\  B(J+2) = Incorrect Response
\  B(J+3) = Pause Time (sec)
\  B(J+4) = Run Time (sec)

\  Constants for Trial Data Array B
^Total         = 0
^CorrectResp   = 1
^IncorrectResp = 2
^Correct       = 3
^Incorrect     = 4
^Trial         = 0
^PauseTime     = 3
^RunTime       = 4

\  C() = IRT Array and Event Pen Code for Soft Cum. Recorder
\  F   = Total Reinforcements


\ List Working Variables Here
\  I = Subscript for the IRT Array C
\  J = Subscript for the Trial Array B
\  L = Ratio Count
\  S = Elapsed Time in Session
\  T = Elapsed Time in 0.01 sec Increments for SoftCR Data


DIM A = 9
DIM B = 1000
^CArraySize = 100000  \ Change this Variable also when modifying the C array size.
DIM C = 100000  \ Dimension Array C for 100001 data points.
               \ Under MED-PC Version IV, this array may be
               \ enlarged up to 1 million elements; however,
               \ 100,000 was felt to be adequate for this application.
               \ An end of array seal -987.987 will limit the saved
               \ file to only those elements used during the running
               \ of the procedure.


\ Z-Pulses Used in this Program
^Z_Pellet    = 1   \ Signal Pellet Reinforcement
^Z_Dipper    = 2   \ Signal Dipper Reinforcement
^Z_Pump      = 3   \ Signal Pump/Light Reinforcement
^Z_Start     = 5   \ Signal Trial Start
^Z_Correct   = 6   \ Signal Correct Response
^Z_Incorrect = 7   \ Signal Incorrect Response
^Z_TimeOut   = 8   \ Signal Time Out Start/Stop
^Z_End       = 32  \ Signal End of Session


DISKCOLUMNS = 5


\***************************************************
\           MEDLAB8 FIXED RATIO SCHEDULE
\    S1 - Set Default Values
\         Correct Lever              (1-Left)
\         Reinforcement Device              (3-Pump/Light)
\         Reinforcement Time                (5 seconds)
\         Time Out Following Reinforcement  (20 seconds)
\         Session Time               (240 minutes)
\         Fixed Ratio Value          (1)
\         Maximum Reinforcers        (150)
\         SoftCR Activation          (1-Yes)
\***************************************************
S.S.1,
S1,
  0.001": SET A(^CorrectLev) = 1,  A(^Reinforcer)      = 3,  A(^ReinfTime) = 5;
          SET A(^TimeOut)    = 20,  A(^SessionTime) = 240, A(^FRVal)      = 1;
          SET A(^MaxReinf)   = 150, A(^SoftCR)      = 1;
          SET J = 5, B(J) = -987.987 ---> S2

S2,     \ First Statement: Wait for START signal, turn HouseLight ON,
        \ test for Correct Lever and turn associated stimulus ON.
        \
        \ Second Statement: Update screen display with default values
        \ for Control Variables.  This will show any changes made via
        \ the "Configure | Change Variables" Window prior to START.
  #START: CLEAR 1,60;
          SET A(^ReinfTimeTicks) = A(^ReinfTime) * 1";
          SET A(^TimeOutTicks) = A(^TimeOut)    * 1";
          SET B(J+^Trial) = 1, B(J+^NextTrial) = -987.987;
          SHOW 2,Tot Cor Rsp,B(^CorrectResp), 3,Tot Incor Rsp,B(^IncorrectResp), 4,Reinforcers,F;
          SHOW 6,Trial #,B(J+^Trial),         7,Cor Rsp,B(J+^CorrectResp),       8,Incor Rsp,B(J+^IncorrectResp);
          ON ^HouseLight, ^LeftLever, ^RightLever; LOCKON ^Fan ---> S3
  1": SHOW 1,Lever Code,A(^CorrectLev),    2,Reinforcers,A(^Reinforcer),            3,Reinforcer Time,A(^ReinfTime);
      SHOW 4,Time Out,A(^TimeOut),         5,Session Time,A(^SessionTime), 6,FR Value,A(^FRVal);
      SHOW 7,Max Reinforcers,A(^MaxReinf), 8,SoftCR Code,A(^SoftCR) ---> SX

S3,     \  Test for Correct Lever
        \  Control FR here.
        \  After each Response check if Fixed Ratio has been met.
  #RA(^CorrectLev): ADD L; Z^Z_Correct;
                    IF L >= A(^FRVal) [@FR_Value_Met, @False]
                       @FR_Met: SET L = 0; ZA(^Reinforcer); Z^Z_TimeOut ---> S4
                       @False: ---> SX
  #R^LeftLever:  Z^Z_Incorrect ---> SX
  #R^RightResponse: Z^Z_Incorrect ---> SX
  #Z^Z_End: ---> S10

S4,     \ Time Out Interval Following Reinforcement
  A(^TimeOutTicks)#T: Z^Z_TimeOut;
                      IF F >= A(^MaxReinf) [@End, @Cont]
                         @End: SET B(J) = -987.987; Z^Z_End ---> S10
                         @Cont: SET B(J+^Trial) = B(J+^PrevTrial) + 1;
                                SHOW 6,Trial #,B(J+^Trial); ON ^HouseLight; Z^Z_Start ---> S3
                                #R^LeftLever:  Z^Z_Correct ---> SX
                                #R^RightResponse: Z^Z_Incorrect ---> SX
  #Z^Z_End: ---> S10

S10,    \ End of Session - Turn Lights Off
        \ Calculate % Correct and % Incorrect.
  0.01": OFF ^HouseLight, ^LeftLever, ^RightLever;
         IF B(^Total) = 0 [@NoCalc, @Calculate]
            @NoCalc: ---> S11
            @Calculate: SET B(^Correct)   = B(^CorrectResp)   / B(^Total) * 100;
                        SET B(^Incorrect) = B(^IncorrectResp) / B(^Total) * 100 ---> S11

S11,    \ Holding State at End of Session
  1': ---> SX


\*********************************************
\            CORRECT LEVER COUNTER
\*********************************************
S.S.2,
S1,
  #START: ---> S2

S2,
  #Z^Z_Correct: ADD B(^Total), B(^CorrectResp), B(J+^CorrectResp);
                SHOW 2,Tot Cor Rsp,B(^CorrectResp), 7,Correct Rsp,B(J+^CorrectResp) ---> SX
  #Z^Z_End: ---> S1


\*********************************************
\           INCORRECT LEVER COUNTER
\*********************************************
S.S.3,
S1,
  #START: ---> S2

S2,
  #Z^Z_Incorrect: ADD B(^Total), B(^IncorrectResp), B(J+^IncorrectResp);
                  SHOW 3,Tot Incorr Rsp,B(^IncorrectResp), 8,Incorrect Rsp,B(J+^IncorrectResp) ---> SX
  #Z^Z_End: ---> S1


\*********************************************
\            REINFORCEMENT CONTROL TIMER
\*********************************************
S.S.4,
S1,
  #Z^Z_Pellet: ON ^Pellet ---> S2
  #Z^Z_Dipper: ON ^Dipper ---> S2
  #Z^Z_Pump:   ON ^Pump, ^LeftLight; OFF ^HouseLight   ---> S2

S2,     \ Time Reinforcement Device for A(^ReinfTime) seconds
        \ Default value set in S.S.1, S1 & S2
  A(^ReinfTimeTicks)#T: OFF ^Pellet, ^Dipper, ^Pump, ^LeftLight ---> S1
  #Z^Z_End:           OFF ^Pellet, ^Dipper, ^Pump, ^LeftLight ---> S1


\*********************************************
\              REINFORCEMENT COUNTER
\*********************************************
S.S.5,
S1,
  #START: ---> S2

S2,
  #ZA(^Reinforcer): ADD F; SHOW 4,Reinforcers,F ---> SX
  #Z^Z_End: ---> S1


\***********************************************
\           PAUSE AND RUN TIME TIMING
\***********************************************
S.S.6,
S1,
  #START: ---> S2

S2,
  #RA(^CorrectLev): ---> S3

S3,
  1": ADD B(J+^RunTime); SHOW 10,Run Time,B(J+^RunTime) ---> S3
  #Z^Z_End: ---> S1
  #ZA(^Reinforcer): SHOW 10,Run Time,B(J+^RunTime);
                SET J = J + 5, B(J+^NextTrial) = -987.987 ---> S4

S4,
  1": ADD B(J+^PauseTime); SHOW 9,Pause Time,B(J+^PauseTime) ---> S4
  #Z^Z_End:   ---> S1
  #Z^Z_Start: ---> S5

S5,
  #RA(^CorrectLev): SHOW 9,Pause Time,B(J+^PauseTime) ---> S3
  1": ADD B(J+^PauseTime); SHOW 9,Pause Time,B(J+^PauseTime) ---> S5
  #Z^Z_End: ---> S1


\**********************************************
\   INCREMENT TIME T FOR IRT AND EVENT ARRAY
\**********************************************
S.S.7,
S1,
  #START: IF A(^SoftCR) > 0 [] ---> S2

S2,
  0.01": ADD T ---> SX
  #Z^Z_End: ---> S1


\*********************************************************
\ ADD A STEP ELEMENT TO ARRAY C FOR EACH CORRECT RESPONSE
\*********************************************************
S.S.8,
S1,
  #START: IF A(^SoftCR) = 1 [@ActivateSoftCR, @NoSoftCR]
             @ActSoftCR: IF A(^CorrectLev) = ^Left [@LeftLeverCorrect, @RightLeverCorrect]
                            @LeftCorrect:  ---> S2
                            @RightCorrect: ---> S3
             @NoSoftCR: ---> SX

S2,     \ Left Lever Correct
  #R^LeftLever: SET C(I) = T + 0.10, T = 0; ADD I;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1

S3,     \ Right Lever Correct
  #R^RightResponse: SET C(I) = T + 0.10, T = 0; ADD I;
                 IF I >= ^CArraySize [@True, @False]
                    @True: ---> S1
                    @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1



\*********************************************************
\ ADD A STEP ELEMENT TO ARRAY C FOR EACH INCORRECT RESPONSE
\*********************************************************
S.S.9,
S1,
  #START: IF A(^SoftCR) = 1 [@ActivateSoftCR, @NoSoftCR]
             @ActSoftCR: IF A(^CorrectLev) = ^Right [@LeftLeverIncorrect, @RightLeverIncorrect]
                            @LeftIncorrect:  ---> S2
                            @RightIncorrect: ---> S3
             @NoSoftCR: ---> SX

S2,     \ Left Lever Incorrect
  #R^LeftLever: SET C(I) = T + 0.11, T = 0; ADD I;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1

S3,     \ Right Lever Incorrect
  #R^RightResponse: SET C(I) = T + 0.11, T = 0; ADD I;
                 IF I >= ^CArraySize [@True, @False]
                    @True: ---> S1
                    @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1



\*************************************************************
\ ADD AN EVENT ELEMENT TO ARRAY C FOR EACH CORRECT RESPONSE
\      ADDITIONAL EVENT ELEMENTS MAY BE ADDED AS NEEDED
\*************************************************************
S.S.10,
S1,
  #START: IF A(^SoftCR) = 1 [@ActivateSoftCR, @NoSoftCR]
             @ActSoftCR: SET C(I) = 0.50, I = I + 1, C(I) = -987.987;
                         IF A(^CorrectLev) = ^Left [@LeftLeverCorrect, @RightLeverCorrect]
                            @LeftCorrect:  ---> S2
                            @RightCorrect: ---> S3
             @NoSoftCR: SET C(0) = -987.987 ---> SX  \ Seal Array

S2,     \ Left Lever Correct
  #R^LeftLever: SET C(I) = T + 0.60, C(I+1) = 0.50, T = 0, I = I + 2;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1

S3,     \ Right Lever Correct
  #R^RightResponse: SET C(I) = T + 0.60, C(I+1) = 0.50, T = 0, I = I + 2;
                 IF I >= ^CArraySize [@True, @False]
                    @True: ---> S1
                    @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1




\*************************************************************
\ ADD AN EVENT ELEMENT TO ARRAY C FOR EACH INCORRECT RESPONSE
\      ADDITIONAL EVENT ELEMENTS MAY BE ADDED AS NEEDED
\*************************************************************
S.S.11,
S1,
  #START: IF A(^SoftCR) = 1 [@ActivateSoftCR, @NoSoftCR]
             @ActSoftCR: SET C(I) = 0.51, I = I + 1, C(I) = -987.987;
                         IF A(^CorrectLev) = ^Right [@LeftLeverIncorrect, @RightLeverIncorrect]
                            @LeftIncorrect:  ---> S2
                            @RightIncorrect: ---> S3
             @NoSoftCR: SET C(0) = -987.987 ---> SX  \ Seal Array

S2,     \ Left Lever Incorrect
  #R^LeftLever: SET C(I) = T + 0.61, C(I+1) = 0.51, T = 0, I = I + 2;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1

S3,     \ Right Lever Incorrect
  #R^RightResponse: SET C(I) = T + 0.61, C(I+1) = 0.51, T = 0, I = I + 2;
                 IF I >= ^CArraySize [@True, @False]
                    @True: ---> S1
                    @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: ---> S1


\****************************************************
\    ADD A PIP ELEMENT TO ARRAY C FOR EACH REINFORCEMENT
\****************************************************
S.S.12,
S1,
   #START: IF A(^SoftCR) > 0 [] ---> S2

S2,
  #ZA(^Reinforcer): SET C(I) = T + 0.20, T = 0; ADD I;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> SX
  #Z^Z_End: SET C(I) = T + 0.31, I = I + 1, C(I) = -987.987 ---> S1


\*************************************************************
\     ADD AN EVENT ELEMENT TO ARRAY C FOR THE TIME-OUT
\*************************************************************
S.S.13,
S1,
  #START: IF A(^SoftCR) = 1 [@ActivateSoftCR, @NoSoftCR]
             @ActSoftCR: SET C(I) = 0.52, I = I + 1, C(I) = -987.987;
                         IF A(^TimeOut) = 0 [@NoEvent, @Record]
                            @NoEvent: ---> SX
                            @Record:  ---> S2
             @NoSoftCR: SET C(0) = -987.987 ---> SX  \ Seal Array

S2,     \ Start Event Pen, Up
  #Z^Z_TimeOut: SET C(I) = T + 0.62, T = 0; ADD I;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> S3
  #Z^Z_End: ---> S1

S3,     \ Stop Event Pen, Down
  #Z^Z_TimeOut: SET C(I) = T + 0.52, T = 0; ADD I;
                IF I >= ^CArraySize [@True, @False]
                   @True: ---> S1
                   @False: SET C(I) = -987.987 ---> S2
  #Z^Z_End: ---> S1


\*********************************************
\                SESSION CLOCK
\*********************************************
S.S.32,
S1,
  #START: SHOW 1,Session,S/60 ---> S2

S2,
  1": ADD S; SHOW 1,Session,S/60;
      IF S/60 >= A(^SessionTime) [@EndSession, @ContinueTiming]
         @End: Z^Z_End ---> S3
         @Cont: ---> SX
  #Z^Z_End: ---> S3

S3,     \ Wait for Screen Update and end with
        \ STOPABORTFLUSH for Automatic Data Saving
  2": ---> STOPABORTFLUSH