Re: unglue words joined together by juncture rules

thank you for the answers.

unfortunately, we don't have resources for researching about finite state transducers (which we have already heard about).

we are trying to find a solution. we have already posted a question similar to this one (http://www.perlmonks.org/?node_id=658691), and the user GrandFather has given a very interesting partial solution (which uses a recursive search to find all matching combinations of cowboycatdog, based on the lexicon cowboy, cow, boy, cat, at, do, dog):

use strict;
use warnings;

my $target = "cowboycatdog";
my @partsList = qw(cowboy cow boy cat at do dog);
my %partsLu;

++$partsLu{$_} for @partsList;

search ($target, {%partsLu}, []);

sub search {
    my ($target, $partsLu, $used) = @_;

    unless (length $target) {
        print join ("-", @$used), "\n";
        return;
    }

    for my $part (keys %$partsLu) {
        next unless 0 == index $target, $part;

        my $remainder = substr $target, length $part;

        delete $partsLu->{$part} unless --$partsLu->{$part};
        search ($remainder, {%$partsLu}, [@$used, $part]);
    }
}
[download]

which prints:

cow-boy-cat-dog

cowboy-cat-dog

the only limitation with this method regarding this problem is that it doesn't consider that the words may have been joined together by phonetic rules (for example, cowboycaddog).

so, would it be a good idea trying to adapt the above code, or creating one that uses a similar method? any suggestions?

Comment on Re: unglue words joined together by juncture rules Download Code

Replies are listed 'Best First'.
Re^2: unglue words joined together by juncture rules by grizzley (Chaplain) on Mar 27, 2008 at 10:46 UTC
You need only one more thing I think. And it is look-ahead assertion. Am I right, thinking, that you want match if next letter after 'cad' is 'd' or next phrase after 'namaH' is 'te'? #!perl -l use strict; use warnings; my $target = "cowboycaddog"; my @partsList = ('cowboy', 'cow', 'boy', 'cat', 'at', 'do', 'dog', 'ca +d(?=d)'); my %partsLu; ++$partsLu{$_} for @partsList; search ($target, {%partsLu}, []); sub search { my ($target, $partsLu, $used) = @_; unless (length $target) { print join ("-", @$used), "\n"; return; } for my $part (keys %$partsLu) { my $tmp = $target; my $re = qr/$part/; next unless $tmp=~s/^$re//; delete $partsLu->{$part} unless --$partsLu->{$part}; search ($tmp, {%$partsLu}, [@$used, $part]); } } [download] Update: Of course strings printed as result will include these assertions, but the problem how to remove `(?=something)` from output IMHO can be left as an exercise for the reader (always wanted to say that :) )	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: unglue words joined together by juncture rules
by grizzley (Chaplain) on Mar 27, 2008 at 10:46 UTC

You need only one more thing I think. And it is look-ahead assertion. Am I right, thinking, that you want match if next letter after 'cad' is 'd' or next phrase after 'namaH' is 'te'?

#!perl -l

use strict;
use warnings;

my $target = "cowboycaddog";
my @partsList = ('cowboy', 'cow', 'boy', 'cat', 'at', 'do', 'dog', 'ca
+d(?=d)');
my %partsLu;

++$partsLu{$_} for @partsList;

search ($target, {%partsLu}, []);

sub search
{
  my ($target, $partsLu, $used) = @_;

  unless (length $target)
  {
    print join ("-", @$used), "\n";
    return;
  }

  for my $part (keys %$partsLu)
  {
    my $tmp = $target;
    my $re = qr/$part/;
    next unless $tmp=~s/^$re//;

    delete $partsLu->{$part} unless --$partsLu->{$part};
    search ($tmp, {%$partsLu}, [@$used, $part]);
  }
}
[download]

Update: Of course strings printed as result will include these assertions, but the problem how to remove (?=something) from output IMHO can be left as an exercise for the reader (always wanted to say that :) )

[reply]
[d/l]
[select]