my %analysed = ( baSlar => ['plural'], baSlarimiz => ['plural', 'possessed by us'], baSimda => ['possessed by me', 'locative'], ); #### sub findroot { my @words = @_; my %stems; foreach ( @words ) { my @letters = split //; do { $stems{join ('', @letters)}++ } while my $stem = pop(@letters); } # dump all the possible stems that don't match every word map { delete $stems{$_} if $stems{$_} < scalar(@words) } keys %stems; #return the stem - i.e. the longest common element return [ sort { length $b <=> length $a } keys %stems ]->[0]; } #### imda: 'possessed by me', 'locative' #### use Algorithm::Permute qw( permute ); # not so fast as other modules, but it compiled OK on cygwin my @permutations = possibles('imda','possessed by me','locative'); sub possibles { my ($string, @items) = @_; my @permutations; my $maxlength = length($string) - scalar(@items) + 1; permute { ##### this is hardcoded my @lengths = (2,1,1); do { my %perm; my @split = getsplit($string, @lengths); for ( my $j = 0; $j < @items; $j++ ) { $perm{$items[$j]} = $split[$j]; } push(@permutations, \%perm); #print Dumper \%perm; } while ( @lengths = nextlength($maxlength, @lengths) ); } @items; } sub getsplit { my ($string, @lengths) = @_; my @splits; my $offset; foreach (@lengths) { push(@splits, substr($string, $offset, $_) ); $offset += $_; } return @splits; } ###### THIS DOESN'T WORK sub nextlength { my ($maxlength, @lengths) = @_; my $incrnext; foreach (@lengths) { if ( $_ >= $maxlength ) { $incrnext = ( $; $_ = 1; } else { $_++ if $incrnext; $incrnext = 0; } } return if $incrnext; return @lengths; } #### @possibles = ( { 'i' => 'locative', 'mda' => 'poss.by.me', }, { 'im' => 'locative', 'da' => 'poss.by.me', }, ........ ); #### my %analysed = ( baSlar => ['root:head', 'plural'], baSlarimiz => ['root:head', 'plural', 'possessed by us'], baSimda => ['root:head', 'possessed by me', 'locative'], );