regex for finding jumbled words

[sso]

Hi, I need help figuring out the regex that would find if a word can
be made from another word.
For example

apple could make pal, lap, leap
it could not make all or peel

Suggestions?

 

[luser-ex-troll]

Hi, I need help figuring out the regex that would find if a word can
be made from another word.
For example

apple  could make  pal, lap, leap
it could not make all or peel

Suggestions?

Regex might not be the best strategy here.
I'd try counting the letters into a hash,
keyed by letter. Then you can generate a similar
hash for words to test and loop through the keys
to check if 'apple' has the right number of each
letter needed to make the word in question.

This could be very slow.

lxt

 

[A. Sinan Unur]

Hi, I need help figuring out the regex that would find if a word can
be made from another word.
For example

apple could make pal, lap, leap
it could not make all or peel

Here is a fish:

#!/usr/bin/perl

use strict;
use warnings;

my $src = 'apple';
my @targets = qw( pal lap leap all peel );

for my $target ( @targets ) {
printf("'%s' %s be made from '%s'\n",
$target,
check( $src, $target ) ? 'can' : 'cannot',
$src
);
}

sub check {
my ($src, $target) = @_;

my %src;
++ $src{ $_ } for split //, $src;

my @target = split //, $target;

for my $x ( @target ) {
return unless exists $src{ $x };
return unless $src{ $x }--;
}
return 1;
}

__END__

C:\DOCUME~1\asu1\LOCALS~1\Temp> t
'pal' can be made from 'apple'
'lap' can be made from 'apple'
'leap' can be made from 'apple'
'all' cannot be made from 'apple'
'peel' cannot be made from 'apple'

--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/

 

[C.DeRykuks]

Regex might not be the best strategy here.
I'd try counting the letters into a hash,
keyed by letter. Then you can generate a similar
hash for words to test and loop through the keys
to check if 'apple' has the right number of each
letter needed to make the word in question.

This could be very slow.

Another regex possibility:

my $src = 'apple';
my $src_sort = join '', sort split //, $src;
my @targets = qw( pal lap leap all peel );

for my $target ( @targets ) {
my $target_re = join '.*?',
sort split //,$target;
printf( "'%s' %s be made from '%s'\n\n",
$target,
$src_sort =~ /$target_re/
? 'can' : 'cannot', $src
);
}

 

[sln]

Another regex possibility:

my $src = 'apple';
my $src_sort = join '', sort split //, $src;
my @targets = qw( pal lap leap all peel );

^^^^^^^^
What is this? The example is ficticious. It has nothing
to do with a solution, its just an example. Throw away the
example, then answer the OP's question.

-sln

 

[C.DeRykuks]

    ^^^^^^^^
What is this? The example is ficticious. It has nothing
to do with a solution, its just an example. Throw away the
example, then answer the OP's question.

Check the OP's original question. I used his example.

 

[A. Sinan Unur]

....

....


Another regex possibility:

my $src = 'apple';
my $src_sort = join '', sort split //, $src;
my @targets = qw( pal lap leap all peel );

for my $target ( @targets ) {
my $target_re = join '.*?',
sort split //,$target;
printf( "'%s' %s be made from '%s'\n\n",
$target,
$src_sort =~ /$target_re/
? 'can' : 'cannot', $src
);
}

Looks clever, but there is a significant disadvantage for what I
perceive to be the requested usage scenario. In your version, a new
regex needs to be computed from scratch each time a word is checked.

Anyhow, here is a version that overcomes that deficiency. I don't think
it would be very slow either.

#!/usr/bin/perl

use strict;
use warnings;

my $src = 'apple';
my $src_re = qr{
\A@{[ join '', map { "$_?" } sort split //, $src ]}\z
}x;

my @targets = qw( pal lap leap all peel );

for my $target ( @targets ) {
my $target_canon = join '', sort split //, $target;

printf( "'%s' %s be made from '%s'\n\n",
$target,
$target_canon =~ $src_re ? 'can' : 'cannot',
$src,
);
}

__END__
C:\DOCUME~1\asu1\LOCALS~1\Temp> s
'pal' can be made from 'apple'

'lap' can be made from 'apple'

'leap' can be made from 'apple'

'all' cannot be made from 'apple'

'peel' cannot be made from 'apple'

C:\DOCUME~1\asu1\LOCALS~1\Temp> t
Rate re with_hash re_o
re 9335/s -- -40% -43%
with_hash 15512/s 66% -- -6%
re_o 16469/s 76% 6% --

#!/usr/bin/perl

use strict;
use warnings;

use Benchmark qw( cmpthese );

cmpthese -1, {

with_hash => sub {
my $src = 'apple';
my @targets = qw( pal lap leap all peel );
my %src;
++ $src{ $_ } for split //, $src;

my $hash_checker = sub {
my ($target) = @_;
my @target = split //, $target;
for my $x ( @target ) {
return unless exists $src{ $x };
return unless $src{ $x }--;
}
return 1;
};

for my $target ( @targets ) {
my $x = $hash_checker->( $target );
}
},

re => sub {
my $src = 'apple';
my $src_sort = join '', sort split //, $src;
my @targets = qw( pal lap leap all peel );

my $re_checker = sub {
my ($target) = @_;
my $target_re = join '.*?', sort split //,$target;
$src_sort =~ /$target_re/;
};

for my $target ( @targets ) {
my $x = $re_checker->( $target );
}
},

re_o => sub {
my $src = 'apple';
my $src_re = qr{
\A@{[ join '', map { "$_?" } sort split //, lc $src ]}\z
}x;

my @targets = qw( pal lap leap all peel );

for my $target ( @targets ) {
my $target_canon = join '', sort split //, lc $target;
my $x = ( $target_canon =~ $src_re );
}
},
};


__END__

--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/

 

[C.DeRykuks]

Anyhow, here is a version that overcomes that deficiency. I don't think
it would be very slow either.

Nice.

 

[A. Sinan Unur]

Nice.

Thanks. Your code was the inspiration that helped me see the regex
equivalent of my earlier hash based solution.

Sinan

--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/