in reply to unglue words joined together by juncture rules

Save your juncture rules in a hash.

my %juncture_of = (
    inm  => 'imm',  # immature
    abt  => 'abst', # abstract
    adt  => 'att',  # attempt
# etc.
);

sub join_euphoniously {
    my $compound = join '', @_;
    while ( my ($raw, $joined) = each %juncture_of ) {
        $compound =~ s/$raw/$joined/;
    }
    return $compound;
}

sub unjoin {
    my $compound = shift;
    
    # maybe no juncture rules applied to this one
    my @possibilities =  ( $compound );

    # analyze whether $string resulted from a juncture rule
    while (my ($raw, $joined) = each %juncture_of ) {
        for my $possibility (@possibilities) {
            if ( $possibility =~ s/$joined/$raw/ ) {
                push @possibilities, $possibility
            }
        }
    }
    return \@possibilities;
}

[download]

Still to do: decompose each possibility into dictionary words.

Replies are listed 'Best First'.
Re^2: unglue words joined together by juncture rules
by oko1 (Deacon) on Mar 21, 2008 at 23:29 UTC 
    > Still to do: decompose each possibility into dictionary words.

    This just happens to be similar to something I've been fiddling with recently. 

    #!/usr/bin/perl -w

my $str = "cowboycatdog";

chomp(my @list = sort { length($b) <=> length($a) } <DATA>);
for my $word (@list){
    my $tmp = $str;
    next unless $tmp =~ s/$word//;
    my @results;
    push @results, $word;
    my @rem = grep ! /^$word$/, @list;
    for my $w (@rem){
        push @results, $w if $tmp =~ s/$w//;
    }
    next if length($tmp);
    push @out, \@results;
}

print "'$str' has the following anagrams:\n\n",
    map "@$_\n", @out;

__DATA__
cowboy
cow
boy
cat
do
dog

    [download]

    The output looks like this: 

    'cowboycatdog' has the following anagrams:

cowboy cat dog
cow boy cat dog
boy cow cat dog
cat cowboy dog
dog cowboy cat
[reply]
[d/l]

In Section Seekers of Perl Wisdom