use strict; use warnings; use Benchmark qw{cmpthese}; my $str = q{123456789}; print q{reRev - }, reRev($str), qq{\n}; print q{reSwap - }, reSwap($str), qq{\n}; print q{spliceSwap - }, spliceSwap($str), qq{\n}; print q{splitMap - }, splitMap($str), qq{\n}; print q{splitMapGrep - }, splitMapGrep($str), qq{\n}; print q{splitRev - }, splitRev($str), qq{\n}; print q{splitRevGrep - }, splitRevGrep($str), qq{\n}; print q{substrRev - }, substrRev($str), qq{\n}; print q{substrSubstr - }, substrSubstr($str), qq{\n}; print q{twoSubstrs - }, twoSubstrs($str), qq{\n}; $str = $str x 1000; my $rcUseReRev = sub { my $ret = reRev($str); }; my $rcUseReSwap = sub { my $ret = reSwap($str); }; my $rcUseSpliceSwap = sub { my $ret = spliceSwap($str); }; my $rcUseSplitMap = sub { my $ret = splitMap($str); }; my $rcUseSplitMapGrep = sub { my $ret = splitMapGrep($str); }; my $rcUseSplitRev = sub { my $ret = splitRev($str); }; my $rcUseSplitRevGrep = sub { my $ret = splitRevGrep($str); }; my $rcUseSubstrRev = sub { my $ret = substrRev($str); }; my $rcUseSubstrSubstr = sub { my $ret = substrSubstr($str); }; my $rcUseTwoSubstrs = sub { my $ret = twoSubstrs($str); }; cmpthese (-3, { ReRev => $rcUseReRev, ReSwap => $rcUseReSwap, SpliceSwap => $rcUseSpliceSwap, SplitMap => $rcUseSplitMap, SplitMapGrep => $rcUseSplitMapGrep, SplitRev => $rcUseSplitRev, SplitRevGrep => $rcUseSplitRevGrep, SubstrRev => $rcUseSubstrRev, SubstrSubstr => $rcUseSubstrRev, TwoSubstrs => $rcUseTwoSubstrs, }); # davido's regexp reverse execute # sub reRev { my $str = shift; $str =~ s{(.{2})}{reverse $1}eg; return $str; } # GrandFather's regexp string substitution # sub reSwap { my $str = shift; $str =~ s{(.)(.)}{$2$1}g; return $str; } # johngg's original split, splice and join # sub spliceSwap { my $str = shift; my @chars = split m{}, $str; for (my $idx = 0; $idx < $#chars; $idx += 2) { splice @chars, $idx, 0, splice @chars, $idx + 1, 1; } return join q{}, @chars; } # johngg's split and reverse via map # sub splitMap { return join q{}, map { my $rev = reverse $_ } split m{(..)}, $_[0]; } # johngg's split and reverse via map with a # grep to remove empty elements from split # sub splitMapGrep { return join q{}, map { my $rev = reverse $_ } grep {$_} split m{(..)}, $_[0]; } # swampyankee's split and reverse of array # sub splitRev { my $str = shift; my @pairs = split m{(.{2})}, $str; $_ = reverse foreach @pairs; return join q{}, @pairs; } # swampyankee's split and reverse of array with # my grep tweak # sub splitRevGrep { my $str = shift; my @pairs = grep {$_} split m{(.{2})}, $str; $_ = reverse foreach @pairs; return join q{}, @pairs; } # davido's use of substr # sub substrRev { my $str = shift; my $rev = q{}; my $pos = 0; while ($pos < length $str) { $rev .= reverse substr $str, $pos, 2; $pos += 2; } return $rev; } # fenLisesi's without error checking so on same # footing as others # sub substrSubstr { my ($str) = @_; for my $i (0 .. (length( $str ) >> 1) - 1) { my $j = $i << 1; substr( $str, $j, 2, reverse substr( $str, $j, 2 ) ); } return $str; } # bh_perl's original tweaked with a join rather than # a sprintf plus changing for loop end test to cope # with odd characters # sub twoSubstrs { my $str = shift; my ($tmp1, $tmp2); my @tmp; for (my $idx=0; $idx < length $str; $idx += 2) { $tmp1 = substr $str, $idx, 1; $tmp2 = substr $str, $idx + 1, 1; push @tmp, $tmp2 . $tmp1; } my $out = join q{}, @tmp; return $out; }