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

MLF2DICT: Extract dictionary entries from a two-level MLF
 
Usage:
  mlf2dict.pl input.mlf > output.dict

Read all word specifications in the input file, and write them to the
output dictionary output.dict.  Each second-level transcription in the
input file spawns one line in the dictionary file, e.g. the line "cat
c ae t" would be the output created after observation of the following
input:

4000000 4100000 k cat 
4100000 4200000 ae 
4200000 4300000 t
4300000 4400000 d dog 
...

A word pronounced exactly the same way many times will produce many
exactly identical dictionary listings in the output.  These identical
listings should be merged using, e.g., Eric Fosler-Lussier's babylex
program.

Example:
  mlf2dict.pl train-ws96-i.mlf > train-ws96-i.dict
  babylex \
   phoneset=swb.phset noway_output=yes \
   input_file=train-ws96-i.dict input_file_type=noway \
   output_file=lexicon.out silence_num=48 relmax_prune_level=0.1 

Here is another use: this script can be used, with dict2mlf.pl, to
convert a phoneme dictionary into a landmark dictionary.

Example: 
  dict2mlf.pl pronlex.dict switchboard.dict icsi.dict
  swb2lm.pl pronlex.mlf switchboard.mlf icsi.mlf
  mlf2dict pronlex.lm.mlf switchboard.lm.mlf icsi.lm.mlf

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(\*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($fh) = $_[0];
  my(@tran) = ();
  my(@labels) = ();
  
  # Read all continuous lines that begin with a char other than period
  for($l=<$fh>; $l =~ /^[^\.]/; $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);
}

###########################################
# mlf2dict:
# find the level one labels (e.g., phones) that make up each
# level two label (e.g., word).
#
# @dict = mlf2dict($mlf_entry)
#
# @mlf_entry is an arrayref of arrayrefs
#   $mlf_entry[$t][0..1] are the times of the $t'th level-one transcription
#   $mlf_entry[$t][2] is the label of the $t'th level-one transcription
#   $mlf_entry[$t][3] is label of level-two transcription starting at $t
# @dict is an array of arrayrefs
#   $dict[$i][0] is the $i'th word
#   @{$dict[$i]}[1..$#{$dict[$i]}] is the $i'th list of phonemes
#
sub mlf2dict {
  my($mlf) = $_[0];
  my(@dict) = ();
  my($dict_entry) = [];

  for(my($t)=0; $t < @$mlf; $t++) {
    # If level-2 is defined, save the old dict_entry & start a new one
    if(@{$$mlf[$t]} > 3) {
      if(@$dict_entry) { push(@dict, $dict_entry); }
      $dict_entry = [ $$mlf[$t][3], $$mlf[$t][2] ];
    }
    # Otherwise: if a dict_entry is being created, expand it
    elsif(@$dict_entry && @{$$mlf[$t]} > 2) 
      { push(@$dict_entry, $$mlf[$t][2]); }
  }
  # Save the last dict_entry
  if(@$dict_entry) { push(@dict, $dict_entry); }
  return(@dict);
}

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

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

# Space for the output dictionary
@DICT = ();

# Read in all lines from the input files
foreach $file (@ARGV) {
  open(MLF_FILE, $file) || die "Unable to open MLF $file: $!";

  while (<MLF_FILE>) {
    # If this line starts a transcription, read it
    if (/\".*\/([^\/\.]+)[^\/]*\"/) {
      my($filename) = $1;
      # Read the transcription
      $IMLF = read_MLF_entry(\*MLF_FILE);

      # Convert it to a dictionary
      @DICT=mlf2dict($IMLF);

      # Write out the dictionary entries
      foreach $line (@DICT) {
	@text = @{$line};
	print "@text\n";
      }
    }
  }
  close(MLF_FILE);
}


