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

RNC2MLF: Convert Radio News transcriptions to MLF format
 
Usage:
  rnc2mlf.pl SCP_file ext1 ext2 ... > output.mlf
Example: 
  rnc2mlf.pl TRAIN.scp ala wrd brk ton > TRAIN.mlf
 

This script reads in several different transcription files from the
Radio News corpus and merges them into an HTK-format MLF file, which
is printed 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:/radio_news/F1A/LABNEWS/J/RADIO/F1AJRLP3.SPH data/F1AJRLP3.mfc

then rnc2mlf.pl, called as in the example above, will search for the
files d:/radio_news/F1A/LABNEWS/J/RADIO/F1AJRLP3.ala, .wrd, .brk and
.ton (case is ignored) and will write the results to an MLF entry
headed by "*/F1AJRLP3.lab"

For each such filename, rnc2mlf.pl looks for filenames in the same
directory but with the extensions <ext1>, <ext2>, etcetera.  ALA
transcriptions are read, and phoneme times are converted using the
global variable $ALAPERIOD (default value: 0.01).  Other
transcriptions are assumed to be in ESPS format by default; times are
converted using the global variable $ESPSPERIOD (default: 1.0).
Output MLF file times are converted using the global variable
$MLFPERIOD (default: 1e-7).

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
Radio News Corpus ala, wrd, and ton files.

Word transcriptions in the ALA input file are currently ignored.  You
can add word transcriptions back using the format given above, but it
is possible that the result may be anomalous when the ALA and WRD
files are not perfectly synchronized, as often happens.

ENDUSAGE

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

# Conversion rates for various file formats
$MLFPERIOD = 0.0000001;
$ALAPERIOD = 0.01;
$ESPSPERIOD = 1;

# 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(@rncdata) = ();

  # Read in the RNC data
  foreach $i (0..$#$EXTS) {
    if ($EXTS[$i] =~ /\bala\b/i)
      { $rncdata[$i] = read_ALA_file( $filename . '.' . $EXTS[$i] ); }
    else
      { $rncdata[$i] = read_RNC_file( $filename . '.' . $EXTS[$i] ); }
  }

  # Merge higher-level RNC transcriptions into lower-level
  for ($j=$#$EXTS; $j > 0; $j--) {
    $rncdata[$j-1] = merge_transcriptions($rncdata[$j-1], $rncdata[$j]);
  }
  
  # Print out the MLF entry
  print_MLF_entry($outfile, $rncdata[0], $fh);
}  
  
###################################################
# Subroutine to read RNC-format transcription file (TON, BRK, or WRD)
#
# Syntax: $data = read_RNC_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..$#{$$tran[0]}] is the sequence of labels at time $i.
#
sub read_RNC_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>) {
    # Ignore lines not in the format of number, number, labels
    if ( /^\s*([\d\-\.]+)\s+([\d\-\.]+)\s+(.*)/ ) {
      my(@labels) = split(/\s+/,$3);

      # Push a reference to @record onto the @data array
      push(@data, [ 0, $1 * $ESPSPERIOD, @labels ] );
    }
  }
  close(INPUTFILE);

  # Set start time of each segment to end time of previous
  foreach $n (1..$#data) 
    { ${$data[$n]}[0] = ${$data[$n-1]}[1]; }

  return(\@data);
}

###################################################
# Subroutine to read ALA-format transcription file (PHN or WRD)
#
# Syntax: $data = read_ALA_file("filename");
#
sub read_ALA_file {
  # Initialize @data to null
  my(@data) = ();

  # Open the INPUTFILE or return a null array
  open(INPUTFILE,$_[0]) || return(@data);

  # Read in all lines from the INPUTFILE
  foreach $_ (<INPUTFILE>) {
    # Process only lines that are in "label number number" format
    if ( /^\s*(\S+)\s+(\d+)\s+(\d+)/) {
      # Label, start, and end
      my($label) = $1; 
      my($tstart)=$ALAPERIOD * $2; 
      my($tend) = $ALAPERIOD * ($2+$3);

      # Push a NIST-compatible start, end, label record
      my(@record) = ($tstart, $tend, $label);
      push(@data, \@record);
    }
  }
  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++; }
    if (abs($$t0[$i][0]-$$w[0]) > abs($$t0[$i+1][0]-$$w[0])) { $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 $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 "File $ARGV[0]: Unable to find two filenames on this line: $_\n"; }
  $SCP{$2} = $1;
}
close(F);

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

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

