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

LAYERMLFS: Combine two or more mlfs as layers in a single MLF.  

Usage:
 layermlfs.pl layer1.mlf layer2.mlf layer3.mlf  > output.mlf 
Example:
 layermlfs.pl phones.mlf words.mlf dialogact.mlf  > output.mlf

This script combines several MLFs as synchronized layers into a single
output MLF.  The start time of any label in the Nth MLF is rounded to
the nearest start time of any label in the (N-1)st MLF.  Thus, for
example, the label of a word is listed on the same line with the first
phoneme in the word; the label of a dialog act is listed on the same
line with the first word composing the dialog act.

ENDUSAGE

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

# Conversion rates for various file formats
$MLFPERIOD = 0.0000001;

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

###################################################
# Subroutine to read MLF entry
#
# Syntax: $data = read_MLF_entry("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 {
  my($filename) = $_[0];
  my($fh) = $_[1];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  while(($l = <$fh>) =~ /^[^\.]/) {
    # Option 1: line is in "time time labels" format
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      @labels = split(/\s+/,$3);
      push(@tran, [ $1 * $MLFPERIOD, $2 * $MLFPERIOD, @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);
}

###################################################
# Layer 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.
#
# We assume that $t2 must be one layer above $t1 in the transcription;
#  if two words from $t1 map to the same row, all but the last are
#  deleted.
#
# $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 ( ($i < $#{$t0} - 1) &&
	    (abs($$t0[$i][0]-$$w[0]) >= abs($$t0[$i+1][0]-$$w[0])))
      { $i++; }
    if (abs($$t0[$i][0]-$$w[0]) > abs($$t0[$i+1][0]-$$w[0])) { $i++; }
    
    # Set $t0[$i][3] (second-level transcription) equal to $w 
    @{$$t0[$i]} = ( @{$$t0[$i]}[0..2], @$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 $USAGE; exit; }

# Read in input MLFs
@MLFARRAY = ();
foreach $N (0..$#ARGV) {
  open(MLF_FILE, $ARGV[$N]) || die "Unable to open MLF $ARGV[$N]: $!";
  my(%NEWMLF) = ();
  while (<MLF_FILE>) {
    # If this line starts a transcription, read it
    if (/\".*\/([^\/\.]+)[^\/]*\"/) {
      my($filename) = $1;
      $NEWMLF{$filename} = read_MLF_entry($filename,\*MLF_FILE);
    }
  }
  close(MLF_FILE);
  $MLFARRAY[$N] = \%NEWMLF;
}

# Print MLF header to STDOUT
print '#!MLF!#', "\n";
  
# For each key in $MLFARRAY[0]: merge the layers
foreach $filename (sort keys %{$MLFARRAY[0]}) {
  # Merge each Nth layer into layer (N-1)
  #  If layer (N-1) doesn't exist, just copy N to (N-1)
  for ($j=$#MLFARRAY; $j > 0; $j--) {
    if(exists($MLFARRAY[$j]{$filename})) {
      if(exists($MLFARRAY[$j-1]{$filename})) {
	$MLFARRAY[$j-1]{$filename} = 
	  merge_transcriptions($MLFARRAY[$j-1]{$filename}, 
			       $MLFARRAY[$j]{$filename}, $j-1, $j);
      }
      else { $MLFARRAY[$j-1]{$filename} = $MLFARRAY[$j]{$filename}; }
    }
  }
  
  # Print out the final merged MLF
  print_MLF_entry($filename, $MLFARRAY[0]{$filename}, \*STDOUT);
}

