REM >Evfixed
REM ========================================================================
REM Delay of reinforcement: Evenden & Ryan (1996) / Tomie et al. (1998) task
REM                         'Systematic' variation of delay.
REM By Rudolf Cardinal.
REM Modification to Evenden task 21 May 2003 for Cath Winstanley.
REM All trials are forced choice.
REM Exact trial sequence is specified by user. Designed for copying
REM a previous subject's exact response sequence - without the choice element!
REM ========================================================================

progname$="Evfixed"
version_date$="21-May-03"
debug%=0
simple%=0

REM ========================================================================
REM Method, data output - see DELAYLIB
REM ========================================================================
REM ========================================================================
REM Thoughts/comments
REM ========================================================================
REM * Forced trials are still given after the last choice trial in a block,
REM   using that block's delay values...
REM * Output of stim=choice, resp=choice means you've aborted the box.
REM   There's no neat handling of box abort. Who cares? Don't do it.
REM
REM ========================================================================
REM Revision History
REM ========================================================================
REM 18 Oct 98 - first written
REM 26 Oct 98 - up and running in some form
REM 13 Nov 98 - mucked around with following TWR/YPL meeting.
REM             (actually did v. little as it's all in DELAYLIB.)
REM  4 Dec 98 - houselights_bridge_delay% added as an explicit option
REM             (default is yes, set in DelayLib)
REM  7 Dec 98 - and it now reports it in print_config
REM 13 Mar 99 - progname$ made more widespread to give !EvNodel support
REM 16 May 99 - delays can be asc/desc/zero for each box (for YPL)
REM             Makes !EvNoDel redundant but it should _still work_.
REM             New:      delay_method_per_box%()
REM                       specify_method_per_box%
REM             Modified: FNcalculate_delay
REM                       PROCget_parameters
REM
REM 21 May 03 - modified to be a new task (see top).
REM             New: trial_type_firstpairforced%(,,)
REM                  trial_type_remainingforced%(,,)
REM             Modified: PROCschedule_next_trial
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 ========================================================================

number_of_blocks% = 5
trials_per_block% = 10
DIM delay_values%(number_of_blocks%)  :REM steps numbered 1-5
FOR dummy%=1 TO number_of_blocks%:READ delay_values%(dummy%):NEXT
DATA 0, 1000, 2000, 4000, 6000
increasing%=1:decreasing%=2:zero%=3
delay_method%=increasing%
DIM delay_method_per_box%(nboxes%)
specify_method_per_box% = no%

global_unadj_delay% = 0 :REM No delay on the unadjusted lever
unadj_nreinf% = 1       :REM 1 pellet on the unadjusted lever
adj_nreinf% = 4         :REM 4 pellets on the adjusted lever

nchoicetrials% = number_of_blocks% * trials_per_block%  :REM 60 trials
pellet_gap% = 50
lights_bridge_delay%=no%  :REM talked to BJE, start with this...
initiation_limhold% = 1000
choice_limhold% = 1000
collection_limhold%=1000
reinf_collect_period%=600
iti_time% = 10000

DIM trial_type_firstpairforced%(nboxes%,number_of_blocks%,2) :REM magic number: two "forced choice" trials...
DIM trial_type_remainingforced%(nboxes%,number_of_blocks%,trials_per_block%)

IF debug%=1 THEN
  number_of_blocks% = 4
  FOR dummy%=1 TO number_of_blocks%:READ delay_values%(dummy%):NEXT
  DATA 0, 100, 200, 300
  delay_method%=increasing%
  trials_per_block% = 2
  nchoicetrials% = number_of_blocks% * trials_per_block%  :REM 60 trials
  global_unadj_delay%=0
  adj_nreinf%=2

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


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 6
  PRINT"!";progname$
  PRINT"______________________________________________________________________"
  PRINT"Delay of reinforcement: Evenden/Tomie task."
  PRINT"                        'Systematic' variation of delay."
  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
    PRINT"Number of blocks/trials and ITI length defined in code."
    specify_method_per_box%=FNget_num_param("Specify delay method per box ("+STR$(no%)+"=no, "+STR$(yes%)+"=yes)",specify_method_per_box%,no%,yes%)
    IF specify_method_per_box%=no% THEN delay_method%=FNget_num_param("Global delay method ("+STR$(increasing%)+"=increasing, "+STR$(decreasing%)+"=decreasing, "+STR$(zero%)+"=ZERO)",delay_method%,increasing%,zero%)
    global_unadj_delay%=FNget_num_param("Unadjusted delay (cs)",global_unadj_delay%,0,500)
    unadj_nreinf%=FNget_num_param("Unadjusted #pellets",unadj_nreinf%,0,500)
    adj_nreinf%=FNget_num_param("Adjusted #pellets",adj_nreinf%,0,500)
    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%)
    houselights_bridge_delay%=FNget_num_param("Houselight on during delay/feeding period ("+STR$(no%)+"=no, "+STR$(yes%)+"=yes)",houselights_bridge_delay%,no%,yes%)
  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%
    delay_method_per_box%(box%) = delay_method%
    REM Must set this, in case we're using global specification.
  NEXT
  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
      IF specify_method_per_box%=yes% THEN delay_method_per_box%(box%) = FNget_num_param("*** Delay method ("+STR$(increasing%)+"=increasing, "+STR$(decreasing%)+"=decreasing, "+STR$(zero%)+"=ZERO)",delay_method_per_box%(box%),increasing%,zero%)
    ENDIF

    FOR block%=1 TO number_of_blocks%
      trial_type_firstpairforced%(box%,block%,1) = FNget_num_param("Box "+STR$(box%)+" - block "+STR$(block%)+" - first forced choice trial - specify "+STR$(adj%)+"=Adj, "+STR$(unadj%)+"=Unadj", unadj%, adj%, unadj%)
      REM adj%=1, unadj%=2... we're magic-numbering a bit here...
      PRINT "The second forced choice trial will be the opposite of what you just selected."
      trial_type_firstpairforced%(box%,block%,2) = FNother_than(trial_type_firstpairforced%(box%,block%,1))
      FOR trial%=1 TO trials_per_block%
        trial_type_remainingforced%(box%,block%,trial%) = FNget_num_param("Box "+STR$(box%)+" - block "+STR$(block%)+" - 'choice' trial "+STR$(trial%)+" - specify "+STR$(adj%)+"=Adj, "+STR$(unadj%)+"=Unadj", unadj%, adj%, unadj%)
        REM adj%=1, unadj%=2... we're magic-numbering a bit here...
      NEXT
    NEXT

  NEXT

  COLOUR3
  PRINT''"3. CHECK THEM."
  PRINT  "--------------":COLOUR7
  FOR box%=1 TO nboxes%
    PRINT"   Box ";box%;" (";subject$(box%);") - session ";session_number%(box%)
  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 PROCtrial_setup(box%)
  adj_delay%(box%,trial%(box%)) = FNcalculate_delay(box%)
  unadj_delay%(box%,trial%(box%)) = global_unadj_delay%
  adj_pellets%(box%,trial%(box%)) = adj_nreinf%
  unadj_pellets%(box%,trial%(box%)) = unadj_nreinf%
ENDPROC

DEF PROCschedule_next_trial(box%)
  CASE FNtrial_within_block(box%) OF
    WHEN 1:     next_trial_type%(box%) = trial_type_firstpairforced%(box%,FNblock_number(box%),1)
    WHEN 2:     next_trial_type%(box%) = trial_type_firstpairforced%(box%,FNblock_number(box%),2)
    OTHERWISE:  next_trial_type%(box%) = trial_type_remainingforced%(box%,FNblock_number(box%),FNtrial_within_block(box%))
                choicetrial%(box%)+=1 :REM to allow "are we there yet?" code in DELAYLIB to work unmodified
  ENDCASE
ENDPROC

DEF PROCtrial_adjustingpoint(box%)
  REM Simple, isn't it! It's all done in PROCtrial_setup().
ENDPROC

DEF FNcalculate_delay(box%)
  LOCAL d%,block%
  block% = FNblock_number(box%)
  CASE delay_method_per_box%(box%) OF
    WHEN increasing%:   d% = delay_values%(block%)
    WHEN decreasing%:   d% = delay_values%(number_of_blocks% - block% + 1)
    WHEN zero%:         d% = 0
    OTHERWISE:          VDU7:PRINTTAB(0,0);"*** Invalid option to FNcalculate_delay.";:END
  ENDCASE
=d%

DEF FNblock_number(box%)
= ((trial%(box%)-1) DIV (trials_per_block%+2)) + 1

DEF FNtrial_within_block(box%)
= trial%(box%) - ((FNblock_number(box%)-1)*(trials_per_block% + 2))

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

DEF PROCdisplay_screen
  LOCAL i%, b%
  PROCsay_hello
  PRINT"Target is ";nchoicetrials%;" choice trials. ";
  PRINT"(";number_of_blocks%;" blocks of ";trials_per_block%;" choice trials.)"
  IF specify_method_per_box%=yes% THEN
    PRINT"Delay methods for each box: ";
    FOR b%=1 TO nboxes%
      PRINT;delay_method_per_box%(b%);",";
    NEXT
    PRINT " where";
  ELSE
    PRINT"Delay method = ";delay_method%;
  ENDIF
  PRINT " (";increasing%;"=increasing, ";decreasing%;"=decreasing, ";zero%;"=zero)"
  PRINT"Delays (in cs) are ";:PROCshow_delays
  PRINT"Modified Evenden technique. Two forced trials begin each block."
  PRINT"Press F1-";nboxes%;" to abort individual boxes."
  PRINT"Elapsed time: ";:clockx%=POS:clocky%=VPOS:PRINT''
  REM   012345678901234567890123456789012345678901234567890123456789012345678901234567890
  PRINT"Box In? AdjLv Trial  ChTr  Blk/Trial AdjDelay  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%));
  PRINTTAB(15,y%);trial%(box%);
  PRINTTAB(22,y%);choicetrial%(box%);
  PRINTTAB(29,y%);FNblock_number(box%);"/";FNtrial_within_block(box%);"   ";
  PRINTTAB(39,y%);adj_delay%(box%,trial%(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(47,FNdisplay_line(box%));state$;:COLOUR7
ENDPROC
DEF PROCupdate_box_stimulus(box%,stim$)
  COLOUR3:PRINTTAB(55,FNdisplay_line(box%));stim$;:COLOUR7
ENDPROC
DEF PROCupdate_box_response(box%,resp$)
  COLOUR3:PRINTTAB(65,FNdisplay_line(box%));resp$;:COLOUR7
ENDPROC
DEF PROCupdate_box_pellets(box%,pel$)
  COLOUR5:PRINTTAB(76,FNdisplay_line(box%));pel$;" ";:COLOUR7
ENDPROC


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

DEF PROCprint_config
  CLS
  PRINT"====================================================================="
  PRINT"!";progname$;" systematic delay, by Rudolf Cardinal, ";version_date$
  PRINT"Finished at ";TIME$
  PRINT"Date/time code: ";date_time$
  IF debug%=1 COLOUR3:PRINT"*** DEBUGGING!!! ***":COLOUR7
  PRINT"====================================================================="

  IF specify_method_per_box%=yes% THEN
    PRINT"  Delay methods for each box - ";
    FOR b%=1 TO nboxes%
      PRINT;delay_method_per_box%(b%);",";
    NEXT
    PRINT" where";
  ELSE
    PRINT"  Delay method = ";delay_method%;
  ENDIF
  PRINT " (";increasing%;"=increasing, ";decreasing%;"=decreasing, ";zero%;"=zero)"

  PRINT"  Delays (in cs) are ";:PROCshow_delays
  PRINT"  Number of choice trials = ";nchoicetrials%
  PRINT"    (";number_of_blocks%;" blocks of ";trials_per_block%;" choice trials.)"
  PRINT"  Modified Evenden technique. Two forced trials begin each block."
  PRINT"  Unadjusting delay = ";global_unadj_delay%;" cs"
  PRINT"  Unadjusting reinforcer = ";unadj_nreinf%;" pellets"
  PRINT"  Adjusting reinforcer = ";adj_nreinf%;" pellets"
  PRINT"  Gap between pellets = ";pellet_gap%;" cs"
  PRINT"  Lights on during delay = ";lights_bridge_delay%;" (";yes%;"=yes, ";no%;"=no)"
  PRINT"  Lights on during delay = ";lights_bridge_delay%;" (";yes%;"=yes, ";no%;"=no)"
  PRINT"  Houselights on during delay/feeding = ";houselights_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"----------------------------------------------------------------------"
    PRINT"Trial Choicetrial InitLat Stimulus Response ChoiceLat AdjDelay Collected? ColLat"
    REM01234567890123456789012345678901234567890123456789012345678901234567890123456789
    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_delay%(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 6
  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
ENDPROC

DEF PROCshow_delays
  REM only copes with the global version. Oh well.
  REM When delays are specified per box, by an uncanny coincidence
  REM (i.e. Magic Number, i.e. Bad Programming Style), delay_method%
  REM gets defaulted to 1 (increasing) so we see the delays in standard
  REM order. It's a bit shoddy but then I don't use the system
  REM and I don't suppose YPL minds too much.
  LOCAL a%,b%,c%,i%
  CASE delay_method% OF
    WHEN increasing%: a%=1:b%=number_of_blocks%:c%=1
    WHEN decreasing%: a%=number_of_blocks%:b%=1:c%=-1
    WHEN zero%:       FOR i%=1 TO number_of_blocks%:PRINT;"0,";:NEXT:PRINT:ENDPROC
    OTHERWISE:        VDU7:PRINT"***Invalid option to PROCshow_delays.":END
  ENDCASE
  FOR i%=a% TO b% STEP c%
    PRINT;delay_values%(i%);",";
  NEXT
  PRINT
ENDPROC