#!/usr/bin/perl
# sphere2mlf.pl: Mark Hasegawa-Johnson, 6/25/2002
# Illinois Speech and Language Engineering (ISLE group)
#
# Usage (printed if sphere2mlf.pl is called with no arguments):
#
$USAGE=<<ENDUSAGE;

SPHERE2MLF: Convert SPHERE-format transcripts to MLF-format.
 
Usage:
  sphere2mlf.pl SCP_file RATE ext1 ext2 ... > output.mlf
Example: 
  sphere2mlf.pl TRAIN.scp 16000 phn wrd > TRAIN.mlf
 
This script reads in multiple NIST-format transcription files, and
merges them into an HTK-format MLF file, which is written to STDOUT.

Each line in SCP_file is assumed to contain two filenames: the
filename of the input NIST-format files (extension ignored), and the
equivalent HTK lab-filename (extension ignored).  Thus, for example,
if the file TRAIN.scp contains the line

d:/timit/TIMIT/TRAIN/DR1/FAEM0/SI1392.WAV data/FAEM0SI1392.mfc

then sphere2mlf.pl, called as in the example above, will search for
the files d:/timit/TIMIT/TRAIN/DR1/FAEM0/SI1392.phn and .wrd (case is
ignored) and will write the results to an MLF entry headed by
"*/FAEM0SI1392.lab"

For each such filename, sphere2mlf.pl looks for filenames in the same
directory but with the extensions <ext1>, <ext2>, etcetera.
NIST-format transcriptions are read, and times are converted using the
global variables $MLFPERIOD and $PHNPERIOD defined in the program
(default values: 100ns and 1/16 ms.  Change these if using
Switchboard).

Extensions must be listed in order of increasing span.  The start time
of any label in an <extN> file is rounded to the nearest start time of
any label in level <ext(N-1)>.  End times of all labels beyond level
<ext1> are entirely discarded.  Each transcription file is assumed to
be sorted by start times.  This algorithm works fine for combining
TIMIT phn, wrd, and text files.

ENDUSAGE

####################################################################
# GLOBAL VARIABLES

# Conversion rates for various file formats
$MLFPERIOD = 0.0000001;
$PHNPERIOD = 1.0 / 16000;

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }

###################################################
# Subroutine to read, convert, and write to output files
# phoneme data corresponding to one waveform.
#
# Syntax: process_file( $infile, $outfile, \@EXTS, \*fh )
#
# foreach $ext (@EXTS) { Search for files of the form "$infile\.$ext" }
# Merge the resulting transcriptions
# Write the result to $fh with pseudo-label filename $outfile
#
sub process_file {
  # Get rid of any file extension
  my($filename) = $_[0];
  $filename =~ s/(\.\S*)//;
  my($outfile) = $_[1];
  my($EXTS) = $_[2];
  my($fh) = $_[3];
  my(@nistdata) = ();

  # Read in the NIST data
  foreach $i (0..$#$EXTS) {
    $nistdata[$i] = read_NIST_file( $filename . '.' . $EXTS[$i] );
  }

  # Merge higher-level NIST transcriptions into lower-level
  for ($j=$#$EXTS; $j > 0; $j--) {
    $nistdata[$j-1] = merge_transcriptions($nistdata[$j-1], $nistdata[$j]);
  }
  
  # Print out the MLF entry
  print_MLF_entry($outfile, $nistdata[0], $fh);
}  
  
###################################################
# Subroutine to read NIST-format transcription file (PHN or WRD)
#
# Syntax: $data = read_NIST_file("filename");
#
# $data is an arrayref of arrayrefs.
# $$data[$i][0] is the start time of the $ith label
# $$data[$i][1] is the end time of the $ith label
# @{$$data[$i][2]} is the $ith label array, consisting of 
#   the array of words entered at this time in the TIMIT file
#
sub read_NIST_file {
  # Initialize @data to null
  my(@data) = ();

  # Open the INPUTFILE or die with an error message
  open(INPUTFILE,$_[0]) || die "Unable to open input file $_[0]: $!";

  # Read in all lines from the INPUTFILE
  foreach $_ (<INPUTFILE>) {
    # Line in the format of number, number, label
    if ( /^([\d\-\.]+)\s+([\d\-\.]+)\s+(.*)/ ) {
      my(@labels) = split(/\s+/,$3);
      # Push a reference to @record onto the @data array
      push(@data, [ $1 * $PHNPERIOD, $2 * $PHNPERIOD, @labels ] );
    }
    # Line in the format of otherstuff, number, number, label
    elsif ( /\s([\d\-\.]+)\s+([\d\-\.]+)\s+(.*)/ ) {
      my(@labels) = split(/\s+/,$3);
      # Push a reference to @record onto the @data array
      push(@data, [ $1 * $PHNPERIOD, $2 * $PHNPERIOD, @labels ] );
    }
  }
  close(INPUTFILE);

  return(\@data);
}

###################################################
# Merge multi-level transcriptions into a composite transcription
#
# Syntax: $t0 = merge_transcriptions($t1, $t2)
#
# $t1 and $t2 are arrayref arrayrefs.
# $$t1[0][0] is the first start time, $$t1[0][1] is first end time.
# $$t1[0][2..$#{$$t1[0]}] is the sequence of labels at first time.
#
# $t0 is constructed using start times and end times from $t1,
# and label strings consisting of space-interpolated concatenation
# of $t1 and $t2 labels.
# Each $t2 label is concatenated to the end of whichever $t1 label has
# closest start time.
#
sub merge_transcriptions {
  my($t1) = $_[0];
  my($t2) = $_[1];
  my($t0) = [];

  # First, copy $t1
  foreach $r (@$t1) { push(@$t0, [ @$r ]); }

  # Next merge $t2 transcriptions into $t0
  $i = 0; 
  foreach $w (@$t2) {
    # Increment until we find the element of $t0 with closest
    # start time to $w.  This assumes that $t0 is sorted by start time.
    while ( (abs($$t0[$i][0]-$$w[0]) > abs($$t0[$i+1][0]-$$w[0])) &&
	    $i < $#$t0 - 1 ) { $i++; }
    
    # Concatenate the labels
    push(@{$$t0[$i]}, @$w[2..$#$w]);
  }

  return($t0);
}

###################################################
# 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]/$MLFPERIOD,$$r[1]/$MLFPERIOD),"@l\n";
  }
  # Print final period that separates sentences
  print $fh '.',"\n";
}

###########################################
# Main Program

if (@ARGV==0) { print STDERR $USAGE; exit; }

# First, read in the script file
#
$SCP_file = shift;
open(F, $SCP_file) || die "Unable to open input script file $ARGV[0]: $!";
foreach (<F>) {
  # Use second filename as key, first filename as value
  # Ignore extensions
  unless (/^\s*([^\s\.]+)\S*\s+([^\s\.]+)/)  {
    print STDERR 
	"File $ARGV[0]: Unable to find two filenames on this line: $_\n"; 
  }
  $SCP{$2} = $1;
}
close(F);

# Read in the sampling rate
$RATE = shift;
$PHNPERIOD = 1.0 / $RATE;

# Assume that all remaining entries on a line are extensions
# that should be merged into the MLF file
@EXTS = @ARGV;

# Print the output MLF header
print STDOUT "#!MLF!#\n";

# Process input files
foreach $filename (keys %SCP) {
  print STDERR "$SCP{$filename}.$EXTS[0] -> $filename.lab\n";
  process_file($SCP{$filename}, $filename, \@EXTS, \*STDOUT);
}

