in reply to Re: Extracting /regex/mg in a while loop
in thread Extracting /regex/mg in a while loop
I updated the code somewhat to allow it to run on my slightly older (5.34) Perl.
I also added an additional method (kco3) as my preferred way to write your version of the code.
#!/usr/bin/env perl #use v5.38; use feature qw|say|; use autodie; use constant { SEP1 => "\n" . '=' x 40, SEP2 => '-' x 40, }; use Benchmark 'cmpthese'; use File::Spec (); my ($null_fh, $base_str); BEGIN { open $null_fh, '>', File::Spec::->devnull(); $base_str = <<~'EOT'; AdataA BdataB CdataC EOT } my @bench_names = qw{net1 net2 hau1 ner1 ner2 kco1 kco2 kco3}; my (%bench_for, %benches_to_cmp, $mult_str); say 'Test', SEP1; for my $bench (@bench_names) { no strict 'refs'; ($bench_for{$bench} = \&{$bench})->(\$base_str); use strict 'refs'; say SEP2; $benches_to_cmp{$bench} = sub { $bench_for{$bench}->(\$mult_str, $null_fh); }; } for my $mult (1, 10, 100, 1_000, 10_000) { $mult_str = $base_str x $mult; say 'Bench (Length: ', length($mult_str), ')', SEP1; cmpthese 0 => \%benches_to_cmp; say SEP2; } sub net1 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; while ($str =~ /(^A|^B)(.+)$/mg){ $out_fh->say("$1 net1 $2"); } return; } sub net2 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; open my $fh, '<', \$str; while (<$fh>) { my ($name, $data) = m/(^A|^B)(.+)$/ or next; $out_fh->say("$name net2 $data"); } return; } sub hau1 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; while ($str =~ m{^ (?<name>A|B) (?<data>.+) $}xmg) { $out_fh->say("$+{name} hau1 $+{data}"); } return; } sub ner1 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; $out_fh->say("$1 ner1 $2") while $str =~ /^([AB])(.+)$/mg; return; } sub ner2 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; $str =~ /^([AB])(.++)$(?{ $out_fh->say("$1 ner2 $2") })./m; return; } sub kco1 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; my $re = qr{(?m:^([AB])(.+)$)}; $out_fh->say("$1 kco1 $2") while $str =~ /$re/g; return; } sub kco3 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; my $re = qr{(?m:^(A|B)(.+)$)}; while ($str =~ /$re/go){ $out_fh->say("$1 kco2 $2") ; } return; } sub kco2 ($rstr, $out_fh = *STDOUT) { my $str = $$rstr; my $re = qr{(?m:^([AB])(.+)$)}; $out_fh->say("$1 kco2 $2") while $str =~ /$re/go;
$ perl pm-11154897.pl Test ======================================== ---------------------------------------- ---------------------------------------- ---------------------------------------- ---------------------------------------- ---------------------------------------- ---------------------------------------- ---------------------------------------- ---------------------------------------- Bench (Length: 21) ======================================== Rate net2 kco1 kco2 kco3 net1 ner1 hau1 ner2 net2 260654/s -- -90% -92% -92% -97% -97% -97% -97% kco1 2536874/s 873% -- -20% -21% -68% -69% -70% -71% kco2 3178301/s 1119% 25% -- -1% -60% -61% -62% -64% kco3 3207697/s 1131% 26% 1% -- -59% -61% -62% -63% net1 7889843/s 2927% 211% 148% 146% -- -4% -5% -10% ner1 8226198/s 3056% 224% 159% 156% 4% -- -1% -6% hau1 8333730/s 3097% 229% 162% 160% 6% 1% -- -5% ner2 8767731/s 3264% 246% 176% 173% 11% 7% 5% -- ---------------------------------------- Bench (Length: 210) ======================================== Rate net2 kco1 kco3 kco2 net1 hau1 ner1 ner2 net2 260526/s -- -90% -92% -92% -97% -97% -97% -97% kco1 2492787/s 857% -- -20% -20% -68% -69% -69% -71% kco3 3114015/s 1095% 25% -- -0% -60% -61% -61% -64% kco2 3123870/s 1099% 25% 0% -- -60% -61% -61% -64% net1 7758408/s 2878% 211% 149% 148% -- -3% -3% -10% hau1 7965224/s 2957% 220% 156% 155% 3% -- -0% -7% ner1 7965224/s 2957% 220% 156% 155% 3% 0% -- -7% ner2 8601600/s 3202% 245% 176% 175% 11% 8% 8% -- ---------------------------------------- Bench (Length: 2100) ======================================== Rate net2 kco1 kco2 kco3 hau1 net1 ner1 ner2 net2 257948/s -- -90% -92% -92% -97% -97% -97% -97% kco1 2501079/s 870% -- -19% -20% -67% -68% -68% -71% kco2 3097753/s 1101% 24% -- -1% -59% -60% -60% -64% kco3 3133787/s 1115% 25% 1% -- -58% -60% -60% -64% hau1 7510752/s 2812% 200% 142% 140% -- -3% -4% -13% net1 7771227/s 2913% 211% 151% 148% 3% -- -0% -10% ner1 7794563/s 2922% 212% 152% 149% 4% 0% -- -10% ner2 8628990/s 3245% 245% 179% 175% 15% 11% 11% -- ---------------------------------------- Bench (Length: 21000) ======================================== Rate net2 kco1 kco2 kco3 net1 ner1 hau1 ner2 net2 231838/s -- -91% -93% -93% -97% -97% -97% -97% kco1 2478677/s 969% -- -20% -22% -67% -68% -69% -70% kco2 3094492/s 1235% 25% -- -3% -59% -61% -62% -63% kco3 3178304/s 1271% 28% 3% -- -58% -59% -61% -62% net1 7593413/s 3175% 206% 145% 139% -- -3% -6% -9% ner1 7840377/s 3282% 216% 153% 147% 3% -- -3% -6% hau1 8068001/s 3380% 225% 161% 154% 6% 3% -- -4% ner2 8382339/s 3516% 238% 171% 164% 10% 7% 4% -- ---------------------------------------- Bench (Length: 210000) ======================================== Rate net2 kco1 kco2 kco3 hau1 ner1 net1 ner2 net2 250558/s -- -85% -89% -92% -96% -97% -97% -97% kco1 1640135/s 555% -- -28% -46% -75% -78% -78% -81% kco2 2269326/s 806% 38% -- -25% -66% -70% -70% -73% kco3 3032215/s 1110% 85% 34% -- -54% -59% -60% -65% hau1 6657718/s 2557% 306% 193% 120% -- -11% -13% -22% ner1 7484171/s 2887% 356% 230% 147% 12% -- -2% -13% net1 7612303/s 2938% 364% 235% 151% 14% 2% -- -11% ner2 8558296/s 3316% 422% 277% 182% 29% 14% 12% -- ----------------------------------------
"These opinions are my own, though for a small fee they be yours too."
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^3: Extracting /regex/mg in a while loop
by kcott (Archbishop) on Oct 11, 2023 at 09:36 UTC |