note
tobyink
<p>Testing some of the existing answers...</p>
<readmore><code>
use v5.14;
use Test::More;
use Benchmark qw(:all);
use IO::Callback;
my @I;
package RNO {
use Moo::Role;
requires 'replace_nth_comma';
my @gamut = (
['a|b,c,d', 1, 'a,b,c,d'],
['a,b|c,d', 2, 'a,b,c,d'],
['a,b,c|d', 3, 'a,b,c,d'],
['aa,bb,cc|dd', 3, 'aa,bb,cc,dd'],
['|,,', 1, ',,,'],
[',|,', 2, ',,,'],
[',,|', 3, ',,,'],
[',,,', 4, ',,,'],
);
sub test_count { scalar @gamut };
sub test {
my $class = shift;
my $passes;
for my $t (@gamut) {
my ($target, @args) = @$t;
my $result = $class->replace_nth_comma(@args);
$passes += ::is($result, $target, "$class, target $target");
}
return $passes;
}
sub bench {
my $class = shift;
for my $count (0..63) {
for my $t (@gamut) {
my ($target, @args) = @$t;
my $result = $class->replace_nth_comma(@args);
}
}
}
}
# OP
package RNO_1004836 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
$count++; # off by one
$str =~ s/(,)/--$count == 1 ? "|":$1/ge;
return $str;
}
}
# AnomalousMonk
package RNO_1004848 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
$count--; # off by one, other way
$str =~ s{ (?: , [^,]*){$count} \K , }{|}xms;
return $str;
}
}
# Kenosis
package RNO_1004858 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
$str =~ s/(,)/!--$count ? '|' : $1/ge;
return $str;
}
}
# choroba
package RNO_1004892 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
my $pos = '0E0'; # plain 0 means the string begins with $from
while ($count-- and $pos >= 0) {
$pos = index $str, q(,), $pos eq '0E0' ? $pos : $pos + 1;
}
substr $str, $pos, 1, q(|) if $pos > 0;
return $str;
}
}
# trizen
package RNO_1004895 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
while ($str =~ /,/g) {
if (--$count == 0) {
substr($str, $-[0], $+[0] - $-[0], '|');
last;
}
}
return $str;
}
}
# grizzley
package RNO_1004906 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
my (undef, $count, $str) = @_;
$count--; # off by one, other way
$str =~ s/((,.*?){$count}),/$1|/;
return $str;
}
}
# LanX
package RNO_1005026 {
use Moo; with 'RNO';
push @I, __PACKAGE__;
sub replace_nth_comma {
no warnings;
my (undef, $count, $str) = @_;
my @str= split /,/, $str;
$str = join( "," , @str[0..$count-1] ) . "|" . join ( "," , @str[$count..$#str] );
return $str;
}
}
my @passed;
for (@I) {
push @passed, $_ if $_->test == $_->test_count;
}
done_testing;
select(IO::Callback->new('>', sub {
my $str = shift;
$str =~ s/^/# /m;
print STDOUT $str;
}));
say "Passed: @passed";
say "Benchmarks...";
cmpthese(-1, { map { my $class = $_; $class => sub { $class->bench } } @passed });
</code></readmore>
<p>The fastest seems to be [id://1004895] by [trizen].</p>
<!-- Node text goes above. Div tags should contain sig only -->
<div class="pmsig"><div class="pmsig-757127">
<small><small>
<tt>perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
</tt></small></small>
</div></div>
1004836
1004836