"C.DeRykuks" <> wrote in
news:5e9cf87b-bb56-48f2-a1fd-:
> On Mar 11, 2:12*pm, luser-ex-troll <mijo...@yahoo.com> wrote:
>> On Mar 11, 1:00*pm, sso <strongsilent...@gmail.com> wrote:
>>
>> > 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
>>
....
>> Regex might not be the best strategy here.
....
> 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 <>
(remove .invalid and reverse each component for email address)
comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/
Similar Threads
