#!/usr/bin/perl
# phn2lm: Mark Hasegawa-Johnson, December 2003
# Illinois Speech and Language Engineering (ISLE group)
#   Modified 4/13/04
#
# Usage text (printed if phn2lm.pl is called with no arguments):
$USAGE=<<ENDUSAGE;

PHN2LM.PL: Convert phone labels to landmark labels.

Usage:
  phn2lm.pl feattab.txt splitphones.txt < inputfile > outputfile
Example: 
  phn2lm.pl feattab.txt splitphones.txt < TRAIN.mlf > TRAIN_lm.mlf

This script reads phoneme labels (labeled using TIMIT, Switchboard, or
any similar phoneme label set), estimates the positions of
manner-change landmarks, and outputs a transcription specifying the
distinctive features at each landmark.  STDIN is an MLF. First label
on each line should be a phoneme; other labels are copied directly
from input to output without change.  STDOUT is an MLF.  Each line in
STDOUT contains two repetitions of the same landmark time, followed by
a complete description of the distinctive features plausibly
implemented at the landmark, followed by any additional labels present
in the input.  Distinctive features are separated by , rather than
space, so that the entire DF transcription is on the first level of
the MLF hierarchy; in order to split the DF transcription, pipe the
output through sed 's/,/ /'.

There are six types of landmarks: -+sonorant, -+continuant,
+-sonorant, +-continuant, +syllabic, and -syllabic.  Sonorant and
continuant landmarks represent instants at which the named features
change.  A +syllabic landmark is a syllable nucleus.  A -syllabic
landmark is an intervocalic glide.  If sonorant and continuant change
simultaneously, the landmarks are transcribed on different lines with
the same lm time.  No landmark is transcribed unless the feature is
specified for both the phone before and the phone after the landmark.

The files feattab.txt and splitphones.txt specify the way in which
landmarks should be computed.  

 - Each line in splitphones.txt specifies a phoneme that should be
 split into multiple phones for the purpose of computing landmarks,
 e.g., the line "ch t sh" specifies that any phoneme "ch" found in
 STDIN produces landmarks just as if it were the sequence "t sh".  If
 STDIN uses Switchboard-style stop transcription, it is recommended
 that each stop should be split into a TIMIT-style closure and release
 segment, e.g., "t tcl t".  Obviously, the time alignment of the
 boundary between the sub-phonemes will be incorrect: the current  
 heuristic is to divide the original phoneme into equal-sized
 sub-units.

 - Each line in feattab.txt specifies distinctive features for a
 phoneme.  Distinctive features not specified are assumed to be null
 for that phoneme.  Any phoneme whose label does not appear in
 feattab.txt is assumed to have no specified features, so, for
 example, it is not necessary to specify any features for silence
 segments.  Examples:

 tcl -sonorant,-continuant,+blade,+anterior,-voice
 t -sonorant,+continuant,-strident,+blade,+anterior,-voice
 sh -sonorant,+continuant,+strident,+blade,-anterior,-voice
 n +sonorant,-continuant,+blade,+anterior
 r +sonorant,+continuant,+blade,-anterior
 er +sonorant,+continuant,+syllabic,+blade,-anterior
 aa +sonorant,+continuant,+syllabic,+low,+tenselow,-front,-high

 Distinctive features at a consonant release or closure landmark
 are those of the consonant, except that the following features are
 adopted from the glide or vowel: 
   anterior, distributed, retroflex
   round
   front

 A manner change landmark between two consonants (e.g., t-s in cats)
 is marked only by the manner feature that changes (-+continuant).

ENDUSAGE


####################################################################
# GLOBAL VARIABLES

# Math functions
sub abs { my($x)=shift; ($x>0) ? $x : -$x ; }
sub round { $_[0] =~ /([^\.]*)(.*)/; ($2 >= 0.5) ? $1+1 : $1; }

# Distinctive features adopted by consonant release or closure
#  from a neighboring vowel or glide
@GLIDE_FEATURES = ('anterior',
		   'distributed',
		   'retroflex',
		   'round',
		   'front');
 
###################################################
# 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
  for($l=<$fh>; $l =~ /^[^\.]/; $l=<$fh>) {
    chomp; chomp;

    # Option 1: line is in "time time labels" format
    if ($l=~/(\d+)\s+(\d+)\s+(.*)/ ) {
      @labels = split(/\s+/,$3);
      push(@tran, [ $1, $2, @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);
}

###################################################
# 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], $$r[1]), "@l\n";
  }
  # Print final period that separates sentences
  print $fh '.',"\n";
}

###################################################
# Subroutine to split phonemes that are phonologically one
#   but phonetically two.
# Alignment times of the sub-phones are arbitrarily placed 
#   at equal intervals from beginning of the input phone
#   to its end.
#
# Syntax: $op = split_phones($ip, $mpphones)
# 
# op: output arrayref of arrayrefs of phonemes.
# ip: input arrayref of arrayrefs of phonemes.
# mpphones: input hashref; keys are phones, vals are arrayrefs of phones
#
sub split_phones {
  my($ip) = $_[0];
  my($op) = [];
  my($mpphones) = $_[1];
  my(@wrd)=();

  for(my($t)=0; $t < @$ip; $t++) {
    # Remove diacritics
    $$ip[$t][2]=~s/\_.*//;

    # Split this phone if a split defined in MULTIPART_PHONES
    if(exists($$mpphones{$$ip[$t][2]})) {
      $outphones = $$mpphones{$$ip[$t][2]};
      $start_time = $$ip[$t][0];
      $duration = $$ip[$t][1] - $$ip[$t][0];
      if($#{$$ip[$t]}>2) { @wrd = @{$$ip[$t]}[3..$#{$$ip[$t]}]; }
      for(my($i)=0; $i < @$outphones; $i++) {
	$end_time = $start_time + ($duration * ($i+1) / @$outphones);
	push(@$op, [$start_time, $end_time, $$outphones[$i], @wrd]); 
	$start_time = $end_time;
	@wrd=();
      }
    }
    # Otherwise, just push the phone record unchanged
    else { push(@$op, $$ip[$t]); }
  }
  return($op);
}
###################################################
# Subroutine to convert phones to landmarks
#
# Syntax: $lms = phn2lm($segs,$feattab)
# 
# lms: arrayref of arrayrefs of landmarks.
# segs: arrayref of arrayrefs of SWB phonemes.
# feattab: hashref of hashrefs: 
#   $feattab{'aa'}{'low'} is value of feature 'low' for phone 'aa'
#
sub phn2lm {
  my($segs) = $_[0];
  my(@lms) = ();
  my($feattab) = $_[1];

  # Create a stack of phoneme and word labels
  my(@phonequeue) = ();
  my(@wordqueue) = ();

  # Initialize cf and csonority
  my($cp) = $$segs[0][2];
  my(%cf) = %{$$feattab{$cp}};
  my($csonority) = ($cf{'sonorant'} eq '+') ? 2 : 0;
  if($cf{'continuant'} eq '+') { $csonority += 1; }
  my(%cdfs) = %cf;
  foreach ('speech','sonorant', 'continuant', 'syllabic')
    { delete($cdfs{$_}) if exists($cdfs{$_}); }

  # Create previous-segment versions of all above
  my($pp)=$cp; my(%pf)=%cf; my(%psonority)=$csonority; my(%pdfs)=%cdfs;

  # Process the segment labels in twos
  for (my($t)=0; $t < @$segs; $t++) {
    # push word label onto appropriate queues
    push(@wordqueue,@{$$segs[$t]}[3..$#{$$segs[$t]}]);
    
    # Find distinctive features of previous and current segments
    $pp=$cp; %pf=%cf; 
    $cp=$$segs[$t][2];
    if(exists($$feattab{$cp})) { %cf=%{$$feattab{$cp}}; }
    else { # If this phone is not in feattab,
      %cf=(); # Define a dummy list (available to next phone)
      print STDERR "WARNING: $cp undefined in $ARGV[0] or $ARGV[1]\n";
      next; # Skip to next phone
    }

    # Define order of DF consideration based on sonority
    $psonority = $csonority;
    $csonority = ($cf{'sonorant'} eq '+') ? 2 : 0;
    if($cf{'continuant'} eq '+') { $csonority += 1; }
    
    # Extract the non-manner-features of prev and cur segments
    %pdfs = %cdfs; %cdfs = %cf;
    foreach ('speech','sonorant', 'continuant', 'syllabic')
      { delete($cdfs{$_}) if exists($cdfs{$_}); }

    # Create landmark distinctive features lmfs
    # If one side has sonority 3 and other doesn't,
    # use all features from the less sonorant side, except @GLIDE_FEATURES
    #
    my(%lmfs)=();
    if($psonority==3 && $csonority < 3) {
      foreach(keys %cdfs) { $lmfs{$_}=$cdfs{$_}; }
      foreach(@GLIDE_FEATURES) {if(exists($pdfs{$_})){$lmfs{$_}=$pdfs{$_};}}
    }
    if($csonority==3 && $psonority < 3) {
      foreach(keys %pdfs) { $lmfs{$_}=$pdfs{$_}; }
      foreach(@GLIDE_FEATURES) {if(exists($cdfs{$_})){$lmfs{$_}=$cdfs{$_};}}
    }

    # Create the potential continuant, sonorant, and syllabic lm labels
    my($lmlabel)='';
    my($lmtype);
    foreach $lmtype ('speech','continuant','sonorant','syllabic') {
      if(exists($cf{$lmtype}) && exists($pf{$lmtype})) {
	# Landmark's been started; extend it
	if($lmlabel ne '') { 
	  $lmlabel .= ','; 
	  if($pf{$lmtype} ne $cf{$lmtype}) { $lmlabel .= $pf{$lmtype}; }
	  $lmlabel .= $cf{$lmtype}.$lmtype;
	}
	# Landmark hasn't been started, but features differ: start a lm
	elsif($pf{$lmtype} ne $cf{$lmtype}) 
	  { $lmlabel = $pf{$lmtype}.$cf{$lmtype}.$lmtype; }
      }
    }

    # If a landmark exists, finish it
    unless($lmlabel eq '') {
      foreach (keys %lmfs) { $lmlabel .= ','.$lmfs{$_}.$_; };
      my(@lmentry) = ( $$segs[$t][0], $$segs[$t][0], $lmlabel, "$pp:$cp" );

      # Shift all word labels from word queue onto first lm
      push(@lmentry, @wordqueue);
      @wordqueue=();
      # Push the landmarks to output transcription
      push(@lms, \@lmentry);
    }
  }
  ##########################
  # Return the landmark array
  return(\@lms);
}

################################################################
# Main program

if (@ARGV==0) { print STDERR $USAGE; exit; }

# Read in the table of manner features
%FEATTAB = ();
open(FILE, $ARGV[0]) || 
  die "Unable to read feature table from $ARGV[0]: $!";
while (<FILE>) {
  next if /^$/;
  next if /^\#/;
  # Split at any space or comma; first entry is phone, remainder are feats
  my(@labels) = split(/[\s,]+/);
  for(my($i)=1; $i <= $#labels; $i++) {
    # Label should be of the form [-+]feature
    $labels[$i] =~ /(\S)(\S+)/;
    # Specify that the value of this feature, for this phone, is + or -
    $FEATTAB{$labels[0]}{$2} = $1;
  }
}
close(FILE);

# Read in the table of multipart phonemes
%MULTIPART_PHONES = ();
open(FILE, $ARGV[1]) || 
  die "Unable to read multipart_phones table from $ARGV[1]: $!";
while(<FILE>) {
  next if /^$/;
  next if /^\#/;
  my(@labels) = split(/\s+/);
  $MULTIPART_PHONES{$labels[0]} = [ @labels[1..$#labels] ];
}
close(FILE);

# Read in all lines from the INPUTFILE
%IMLF  = ();
while (<STDIN>) {
  # If this line starts a transcription, read it
  if (/\".*\/([^\/\.]+)[^\/]*\"/) {
    my($filename) = $1;
    $IMLF{$filename} = read_MLF_entry($filename,\*STDIN);
  }
}

# Print output MLF header
print '#!MLF!#',"\n";

# Convert each entry to landmark, in turn
foreach $filename (sort keys %IMLF) {	
  print STDERR "$filename.phn -> $filename.lm\n";
  # Convert the transcription
  $OMLF = split_phones($IMLF{$filename},\%MULTIPART_PHONES);
  $LMLF = phn2lm($OMLF,\%FEATTAB);
  
  # Print out the transcription to STDOUT
  print_MLF_entry($filename, $LMLF, \*STDOUT);
}





