REM >Richards
REM ========================================================================
REM Delay of reinforcement: Richards (1996) task - adjusting magnitude
REM By Rudolf Cardinal.
REM First written: 18 Oct 98.
REM Developed from !FreeAdj. Uses the shared DelayLib library.
REM ========================================================================

progname$="Richards"
version_date$="1 Dec 98"
debug%=0
simple%=0                   :REM Simplifies configuration as much as poss.

REM ========================================================================
REM Methods, data output - see DELAYLIB and methods document
REM ========================================================================
REM ========================================================================
REM Thoughts/comments
REM ========================================================================
REM * global - unadj_nreinf%, global_adj_delay%
REM * per box - box_unadj_delay%(), current_adj_nreinf%()
REM * per trial - adj_nreinf%()
REM
REM ========================================================================
REM Revision History
REM ========================================================================
REM 18 Oct 98 - written. Taken almost whole from !FreeAdj.
REM 13 Nov 98 - mucked around with following TWR/YPL meeting.
REM             (actually did v. little as it's all in DELAYLIB.)

REM ========================================================================
REM Libraries
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
LIBRARY "<RudolfDir>.ProgLibs.DelayLib"
maxnchoicetrials%=100:PROCdelay_lib_init

REM ========================================================================
REM Constants
REM ========================================================================
min_unadj_delay%=0
def_unadj_delay%=1000       :REM Per-session value, so asks the user.
max_unadj_delay%=6000       :REM Richards used 16s; I think 60s may be needed.
unadj_nreinf% = 4           :REM 4 pellets on the fixed lever.
                            :REM The adjusting lever varies between 1 and this.
global_adj_delay% = 0       :REM No delay on the adjusting-magnitude lever.
adjusting_method% = mazur%
nblocks% = 10               :REM for Mazur, number of 4-trial blocks
max_consec_choice% = 2      :REM for Richards, after this many responses on a single lever,
                            :REM a forced-choice trial is initiated.

nchoicetrials% = 60         :REM gets changed later (see PROCget_parameters)
pellet_gap% = 50
initiation_limhold% = 1000
choice_limhold% = 1000
lights_bridge_delay%=yes%
collection_limhold%=1000
reinf_collect_period%=600
iti_time% = 10000

IF debug%=1 THEN
  unadj_nreinf%=2
  nchoicetrials%=4
  max_consec_choice%=2  :REM for Richards method
  nblocks%=3            :REM for Mazur method
  def_unadj_delay%=300

  initiation_limhold% = 300
  choice_limhold%= 300
  collection_limhold%=300
  reinf_collect_period%=200
  iti_time%=2000
ENDIF

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

DIM current_adj_nreinf%(nboxes%)        :REM *** ADJUSTING #PELLETS.
DIM box_unadj_delay%(nboxes%)           :REM *** FIXED DELAY

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

dummy% = RND(-TIME)
PROCsay_hello
PROCget_parameters
PROCselect_filenames
PROCwarn_kickoff
PROCdisplay_screen
FOR i%=1 TO nboxes%
  PROCstart_box(i%)
  PROCpipe_fkey(i%,0,1,"FNabort_box(",i%,E%)
NEXT
start_time% = TIME
PROCpipe_timer(clock_timer%, 100, 100, "FNclock_tick(",0,E%)
PROCwait(E%): *AE
END

REM ========================================================================
REM Startup functions
REM ========================================================================

DEF PROCsay_hello
  MODE 12
  COLOUR 5
  PRINT"!Richards"
  PRINT"______________________________________________________________________"
  PRINT"Delay of reinforcement: Richards task, adjusting magnitude."
  PRINT"By Rudolf Cardinal. Version date ";version_date$
  COLOUR 7
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT'
ENDPROC


DEF PROCget_parameters
  COLOUR1
  PRINT "1. CHOOSE OVERALL PARAMETERS"
  PRINT "----------------------------":COLOUR7
  IF simple%=0 THEN
    unadj_nreinf%=FNget_num_param("Large fixed reward (#pellets)",unadj_nreinf%,2,6)
    global_adj_delay%=FNget_num_param("Short delay to variable reward (cs)",global_adj_delay%,0,500)

    adjusting_method%=FNget_num_param("Adjusting method - USE MAZUR ("+STR$(mazur%)+"=Mazur, "+STR$(richards%)+"=Richards",adjusting_method%,mazur%,richards%)
    IF adjusting_method%=mazur% THEN
      nblocks%=FNget_num_param("  Number of 4-trial blocks",nblocks%,5,15)
      nchoicetrials%=nblocks%*2
    ENDIF
    IF adjusting_method%=richards% THEN
      nchoicetrials%=FNget_num_param("  Number of choice trials",nchoicetrials%,5,nchoicetrials%)
      max_consec_choice%=FNget_num_param("  Trigger forced choice after how many repetitions (0=never,1=stupid)",max_consec_choice%,0,30)
    ENDIF

    pellet_gap%=FNget_num_param("Time between individual pellets (cs)",pellet_gap%,10,100)
    lights_bridge_delay%=FNget_num_param("CS light on during delay ("+STR$(no%)+"=no, "+STR$(yes%)+"=yes)",lights_bridge_delay%,no%,yes%)
    PRINT"... and you're not allowed to muck around with the ITI times."
  ELSE
    PRINT"In simple mode. Skipped."
  ENDIF

  COLOUR1:PRINT '
  PRINT "2. PARAMETERS FOR EACH BOX"
  PRINT "--------------------------":COLOUR7
  LOCAL box%, defside%,lever$,satisfied%,delaytemp%,i%
  FOR box%=1 TO nboxes%
    COLOUR3:PRINT'"______________________________ BOX ";box%':COLOUR7
    subject$(box%) = FNget_str_param("          Rat name: ","???")
    INPUT "           Session: " session_number%(box%)

    REM odd-numbered boxes have L=unadj, R=adj
    REM even-numbered boxes have the reverse
    IF (box% MOD 2)=0 THEN defside%=left% ELSE defside%=right%
    IF simple%=1 THEN
      adj_side%(box%) = defside%
    ELSE
      PRINT"Adjusted lever [";sidename$(defside%);"]: ";
      INPUT""lever$
      CASE lever$ OF
          WHEN "L","l": adj_side%(box%) = left%
          WHEN "R","r": adj_side%(box%) = right%
          OTHERWISE:    REM leave it as it is, then!
                        adj_side%(box%) = defside%
      ENDCASE
    ENDIF

    box_unadj_delay%(box%)=FNget_num_param("Long delay to fixed reward (cs)",def_unadj_delay%,min_unadj_delay%,max_unadj_delay%)
    current_adj_nreinf%(box%)=FNget_num_param("Starting variable reward (#pellets)",2,1,unadj_nreinf%)
  NEXT

  COLOUR3
  PRINT''"3. CHECK THEM."
  PRINT  "--------------":COLOUR7
  FOR box%=1 TO nboxes%
    PRINT"   Box ";box%;" (";subject$(box%);") - session ";session_number%(box%);
    PRINT" - long delay is ";box_unadj_delay%(box%);", starting with ";current_adj_nreinf%(box%);" pellets"
  NEXT
  COLOUR3
  PRINT'"Press a key if you're happy. We won't start quite yet.";:COLOUR7:IFGET
ENDPROC


REM ========================================================================
REM Box control/calculation functions
REM ========================================================================

DEF PROCschedule_next_trial(box%)
  CASE adjusting_method% OF
    WHEN mazur%:    PROCschedule_mazur(box%)
    WHEN richards%: PROCschedule_richards(box%)
  ENDCASE
ENDPROC

DEF PROCtrial_setup(box%)
  adj_pellets%(box%,trial%(box%)) = current_adj_nreinf%(box%)
  unadj_pellets%(box%,trial%(box%)) = unadj_nreinf%
  adj_delay%(box%,trial%(box%)) = global_adj_delay%
  unadj_delay%(box%,trial%(box%)) = box_unadj_delay%(box%)  :REM ?? clash
ENDPROC

DEF PROCtrial_adjustingpoint(box%)
  CASE adjusting_method% OF
    WHEN mazur%:    PROCadjust_mazur(box%)
    WHEN richards%: PROCadjust_richards(box%)
  ENDCASE
ENDPROC

DEF PROCadjust_mazur(box%)
  LOCAL r%
  IF trial%(box%)<2 THEN ENDPROC
  IF stimulus%(box%,trial%(box%))<>choice% OR stimulus%(box%,trial%(box%)-1)<>choice% THEN ENDPROC
  r% = response%(box%,trial%(box%))
  IF r%<>response%(box%,trial%(box%)-1) THEN ENDPROC
  IF r%=adj% THEN current_adj_nreinf%(box%)=FNdec_magnitude(current_adj_nreinf%(box%))
  IF r%=unadj% THEN current_adj_nreinf%(box%)=FNinc_magnitude(current_adj_nreinf%(box%))
  REM if omission, ignore
ENDPROC

DEF PROCadjust_richards(box%)
  IF stimulus%(box%,trial%(box%)) <> choice% THEN ENDPROC
  IF response%(box%,trial%(box%)) = adj% THEN current_adj_nreinf%(box%)=FNdec_magnitude(current_adj_nreinf%(box%))
  IF response%(box%,trial%(box%)) = unadj% THEN current_adj_nreinf%(box%)=FNinc_magnitude(current_adj_nreinf%(box%))
ENDPROC

DEF FNinc_magnitude(p%)
  IF p%<unadj_nreinf% THEN =p%+1 ELSE =p%

DEF FNdec_magnitude(p%)
  IF p%>1 THEN =p%-1 ELSE =p%

REM ========================================================================
REM Display/clock functions
REM ========================================================================

DEF PROCdisplay_screen
  LOCAL i%
  PROCsay_hello
  PRINT"Target is ";nchoicetrials%;" choice trials."
  IF adjusting_method%=mazur% THEN
    PRINT"Mazur technique. There are ";nblocks%;" blocks of four trials."
  ELSE
    PRINT"Richards technique. Forced trial triggered after ";max_consec_choice%;" consecutive choices."
  ENDIF
  PRINT"Fixed lever delivers ";unadj_nreinf%;" pellets (delay shown below)."
  PRINT"Adjusting lever delivers after ";global_adj_delay%;" cs (magnitude shown below)."
  PRINT"Press F1-";nboxes%;" to abort individual boxes."
  PRINT"Elapsed time: ";:clockx%=POS:clocky%=VPOS:PRINT''
  REM   012345678901234567890123456789012345678901234567890123456789012345678901234567890
  PRINT"Box In? AdjLv Trial  ChoiceTr FixDelay AdjMag State  Stimulus  Response  Pellets"
  PRINT"________________________________________________________________________________"
  display_firstline%=VPOS
  FOR i%=1 TO nboxes%:PROCupdate_box(i%):NEXT
ENDPROC

DEF PROCupdate_box(box%)
  LOCAL y%
  y% = FNdisplay_line(box%)
  PRINTTAB(0,y%);box%;
  PRINTTAB(8,y%);sidename$(adj_side%(box%));
  IF adjusting_method%=mazur% THEN
    PRINTTAB(15,y%);(trial%(box%)-1)DIV4 + 1;"/";(trial%(box%)-1)MOD4 + 1;
  ELSE
    PRINTTAB(15,y%);trial%(box%);"   ";
  ENDIF
  PRINTTAB(25,y%);choicetrial%(box%);
  PRINTTAB(30,y%);box_unadj_delay%(box%);
  PRINTTAB(41,y%);current_adj_nreinf%(box%);
  PROCupdate_box_pellets(box%,"  ")
  PROCupdate_box_stimulus(box%,"      ")
  PROCupdate_box_response(box%,"     ")
  PROCupdate_box_nosepoke(box%)
ENDPROC

DEF PROCupdate_box_nosepoke(box%)
  PRINTTAB(5,FNdisplay_line(box%));
  IF FNswitch(nosepoke%(box%),E%)=On THEN PRINT"*"; ELSE PRINT" ";
ENDPROC
DEF PROCupdate_box_state(box%,state$)
  COLOUR3:PRINTTAB(46,FNdisplay_line(box%));state$;:COLOUR7
ENDPROC
DEF PROCupdate_box_stimulus(box%,stim$)
  COLOUR3:PRINTTAB(54,FNdisplay_line(box%));stim$;:COLOUR7
ENDPROC
DEF PROCupdate_box_response(box%,resp$)
  COLOUR3:PRINTTAB(64,FNdisplay_line(box%));resp$;:COLOUR7
ENDPROC
DEF PROCupdate_box_pellets(box%,pel$)
  COLOUR5:PRINTTAB(75,FNdisplay_line(box%));pel$;" ";:COLOUR7
ENDPROC


REM ========================================================================
REM Results/output functions
REM ========================================================================

DEF PROCprint_config
  CLS
  PRINT"====================================================================="
  PRINT"!Richards, by Rudolf Cardinal, ";version_date$
  PRINT"Finished at ";TIME$
  PRINT"Date/time code: ";date_time$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT"====================================================================="
  PRINT"  Number of choice trials = ";nchoicetrials%
  IF adjusting_method%=mazur% THEN
    PRINT"  Mazur technique. There are ";nblocks%;" blocks."
  ELSE
    PRINT"  Richards technique. Forced trial triggered after ";max_consec_choice%;" consecutive choices."
  ENDIF
  PRINT"  Fixed reinforcer = ";unadj_nreinf%;" pellets"
  PRINT"  Adjusting (immediate) lever delay = ";global_adj_delay%
  PRINT"  Adjusting magnitude = 1 to ";unadj_nreinf%;" pellets"
  PRINT"  Gap between pellets = ";pellet_gap%;" cs"
  PRINT"  Lights on during delay = ";lights_bridge_delay%;" (";yes%;"=yes, ";no%;"=no)"
  PRINT"  'ITI' time (choice->new trial) = ";iti_time%;" cs"
  PRINT
ENDPROC

DEF PROCprint_data
  LOCAL box%, t%
  FOR box%=1 TO nboxes%
    PRINT"BOX ";box%
    PRINT"----------------------------------------------------------------------"
    PRINT"Rat ID:         ";subject$(box%)
    PRINT"Adjusted lever: ";sidename$(adj_side%(box%))
    PRINT"Session:        ";session_number%(box%)
    PRINT"Fixed delay:    ";box_unadj_delay%(box%)
    PRINT"----------------------------------------------------------------------"
    PRINT"Trial Choicetrial InitLat Stimulus Response ChoiceLat Adj#Pel  Collected? ColLat"
    REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
    FOR t%=1 TO trial%(box%)
      PRINTTAB(0);t%;
      PRINTTAB(6);choicetrial_num%(box%,t%);
      PRINTTAB(18);initiation_lat%(box%,t%);
      PRINTTAB(26);desc$(stimulus%(box%,t%));
      PRINTTAB(35);desc$(response%(box%,t%));
      PRINTTAB(44);choice_lat%(box%,t%);
      PRINTTAB(54);adj_pellets%(box%,t%);
      PRINTTAB(63);yesno$(reward_collected%(box%,t%));
      PRINTTAB(74);collect_latency%(box%,t%)
    NEXT
    PRINT
  NEXT
ENDPROC

DEF PROCprint_summaries
  LOCAL box%
  COLOUR 5
  PRINT'"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"'
  PRINT"SUMMARIES (lever totals refer to choice trials only)"
  COLOUR 7
  PRINT
  PRINT"Box  Trials  ChoiceTrials  Adj#  Unadj#  Om#  Pellets consumed  Subject ID"
  PRINT"--------------------------------------------------------------------------"
  REM   01234567890123456789012345678901234567890123456789012345678901234567890123456789
  FOR box%=1 TO nboxes%
    PRINTTAB(0);box%;
    PRINTTAB(5);trial%(box%);
    PRINTTAB(13);choicetrial%(box%);
    PRINTTAB(27);adjtotal%(box%);
    PRINTTAB(33);unadjtotal%(box%);
    PRINTTAB(41);omissiontotal%(box%);
    PRINTTAB(46);pelletcount%(box%);" (";FNfood_mass(pelletcount%(box%));"g)";
    PRINTTAB(64);subject$(box%)
  NEXT
  PRINT
  COLOUR 5
  PRINT"MAGNITUDES FOR NEXT TIME:"
  PRINT"---------------------"
  COLOUR 7
  FOR box%=1 TO nboxes%
    PRINT"Box ";box%;" (";subject$(box%);") - ";current_adj_nreinf%(box%)
  NEXT
  PRINT
ENDPROC