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

timit2sphinx.pl: Convert TIMIT phoneme labels into SPHINX segment labels

Usage:
  timit2sphinx.pl <mlf> ...
Example: 
  timit2sphinx.pl TRAIN.mlf TEST.mlf 

This script converts a TIMIT transcription into a SPHINX
transcription.  Inputs are MLF files containing two levels: TIMIT
phones and words.  Outputs are landmark transcriptions with the same
filenames as inputs, but with extension "spmlf."  A segment
statistics file with extension ".spstats" is also created.

ENDUSAGE

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

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

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }
sub round { $_[0] =~ /([^\.]*)(.*)/; ($2 >= 0.5) ? $1+1 : $1; }

# List of function words whose phonemes should be distinguished
%FUNCTION_WORD_LIST = 
  (     'a', '1','all', '1', 'and', '1','any', '1',
	'are', '1', 'at', '1', 'be', '1', 
	'been', '1','by', '1','did', '1','find', '1',
	'for', '1','from', '1','get', '1',
	'give', '1','has', '1','have', '1','how', '1',
	'in', '1','is', '1','it', '1',
	'list', '1', 'many', '1','more', '1','of','1',
	'on','1','one','1','or','1',
	'show','1','than','1','that','1','the', '1',
	'their','1','to','1','use','1',
	'was','1','were','1','what','1','why','1',
	'will','1','with','1','would','1'
  );


###################################################
# Subroutine to read MLF-format transcription file
#
# Syntax: $data = read_MLF_file("filename");
#
# Returned value $data is a reference to a hash.
# Hash keys are the roots of filenames given in the MLF file.
# Hash values are references to phn-structure arrays, i.e.
#   arrays of the form returned by read_NIST_file or read_ALA_file:
#   Each element of the array is a subarray containing start time,
#   end time, and labels.
# $$data{$filename}[0][0] is starttime, $$data{$filename}[0][1] is endtime,
# @{$$data{$filename}[0]}[2..$#{$$data{$filename}[0]}] is the array
# slice containing all remaining labels 
#
sub read_MLF_file {
  # Initialize %MLF to null
  my(%MLF)  = ();

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

  # Read in all lines from the INPUTFILE
  while (<INPUTFILE>) {
    # If this line starts a transcription, read it
    if (/\".*\/([^\/\.]+)[^\/]*\"/) {
      my($filename) = $1;
      $MLF{$filename} = read_MLF_entry($filename, \*INPUTFILE);
    }
  }
  close(INPUTFILE);

  # Return a reference to the MLF structure
  return(\%MLF);
}
  
###################################################
# 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) = ();
      
  # Read all consecutive legible transcription lines
  for($l=<$fh>; $l=~/(\d+)\s+(\d+)\s+(.*)/; $l=<$fh>) {
    my(@labels) = split(/\s+/,$3);
    # Push a reference to @record onto the @tran array
    push(@tran, [ $1 * $MLFPERIOD, $2 * $MLFPERIOD, @labels ] );
  }
  return(\@tran);
}

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

###################################################
# Subroutine to convert TIMIT phones to SPHINX phone set
#
# Syntax: @data = timit2sphinx(@data)
# 
sub timit2sphinx {
  my($input) = $_[0];
  my(@data) = ();

  # Copy the phoneme records, so we don't modify the original
  foreach $r (@$input) { push(@data, [ @$r ]); }
  
  # Process each record, while there are records left
  for( my($i)=$#data; $i >= 0; $i-- ) {
    # Merge TIMIT labels as necessary to approximate Lee et al. 1990
    foreach $_ ( $data[$i][2] ) {
      /ax\-h/ && { $data[$i][2] = 'ax' };
      /axr/ && { $data[$i][2] = 'er' };
      /ux/ && { $data[$i][2] = 'uw' };
      /hv/ && { $data[$i][2] = 'hh' };
      /em/ && { $data[$i][2] = 'm' };
      /nx/ && { $data[$i][2] = 'n' };
      /eng/ && { $data[$i][2] = 'ng' };
      /el/ && { $data[$i][2] = 'l' };
      /(h\#)|(pau)/ && { $data[$i][2] = 'sil' } && { $data[$i][3] = 'sil' };
      /pcl/ && { $data[$i][2] = 'pd' };
      /bcl/ && { $data[$i][2] = 'b' };
      /kcl/ && { $data[$i][2] = 'kd' };
      /gcl/ && { $data[$i][2] = 'g' };
      /tcl/ && { $data[$i][2] = 'td' };
      /dcl/ && { $data[$i][2] = 'dd' };
      /jh/ && { $data[$i][2] = 'zh' };
    }
  }
  # Now delete stop closures iff following segment
  # is homorganic stop release.
  # Special cases: 
  #  (1) 'td s' becomes the special Lee et al. phoneme 'ts'
  #  (2) 'td ch'->'ch', but 'dd jh' stay separate, 
  #       so that 'jh' and 'zh' can be modeled using the same HMM
  for( my($i)=$#data-1; $i >= 0; $i-- ) {
    # First, find necessary mergers: mark found mergers by setting start times equal
    foreach $_ ( $data[$i][2] . ' ' . $data[$i+1][2] ) {
      /^td t$/ && { $data[$i+1][0]=$data[$i][0] };
      /^td ch$/ && { $data[$i+1][0]=$data[$i][0] };
      /^td s$/ && { $data[$i+1][0]=$data[$i][0] };
      /^td s$/ && { $data[$i+1][2]='ts' };
      /^dd d$/ && { $data[$i+1][0]=$data[$i][0] };
      /^pd p$/ && { $data[$i+1][0]=$data[$i][0] };
      /^b b$/ && { $data[$i+1][0]=$data[$i][0] };
      /^kd k$/ && { $data[$i+1][0]=$data[$i][0] };
      /^g g$/ && { $data[$i+1][0]=$data[$i][0] };
      /^(epi)|(q) / && { $data[$i+1][0]=$data[$i][0] };
    }
    # If segment to be eliminated includes higher-level notation, move it forward
    if ( $data[$i+1][0] == $data[$i][0] && @{$data[$i]} > 3 ) 
      { push( @{$data[$i+1]}, @{$data[$i]}[3..$#{$data[$i]}] ); }

    # Now delete the unnecessary segment
    ( $data[$i+1][0] == $data[$i][0] ) && splice(@data,$i,1);
  }

  # Return the modified @data array
  return(\@data);
} 

###################################################
# Subroutine to expand center phoneme of a triphone
# into function-word vs. non-function-word
#
# Syntax: $phndata = functionwordphones(\@data);
# 
sub functionwordphones {
  my($input) = $_[0];
  my(@data) = ();

  # Flag to show if current word is a function word
  my($fnwd) = 0;

  # Copy over each phoneme, changing to function words as we go
  foreach $r (@$input) { 
    # Copy all of the scalar so we don't modify the original
    my(@record) = @$r;
    # If a word is specified, update $fnwd
    if(@record > 3) {
      if ($FUNCTION_WORD_LIST{$record[3]} ne '') { $fnwd = 1; }
      else { $fnwd = 0; }
    }
    # If current word is $fnwd, append _f to the center phoneme
    if($fnwd > 0) { $record[2] =~ s/([^\+]+)(\+\S+)?/$1_f$2/; }

    # Append to the data list
    push(@data, \@record);
  }
  return(\@data);
}

###################################################
# Subroutine to expand phonemes to triphones
#
# Syntax: $data = phone2triphone(\@data);
# 
sub phone2triphone {
  my($input) = $_[0];
  my(@data) = ();

  # Copy the phoneme records, so we don't modify the original
  foreach $r (@$input) { push(@data, [ @$r ]); }

  # Add triphone descriptors
  foreach $n (0..$#data) {

    # Add left context unless phone is word-initial
    unless ($n == 0 || @{$data[$n]} > 3 )
      { $data[$n][2] = $$input[$n-1][2] . '-' . $$input[$n][2]; }

    # Add right context unless phone is word-final
    unless ($n == $#data || @{$data[$n+1]} > 3 )
      { $data[$n][2] .= '+' . $$input[$n+1][2]; }
  }
  return(\@data);
}

################################################################
# Main program

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

if ($ARGV[0] eq "notes") { print $DEVELOPMENTNOTES; exit; }

foreach $MLF_file (@ARGV) {
  # Load the MLF
  $IMLF = read_MLF_file($MLF_file);

  # Open the output file
  $outfile = $MLF_file;
  $outfile =~ s/(\.\S+)?$/\.spmlf/;
  open(OUTLM, ">$outfile") || die "Unable to write to $outfile: $!";
  print OUTLM '#!MLF!#',"\n";

  %LSTATS = ();
  %LFILES = ();

  # Convert each entry to landmark, in turn
  foreach $filename (keys %{$IMLF}) {
    print "$MLF_file:$filename -> $outfile:$filename\n";

    # Convert the transcription
    $SMLF = timit2sphinx($$IMLF{$filename});
    $SMLF = phone2triphone($SMLF);
    $SMLF = functionwordphones($SMLF);

    # Collect statistics on the landmark labels
    foreach $p (@$SMLF) {
      $LSTATS{$$p[2]}=$LSTATS{$$p[2]} ? $LSTATS{$$p[2]}+1 : 1; 
      $LFILES{$$p[2]}{$filename} = '1';
    }
    
    # Print out the transcription to STDOUT
    print_MLF_entry($filename, $SMLF, \*OUTLM);
  }

  # Write out the STATS file
  $STATS_file = $MLF_file;
  $STATS_file =~ s/\.\S+/\.spstats/;
  if (open(STATS, ">$STATS_file")) {
    foreach $key (sort keys %LSTATS) 
      { print STATS "$key $LSTATS{$key}\n"; }
    close(STATS);
  }

  # Write out the LFILES file
  $FILES_file = $MLF_file;
  $FILES_file =~ s/\.\S+/\.spfiles/;
  if (open(FILES, ">$FILES_file")) {
    foreach $key (sort keys %LFILES) {
      @files = keys %{$LFILES{$key}};
      foreach $i (0..$#files) { $files[$i] = "data/$files[$i].cat"; }
      foreach $i (0..$#files-1) { $files[$i] .= ' +'; }
      print FILES "$key @files\n";
    }
    close(FILES);
  }

}



