3 Examples of Multiple-Word Search n Replace

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
[download]

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!
[download]

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
[download]

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
[download]

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
[download]

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

Replies are listed 'Best First'.
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 ;` [download] 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` [download] TIMTOWTDI, enoch	[reply] [d/l] [select]
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:??;`	[reply]
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;` [download] 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...}	[reply] [d/l] [select]
Re: Re: 3 Examples of Multiple-Word Search n Replace by chunlou (Curate) on Jun 28, 2003 at 19:40 UTC
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."	[reply]
Re: Re: Re: 3 Examples of Multiple-Word Search n Replace by demerphq (Chancellor) on Jun 28, 2003 at 21:38 UTC
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...}	[reply] [d/l]
Re: Re: 3 Examples of Multiple-Word Search n Replace by chunlou (Curate) on Jun 28, 2003 at 20:50 UTC
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? [download]	[reply] [d/l]


We don't bite newbies here... much
	PerlMonks