#!/usr/bin/perl -w

# (c) Tylman Ule (ule@sfs.uni-tuebingen.de)
# $Id: morphstrings.pl,v 1.2 2004/12/13 07:56:10 ule Exp $

use Getopt::Std;
use IO::File;
use Pod::Usage;
use strict;


my(%hOpts,
   $sLine, %hForms);

getopts('hi:s:vV', \%hOpts);

my $verbose = IO::File->new();
if( exists($hOpts{'v'}) )  {
  $verbose->fdopen(2, ">")
    || die "$0: fatal: could not open verbose output\n";
  $verbose->autoflush (0);
}
else  {
  $verbose->open('>/dev/null')
    || die "$0: fatal: cannot suppress verbose output\n";
}

pod2usage()
  if( exists($hOpts{'h'}) );


'$Revision: 1.2 $' =~ /Revision:\s+(\S+)\s/;
my $sToollVersion = $1;

if( exists($hOpts{'V'}) )  {
  print "$0: version $sToollVersion\n";
  exit(0);
}



if ( not(exists($hOpts{'i'})) )  {
  die "usage\n$0 -i iterations\n";
}
my $nMaxIterations = $hOpts{'i'};

my $nMinMorphstringLen = 4;
if ( exists($hOpts{'s'}) ) {
  die "$0: please specify number instead of '$hOpts{'s'}' as minimum morphstring length\n"
    if( $hOpts{'s'} !~ /^\d+$/ );
  $nMinMorphstringLen = $hOpts{'s'};
}
$verbose->print("$0: using minimum morphstring length $nMinMorphstringLen\n");


while( $sLine = <> )  {
  chomp($sLine);

  # remember input form
  $hForms{$sLine}{ORIG} = undef;
}


my(@aForms, $bNew, $nIteration);

# current iteration
$nIteration = 0;

# did anything new appear
$bNew = -1;

while ($bNew &&
       ( ($nIteration<$nMaxIterations) || ($nMaxIterations == 0) ) )  {
  $bNew = 0;

  # fetch all current forms,
  # shorter forms first, sorted in reverse lexical order
  @aForms = sort {length($a) <=> length($b) || $b cmp $a} (keys(%hForms));

  $verbose->print("$0: iteration $nIteration using ", ($#aForms+1), " forms ...\n");

  # index to longest form
  my $nLong = $#aForms;

  # continue as long as there is some form at least twice the minimum length
  while( ($nLong > 0) && (length($aForms[$nLong]) >= (2*$nMinMorphstringLen)) )  {

    # index to shortest form
    my $nShort=0;
    while(length($aForms[$nShort]) < $nMinMorphstringLen)  {
      $nShort++;
    }

    # the current long form
    my $sLong=$aForms[$nLong];

    while( length($sLong) >= length($aForms[$nShort])+$nMinMorphstringLen )  {
      # the current short form
      my $sShort=$aForms[$nShort];

      # check if short form is suffix of long form
      if(index($sLong, $sShort, 0) == 0)  {
	my $sSuffix = substr($sLong, length($sShort));
	if( not(exists($hForms{$sSuffix})) )  {
	  $verbose->print("$sShort ($sSuffix)\n");
	}
	if( not(exists($hForms{$sSuffix}{SUF}{$sShort})) )  {
	  $bNew = -1;
	  $hForms{$sSuffix}{SUF}{$sShort} = $nIteration;
	}
      }

      # check if short form is prefix of long form
      if(index($sLong, $sShort, length($sLong)-length($sShort))
	 == length($sLong)-length($sShort))  {
	my $sPrefix = substr($sLong, 0, length($sLong)-length($sShort));
	if( not(exists($hForms{$sPrefix})) )  {
	  $verbose->print("($sPrefix) $sShort\n");
	}
	if( not(exists($hForms{$sPrefix}{PRE}{$sShort})) )  {
	  $bNew = -1;
	  $hForms{$sPrefix}{PRE}{$sShort} = $nIteration;
	}
      }
      $nShort++;
    }
    $nLong--;
  }

  $nIteration++;
}


foreach my $sForm (sort(keys(%hForms)))  {
  print $sForm;
  if( not(exists($hForms{$sForm}{ORIG})) )  {
    print ' *';
  }
  if( exists($hForms{$sForm}{PRE}) )  {
    foreach my $nPrefix (sort {$hForms{$sForm}{PRE}{$a}
				 <=> $hForms{$sForm}{PRE}{$b}}
			 (keys(%{$hForms{$sForm}{PRE}})))  {
      print ' -', $nPrefix;
      print "(", $hForms{$sForm}{PRE}{$nPrefix}, ')';
    }
  }
  if( exists($hForms{$sForm}{SUF}) )  {
    foreach my $nSuffix (sort  {$hForms{$sForm}{SUF}{$a}
				 <=> $hForms{$sForm}{SUF}{$b}}
			 (keys(%{$hForms{$sForm}{SUF}})))  {
      print ' ', $nSuffix, '-';
      print "(", $hForms{$sForm}{SUF}{$nSuffix}, ')';
    }
  }
  print "\n";
}

exit(0);


1;

__END__


=head1 NAME

B<morphstrings> - find interesting substrings in word forms

=head1 SYNOPSIS

B<morphstrings> B<-i> I<iterations> [ B<-s> I<shortest> ] F<forms> >
F<morphstrings>

=head1 DESCRIPTION

B<morphstrings> tries to determine substrings of given word forms that are
possibly morphemes (i.e. "morphstrings"), by looking for recurring affixes in
a list of word forms.  The goal of B<morphstrings> is not primarily to detect
linguistically sound morphemes but rather to find potentially informative
substrings in longer word forms.

=head2 OPTIONS

=over 4

=item B<-i> I<iterations>

Try to find morphstrings I<iterations> times.  Setting I<iterations> to 0 lets
B<morphstrings> continue until no new morphstrings are found.  This may take
quite a while for longer lists and may produce very much noise, so this
setting is most useful when you do not have too many input forms.

=item B<-s> I<shortest>

Only look for morphstrings that have at least I<shortest> characters.  Default
is 4.

=item B<-h>

Show synopsis.

=item B<-v>

Verbose output.

=item B<-V>

Print version number.

=back

=head1 FILES

Input file is a plain text list of wordforms, with a single word form on each
line.  Whitespace is preserved in input forms, so please strip it off if it is
not part of the word forms.

The output is again line-based, where each line has one or more columns.  The
first column of each line gives the morphstring.  The next column contains an
asterisk "*" for each new morphstring.  The following columns list the
complement parts of the combinations in which the morphstring was found,
together with the iteration in which it was found.  Earlier iterations tend to
provide more reliable substrings.

=head1 EXAMPLES

Suppose you provide the following list of word forms:

 Knäckebrotmaschine
 Brot
 Knäckebrot

which you will normalise for capitalisation to have fewer different
word forms (easy by setting the correct locale and using "tr
'[:upper:]' '[:lower:]'"):

 knäckebrotmaschine
 brot
 knäckebrot

Then you will receive the following output:

 brot -maschine(2) knäcke-(1)
 brotmaschine * knäcke-(1)
 knäcke * -brot(0) -brotmaschine(2)
 knäckebrot -maschine(1)
 knäckebrotmaschine
 maschine * knäckebrot-(0) brot-(2)

I.e. "knäcke", "maschine" and "brotmaschine" are new (indicated by asterisks
"*") and they were found in the first and second iterations (zero/one in
brackets "(0)" / "(1)"), where "knäcke" is the prefix of "brot", and
"maschine" is the suffix of "knäckebrotmaschine" (indicated by the dashes
"-").  Finally, "brotmaschine" was discovered during the second iteration (one
in brackets "(1)") by applying the new morphstrings found in the first
iteration, and so on.

=head1 COPYRIGHT

Permission to use, copy, modify and distribute this software and its
supporting documentation for any purpose and without fee is hereby granted,
provided that this copyright notice and this permission notice and disclaimer
appear in all copies.

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.  In no event shall the
author be liable for any special, indirect or consequential damages or any
damages whatsoever resulting from loss of use, data or profits, whether in an
action of contract, negligence or other tortious action, arising out of or in
connection with the use or performance of this software.

=head1 AUTHOR

Tylman Ule <ule@sfs.uni-tuebingen.de>

following an idea of Jorn Veenstra <veenstra@sfs.uni-tuebingen.de>

=cut

