2501 has asked for the wisdom of the Perl Monks concerning the following question:
I am playing a game with a co-worker and part of what is required is to match all the letters in one word with the letters in another word.
The only way I know of to do this is embarassing and messy.
Is there a nice regex or eval to do this?
examples would be:
"the" would match "there"
"abcde" would match "gcdabef"
thanks for your time,
2501
Re: Does a regex exist for this problem?
by japhy (Canon) on Jan 25, 2002 at 22:30 UTC
|
Fletch's solution needs a slight bit of tweaking. It matches a false positive with "every" being in the word "very", since the "e" matches twice.
# are all letters of X in Y?
sub inclusive {
my ($src, $dst) = @_;
my %p;
# I don't know which of these is optimal...
# so I leave it up to you
# for my $c (split //, $src) {
while (defined(my $c = chop $src)) {
return if !($p{$c} = 1 + index($dst, $c, $p{$c} || 0))
}
return 1;
}
That's a better approach, in my opinion. You can use a regex too, but that would be a terribly ugly approach.
_____________________________________________________
Jeff[japhy]Pinyan:
Perl,
regex,
and perl
hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??; | [reply] [d/l] |
Re: Does a regex exist for this problem?
by Juerd (Abbot) on Jan 25, 2002 at 23:09 UTC
|
This is how I'd do it:
(Update (200201251950+0100))
sub weirdmatch {
my ($foo, $bar) = @_;
$bar =~ s/\Q$1// or return 0 while $foo =~ s/(.)//;
return 1;
}
print weirdmatch('the' => 'there'); # 1
print weirdmatch('foo' => 'raboof'); # 1
print weirdmatch('moo' => 'monkey'); # 0
2;0 juerd@ouranos:~$ perl -e'undef christmas'
Segmentation fault
2;139 juerd@ouranos:~$
| [reply] [d/l] [select] |
Re: Does a regex exist for this problem?
by Fletch (Bishop) on Jan 25, 2002 at 20:56 UTC
|
sub match_all_letters {
my( $match, $in ) = @_;
my @letters = split( //, $match );
return @letters == grep { index( $in, $_ ) != -1 } @letters;
}
__END__
DB<2> x match_all_letters( "the" => "there" )
0 1
DB<3> x match_all_letters( "zxd" => "there" )
0 ''
DB<4> x match_all_letters( "theq" => "there" )
0 ''
DB<5> x match_all_letters( "abcde" => "gcdabef" )
0 1
| [reply] [d/l] |
Re: Does a regex exist for this problem?
by japhy (Canon) on Jan 26, 2002 at 06:09 UTC
|
I don't think this should be used, but here goes:
sub inclusive {
my ($big, $little) = @_;
$big =~ join(
'',
map { "(?=.*" . join('.*', @$_) . ")" }
map { ++$i & 1 ? [ map quotemeta, split // ] : () }
join('', sort split //, $little) =~ /((.)\2*)/gs;
);
}
It feels like a hack...
Update: and here's another hack:
sub inclusive {
($chunk, $word) = @_; # sorry, no 'my' here
my $r;
$r = qr{
(??{ "[^\Q$word\E]*" })
((??{ "[\Q$word\E]" }))
(?{ substr($word, index($word,$1), 1) = "" })
(?(?{ length $word })(??{ $r }))
|
(?!)
}x;
scalar $chunk =~ $r;
}
_____________________________________________________
Jeff[japhy]Pinyan:
Perl,
regex,
and perl
hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??; | [reply] [d/l] [select] |
Re: Does a regex exist for this problem?
by andye (Curate) on Jan 25, 2002 at 23:06 UTC
|
sub includes {
$_=$_[1];
foreach my $ltr (split //,$_[0]) {s/$ltr//i};
if (length) {print "no match"} else {print "match"}
}
includes("elephant", "ant");
andy. | [reply] [d/l] |
Re: Does a regex exist for this problem?
by petral (Curate) on Jan 26, 2002 at 00:48 UTC
|
sub includes {
my($in, $test) = @_;
my $ins = join '', sort split//, $in;
my $ts = join '.*', sort split//, $test;
return $ins =~ /$ts/ || 0
}
or, similar to andye and Juerd above,
sub includes {
my($in, $test) = @_;
return (length $test == grep $test=~s/$_//, $in=~/./g) ||0;
}
  p | [reply] [d/l] [select] |
(crazyinsomniac) Re: Does a regex exist for this problem?
by crazyinsomniac (Prior) on Jan 26, 2002 at 10:09 UTC
|
I thought I'd put my two cents in ...
#!/usr/bin/perl -wl
use strict;
for my $f( ['the','there'],
['abcde','gcdabef'],
['abe','lbbe'],
['forky','fork'] )
{
print "@$f =>", fooey($f);
}
sub fooey {
my ($this,$that) = @{$_[0]};
my $yes;
for my $char(split'',$this)
{
++$yes if $that =~ /\Q$char\E/;
}
return $yes == length $this? 1: 0;
}
__END__
the there =>1
abcde gcdabef =>1
abe lbbe =>0
forky fork =>0
my second take on this...
#!/usr/bin/perl -wl
use strict;
for my $f( ['the','there'],
['abcde','gcdabef'],
['abe','lbbe'],
['forky','fork'] )
{
print "@$f =>", fooey($f);
}
sub fooey {
my ($this,$that) = @{$_[0]};
my %yes;
my $char = quotemeta $this;
{
$that =~ s/([$char])/$yes{$1}++/ge;
}
return ((scalar(keys %yes) == length $this? 1: 0);
}
__END__
the there =>1
abcde gcdabef =>1
abe lbbe =>0
forky fork =>0
| [reply] [d/l] [select] |
substring matching with regexes (boo)
by boo_radley (Parson) on Jan 25, 2002 at 22:56 UTC
|
| [reply] |
|
| [reply] [d/l] |
|
true enough... I made the problem something entirely different in my mind than what it actually was... mea culpa.
| [reply] |
|
Allright there boo - the letters don't have to be in the same order, or next to each other - unless I've misunderstood the question, which is always a possibility. ;) andy.
| [reply] |
|
|