#ivsa.pl
#
# Rudolf Cardinal, 21 June 99.
#
# Processes output files from second-order IV self-admin code.
# Generates a per-session and a per-response file in comma-delimited format.
# {Rat,date/time} uniquely identify a session.
# Second-order output mostly the same, though v10 includes index of curvature.


($switches) = ( $ARGV[0] =~ /^-(\w+)/ );
$switches =~ tr/A-Z/a-z/;    # canonicalize to lower case
if ($switches) {
  # print "Switches: $switches\n";
  shift @ARGV;    # get rid of the switches from ARGV
  # NOTE - shift returns the dropped value, but it modifies the array directly too.
  # So writing "@ARGV = shift" makes ARGV contain nothing but the first item.
}

( $input, $sessionfile, $responsefile, $intervalfile ) = @ARGV;

$verbose = 0;    # default
$verbose = 1 if ($switches =~ /verbose/);

if ( !$input ) {
  print "IVSA.pl - processes second-order IVSA data into database format\n";
  print "\n";
  print "Syntax:\n";
  print "  ivsa.pl [-verbose] inputfile [sessionfile [responsefile [intervalfile]]]\n\n";
  print "where 'inputfile' is your data file, 'sessionfile' is the file to store\n";
  print "per-session data in, 'responsefile' is the file to store per-response\n";
  print "data in, etc. If you omit a destination filename, it will be generated\n";
  print "by appending '-session.txt', '-responses.txt' or '-intervals.txt' to the\n";
  print "input filename.";
  die "\n";
}

$sessionfile = $input . "-session.txt" unless $sessionfile;
$responsefile = $input . "-responses.txt" unless $responsefile;
$intervalfile = $input . "-intervals.txt" unless $intervalfile;

print "- ivsa.pl";
print " (verbose mode)" if $verbose;
print "\n";
print "  Input file is $input\n";
print "  Session output file is $sessionfile\n";
print "  Response output file is $responsefile\n";
print "  Interval output file is $intervalfile\n";

open(Input, "<" . $input) || die "* Can't read input file.\n";

# -----------------------------------------------------------------------
# get rat name and date/time, looks like this: 

HEADER: while(<Input>) {
  if (/Box (\d+): (\w+) - (.*);\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+\w+\W+(\w+)/) {
    # Bizarrely, I can't get this to work with "^Box", even though it's the start of a line.
    # Something to do with "Embedded newlines will not be matched by ^ or $"? (from perlre.html)
    # We ignore the "seconds" field.
    #
    # 30 June 99: was (/Box (\d+): (\w+) - (\w*);\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+(\w+)\W+\w+\W+(\w+)/)
    # but this can't cope with treatment fields like "sal10 + cocaine reinst", so used .* rather than \w* for that field.
    # Seems to work fine.
    # Presence of semicolons may screw it up (though maybe not, it's quite clever...).
    # Presence of commas will screw up the database import. Could always stick quotes around the whole field in the session file...
    $box = $1;
    $rat = $2;
    $treatment = $3;
    $dayname = $4;
    $day = $5;
    $month = $6;
    $year = $7;
    $hour = $8;
    $min = $9;
    $session_length = $10;
    last HEADER;
  }
  die "* Couldn't find header.\n" if eof(Input);
}

# For the rest of the lines, we won't abort if we can't find them (unlike the header).
# However, we will scan the whole file in case some program outputs them in a different
# order, or never outputs a particular line (meaning that the next search has to restart
# from the beginning of the file).
#
# File looks like this:
#
# Box 6: rat - treatment; Sun,09 May 1999.08:16:11, 192 min session
# LEFT Lever active: Overall FR 10, FR 10 for CS
# Reinforcements per spell: 1
# CS duration (csec): 100
# Reinforcement delay (csec): 100
# Lever retraction time (csec): 2000
# Reinforcement duration (csec): 728
# Active: 575     Inactive: 18     Stimuli: 56     Reinforcements: 5
# Top beams: 0
# Bottom beam: 0   TOTAL:0
# ...
# Mean IRT (dsec) = 124

seek(Input,0,0); # when third parameter is zero, second parameter is absolute offset
POINT_1: while(<Input>) {
  if (/(\w+) Lever active: Overall (.+), (.+) for CS/) {
    $active_lever = $1;
    $overall_schedule = $2;
    $cs_schedule = $3;
    last POINT_1;
  }
}
seek(Input,0,0);
POINT_2: while(<Input>) {
  if (/Reinforcements per spell: (\w+)/) {
    $reinf_per_spell = $1;
    last POINT_2;
  }
}
seek(Input,0,0);
POINT_3: while(<Input>) {
  if (/CS duration \(csec\): (\w+)/) {
    $cs_duration = $1;
    last POINT_3;
  }
}
seek(Input,0,0);
POINT_4: while(<Input>) {
  if (/Reinforcement delay \(csec\): (\w+)/) {
    $reinf_delay = $1;
    last POINT_4;
  }
}
seek(Input,0,0);
POINT_5: while(<Input>) {
  if (/Lever retraction time \(csec\): (\w+)/) {
    $lever_retraction_time = $1;
    last POINT_5;
  }
}
seek(Input,0,0);
POINT_BOLLOCKS: while(<Input>) {
  if (/Reinforcement duration \(csec\): (\w+)/) {
    $reinf_duration = $1;
    last POINT_BOLLOCKS;
  }
}
seek(Input,0,0);
POINT_6: while(<Input>) {
  if (/Active:\W+(\w+)\W+Inactive:\W+(\w+)\W+Stimuli:\W+(\w+)\W+Reinforcements:\W+(\w+)/) {
    $active_responses = $1;
    $inactive_responses = $2;
    $stimuli = $3;
    $reinforcements = $4;
    last POINT_6;
  }
}
seek(Input,0,0);
POINT_7: while(<Input>) {
  # One of these two formats is used for photobeam reporting. Top beam equated to left beam.
  if (/Top beams:\W+(\w+)/) {
    $top_beams = $1;
    last POINT_7;
  }
  if (/Photobeams\W+top:\W+(\d+)/) {
    $top_beams = $1;
    last POINT_7;
  }
}
seek(Input,0,0);
POINT_8: while(<Input>) {
  # One of these two formats is used for photobeam reporting.
  if (/Bottom beam:\W+(\w+)\W+TOTAL:(\w+)/) {
    $bottom_beams = $1;
    $total_beams = $2;
    last POINT_8;
  }
  if (/\W+bottom:(\d+)/) {
    $bottom_beams = $1;
    last POINT_8;
  }
}
seek(Input,0,0);
POINT_LEFT_BEAM: while(<Input>) {
  # Extra one for left beams, comes from Pat's data
  if (/Left beam:\W+(\d+)/) {
    $left_beams = $1;
    last POINT_LEFT_BEAM;
  }
	if (/Photobeams\W+Left:\W+(\d+)/) {
		$left_beams = $1;
		last POINT_LEFT_BEAM;
	}
}
seek(Input,0,0);
POINT_RIGHT_BEAM: while(<Input>) {
  # Extra one for right beams, comes from Pat's data
  if (/Right beam:\W+(\d+)\W+TOTAL:(\d+)/) {
    $right_beams = $1;
		$total_beams = $2;
    last POINT_RIGHT_BEAM;
  }
	if (/Right:(\d+)/) {
		$right_beams = $1;
		last POINT_RIGHT_BEAM;
	}
}
seek(Input,0,0);
POINT_9: while(<Input>) {
  if (/Mean IRT \(dsec\) =\W+(\w+)/) {
    $mean_irt = $1;
    last POINT_9;
  }
}
seek(Input,0,0);
POINT_10: while(<Input>) {
  if (/Time to start first FI\/FR \(dsec\) =\W+(\w+)/) {
    $time_to_start_first = $1;
    last POINT_10;
  }
}
seek(Input,0,0);
POINT_11: while(<Input>) {
  if (/Mean Ic =\W+([0-9.]+)/) {
    $mean_index_curvature = $1;
    last POINT_11;
  }
}
seek(Input,0,0);
POINT_12: while(<Input>) {
  if (/Average CS per US =\W+([0-9.]+)/) {
    $mean_cs_per_us = $1;
    ($mean_after_fi) = ($' =~ /\W+([0-9.]+) secs after FI/);
    # Not all versions provide the mean after FI.
    last POINT_12;
  }
}

$date_time = $day . substr($month,0,3) . $year . "_" . $hour . $min;
print "- Rat:       $rat\n";
print "  Date/time: $date_time\n";
if ($verbose) {
  print "  Treatment: $treatment\n";
}

open(Session, ">" . $sessionfile) || die "* Can't write to session file.\n";      # Output a header.

print Session "RAT,DATE_TIME,TREATMENT,BOX,SESSION_LENGTH,ACTIVE_LEVER,OVERALL_SCHEDULE,CS_SCHEDULE,REINF_PER_SPELL,";
print Session "CS_DURATION,REINF_DELAY,LEVER_RETRACT_TIME,REINF_DURATION,ACTIVE_RESPONSES,INACTIVE_RESPONSES,STIMULI,REINFORCEMENTS,";
print Session "TOP_BEAMS,BOTTOM_BEAMS,LEFT_BEAMS,RIGHT_BEAMS,TOTAL_BEAMS,";
print Session "MEAN_IRT,TIME_TO_START_FIRST,MEAN_INDEX_CURVATURE,";               # specialist?
print Session "MEAN_CS_PER_US,MEAN_AFTER_FI";                                   # specialist
print Session "\n";

print Session $rat .",". $date_time .",". $treatment . "," . $box .",". $session_length .",". $active_lever .",". $overall_schedule ."," ;
print Session $cs_schedule .",". $reinf_per_spell .",". $cs_duration .",". $reinf_delay .",". $lever_retraction_time ."," ;
print Session $reinf_duration .",". $active_responses .",". $inactive_responses .",". $stimuli .",". $reinforcements ."," ;
print Session $top_beams .",". $bottom_beams .",". $left_beams .",". $right_beams .",". $total_beams ."," ;
print Session $mean_irt .",". $time_to_start_first .",". $mean_index_curvature .",";
print Session $mean_cs_per_us .",". $mean_after_fi ."\n";

# -----------------------------------------------------------------------
# Active lever responses

seek(Input,0,0);
RESPONSEPOINT: while(<Input>) {
  last RESPONSEPOINT if /Response times - active lever .*$/;
  die "* Couldn't find active lever response times.\n" if eof(Input);
}
RESPONSENUMBERS: while (<Input>) {
  last RESPONSENUMBERS if /./;
  # skip any blank lines
}
chomp;                            # get rid of trailing newline
@responsetimes = split;           # i.e. split $_ on whitespace

die "* No responses found!\n" if ($#responsetimes <= 0);
open(Responses, ">" . $responsefile) || die "* Can't write to response file.\n";      # Output a header.
print "  No. of active lever response times: $#responsetimes\n" if $verbose;
print Responses "RAT,DATE_TIME,LEVER,RESPONSE_NUM,RESPONSE_TIME,CONSEQUENCE,CS_SO_FAR,US_SO_FAR\n";

$cs_count = 0;
$us_count = 0;
#   Then walk through the array and output something neat. Response times are in ds.
for ($i = 0; $i <= $#responsetimes; $i++) {
  if ($responsetimes[$i] =~ /(\w+)\*(\w+)/) {
    $responsetimes[$i] = $1;
    $consequence[$i] = $2;
  }
  print Responses $rat .",". $date_time .",Active,". ($i+1) .",". $responsetimes[$i] .",". $consequence[$i] .",". $cs_count .",". $us_count ."\n";
  $cs_count++ if $consequence[$i] eq "CS";
  $us_count++ if $consequence[$i] eq "US";
}

# -----------------------------------------------------------------------
# Inactive lever responses.
# Rewind to start of file in case inactive responses came first.

seek(Input,0,0);
INACTIVEPOINT: while(<Input>) {
  last INACTIVEPOINT if /Response times - inactive lever .*$/;
  die "* Couldn't find inactive lever response times.\n" if eof(Input);
}
INACTIVENUMBERS: while (<Input>) {
  last INACTIVENUMBERS if /./;
  # skip any blank lines
}
chomp;
@responsetimes = split;
print "  No. of inactive lever response times: $#responsetimes\n" if $verbose;
for ($i = 0; $i <= $#responsetimes; $i++) {
  print Responses $rat . "," . $date_time . ",Inactive," . ($i+1) . "," . $responsetimes[$i] . ",,,\n";
}


# -----------------------------------------------------------------------
#   Interval data.

seek(Input,0,0);
while(<Input>) {
  while (/US No\. (\d+)\. =\W+(\d+)/) {
    $us_num = $1;
    $cs_per_us[$us_num] = $2;
    ($sec_after_fi[$us_num]) = ($' =~ /\W+([0-9.]+)\W+secs after FI/);
    $_ = $';
    # This last statement makes the $_ variable equal to the portion of the previous string *after* the match (whichever it was).
    # In other words, it allows us to look for a second occurrence on the same line.
    # In addition, not all IV code provides the "after FI" bit.
  }
}
seek(Input,0,0);
$us_num = 0;
INTERVAL_IC: while(<Input>) {
  if (/Res=\W+([0-9.]+)\W+Del=\W+([0-9.]+)/) {
    $us_num++;
    $res[$us_num] = $1;
    $del[$us_num] = $2;
    while (<Input>) {
      if (/Ic=\W+([0-9.]+)/) {
        $ic[$us_num] = $1;
        next INTERVAL_IC;
      }
      print "* Missing index of curvature data for reinforcer \#$us_num\n" if eof(Input);
    }
  }
}

die "* No interval data available.\n" if ($us_num == 0);
open(Intervals, ">" . $intervalfile) || die "* Can't write to interval file.\n";
print Intervals "RAT,DATE_TIME,INTERVAL,CS_PER_US,SECS_AFTER_FI,RESPONSES,DELAY,IC\n";

for ($i = 1; $i <= $reinforcements; $i++) {
  print Intervals $rat .",". $date_time .",". $i .",". $cs_per_us[$i] .",". $sec_after_fi[$i] .",";
  print Intervals $res[$i] .",". $del[$i] .",". $ic[$i] ."\n";
}

# -----------------------------------------------------------------------
#   Close and terminate.

print "\# Done.\n";
close(Input);
close(Session);
close(Responses);
close(Intervals);
