Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Regex to find intersection of two words

by 2501 (Pilgrim)
on Jan 25, 2002 at 20:47 UTC ( [id://141539]=perlquestion: print w/replies, xml ) Need Help??

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
  • Comment on Regex to find intersection of two words

Replies are listed 'Best First'.
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:??;

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:~$

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
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:??;

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.

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
(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

     
    ______crazyinsomniac_____________________________
    Of all the things I've lost, I miss my mind the most.
    perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

substring matching with regexes (boo)
by boo_radley (Parson) on Jan 25, 2002 at 22:56 UTC
    deletia
    there is shame.
      /\b.*$s.*\b/ equals /$s/ in boolean sense.

      2;0 juerd@ouranos:~$ perl -e'undef christmas' Segmentation fault 2;139 juerd@ouranos:~$

        true enough... I made the problem something entirely different in my mind than what it actually was... mea culpa.
      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://141539]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2024-04-24 22:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found