(bbfu) (another way) Re: Replacing a given character starting with the xth occurence in a string

Another way:

my $nth = 3;
my $rep = 1;
my $chr = 'e';
my $str = "Terence and Philip are sweet\n";

my $pos = 0;
$pos = index($str, $chr, $pos+1) for(1..$nth);
substr($str, $pos) =~ s/$chr/$rep/g;

print $str;
[download]

You could, of course, move the $pos finding part into a do block within the substr expression but it's a bit unwieldy.

Update: Well, my method's a little bit more wordy then quent's but it's ever-so-slightly faster, almost definately because it avoids doing the string-eval. I don't think it's a significant difference, though. I was just curious. :-)

my $s = "Terence and Philip are sweet\n";
my $c = 'e';
my $r = 1;
my $n = 3;

sub mine {
  my ($str, $chr, $rep, $nth) = @_;
  my $pos = 0;
  $pos = index($str, $chr, $pos+1) for(1..$nth);
  substr($str, $pos) =~ s/$chr/$rep/g;
  return $str;
}

sub quents {
  my ($str, $chr, $rep, $nth) = @_;
  my $i = 1;
  $str =~ s/($chr)/$i++<$nth?$1:$rep/eg;
  return $str;
}

use Benchmark qw( timethese cmpthese );

cmpthese(500000, {
  "Mine"    => sub { mine   ($s, $c, $r, $n) },
  "Quent's" => sub { quents ($s, $c, $r, $n) },
});

__END__
Benchmark: timing 500000 iterations of Mine, Quent's...
      Mine: 14 wallclock secs (14.08 usr +  0.00 sys = 14.08 CPU) @ 35
+511.36/s (n=500000)
   Quent's: 19 wallclock secs (18.58 usr +  0.03 sys = 18.61 CPU) @ 26
+867.28/s (n=500000)
           Rate Quent's    Mine
Quent's 26867/s      --    -24%
Mine    35511/s     32%      --
[download]

bbfu
Seasons don't fear The Reaper.
Nor do the wind, the sun, and the rain.
We can be like they are.

Comment on (bbfu) (another way) Re: Replacing a given character starting with the xth occurence in a string Select or Download Code

Replies are listed 'Best First'.
Re: (bbfu) (another way) Re: Replacing a given character starting with the xth occurence in a string by MeowChow (Vicar) on May 21, 2001 at 09:36 UTC
Your solution has a few subtle bugs, try it with: `print mine ("Terence and Philip are sweet", 'c', 'Z', 3);` [download] This happens because `$pos` is set to -1 after not finding a second 'c', and since you are indexing from `$pos + 1`, which has become 0, index searches from the start of the string, again. You should also initialize `$pos` to -1, not zero, for similar reasons (otherwise it ignores the first character in the string). Getting this problem right, without boundary or fencepost erros, employing manual indexing and positioning is remarkably tricky. So much so, that I'm not even sure the following fixed-up code is error-free: `sub crep { my ($str, $chr, $rep, $nth) = @_; my $pos = 0; while (--$nth > 0) { $pos = index $str, $chr, $pos; last if $pos < 0; $pos++; } substr ($str, $pos) =~ s/$chr/$rep/g if $pos >= 0; return $str; }` [download] I would really like to see if this can be improved upon, assuming the same method is used. In the meantime, here's a slight variant, which I believe to be correct: `sub crep { my ($str, $chr, $rep, $num) = @_; my $tstr = ''; $tstr .= substr $str, 0, (1 + index $str, $chr), '' while --$num; $str =~ s/$chr/$rep/g; $tstr.$str; }` [download] update: I'm beginning to believe that this problem is the poster-child for unit testing! A more promising possibility... caveat emptor as always: `sub crep { my ($str, $chr, $rep, $num) = @_; $str !~ /$chr/g and return $str while $num--; substr ($str, -1 + pos $str) =~ s/$chr/$rep/g; return $str; }` [download] Of course, this one dances around the index problem with a regex. update2: Improving on the original fix... `sub crep { my ($str, $chr, $rep, $nth) = @_; my $pos = 0; ($pos = index $str, $chr, $pos)++ < 0 and return $str while --$nth; substr ($str, $pos) =~ s/$chr/$rep/g; return $str; }` [download] MeowChow s aamecha.s a..a\u$&owag.print	[reply] [d/l] [select]
Re: (bbfu) (another way) Re: Replacing a given character starting with the xth occurence in a string by zeidrik (Scribe) on May 21, 2001 at 13:55 UTC
here comes another way :) `#!/usr/local/bin/perl -w use strict; my $s = "Terence and Philip are sweet\n"; my $c = 'e'; my $r = 1; my $n = 3; sub mine { my ($str,$chr,$new,$nbr)=@_; my $reg="(.+?)$chr" x --$nbr; $_=$str; (/$reg/)&&($str=$&)&&($_=$')&&(s/$chr/$new/g); return $str.$_; } print mine($s,$c,$r,$n);` [download] The code for benchmarking agains BBFU's proc and Quent's #!/usr/local/bin/perl -w use strict; my $s = "Terence and Philip are sweet\n"; my $c = 'e'; my $r = 1; my $n = 3; sub mine { my ($str,$chr,$new,$nbr)=@_; my $reg="(.+?)$chr" x $nbr; $_=$str; (/$reg/)&&($str=$&)&&($_=$')&&(s/$chr/$new/g); return $str.$_; } sub bbfus { my ($str, $chr, $rep, $nth) = @_; my $pos = 0; $pos = index($str, $chr, $pos+1) for(1..$nth); substr($str, $pos) =~ s/$chr/$rep/g; return $str; } sub quents { my ($str, $chr, $rep, $nth) = @_; my $i = 1; $str =~ s/($chr)/$i++<$nth?$1:$rep/eg; return $str; } use Benchmark qw( timethese cmpthese ); cmpthese(500000, { "BBFU'S" => sub { bbfus ($s, $c, $r, $n) }, "Quent's" => sub { quents ($s, $c, $r, $n) }, "MINE" => sub { mine ($s,$c,$r,$n) }, }); [download] AND THE BENCHMARKS :) `Benchmark: timing 500000 iterations of BBFU'S, MINE, Quent's... BBFU'S: 20 wallclock secs (19.45 usr + 0.00 sys = 19.45 CPU) @ 25 +706.94/s (n=500000) MINE: 19 wallclock secs (19.87 usr + 0.02 sys = 19.88 CPU) @ 25 +146.69/s (n=500000) Quent's: 25 wallclock secs (24.97 usr + 0.00 sys = 24.97 CPU) @ 20 +026.70/s (n=500000) Rate Quent's MINE BBFU'S Quent's 20027/s -- -20% -22% MINE 25147/s 26% -- -2% BBFU'S 25707/s 28% 2% --` [download]	[reply] [d/l] [select]