From 241b8ba8a74f88f411c4d09b96cd81af948d979c Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 28 Nov 2022 08:58:58 +0000 Subject: Create ch-1.pl --- challenge-193/james-smith/perl/ch-1.pl | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 challenge-193/james-smith/perl/ch-1.pl diff --git a/challenge-193/james-smith/perl/ch-1.pl b/challenge-193/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..28da54e4e6 --- /dev/null +++ b/challenge-193/james-smith/perl/ch-1.pl @@ -0,0 +1,13 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); + +say join ', ', binary($_) for 1..10; + +sub binary { + my $t = "%0$_[0]b"; + map { sprintf $t, $_ } 0.. (1<<$_[0])-1 +} -- cgit From dcf2530588db81ad20f5bb7aece05969fe681642 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 28 Nov 2022 13:38:49 +0000 Subject: Create ch-2.pl Two solutions a hacky array one which counts... But then a second faster one that only works on the first three entries in the array --- challenge-193/james-smith/perl/ch-2.pl | 47 ++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 challenge-193/james-smith/perl/ch-2.pl diff --git a/challenge-193/james-smith/perl/ch-2.pl b/challenge-193/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..2c004a7e6c --- /dev/null +++ b/challenge-193/james-smith/perl/ch-2.pl @@ -0,0 +1,47 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; + +my @list1 = ( 'bob', map { chr(97+rand(26)) x 3 } 1..10000 ); +my @list2 = ( ( map { chr(97+rand(26)) x 3 } 1..10000 ), 'bob' ); +my @TESTS = ( + [ [qw(adc wzy abc)], 'abc' ], + [ [qw(aaa bob ccc ddd)], 'bob' ], + [ [@list1], 'bob' ], + [ [@list2], 'bob' ], +); + +is( odd_string_array( @{$_->[0]} ), $_->[1] ) for @TESTS; +is( odd_string_fast( @{$_->[0]} ), $_->[1] ) for @TESTS; + +sub odd_string_array { + my %x; + ## Keyed by signature - so one key will have + push @{$x{ + ord( substr $_, 1 ) * 99 + + ord( substr $_, 2 ) + - ord( $_ ) * 100 + }}, $_ for @_; + [ grep { @{$_}==1 } values %x ]->[0][0] +} + +sub odd_string_fast { + my($x1,$x2,$y1,$y2,$z1,$z2) = ( + ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), + ord($_[1]) - ord(substr$_[1],1), ord($_[1]) - ord(substr$_[1],2), + ord($_[2]) - ord(substr$_[2],1), ord($_[2]) - ord(substr$_[2],2), + ); + if( $x1 == $y1 && $x2 == $y2 ) { ## First & second match so NOT 1st + if( $x1 == $z1 && $x2 == $z2 ) { ## Third matches first - so find first which doesn't + ( $x1 != ord($_) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2) ) && return $_ for @_[3..$#_]; + } else { + return $_[2]; + } + } ## Different so it must be 1st or ceons + $_[ $x1 == $z1 && $x2 == $z2 ? 1 : 0 ] +} + + -- cgit From ececd3c155ddaf3e7d0634031db73912f99bf410 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 28 Nov 2022 15:53:10 +0000 Subject: Update ch-1.pl --- challenge-193/james-smith/perl/ch-1.pl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/challenge-193/james-smith/perl/ch-1.pl b/challenge-193/james-smith/perl/ch-1.pl index 28da54e4e6..fe0ffaa757 100644 --- a/challenge-193/james-smith/perl/ch-1.pl +++ b/challenge-193/james-smith/perl/ch-1.pl @@ -5,9 +5,10 @@ use strict; use warnings; use feature qw(say); -say join ', ', binary($_) for 1..10; +say join ', ', all_binary($_) for 1..10; + +sub all_binary { ## Make a template so we don't have + my $t = "%0$_[0]b"; ## to do interpolation everytime + map { sprintf $t, $_ } 0 .. (1<<$_[0])-1 ## Need brackets as - is actioned +} ## before <<. -sub binary { - my $t = "%0$_[0]b"; - map { sprintf $t, $_ } 0.. (1<<$_[0])-1 -} -- cgit From e255656482e42e9cae4b18ca62be8b23847a2b6d Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 28 Nov 2022 17:12:22 +0000 Subject: Update README.md --- challenge-193/james-smith/README.md | 143 +++++++++++------------------------- 1 file changed, 41 insertions(+), 102 deletions(-) diff --git a/challenge-193/james-smith/README.md b/challenge-193/james-smith/README.md index e509b7da91..a14e31832b 100644 --- a/challenge-193/james-smith/README.md +++ b/challenge-193/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 191](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith) | -[Next 193 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith) +[< Previous 192](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith) | +[Next 194 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-194/james-smith) -# The Weekly Challenge 192 +# The Weekly Challenge 193 You can find more information about this weeks, and previous weeks challenges at: @@ -13,124 +13,63 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith -# Task 1 - Binary Flip +# Task 1 - Binary string -***You are given a positive integer, `$n`. Write a script to find the binary flip.*** +***You are given an integer, `$n > 0`. Write a script to find all possible binary numbers of size `$n`.*** ## Solution -### Use maths... +This weeks task 1 is relatively simple. (1) We need to work out what the minimum and maximum +integers are and then just print them padded to the right length. Thankfully Perl is great +at this as it is integral to it's design. -This isn't as simple as using `~` as this will flip ALL the bits including those before the first 1. - -We need to therefore work through bit by bit reducing the number until we have reach zero. - -We use the right shift operator to reduce `$n` each time. We have to push the values back onto the -answer. We can do this with addition - actually as we using bit-operators elsewhere we use the `|` operator - -If the last digit is `1` we do nothing, if the last digit is `0` where add `2^$k` where $k is the -position we are currently checking. Note as we are right-shifting we have to increase `$k` each time. +The largest value is '(2^n)-1' and the template for `sprintf` is '`%0{n}b`'. Which gives us ```perl -sub binary_flip { - my($r,$k,$n) = (0,0,shift); - $r|=(~$n&1)<<$k++,$n>>=1 while $n; - $r; -} -``` - -### Use strings... - -This can also be done by converting to a string and then coverting back again. - +sub all_binary { ## Make a template so we don't have + my $t = "%0$_[0]b"; ## to do interpolation everytime + map { sprintf $t, $_ } 0 .. (1<<$_[0])-1 ## Need brackets as - is actioned +} ## before <<. ``` -sub string_flip { - $_[0] ? oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r : 0; -} -``` - -We use `tr` with the `r` option to return the result of the translation... - -Note we have to check whether the input is `0` as in this case the output is also `0` as there is no leading 1. +# Task 2 - Odd String -### Performance... +***You are given a list of strings of same length, `@s`. Write a script to find the odd string in the given list. Use positional value of alphabet starting with 0, i.e. `a = 0`, `b = 1`, ... `z = 25`.*** -Well this is where Perl is uber fast when it comes to strings - the string solution is faster than the bit manipulation. This is probably due to the overhead of each separate operation in the numeric version. For a test example of "12345678" (`1011 1100 0110 0001 0100 1110`) the string method is 8x faster than the binary method. - -### Let's try again... - -Annoyed with the fact the elegant {bit operator based} solution is slower than the "hacky" string one - let's revisit the code using inline C - effectively it is EXACTLY the same algortihm as our first perl method. - -```C -int c_flip(int n) { - int r=0; - int k=0; - while(n) { - r|=(1^n&1)<>=1; - } - return r; -} -``` - -Now - when comparing this to the other two: The C version is 4.5 times faster than the string version OR 35x faster than the equivalent Perl version. - -A further re-write of the C gives: - -```C -int c2(int n) { - int o = n; - int m = 0; - while(o) { - m<<=1; - m++; - o>>=1 - } - return n^m; -} -``` - -Here we compute a mask of `1`s as long as the binary representation of the number so for `25` = `11001` we have a mask of `11111` and so doing a bitwize XOR operation gives us `00110` or `6`. Which is even faster as it only does the XOR (`^`) once. {approx 5 times faster than the regex version} - -# Task 2 - Equal Distribution - -***You are given a list of integers greater than or equal to zero, `@list`. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print `-1`*** +You are given a list of integers greater than or equal to zero, `@list`. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print `-1` ## Solution ```perl -sub equal_dis { - my($av,$k) = (0,0); - $av+=$_ for @_; - return -1 if $av%@_; - $av/=@_; - $k+=abs($av-$_[0]),$_[1]-=$av-shift while @_>1; - $k; +sub odd_string_array { + my %x; + ## Keyed by signature - so one key will have + push @{$x{ + ord( substr $_, 1 ) * 99 + + ord( substr $_, 2 ) + - ord( $_ ) * 100 + }}, $_ for @_; + [ grep { @{$_}==1 } values %x ]->[0][0] } ``` -The first thing to realise is that we only have a solution if the digits up to a multiple of the length of the list. - -So first thing we do is work out the sum and see if it is divisible by the length. - -Second is how to work out the number of steps. This is easier than you think. We only have to consider the case where we move numbers right to left or left to right, starting at the left. We are not bothered whether any number becomes negative. - -So (1) how much do we need to move? This is simply `$av - $A[$p]`. So we borrow it from the next number so `$A[$p+1] = $A[$p+1] - $av + $A[$p]` and the number of steps is just `abs($av-$A[$p])`. Giving the code above. - -### A minor optimization - -We can do away with the array - and just use a scalar for the "size" of the next bin - giving us: +### Faster solution.. ```perl -sub equal_dis2 { - my($av,$k,$f) = (0,0,$_[0]); - $av+=$_ for @_; - return -1 if $av%@_; - $av/=@_; - $k+=abs($av-$f),$f=$_[$_]-$av+$f for 1..$#_; - $k; +sub odd_string_fast { + my($x1,$x2,$y1,$y2,$z1,$z2) = ( + ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), + ord($_[1]) - ord(substr$_[1],1), ord($_[1]) - ord(substr$_[1],2), + ord($_[2]) - ord(substr$_[2],1), ord($_[2]) - ord(substr$_[2],2), + ); + if( $x1 == $y1 && $x2 == $y2 ) { ## First & second match so NOT 1st + if( $x1 == $z1 && $x2 == $z2 ) { ## Third matches first - so find first which doesn't + ( $x1 != ord($_) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2) ) && return $_ for @_[3..$#_]; + } else { + return $_[2]; + } + } ## Different so it must be 1st or ceons + $_[ $x1 == $z1 && $x2 == $z2 ? 1 : 0 ] } ``` - -- cgit From 48f165d60bcf8b2ef44e1785d4a2dd7d18d19eab Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 28 Nov 2022 17:12:45 +0000 Subject: Create blog.txt --- challenge-193/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-193/james-smith/blog.txt diff --git a/challenge-193/james-smith/blog.txt b/challenge-193/james-smith/blog.txt new file mode 100644 index 0000000000..36bac2d0cc --- /dev/null +++ b/challenge-193/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-193/james-smith -- cgit From c4876f9ff9a89cf2b2f4b0b9340bb313c7c3f28f Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 29 Nov 2022 01:49:23 +0000 Subject: Update README.md --- challenge-193/james-smith/README.md | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/challenge-193/james-smith/README.md b/challenge-193/james-smith/README.md index a14e31832b..f22a0e5110 100644 --- a/challenge-193/james-smith/README.md +++ b/challenge-193/james-smith/README.md @@ -41,6 +41,10 @@ You are given a list of integers greater than or equal to zero, `@list`. Write a ## Solution +First pass - we compute a signature for each string, and store them in arrays, keyed by the signature... We use "100 * first difference + second difference". + +Once we have the hash - we find the value {array} with only 1 element in it - and return that value... + ```perl sub odd_string_array { my %x; @@ -56,6 +60,18 @@ sub odd_string_array { ### Faster solution.. +We note (1) this takes a lot of memory!, (2) we need to compute the signature of each number... + +So can we do better... First we note that we will need to compute the signatures of at least 3 entries. As we need to find two the same and one different. + +So we do this for the first three strings. If all strings have the same signature we need to loop through the remainder of the list to find one which is different. + +If they are not - we just use logic to work out which is different. + + * first two the same - it must be the third + * first and third the same - must be second + * o/w first. + ```perl sub odd_string_fast { my($x1,$x2,$y1,$y2,$z1,$z2) = ( @@ -73,3 +89,5 @@ sub odd_string_fast { $_[ $x1 == $z1 && $x2 == $z2 ? 1 : 0 ] } ``` + +How much faster is this... depends on how far along the list you need to go until you find the unique element. Testing a list of strings with the odd one in a random location - we saw a speed up of around 3.5x. -- cgit From c1f05931f4a6438627eb4794ed852ec66af243c2 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 29 Nov 2022 08:15:38 +0000 Subject: Update ch-2.pl --- challenge-193/james-smith/perl/ch-2.pl | 75 ++++++++++++++++++++++++---------- 1 file changed, 54 insertions(+), 21 deletions(-) diff --git a/challenge-193/james-smith/perl/ch-2.pl b/challenge-193/james-smith/perl/ch-2.pl index 2c004a7e6c..35391469fa 100644 --- a/challenge-193/james-smith/perl/ch-2.pl +++ b/challenge-193/james-smith/perl/ch-2.pl @@ -5,19 +5,30 @@ use warnings; use feature qw(say); use Test::More; -my @list1 = ( 'bob', map { chr(97+rand(26)) x 3 } 1..10000 ); -my @list2 = ( ( map { chr(97+rand(26)) x 3 } 1..10000 ), 'bob' ); +my $SIZE = 100; + +my %map2 = map { my $a=$_; map { ("$a$_" => ord($a)-ord($_)) } 'a'..'z' } 'a'..'z'; +my %map3 = map { my $b = $_; map { my $a=$_; map { ("$a$b$_" => ord($a)*99-ord($b)*100+ord($_)) } 'a'..'z' } 'a'..'z' } 'a'..'z'; +my @list = map { chr(97+rand(26)) x 3 } 1..$SIZE; my @TESTS = ( - [ [qw(adc wzy abc)], 'abc' ], + [ [qw(adc wzy abc)], 'abc' ], + [ [qw(bob bbb ccc ddd)], 'bob' ], [ [qw(aaa bob ccc ddd)], 'bob' ], - [ [@list1], 'bob' ], - [ [@list2], 'bob' ], + [ [qw(aaa bbb bob ddd)], 'bob' ], + [ [qw(aaa bbb ccc bob)], 'bob' ], + ## Put "bob" in every position within the list... + map { my $t = [ @list ]; $t->[$_]='bob'; [ $t, 'bob' ] } 0..$SIZE-1 +); +my @TESTS = + @lists, ); -is( odd_string_array( @{$_->[0]} ), $_->[1] ) for @TESTS; -is( odd_string_fast( @{$_->[0]} ), $_->[1] ) for @TESTS; +is( odd_string_array( @{$_->[0]} ), $_->[1] ) for @TESTS; +is( odd_string_ord( @{$_->[0]} ), $_->[1] ) for @TESTS; +is( odd_string_map_2( @{$_->[0]} ), $_->[1] ) for @TESTS; +is( odd_string_map_3( @{$_->[0]} ), $_->[1] ) for @TESTS; -sub odd_string_array { +sub odd_string { my %x; ## Keyed by signature - so one key will have push @{$x{ @@ -28,20 +39,42 @@ sub odd_string_array { [ grep { @{$_}==1 } values %x ]->[0][0] } -sub odd_string_fast { - my($x1,$x2,$y1,$y2,$z1,$z2) = ( - ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), - ord($_[1]) - ord(substr$_[1],1), ord($_[1]) - ord(substr$_[1],2), - ord($_[2]) - ord(substr$_[2],1), ord($_[2]) - ord(substr$_[2],2), +sub odd_string_ord { + my($x1,$x2) = ( + ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), ); - if( $x1 == $y1 && $x2 == $y2 ) { ## First & second match so NOT 1st - if( $x1 == $z1 && $x2 == $z2 ) { ## Third matches first - so find first which doesn't - ( $x1 != ord($_) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2) ) && return $_ for @_[3..$#_]; - } else { - return $_[2]; - } - } ## Different so it must be 1st or ceons - $_[ $x1 == $z1 && $x2 == $z2 ? 1 : 0 ] + ## The first two characters are different - so we need to check the first against the third + ## If it is the same then the character we want is the second character o/w the first + ## Note the comparison returns 1 if true & 0 if false so can use that as the index to @_ + return $_[ $x1 == ord($_[2]) - ord(substr$_[2],1) && $x2 == ord($_[2]) - ord(substr$_[2],2) ] + if $x1 != ord($_[1]) - ord(substr$_[1],1) || $x2 != ord($_[1]) - ord(substr$_[1],2); + ## We remove the first two strings as we don't need to compare them... + splice@_,0,2; + ## Compare all strings {we will end up with an answer as we know there is a unique string + ( $x1 != ord($_ ) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2 ) ) && return $_ for @_; + ## in the list... +} + +## Pre compute `ord($a) - ord($b)` for two letters [keyed with the string `"$a$b"`] and use +## this to avoid the repeated ord calculation.... (676 entries) +## This isn't as efficient as the ord calculation tho! +sub odd_string_map_2 { + my($x1,$x2) = ( $map2{ substr $_[0],0,2 }, $map2{ substr $_[0],1,2 } ); + return $_[ $x1 == $map2{ substr $_[2],0,2 } && $x2 == $map2{ substr $_[2],1,2 } ] + if $x1 != $map2{ substr $_[1],0,2 } || $x2 != $map2{ substr $_[1],1,2 }; + splice@_,0,2; + ( $x1 != $map2{ substr $_, 0,2 } || $x2 != $map2{ substr $_, 1,2 } ) && return $_ for @_; } +## Pre compute the signature for all triples (17,576 entries) +## this to avoid the repeated ord calculation...., and now the `substr` operation +## as well - this gives us the simpler code.... + +sub odd_string_map_3 { + my $x = $map3{ $_[0] }; + return $_[ $x == $map3{ $_[2] } ] + if $x != $map3{ $_[1] }; + splice@_,0,2; + $x == $map3{ $_ } || return $_ for @_; +} -- cgit From 82bfe670984001f60cd499a76d3249bbe8f43605 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 29 Nov 2022 12:43:03 +0000 Subject: Update ch-2.pl --- challenge-193/james-smith/perl/ch-2.pl | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/challenge-193/james-smith/perl/ch-2.pl b/challenge-193/james-smith/perl/ch-2.pl index 35391469fa..e4877da7b9 100644 --- a/challenge-193/james-smith/perl/ch-2.pl +++ b/challenge-193/james-smith/perl/ch-2.pl @@ -9,7 +9,9 @@ my $SIZE = 100; my %map2 = map { my $a=$_; map { ("$a$_" => ord($a)-ord($_)) } 'a'..'z' } 'a'..'z'; my %map3 = map { my $b = $_; map { my $a=$_; map { ("$a$b$_" => ord($a)*99-ord($b)*100+ord($_)) } 'a'..'z' } 'a'..'z' } 'a'..'z'; + my @list = map { chr(97+rand(26)) x 3 } 1..$SIZE; + my @TESTS = ( [ [qw(adc wzy abc)], 'abc' ], [ [qw(bob bbb ccc ddd)], 'bob' ], @@ -19,9 +21,6 @@ my @TESTS = ( ## Put "bob" in every position within the list... map { my $t = [ @list ]; $t->[$_]='bob'; [ $t, 'bob' ] } 0..$SIZE-1 ); -my @TESTS = - @lists, -); is( odd_string_array( @{$_->[0]} ), $_->[1] ) for @TESTS; is( odd_string_ord( @{$_->[0]} ), $_->[1] ) for @TESTS; @@ -40,9 +39,7 @@ sub odd_string { } sub odd_string_ord { - my($x1,$x2) = ( - ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), - ); + my($x1,$x2) = ( ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2) ); ## The first two characters are different - so we need to check the first against the third ## If it is the same then the character we want is the second character o/w the first ## Note the comparison returns 1 if true & 0 if false so can use that as the index to @_ -- cgit From 5202c4dd43c74e5c340900b10992dda150383012 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 29 Nov 2022 12:58:39 +0000 Subject: Update README.md --- challenge-193/james-smith/README.md | 66 ++++++++++++++++++++++++++++--------- 1 file changed, 51 insertions(+), 15 deletions(-) diff --git a/challenge-193/james-smith/README.md b/challenge-193/james-smith/README.md index f22a0e5110..e62ff12914 100644 --- a/challenge-193/james-smith/README.md +++ b/challenge-193/james-smith/README.md @@ -72,22 +72,58 @@ If they are not - we just use logic to work out which is different. * first and third the same - must be second * o/w first. +We will try three different methods: + + * Calculate each difference on the fly + * Store the score for adjacent letters - and look up in a hash {hash size 676} + * Store a "score" for each triple - and look up in a a hash {hash size 17,576} + +The logic of all three code bases is the same - just how the "signature" is calculated. You can see this by the structure of the code + ```perl -sub odd_string_fast { - my($x1,$x2,$y1,$y2,$z1,$z2) = ( - ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2), - ord($_[1]) - ord(substr$_[1],1), ord($_[1]) - ord(substr$_[1],2), - ord($_[2]) - ord(substr$_[2],1), ord($_[2]) - ord(substr$_[2],2), - ); - if( $x1 == $y1 && $x2 == $y2 ) { ## First & second match so NOT 1st - if( $x1 == $z1 && $x2 == $z2 ) { ## Third matches first - so find first which doesn't - ( $x1 != ord($_) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2) ) && return $_ for @_[3..$#_]; - } else { - return $_[2]; - } - } ## Different so it must be 1st or ceons - $_[ $x1 == $z1 && $x2 == $z2 ? 1 : 0 ] +sub odd_string_ord { + my($x1,$x2) = ( ord($_[0]) - ord(substr$_[0],1), ord($_[0]) - ord(substr$_[0],2) ); + return $_[ $x1 == ord($_[2]) - ord(substr$_[2],1) && $x2 == ord($_[2]) - ord(substr$_[2],2) ] + if $x1 != ord($_[1]) - ord(substr$_[1],1) || $x2 != ord($_[1]) - ord(substr$_[1],2); + splice@_,0,2; + ( $x1 != ord($_ ) - ord(substr$_,1) || $x2 != ord($_) - ord(substr$_,2 ) ) && return $_ for @_; +} + +my %map2 = map { my $a=$_; map { + ("$a$_" => ord($a)-ord($_)) +} 'a'..'z' } 'a'..'z'; + +sub odd_string_map_2 { + my($x1,$x2) = ( $map2{ substr $_[0],0,2 }, $map2{ substr $_[0],1,2 } ); + return $_[ $x1 == $map2{ substr $_[2],0,2 } && $x2 == $map2{ substr $_[2],1,2 } ] + if $x1 != $map2{ substr $_[1],0,2 } || $x2 != $map2{ substr $_[1],1,2 }; + splice@_,0,2; + ( $x1 != $map2{ substr $_, 0,2 } || $x2 != $map2{ substr $_, 1,2 } ) && return $_ for @_; +} + +my %map3 = map { my $b = $_; map { my $a=$_; map { + ("$a$b$_" => ord($a)*99-ord($b)*100+ord($_)) +} 'a'..'z' } 'a'..'z' } 'a'..'z'; + +sub odd_string_map_3 { + my $x = $map3{ $_[0] }; + return $_[ $x == $map3{ $_[2] } ] + if $x != $map3{ $_[1] }; + splice@_,0,2; + $x == $map3{ $_ } || return $_ for @_; } ``` -How much faster is this... depends on how far along the list you need to go until you find the unique element. Testing a list of strings with the odd one in a random location - we saw a speed up of around 3.5x. +### Performance + +How much faster are these... depends on how far along the list you need to go until you find the unique element. +Testing a list of strings with the odd one in a random location - we saw: + +| Method | Speed up | +| --------- | -------: | +| 2-chr map | x 3.3 | +| Ord | x 4.3 | +| 3-chr map | x 10.1 | + +I think the overhead of the `substr` and hash lookup for the 2-chr map is greater the `ord` lookups. But avoiding +doing the `substr` makes the 3-chr map substantially faster... -- cgit