REM >FVRIP
REM ========================================================================
REM FR, VR, FI, VR, probabilistic schedules of reinforcement.
REM
REM One lever at a time.
REM Session time held constant.
REM By Rudolf Cardinal.
REM First written: 17 Oct 98.
REM ========================================================================

version_date$="1 Dec 98"
debug%=0

REM ========================================================================
REM Method
REM ========================================================================
REM
REM Houselight on. One lever only.
REM Levers are 'debounced' to 10 Hz max.
REM Possibly inconsistent:
REM          interval schedules reinforce the first press
REM          ratio schedules don't

REM ========================================================================
REM Revision History
REM ========================================================================
REM
REM 17 Oct 98 - first version.
REM             KNOWN PROBLEM: if multiple pellets are given, the behaviour
REM             when a lever is pressed during the inter-pellet interval
REM             is undefined.
REM 1 Dec 98  - clock timer was overlapping with box 4

REM ========================================================================
REM Library calls
REM ========================================================================

PROCinit              :REM Arachnid init
PROCkill_all          :REM Arachnid init
LIBRARY "<RudolfDir>.ProgLibs.Ascii"
LIBRARY "<RudolfDir>.ProgLibs.UI"
LIBRARY "<RudolfDir>.ProgLibs.DateTime"
LIBRARY "<RudolfDir>.ProgLibs.Filename"
date_time$ = FNdate_time_code
LIBRARY "<RudolfDir>.ProgLibs.Arachnid"
LIBRARY "<RudolfDir>.ProgLibs.BoxConst"
PROCcombined_boxes

REM ========================================================================
REM Constants
REM ========================================================================

session_time% = 30 * 60 * 100  :REM 30 minutes
nreinf% = 1 :REM pellets per reinforcement
IF debug%=1 THEN session_time% = 1 * 60 * 100 :REM 1 minute for debugging
pellet_gap% = 50 :REM 0.5s between multiple pellets
debounce_time% = 10 :REM debounce to 10 Hz max.

session_timer% = nboxes% * 0    :REM only one used!
pellet_timer% = nboxes% * 1
interval_timer% = nboxes% * 2
debounce_timer% = nboxes% * 3
clock_timer% = nboxes% * 4 + 1  :REM only one used!
left%=1:right%=2:DIM side$(2):side$(left%)="left": side$(right%)="right"
fr%=1: vr%=2: fi%=3: vi%=4: prob%=5

REM ========================================================================
REM Variables
REM ========================================================================

DIM presscount%(nboxes%)       :REM number of presses
DIM reinfcount%(nboxes%)       :REM number of reinforcements
DIM subject$(nboxes%)          :REM subject name
DIM side%(nboxes%)             :REM left or right lever
DIM schedule%(nboxes%)         :REM type of schedule
DIM ratio%(nboxes%)            :REM ratio (FR) or current ratio (VR)
DIM interval%(nboxes%)         :REM interval (FI) or current interval (VI)
DIM min_ratio%(nboxes%)        :REM minimum ratio, for VR
DIM max_ratio%(nboxes%)        :REM maximum ratio, for VR
DIM min_interval%(nboxes%)     :REM minimum interval, for VI
DIM max_interval%(nboxes%)     :REM maximum interval, for VI
DIM probability(nboxes%)       :REM p(reinf), for probabilistic reinforcement
DIM ratio_counter%(nboxes%)    :REM #responses in this "ratio"
DIM interval_elapsed%(nboxes%) :REM has the interval elapsed?
DIM debouncing%(nboxes%)       :REM press invalid because <10cs since last

REM ========================================================================
REM Main
REM ========================================================================

dummy% = RND(-TIME)
PROCsay_hello
logfile$ = FNget_filename("TEXT LOG - enter filename (no spaces etc.)")
PROCget_parameters
PROCdisplay_screen
FOR i% = 1 TO nboxes%: PROCstart_the_box(i%): NEXT
PROCpipe_timer(session_timer%, session_time%, 0, "FNend_session(", 0, E%)
PROCpipe_fkey(12,0,1,"FNend_session(",0,E%)
start_time% = TIME
PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
PROCwait(E%): *AE
END

REM ========================================================================
REM Functions common to all schedules
REM ========================================================================

DEF PROCsay_hello
  MODE 12
  PRINT"FVRIP - simple schedules of reinforcement."
  PRINT"By Rudolf Cardinal. Version as of ";version_date$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT"----------------------------------------------------------------------"
  PRINT
ENDPROC


DEF PROCget_parameters
  COLOUR1
  PRINT "1. CHOOSE OVERALL PARAMETERS"
  PRINT "----------------------------":COLOUR7
  session_time%=60*100*FNget_num_param("Session time (min)",session_time%/(60*100),1,120)
  nreinf%=FNget_num_param("Number of pellets per reinforcement",1,1,10)

  COLOUR1:PRINT ''
  PRINT "2. PARAMETERS FOR EACH BOX"
  PRINT "--------------------------":COLOUR7
  LOCAL box%
  FOR box%=1 TO nboxes%
    COLOUR3:PRINT'"______________________________ BOX ";box%':COLOUR7
    subject$(box%) = FNget_str_param("Subject name: ","???")
    PRINT"Lever side (";left%;"=left, ";right%;"=right)";
    side%(box%)=FNget_num_param("",left%,left%,right%)
    COLOUR1
    PRINT"Schedules available: ";fr%;"=FR, ";vr%;"=VR, ";fi%;"=FI, ";vi%;"=VI, ";prob%;"=probabilistic."
    schedule%(box%)=FNget_num_param("Choose a schedule",1,fr%,prob%)
    COLOUR7
    CASE schedule%(box%) OF
      WHEN fr%:   ratio%(box%)=FNget_num_param("  Ratio",1,1,100)
      WHEN fi%:   interval%(box%)=FNget_num_param("  Interval (cs)",1000,10,6000)
      WHEN vr%:   min_ratio%(box%)=FNget_num_param("  Minimum ratio",1,1,100)
                  max_ratio%(box%)=FNget_num_param("  Maximum ratio",5,1,100)
      WHEN vi%:   min_interval%(box%)=FNget_num_param("  Minimum interval (cs)",100,10,6000)
                  max_interval%(box%)=FNget_num_param("  Maximum interval (cs)",1000,10,6000)
      WHEN prob%: probability(box%)=FNget_num_param("  Probability of reinforcement",0.5,0.01,1)
    ENDCASE
  NEXT

  COLOUR3
  PRINT''"3. ALL DONE."
  PRINT"------------"
  PRINT'"OK. Press a key to begin...";:COLOUR7:IFGET
ENDPROC


DEF PROCstart_the_box(box%)
  LOCAL lever%, levercon%
  IF side%(box%)=left% THEN
    lever%=leftlever%(box%)
    levercon%=leftlevercontrol%(box%)
  ELSE
    lever%=rightlever%(box%)
    levercon%=rightlevercontrol%(box%)
  ENDIF
  PROCswitch_on(houselight%(box%),E%)
  PROCswitch_on(levercon%,E%)
  CASE schedule%(box%) OF
    WHEN fr%:     PROCpipe_switch(lever%,On,1,"FNfixed_ratio(",box%,E%)
    WHEN fi%:     REM reinforce the first press
                  interval_elapsed%(box%)=1
                  PROCpipe_switch(lever%,On,1,"FNfixed_interval(",box%,E%)
    WHEN vr%:     ratio%(box%) = FNselect_ratio(box%)
                  PROCpipe_switch(lever%,On,1,"FNvariable_ratio(",box%,E%)
    WHEN vi%:     interval_elapsed%(box%)=1
                  PROCpipe_switch(lever%,On,1,"FNvariable_interval(",box%,E%)
    WHEN prob%:   PROCpipe_switch(lever%,On,1,"FNprobabilistic(",box%,E%)
  ENDCASE
ENDPROC


DEF FNdescribe_schedule(box%)
  LOCAL sched$
  CASE schedule%(box%) OF
    WHEN fr%:     sched$ = "FR("+STR$(ratio%(box%))+")"
    WHEN fi%:     sched$ = "FI("+STR$(interval%(box%)/100)+")"
    WHEN vr%:     sched$ = "VR("+STR$(min_ratio%(box%))+"-"+STR$(max_ratio%(box%))+")"
    WHEN vi%:     sched$ = "VI("+STR$(min_interval%(box%)/100)+"-"+STR$(max_interval%(box%)/100)+")"
    WHEN prob%:   sched$ = "p("+STR$(probability(box%))+")"
  ENDCASE
=sched$


DEF PROCreinforce(box%)
  PROCspaced_pellet(pellet%(box%),nreinf%,pellet_timer%+box%,pellet_gap%)
  reinfcount%(box%) += 1
ENDPROC


DEF FNend_session(dummy%, R%)
  IF R%=0 =0
  LOCAL box%
  PROCkill_all
  FOR box% = 1 TO nboxes%
    PROCswitch_off(houselight%(box%),E%)
    PROCswitch_off(leftlevercontrol%(box%),E%)
    PROCswitch_off(rightlevercontrol%(box%),E%)
    PROCswitch_off(pellet%(box%),E%)
  NEXT
  IF debug%=0 THEN VDU 2
  OSCLI("SPOOL "+logfile$)  :REM output to disk
  PROCreport_results
  OSCLI("SPOOL")
  OSCLI("SETTYPE "+logfile$+" TEXT") :REM set file type
  VDU 3
=0


DEF PROCdisplay_screen
  CLS
  PRINT"FRVIP - simple schedules of reinforcement."
  PRINT"Rudolf Cardinal. Version date: ";version_date$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT "Press F12 to abort the whole session."'
  PRINT "Session time: ";session_time%DIV6000;" min ";(session_time%MOD6000)DIV100;" sec"
  PRINT "Number of pellets per reinforcement: ";nreinf%
  IF nreinf%>1 THEN PRINT "  - interpellet time ";pellet_gap%;" cs"
  COLOUR 4:PRINT '"Time remaining: ";:COLOUR 7:clockx%=POS:clocky%=VPOS
  PRINT''
  REM012345678901234567890123456789012345678901234567890123456789012345678
  PRINT"Box    Schedule      Side    #Presses   #Reinf   Subject"
  PRINT"_____________________________________________________________________"
  display_firstline%=VPOS
  LOCAL box%, y%
  FOR box%=1 TO nboxes%
    y%=FNdisplay_line(box%)
    PRINTTAB(0,y%);box%;
    PRINTTAB(7,y%);FNdescribe_schedule(box%);
    PRINTTAB(21,y%);side$(side%(box%));
    PROCupdate_box_display(box%)
    PRINTTAB(49,y%);subject$(box%);
  NEXT
ENDPROC


DEF PROCupdate_box_display(box%)
  LOCAL y%
  y%=FNdisplay_line(box%)
  PRINTTAB(29,y%);presscount%(box%);
  PRINTTAB(40,y%);reinfcount%(box%);
ENDPROC


DEF FNdisplay_line(box%)
= display_firstline% + (box%-1)*2


DEF PROCreport_results
  LOCAL box%
  CLS
  PRINT"FVRIP - completed at ";TIME$
  PRINT"________________________________________________________"''
  PRINT "Session time: ";session_time%DIV6000;" min ";(session_time%MOD6000)DIV100;" sec"
  PRINT "Number of pellets per reinforcement: ";nreinf%
  IF nreinf%>1 THEN PRINT "  - interpellet time ";pellet_gap%;" cs"
  PRINT'
  PRINT"Box    Schedule      Side    #Presses   #Reinf   Subject"
  PRINT"________________________________________________________"
  REM012345678901234567890123456789012345678901234567890123456789
  FOR box% = 1 TO nboxes%
    PRINTTAB(0);box%;TAB(7);FNdescribe_schedule(box%);
    PRINTTAB(21);side$(side%(box%));
    PRINTTAB(29);presscount%(box%);
    PRINTTAB(40);reinfcount%(box%);" (";FNfood_mass(reinfcount%(box%));"g)";
    PRINTTAB(58);subject$(box%)
  NEXT
  PRINT''
ENDPROC


DEF PROCdebounce(box%)
  debouncing%(box%)=1
  PROCpipe_timer(debounce_timer%+box%,debounce_time%,0,"FNdebounce2(",box%,E%)
ENDPROC


DEF FNdebounce2(box%,R%)
  IF R%=0 =0
  debouncing%(box%)=0
=0


DEF FNclock_tick(dummy%,R%)
  IF R%=0 =0
  LOCAL t%
  t% = session_time% - (TIME - start_time%)
  COLOUR4:PRINTTAB(clockx%,clocky%);t%DIV6000;" min ";(t%MOD6000)DIV100;" sec     ":COLOUR7
=0


REM ========================================================================
REM Lever-press functions for individual schedules
REM ========================================================================

DEF FNfixed_ratio(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  ratio_counter%(box%)+=1
  IF ratio_counter%(box%) = ratio%(box%) THEN
    ratio_counter%(box%) = 0
    PROCreinforce(box%)
  ENDIF
  PROCupdate_box_display(box%)
=0


DEF FNvariable_ratio(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  ratio_counter%(box%)+=1
  IF ratio_counter%(box%) = ratio%(box%) THEN
    ratio_counter%(box%) = 0
    PROCreinforce(box%)
    ratio%(box%) = FNselect_ratio(box%)
  ENDIF
  PROCupdate_box_display(box%)
=0


DEF FNfixed_interval(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  IF interval_elapsed%(box%) = 1 THEN
    PROCreinforce(box%)
    interval_elapsed%(box%) = 0
    PROCpipe_timer(interval_timer%+box%,interval%(box%),0,"FNend_of_interval(",box%,E%)
  ENDIF
  PROCupdate_box_display(box%)
=0


DEF FNvariable_interval(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  IF interval_elapsed%(box%) = 1 THEN
    PROCreinforce(box%)
    interval_elapsed%(box%) = 0
    interval%(box%) = FNselect_interval(box%)
    PROCpipe_timer(interval_timer%+box%,interval%(box%),0,"FNend_of_interval(",box%,E%)
  ENDIF
  PROCupdate_box_display(box%)
=0


DEF FNprobabilistic(box%,R%)
  IF R%=0 =0
  IF debouncing%(box%)=1 THEN =0
  PROCdebounce(box%)
  presscount%(box%)+=1
  IF RND(1) < probability(box%) THEN PROCreinforce(box%)
  PROCupdate_box_display(box%)
=0


REM ========================================================================
REM Subsidiary functions for individual schedules
REM ========================================================================

DEF FNselect_ratio(box%)
= min_ratio%(box%) + RND(max_ratio%(box%)-min_ratio%(box%)+1) - 1

DEF FNselect_interval(box%)
= min_interval%(box%) + RND(max_interval%(box%)-min_interval%(box%)+1) -1

DEF FNend_of_interval(box%,R%)
  IF R%=0 =0
  interval_elapsed%(box%) = 1
=0