Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

3 Examples of Multiple-Word Search n Replace

by chunlou (Curate)
on Jun 27, 2003 at 18:02 UTC ( #269680=perlmeditation: print w/ replies, xml ) Need Help??

Search and replace a bunch of words simultaneously seems a somewhat fairly common question. Thought I might as well put up a few examples for reference.

First, the classical hash technique:
my %ch = ('green' => 'lousy', 'blue' => 'cool', 'pink' => 'mini' ) ; my $str = 'I have a green hat, blue shirt, plus a pink jacket'; print $str . "\n" ; $str =~ s/(green|blue|pink)/$ch{$1}/g ; print $str ; __END__ I have a green hat, blue shirt, plus a pink jacket I have a lousy hat, cool shirt, plus a mini jacket

Very self-explanatory, right?

Second, let's try the more flexible RegexpHash:
use Tie::RegexpHash; my %sr; tie %sr, 'Tie::RegexpHash'; $sr{qr/\bh+(a|@)+t+e+\b/i} = 'love'; $sr{qr/\b(u|you|eww)\b/i} = 'you'; # - - - - - - - - - - - - - - - - -- - - - -- - - - - $_ = "I hate you i HAte u i HH\@\@\@TTeE eww i HA\@AaaTTee u I HATE YO +U!\n"; print; my $s = join("|", keys%sr); s/($s)/$sr{$1}/g; print; __END__ I hate you i HAte u i HH@@@TTeE eww i HA@AaaTTee u I HATE YOU! I love you i love you i love you i love you I love you!

It's certainly better than hardcoding all the variation of "hate" with the plain old hash.

What if you want the replacements to be conditional on the matches? Like, using $1, etc. Let's see, let's try British spelling to American spelling conversion:
use Tie::RegexpHash; my %sr; tie %sr, 'Tie::RegexpHash'; # - - - - - - - - - - - - - - - - - - - - - - - - - - # search and replace $sr{qr/\b(h)arbour\b/i} = '$2arbor'; $sr{qr/\b(h)onour(.*?)\b/i} = '$3onor$4'; $sr{qr/\b(c)entre\b/i} = '$5enter'; # - - - - - - - - - - - - - - - - -- - - - -- - - - - $_ = "Programmers Honoured at Harbour Centre\n"; print; my $s = join("|", keys%sr); s/($s)/eval'"'.$sr{$1}.'"'/ge; print; __END__ Programmers Honoured at Harbour Centre Programmers Honored at Harbor Center

You have the upper/lowercase agreement, and you don't have to hardcode all the 'honour,' 'honourable,' 'honourary,' etc. Pretty good. (Thanks Skeeve for the eval hint.)

But, wait. There're so many $1 ... $n. What if I add, delete, or somehow reorder the key/value pairs? Well, let's see:
use Tie::RegexpHash; my %sr; tie %sr, 'Tie::RegexpHash'; # - - - - - - - - - - - - - - - - - - - - - - - - - - # search and replace $sr{qr/\b(c)entre\b/i} = '$5enter'; $sr{qr/\b(h)arbour\b/i} = '$2arbor'; $sr{qr/\b(h)onour(.*?)\b/i} = '$3onor$4'; $sr{qr/(T|t)heatre/} = 'theater'; # - - - - - - - - - - - - - - - - -- - - - -- - - - - $_ = "Programmers Honoured at Harbour Centre\n"; print; my $s = join("|", keys%sr); s/($s)/eval'"'.$sr{$1}.'"'/ge; print; __END__ Programmers Honoured at Harbour Centre Programmers onorH at arbor enter

Right, we're doomed. Keeping track of all the bracketing contructs and trying to put all the $1...$n in the right order seems too impractical. Let's look for some other modules...

Third example here comes:
use Regexp::Subst::Parallel; my @sr =( qr/\b(h)arbour\b/i => '$1arbor', qr/\b(h)onour(.*?)\b/i => '$1onor$2', qr/\b(c)entre\b/i => '$1enter', qr/\b(L|l)ift\b/ => sub{$_=$_[1]=~/L/?"E":"e";$_."leva +tor"} ); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - $_ = "Man Honoured at Harbour Centre by the Lift\n"; print; $_ = subst($_, @sr); print; __END__ Man Honoured at Harbour Centre by the Lift Man Honored at Harbor Center by the Elevator

Since the expression in each replacement is independent of each other (unlike RegexpHash). We're in good shape.

And notice how we can use a sub in replacement for even more flexibility (which, incidentally, tastes like a functional programming flavor).

Comment on 3 Examples of Multiple-Word Search n Replace
Select or Download Code
Re: 3 Examples of Multiple-Word Search n Replace
by enoch (Chaplain) on Jun 27, 2003 at 21:20 UTC
    In the spirit of laziness as it pertains to maintaining/adding-things-to code, I would rewrite the first example to automatically generate the words to be replaced from the keys in the hash (and, I was just a little bored, so I did this).
    my %ch = ('green' => 'lousy', 'blue' => 'cool', 'pink' => 'mini',) ; my $str = 'I have a green hat, blue shirt, plus a pink jacket'; print $str . "\n" ; my $keyList = '('. (join '|', keys %ch) . ')'; my $regex = qr/$keyList/; $str =~ s/$regex/$ch{$1}/g; print $str ;
    That way, if we wanted to change all instances of 'hat' to 'fedora', we just add it to the hash and go about our business.
    my %ch = ('green' => 'lousy', 'blue' => 'cool', 'pink' => 'mini', 'hat' => 'fedora') ; my $str = 'I have a green hat, blue shirt, plus a pink jacket'; print $str . "\n" ; my $keyList = '('. (join '|', keys %ch) . ')'; my $regex = qr/$keyList/; $str =~ s/$regex/$ch{$1}/g; print $str ; __END__ I have a green hat, blue shirt, plus a pink jacket I have a lousy fedora, cool shirt, plus a mini jacket
    TIMTOWTDI,
    enoch
Re: 3 Examples of Multiple-Word Search n Replace
by japhy (Canon) on Jun 28, 2003 at 04:17 UTC
    I dislike the Tie::RegexpHash method, because it involves matching a regex once, and then doing it again in the tied hash's implementation.

    _____________________________________________________
    Jeff[japhy]Pinyan: Perl, regex, and perl hacker, who'd like a job (NYC-area)
    s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

Re: 3 Examples of Multiple-Word Search n Replace
by demerphq (Chancellor) on Jun 28, 2003 at 09:41 UTC

    I cant remember the name of the CPAN version, but its possible to construct a relatively optimized Regex for matching multiple strings by constructing a Patricia Trie. (There are various discussions of this technique on PM.) Then the issue becomes simply

    my %replace_hash=(foo=>'bar',baz=>'fnord'); my $regex=compile_regex(keys %replace_hash); s/\b($regex)\b/$replace_hash{$1}/g;

    Its actually not difficult to construct the optimized regex, but the result scales poorly. Once you have more than a few dozen words involved the time take in backtracking etc (with or without look forward assertions) becomes signifigant. In that case Ive found that its actually faster to use the Patricia tree directly and not bother with the regex. This would not be true however if we had a choice of a DFA regex or an NFA regex. The Patricia Trie essentially repesents (most of) a DFA state transition table and as such it needs minimal backtracking. In fact it never backtracks over the initial character, advancing one character every match failure, and with further optimization it need not backtrack at all. (DFA's never backtrack, hence the term "deterministic")

    update: I wrote a node explaining Patricia Tries here: Re:x2 A Regexp Assembler/Compiler (Whats a 'trie'?)


    ---
    demerphq

    <Elian> And I do take a kind of perverse pleasure in having an OO assembly language...
      Thought, might be helpful to have a quick reference for some other readers...

      Patrica Tree/Trie = "Practical Algorithm to Retrieve Info Coded In Alphanumeric," where Trie came from reTRIEval (pronounced either "tree" or "try")

      Suppose you have data: good gal bad gag

      How it looks like in a noncompact tree:
      
      	         ^    ____ $ ___(NULL)
      	     /  / \ \
      	    b  g  g  g
      	   /  /   |   \
      	  a  a    a    o
      	 /   |    |     \
      	d    g    l      o
      	|    |    |       \
      	$    $    $       d
      	|    |    |       |
               (bad)(gag)(gal)     $
                                   |
                                (good)
      
      

      How it looks like in a Patrica Tree
      
      	       ^    ____ $ ___(NULL)
      	     /    \ 
      	    b     g 
      	   /    /   \
      	  a    a     o
      	 /    |  \    \
      	d     g   l    o
      	|     |   |     \
      	$     $   $     d
      	|     |   |     |
               (bad)(gag) (gal)  $
                                 |
                              (good)
      

      I suppose most people know in this context DFA and NFA stand for "Deterministic Finite Automaton" and "Nondeterministic Finite Automaton" respectively, not "Dairy Farmers of America" and "National Farmers Association."

        And as can be seen from the bottom tree if we walk the tree from the root outward trying to match character by character and ever fail, then we need only backtrack to position N+1 and restart the process.

        This can then be optimized further by adding extra data to each node: how many characters we can advance if we fail at that point. For instance in a tree that contained only 'behoove' and 'hold' we could precalculate that when the 'h' in behoove is our last accepting character we can advance two chars, likewise if we added 'oven' to the tree we could calculate that when we get to the first 'o' in 'behoove' we could advance three chars, and if we get to the second 'o' and fail that we can advance 6 chars, because if we fail at that point we _cant_ match 'oven'. We can also do things like calculate where in the tree we should be if we fail with a given character. All of this adds up to the possibility of matching constant strings in a single pass with no backtracking.

        This is essentially what a DFA regex engine does. Although usually the tree isn't directly represented as a tree, but rather as a massive state transition table. In this representation the tree is represented as a table, with each node represented as row, and each row being called a state. (state == node). Each row would have sufficient fields for all the possible inputs (ie 255 chars), and each field would contain the newstate, and some kind of action statement, probably something like reject, accept,reject-advance, and accept-advance.


        ---
        demerphq

        <Elian> And I do take a kind of perverse pleasure in having an OO assembly language...
      Since you mentioned DFA with regex (which reminded me of natural language processing), here's a naive twisted example:
      use Tie::RegexpHash; use Regexp::Subst::Parallel; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $how = sub { my %ans = ( is => "print \"It's fine.\\n\"", are => "howare(\"$_[3]\")" ); eval $ans{$_[2]} ; }; sub howare { tie my %ans, 'Tie::RegexpHash'; %ans = ( qr/you/i => "print \"I'm fine.\\n\"", qr/^(?!you)(.*)$/i => "print \"All good.\\n\"" ); eval $ans{$_[0]} ; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my @sr =( qr/^(how) (is|are) (you|.*)(\?)$/i => $how, qr/^(?!how)(.*)$/i => sub{print "Say what?\n"} ); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - $_ = "\nHow is everything?\n"; print; subst($_, @sr); $_ = "\nHow are you?\n"; print; subst($_, @sr); $_ = "\nHow are things?\n"; print; subst($_, @sr); $_ = "\nDo you dig me?\n"; print; subst($_, @sr); __END__ How is everything? It's fine. How are you? I'm fine. How are things? All good. Do you dig me? Say what?

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://269680]
Approved by jeffa
Front-paged by gmax
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (7)
As of 2014-12-28 21:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (183 votes), past polls