#!/usr/bin/perl
# phn2lm: Mark Hasegawa-Johnson, December 2003
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage text (printed if called with no arguments):
$USAGE=<<ENDUSAGE;

EXTRACT_EXAMPLES.PL: Extract examples from feature files based on MLF

USAGE:
  extract_examples.pl featdir pluslabel maxnum method other < in.mlf > out.txt

ARGUMENTS:

 featdir -
         featdir is the directory in which feature files are found
         If  "*/filename.dat" is an entry in in.mlf, than the corresponding
         feature file should be "featdir/filename.mfc".

 pluslabel - label used to identify "plus" exemplars

 maxnum - maximum number of tokens to read, for each class (0 means
    read all available tokens)

 method - method to use for finding minus tokens.  Possibilities are:
    "default" - all tokens matching the labels in "other" are read as
       tokens.  Those that match pluslabel are plus tokens, all others
       are minus tokens.
    "labeled" - first label in the "other" sequence is a label that
       must be explicitly matched by a minus token.  All other labels 
       in "other" must be matched by both plus and minus tokens.
    "midpoint" - minus tokens are the temporal midpoints between 
       neighboring plus tokens, e.g. if there are plus tokens at
       10cs and 24cs, minus tokens are extracted at 5cs and 17cs.
     
 in.mlf -

  MLF-format label file.  Any line in in.mlf containing pluslabel is
  considered a positive example.  The label must be bounded by spaces
  and/or commas, thus the following line is an example of
  "-+sonorant", "+lips", and "b", but not an example of "+sonorant":

 30000 30000 -+continuant,-+sonorant,+lips b

 The "landmark time" of every example is set to the average of the
 transcribed start time and end time (identical in the example above).
 The internal variable $landmark_time is set to the landmark time
 measured in 10ms frames, thus it is the MLF time divided by 100000.

 out.txt: output data file, containing up to 5000 plus examples and up
 to 5000 minus examples.  Lines are printed in the following format:

 s,d,d,d,....

 where "s" is either +1 or -1, depending on whether the example is
 plus or minus, and "d" is a real number.  "d" is extracted from the
 MFCC file "featdir/filename.mfc" using the following command (issued
 as a shell command exactly as shown):

 HList -s $start_time -e $end_time -r featdir/filename.mfc

 where $start_time is $landmark_time-5, and $end_time is
 $landmark_time+5.  If $start_time is less than 0, it is set to 0, and
 the first frame is repeated an appropriate number of times.  If
 $end_time is greater than $num_frames, the last frame is repeated an
 appropriate number of times.  Thus the number of "d" entries on each
 line of out.txt is always 11 times the feature vector size of
 infile.mfc.

EXAMPLES:

 extract_examples.pl mfcc +lips 5000 default -+sonorant < in.mlf > out.txt

 Extract all -+sonorant landmarks from directory mfcc.  Those marked
 +lips are plus examples; others are minus examples.  Up to 5000
 examples of each class are extracted.

 extract_examples.pl featdir +voice 0 labeled -voice +syllabic \
        < in.mlf > out.txt

 Extract all +syllabic landmarks.  Those marked +voice are plus
 examples, those marked -voice are minus examples, others are ignored.
 Extract all available examples of each class.

 extract_examples.pl featdir -+sonorant 5000 midpoint < in.mlf > out.txt

 Extract exactly 5000 plus examples of -+sonorant landmarks, and 5000
 minus examples.  Minus examples are taken from instants in time
 halfway between the transcribed plus examples.

ENDUSAGE


####################################################################
# GLOBAL VARIABLES

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }
sub round { $_[0] =~ /([^\.]*)(.*)/; ($2 >= 0.5) ? $1+1 : $1; }
 
###################################################
# Subroutine to read MLF entry, separate comma-separated-values
#
# Syntax: $data = read_MLF_entry_with_commas("filename", \*INPUTFILE);
#
# Returned value $data is an arrayref of arrayrefs
# $$tran[0][0] is first seg start time, $$tran[0][1] is end time,
# @$$tran[0][2..$#{$$tran[0]}] is the sequence of labels at first time.
#
sub read_MLF_entry_with_commas {
  my($filename) = $_[0];
  my($fh) = $_[1];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  for($l=<$fh>; $l =~ /^[^\.]/; $l=<$fh>) {
    chomp; chomp;

    # Option 1: line is in "time time labels" format
    #    Split at all commas, and at all spaces
    #    Divide times by 100000
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      @labels = split(/[,\s]+/,$3);
      push(@tran, [ $1/100000, $2/100000, @labels ] );
    }
    # Option 2: line contains any non-whitespace labels, but no times
    elsif ($l =~ /\S/) {
      @labels = split(/[,\s]+/,$l);
      push(@tran, [ 0, 0, @labels ] );
    }
  }
  return(\@tran);
}

###################################################
# Subroutine to search an MLF entry for examples that match $labels
#
# Syntax: ($plusex,$minusex) = trans_examples($trans,$labels)
#
# $trans, $plusex, and $minusex are all 
#    arrayrefs of arrayrefs, in readmlf format.
# $labels is an arrayref of label strings.
# $plusex contains all entries from $trans that match all $labels;
# $minusex contains all others.
#
sub trans_examples {
 my($trans) = $_[0];
 my($labels) = $_[1];
 my(@plusex) = ();
 my(@minusex) = ();

 foreach $entry (@$trans) {
   # entry goes into plusex only if it matches all labels
   $matchingentry=1;
   foreach $label (@$labels) { 
     unless(grep(/^$label$/,@$entry)) { $matchingentry=0; } 
   }
   if($matchingentry==1) { 
     push(@plusex,$entry);
     # print STDERR "Matched ", @$labels, ' ', @$entry, "\n";
   }
   else {
     push(@minusex,$entry);
     # print STDERR "FAILED  ", @$labels, ' ', @$entry, "\n";
   }
 }
 return(\@plusex,\@minusex);
}

###################################################
# Subroutine to look up example vectors, and print to STDOUT
#
# Syntax: print_example_vectors($times, $featdir, $label, $fh) 
#
# $times is an arrayref with elements of the form $filename:$time
# $featdir is the directory in which to search for data files
# $label is 1 or -1
# $fh is the filehandle reference
#
sub print_example_vectors {
  my($times) = $_[0];
  my($featdir) = $_[1];
  my($label) = $_[2];
  my($fh) = $_[3];
  my($previous_file) = "dummy_file";
  my(@indat) = ();

  # Set the vector interpolation to comma
  $"=', ';

  foreach $entry (@$times) {
    # Read the filename and time
    ($filename, $time, @remainder) = split(/:/, $entry);

    # Eliminate the " and */ from filename, and delete .lab
    $filename =~ s:\"::g;
    $filename =~ s:\*\/::;
    $filename =~ s/\.lab//;
    
    # If @indat does not contain data from $filename, read data
    unless ($filename eq $previous_file) {
      print STDERR "Copying mfcc data from $featdir/$filename.mfc\n";
      @indat=();
      open(FEATFILE, "HList -r $featdir/$filename.mfc |");
      while($indat=<FEATFILE>) { push(@indat,[split(/\s+/,$indat)]); }
      close(FEATFILE);
      $previous_file = $filename;
    }

    # If $time is within the file, copy a vector
    if($time >= 0 && $time <= $#indat) {
      my(@vec) = ($label);

      my($start_time) = ($time < 5) ? 0 : $time-5;
      my($end_time) = ($time > $#indat-5) ? $#indat : $time+5;
      
      # If $time is less than 5, repeat 5-$time examples of $indat[0]
      if($time < 5) { foreach $i ($time..4) { push(@vec, @{$indat[0]}); } }

      # Copy examples of all vectors from $start_time to $end_time
      foreach $i ($start_time..$end_time) { push(@vec, @{$indat[$i]}); }

      # If $time is less than 5, repeat 5-$time examples of $indat[0]
      if($time > $#indat-5) 
	{ foreach $i (($#indat-5)..$time) { push(@vec, @{$indat[$#indat]}); } }

      # Print the vector to STDOUT
      print $fh "@vec\n";
    }
  }
}
	

###################################################
# Subroutine to sprint a vector of real-valued numeric entries
#
# Syntax: $string = sprintvec($vec)
#
# $vec is an arrayref
#
sub sprintvec {
  my($vec)=$_[0];
  my($string)=sprintf("%g",$$vec[0]);
  foreach (@{$vec}[1..$#{$vec}]) { $string .= sprintf(",%g",$_); }
  return($string);
}

###################################################
# Print phoneme data to an MLF file
#
# Syntax: print_MLF_entry("root_filename", \@phndata, $filehandleref);
#
# The output filehandle MLF must be globally defined
# and already open.
#
sub print_MLF_entry {
  my($filename) = $_[0];
  my($phndata) = $_[1];
  my($fh) = $_[2];

  # Print the filename to the MLF
  $filename =~ s:.*/::g;
  $filename =~ s/\..*//g;
  print $fh "\"*/$filename\.lab\"\n";

  # Print out the converted data into MLF, and to the label file
  foreach $r (@$phndata) {
    my(@l) = @$r[2..$#$r];
    print $fh sprintf("%d %d ", $$r[0], $$r[1]), "@l\n";
  }
  # Print final period that separates sentences
  print $fh '.',"\n";
}

################################################################
# Main program

if (@ARGV==0) { print STDERR $USAGE; exit; }

# Arguments
$FEATDIR=$ARGV[0];  # Directory to search for acoustic features
$PLUSLABEL=$ARGV[1]; # Label associated with plus tokens
$NUMTOKS=$ARGV[2];  # Maximum number of tokens to extract
$METHOD=$ARGV[3];   # Method for finding minus examples
@OTHERS=@ARGV[4..$#ARGV];

# Escape "+" and "-" in the input fields
$PLUSLABEL =~ s/([\+\-])/\\\1/g;
foreach (@OTHERS) { s/([\+\-])/\\\1/g; }

# Arrays for plus-files and minus-files, plus-vecs and minus-vecs
@PFILES=();
@MFILES=();

# Read in all lines from the INPUTFILE
while (<STDIN>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    print STDERR "extract_examples.pl from $filename\n";
    my($trans) = read_MLF_entry_with_commas($filename,\*STDIN);

    # If method eq "default": get all examples, filter plus examples
    if($METHOD eq "default") {
      ($examples, $trash) = trans_examples($trans, \@OTHERS);
      ($plusex, $minusex) = trans_examples($examples, [$PLUSLABEL]);
      foreach $ex (@$plusex) 
	{ push(@PFILES,$filename.':'.sprintf("%d",$$ex[0]).':'.$$ex[$#$ex]); }
      foreach $ex (@$minusex) 
	{ push(@MFILES,$filename.':'.sprintf("%d",$$ex[0]).':'.$$ex[$#$ex]); }
    }
    # If method eq "labeled": get examples matching plus or minus
    elsif($METHOD eq "labeled") {
      ($plusex, $trash) = 
	trans_examples($trans, [$PLUSLABEL, @OTHERS[1..$#OTHERS]]);
      ($minusex, $trash) = trans_examples($trans, \@OTHERS);
      foreach $ex (@$plusex) 
	{ push(@PFILES,$filename.':'.sprintf("%d",$$ex[0]).':'.$$ex[$#$ex]); }
      foreach $ex (@$minusex) 
	{ push(@MFILES,$filename.':'.sprintf("%d",$$ex[0]).':'.$$ex[$#$ex]); }
    }
    # If method eq "midpoint": get plus examples, midpoints
    elsif($METHOD eq "midpoint") {
      ($plusex, $trash) = trans_examples($trans, [$PLUSLABEL, @OTHERS]);
      $minusex = [];
      my($start_time) = 0;
      foreach $ex (@$plusex) {
	push(@PFILES,$filename.':'.sprintf("%d",$$ex[0]).':'.$$ex[$#$ex]); 
	push(@MFILES,$filename.':'.sprintf("%d",($start_time+$$ex[0])/2));
	$start_time=$$ex[0];
      }
    }
    # Otherwise: method unknown.  Print an error and exit
    else {
      die "extract_examples.pl: Method $METHOD unknown\n";
    }
  }
}

# Downsample the example lists as uniformly as possible
if($NUMTOKS>0) {
  if($NUMTOKS <= $#PFILES) { 
    foreach $i (0..($NUMTOKS-1)) 
      { $PFILES[$i] = $PFILES[sprintf("%d",$#PFILES*$i/$NUMTOKS+0.5)]; }
    splice(@PFILES,$NUMTOKS);
  }
  if($NUMTOKS <= $#MFILES) { 
    foreach $i (0..($NUMTOKS-1)) 
      { $MFILES[$i] = $MFILES[sprintf("%d",$#MFILES*$i/$NUMTOKS+0.5)]; }
    splice(@MFILES,$NUMTOKS);
  }
}

# Debug: output post-downsampling examples
open(FID,">plusexamples.txt");
foreach $vec (@PFILES) { print FID "1,", $vec, "\n"; }
close(FID);
open(FID,">minusexamples.txt");
foreach $vec (@MFILES) { print FID "-1,", $vec, "\n"; }
close(FID);
  
# Print example vectors to STDOUT
@PVECS=print_example_vectors(\@PFILES, $FEATDIR, "1", \*STDOUT);
@MVECS=print_example_vectors(\@MFILES, $FEATDIR, "-1", \*STDOUT);


