From 690c285cbe6d54e23bac98561cdbe25c070c58a6 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:02:20 +0000 Subject: Update README.md --- challenge-191/james-smith/README.md | 68 +++++++++++++++---------------------- 1 file changed, 27 insertions(+), 41 deletions(-) diff --git a/challenge-191/james-smith/README.md b/challenge-191/james-smith/README.md index 6aa5575439..324a5aa9e5 100644 --- a/challenge-191/james-smith/README.md +++ b/challenge-191/james-smith/README.md @@ -114,49 +114,35 @@ These observations lead us to the following code... my %cache; sub cute { - ## (0) Clear cache... - %cache=(); - ## (1) If n is 1 short cut and return 1 - $_[0]==1 ? 1 : _cute_count( 0, - ## (2) Just keep the lists - map { $_->[1] } - ## (3) Sort so the shortest lists are first - then sort by integer - sort { @{$a->[1]} <=> @{$b->[1]} || - $a->[0] <=> $b->[0] - } - ## (4) Find all values between 1 & n which are either a factor or - ## multiple. Store each as pair, of the number + all values. - map {[ ($a=$_), [ - grep { !( $_%$a && $a%$_ ) } 1 .. $_[0] - ] ]} - ## (5) Looping over 1 to n - 1 .. $_[0] + %cache=(); ## (0) Clear cache... + $_[0]==1 ? 1 : _cute( 0, ## (1) If n is 1 short cut and return 1 + map { $_->[1] } ## (2) Just keep the lists + sort { @{$a->[1]} <=> @{$b->[1]} || ## (3) Sort so the shortest lists are + $a->[0] <=> $b->[0] ## first - then sort by integer + } ## (4) Find all values between 1 & n + map {[ ($a=$_), [ ## which are either a factor + grep { !( $_%$a && $a%$_ ) } ## or multiple, store each as pair + 1 .. $_[0] ## of number and list of values + ] ]} ## + 1 .. $_[0] ## (5) Looping over 1 to n ) } - -sub _cute_count { - ## (6) We shift of the index number of seen numbers - ## and also the next group of possible numbers... - my( $seen, $next ) = ( shift, shift ); - ## (7) If we have already computed the value return... - ## (8) otherwise we loop over the values possible in the - ## "nth" position (this is loose as they aren't ordered directly) - ## by " but by the count {we are only counting so don't need to - ## produce numbers} - $cache{$seen} //= sum0 map { - ## (9) We sum up the value for each value in this list which hasn't - ## been seen (and return it!) - ($seen & 1<<$_) ? 0 - ## (10) If there is only 1 number left in the list we count 1 - ## (as all numbers can be in the last position) - : @_ < 2 ? 1 - ## (11) o/w we call this method again after knocking out the number - : _cute_count( $seen | 1<<$_ , @_ ) - } @{$next} -} - ## Note we don't use a string as a key - but use a bit mast - - ## #9 & #11 using "|" to set a bit & "&" to check it has - ## been set. +sub _cute { + my( $seen, $next ) = ( shift, shift ); ## (6) We shift of the index number of seen numbers + ## and also the next group of possible numbers... + $cache{$seen} //= sum0 map { ## (7) If we have already computed the value return... + ## (8) otherwise we loop over the values possible in the + ## "nth" position (this is loose as they aren't + ## ordered directly) by " but by the count {we are + ## only counting so don't need to produce numbers} + ## (9) We sum up the value for each value in this list + ($seen & 1<<$_) ? 0 ## which hasn't been seen (and return it!) + : @_ < 2 ? 1 ## (10) If there is only 1 number left in the list we + ## count 1 (as all numbers can be in the last position) + : _cute( $seen | 1<<$_ , @_ ) ## (11) o/w we call this method again after tagging number seen + } @{$next} ## Note we don't use a string as a key - but use a bit mast - +} ## #9 & #11 using "|" to set a bit & "&" to check + ## it has been set. ``` or without comments: -- cgit From cadae443be15eba8911bf85625bdff59b8b6b04f Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:03:06 +0000 Subject: Create ch-1.pl --- challenge-192/james-smith/perl/ch-1.pl | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 challenge-192/james-smith/perl/ch-1.pl diff --git a/challenge-192/james-smith/perl/ch-1.pl b/challenge-192/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..bc94462d44 --- /dev/null +++ b/challenge-192/james-smith/perl/ch-1.pl @@ -0,0 +1,20 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @TESTS = ( [5,2],[4,3],[6,1] ); + +is( binary_flip( $_->[0] ), $_->[1] ) for @TESTS; +done_testing(); + +sub binary_flip { + my($r,$k,$n) = (0,1,shift); + $r=(1-$n&1)*$k+$r,$k<<=1,$n>>=1 while $n; + $r; +} -- cgit From 113e4dfdd5adc942e5b467fffe5f54996b7aa4a3 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:03:23 +0000 Subject: Create ch-2.pl --- challenge-192/james-smith/perl/ch-2.pl | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 challenge-192/james-smith/perl/ch-2.pl diff --git a/challenge-192/james-smith/perl/ch-2.pl b/challenge-192/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..36b2dc27dc --- /dev/null +++ b/challenge-192/james-smith/perl/ch-2.pl @@ -0,0 +1,23 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @TESTS = ( [ [1,0,5], 4 ], [ [0,2,0],-1], [ [0,3,0], 2 ] ); + +is( equal_dis( @{$_->[0]} ), $_->[1] ) for @TESTS; +done_testing(); + +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; +} -- cgit From 3aa707d4771a5ae85fb2395fbecf575030da075d Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:04:05 +0000 Subject: Create blog.txt --- challenge-192/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-192/james-smith/blog.txt diff --git a/challenge-192/james-smith/blog.txt b/challenge-192/james-smith/blog.txt new file mode 100644 index 0000000000..a6f33b7883 --- /dev/null +++ b/challenge-192/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith -- cgit From 9f10bb06e148ef2e6b98c169b580bab06db2b325 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:40:39 +0000 Subject: Update README.md --- challenge-192/james-smith/README.md | 241 +++++------------------------------- 1 file changed, 30 insertions(+), 211 deletions(-) diff --git a/challenge-192/james-smith/README.md b/challenge-192/james-smith/README.md index 6aa5575439..9faa97f314 100644 --- a/challenge-192/james-smith/README.md +++ b/challenge-192/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 189](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith) | -[Next 191 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith) +[< 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) -# The Weekly Challenge 190 +# The Weekly Challenge 192 You can find more information about this weeks, and previous weeks challenges at: @@ -15,233 +15,52 @@ You can find the solutions here on github at: https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith -# Task 1 - Twice Largest +# Task 1 - Binary Flip -***You are given list of integers, `@list`. Write a script to find out whether the largest item in the list is at least twice as large as each of the other items.*** +***You are given a positive integer, `$n`. Write a script to find the binary flip.*** ## Solution -We can simplify the condition to that the largest number is at least twice the value of the second largest number. +This isn't as simple as using `~` as this will flip ALL the bits including those before the first 1. -Our naive approach could be to sort the numbers and check `$list[-1] >= 2*$list[-2]`. +We need to therefore work through bit by bit reducing the number until we have reach zero. -```perl -sub is_double_sort { - sub {$_[0]>=2*$_[1]||-1}->(sort {$b<=>$a} @_) -} -``` - -But this isn't efficient if the list is large (but how large is large we will find out later) - instead we will just track the two largest numbers. +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 - * We grab the first two numbers, and store the largest one in $f and the other one in $s. - * For each other number ($_): - * $_ <= $s - ignore do nothing - * $s < $_ && $_ <= $f - replace 2nd number $s with $_ - * $f < $_ - replace 2nd number $s with $f, and replace $f with $_ - * Return is based on whether `$f >= 2*$s` +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. ```perl -sub is_double { - my( $f, $s ) = ( shift, shift ); # First two numbers - ( $f, $s ) = ( $s, $f ) if $f < $s; # Switch if 1st < 2nd - $_>$f ? ( ( $f, $s ) = ( $_, $f ) ) # For each number - : ( $_ > $s && ( $s = $_ ) ) for @_; # if > 1st - # demote 1st to 2nd - # replace 1st - # if > 2nd - # demote 2nd - $f >= 2*$s ? 1 : -1 # Check condition +sub binary_flip { + my($r,$k,$n) = (0,0,shift); + $r|=(~$n&1)<<$k++,$n>>=1 while $n; + $r; } ``` -### How large is large - -Some experiments with a longer and longer list seem to indicate that the breakeven point is about 200 - so sorting lists of less than 200 numbers is more efficient than the perl above, but over 200 the max strategy is best... - -# Task 2 - Cute List - -***You are given an integer, `0 < $n <= 15`. Write a script to find the number of orderings of numbers that form a cute list.*** - -***With an input `@list = (1, 2, 3, .. $n)` for positive integer `$n`, an ordering of `@list` is cute if for every entry, indexed with a base of 1, either:*** +So instead we need to shift off the last bit until we get the zero value +# Task 2 - Equal Distribution - * ***`$list[$i]` is evenly divisible by `$i`*** - * ***`$i` is evenly divisible by `$list[$i]`*** +***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 -Again this weeks task 2 is a much more interesting challenge. And has a number of different approaches we can find. - - * Do we use recursion - or - interation? - * Do we memoize or not? if so what key do we use? - * Are there any simple optimizations - how to make the loop fail earlier? - -Firstly - we could use permutations - but this screams out initially at least for recursion. - -Before we start some observations: - - * We can pre-compute which numbers can be at which position to give us an array like: - - * `[1,2,3,4,5,6,7]`, `[1,2,4,6]`, `[1,3,6]`, `[1,2,4]`, `[1,5]`, `[1,2,3,6]`, `[1,7]` - - * When we search we can re-order the lists to fill in numbers from the short lists first - - * `[1,5]`, `[1,7]`, `[1,3,6]`, `[1,2,4]`, `[1,2,4,6]`, `[1,2,3,6]`, `[1,2,3,4,5,6,7]` - - * As a bonus - this reduces the search space further as the last list will ALWAYS contain - a valid digit. So we always know that will return a single value. This allows us the - shortenings (#1 & #10) - - * Our keys are all integers and less than 64. We can therefore use a bit mask as the keys - for the cache... {#9 & #11) - - Already placed `2`, `4`, `7` they key would be `10010100` - - * Using a cache can greatly reduce the number of calls (at the expense of memory) see - #0 & #7. Note we use the `//=` operator here rather than the '||=' as a 0 value - being cached is as important as a non-zero value and `//=` is a defined check - rather than a check for true {which `0` would faile} - - * #2, #3 & #4 use a similar {but sort of inverted logic} to a schwartzian transform, - which we carry over a variable which is important for the sort as a value in an - array ref only to throw it away with an extra `map`. - - * #8 - we steal `sum0` from `List::Util` but we could equally write our own - to - avoid the library `sub sum0 { my $t=0; $t+=$_ for @_; $t }` - -These observations lead us to the following code... - ```perl -my %cache; - -sub cute { - ## (0) Clear cache... - %cache=(); - ## (1) If n is 1 short cut and return 1 - $_[0]==1 ? 1 : _cute_count( 0, - ## (2) Just keep the lists - map { $_->[1] } - ## (3) Sort so the shortest lists are first - then sort by integer - sort { @{$a->[1]} <=> @{$b->[1]} || - $a->[0] <=> $b->[0] - } - ## (4) Find all values between 1 & n which are either a factor or - ## multiple. Store each as pair, of the number + all values. - map {[ ($a=$_), [ - grep { !( $_%$a && $a%$_ ) } 1 .. $_[0] - ] ]} - ## (5) Looping over 1 to n - 1 .. $_[0] - ) +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 _cute_count { - ## (6) We shift of the index number of seen numbers - ## and also the next group of possible numbers... - my( $seen, $next ) = ( shift, shift ); - ## (7) If we have already computed the value return... - ## (8) otherwise we loop over the values possible in the - ## "nth" position (this is loose as they aren't ordered directly) - ## by " but by the count {we are only counting so don't need to - ## produce numbers} - $cache{$seen} //= sum0 map { - ## (9) We sum up the value for each value in this list which hasn't - ## been seen (and return it!) - ($seen & 1<<$_) ? 0 - ## (10) If there is only 1 number left in the list we count 1 - ## (as all numbers can be in the last position) - : @_ < 2 ? 1 - ## (11) o/w we call this method again after knocking out the number - : _cute_count( $seen | 1<<$_ , @_ ) - } @{$next} -} - ## Note we don't use a string as a key - but use a bit mast - - ## #9 & #11 using "|" to set a bit & "&" to check it has - ## been set. ``` -or without comments: +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. -```perl -sub cute { - %cache=(); - $_[0]==1 ? 1 : _cute_count( 0, - map { $_->[1] } - sort { @{$a->[1]} <=> @{$b->[1]} || - $a->[0] <=> $b->[0] - } - map {[ ($a=$_), [ - grep { !( $_%$a && $a%$_ ) } 1 .. $_[0] - ] ]} - 1 .. $_[0] - ) -} +So first thing we do is work out the sum and see if it is divisible by the length. -sub _cute_count { - my( $seen, $next ) = ( shift, shift ); - $cache{$seen} //= sum0 map { - ($seen & 1<<$_) ? 0 - : @_ < 2 ? 1 - : _cute_count( $seen | 1<<$_ , @_ ) - } @{$next} -} -``` -### Performance - -We compared this algorithm with various ones with ordering and without we have the following timings: - -| Method | Rate | Gain | -| :-------------------------- | ------: | ---: | -| No-cache, no-ordering trick | 1.19/s | | -| No-cache, ordering trick | 7.29/s | 6x | -| Cache, no-ordering trick | 17.4/s | 15x | -| Cache, ordering trick | 97.0/s | 80x | - -The difference expands rapdily as N increases - for `n=20` the optimal solution takes around 0.162 seconds - where the non-optimal solution 96, for an approximately `600x` speed up - this is approx `12x` for the ordering trick & `50x` for the cacheing. - -### Timings for increasing `$N` - -The original challenge asked us to compute values up to `n=15` - the cumulative time for this is between 1.05 and 1.30 seconds. We can continue on to `n=30` taking around 19 seconds. - -The script finally crashes after `n=39` (with a count of around 5.5 trillion) - when the cache memory usage exceeds 7GBytes (the capacity of the machine) and starts to swap. {Note although this machine has more memory it also has a slower processor - so the times are approximately 30% longer than on the box used for the timings above} - -| ind | Count | Time loop | Cumul time | -| --: | ----------------: | ---------: | ---------: | -| 1 | 1 | 0.000010 | 0.000011 | -| 2 | 2 | 0.000018 | 0.000076 | -| 3 | 3 | 0.000016 | 0.000105 | -| 4 | 8 | 0.000022 | 0.000136 | -| 5 | 10 | 0.000028 | 0.000175 | -| 6 | 36 | 0.000067 | 0.000251 | -| 7 | 41 | 0.000085 | 0.000346 | -| 8 | 132 | 0.000177 | 0.000533 | -| 9 | 250 | 0.000241 | 0.000790 | -| 10 | 700 | 0.000493 | 0.001299 | -| 11 | 750 | 0.000601 | 0.001916 | -| 12 | 4,010 | 0.001535 | 0.003466 | -| 13 | 4,237 | 0.001722 | 0.005206 | -| 14 | 10,680 | 0.002893 | 0.008116 | -| 15 | 24,679 | 0.005721 | 0.013854 | -| 16 | 87,328 | 0.009010 | 0.022884 | -| 17 | 90,478 | 0.010208 | 0.033113 | -| 18 | 435,812 | 0.020486 | 0.053620 | -| 19 | 449,586 | 0.023270 | 0.076913 | -| 20 | 1,939,684 | 0.078741 | 0.155676 | -| 21 | 3,853,278 | 0.125847 | 0.281549 | -| 22 | 8,650,900 | 0.173449 | 0.455045 | -| 23 | 8,840,110 | 0.224917 | 0.680006 | -| 24 | 60,035,322 | 0.359825 | 1.039877 | -| 25 | 80,605,209 | 0.511679 | 1.551599 | -| 26 | 177,211,024 | 0.663506 | 2.215148 | -| 27 | 368,759,752 | 1.033414 | 3.248616 | -| 28 | 1,380,348,224 | 2.533999 | 5.782659 | -| 29 | 1,401,414,640 | 2.951694 | 8.734403 | -| 30 | 8,892,787,136 | 10.241124 | 18.975582 | -| 31 | 9,014,369,784 | 11.076978 | 30.052606 | -| 32 | 33,923,638,848 | 13.505877 | 43.558524 | -| 33 | 59,455,553,072 | 20.499038 | 64.057609 | -| 34 | 126,536,289,568 | 23.903329 | 87.960986 | -| 35 | 207,587,882,368 | 57.064045 | 145.025074 | -| 36 | 1,495,526,775,088 | 99.565625 | 244.590748 | -| 37 | 1,510,769,105,288 | 109.442520 | 354.033321 | -| 38 | 3,187,980,614,208 | 134.032712 | 488.066089 | -| 39 | 5,415,462,995,568 | 175.846131 | 663.912274 | +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. -- cgit From 39e5a2e6dea457369eac1d519107bcd2911fec02 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:41:41 +0000 Subject: Update ch-1.pl --- challenge-192/james-smith/perl/ch-1.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-192/james-smith/perl/ch-1.pl b/challenge-192/james-smith/perl/ch-1.pl index bc94462d44..4a347bc343 100644 --- a/challenge-192/james-smith/perl/ch-1.pl +++ b/challenge-192/james-smith/perl/ch-1.pl @@ -15,6 +15,6 @@ done_testing(); sub binary_flip { my($r,$k,$n) = (0,1,shift); - $r=(1-$n&1)*$k+$r,$k<<=1,$n>>=1 while $n; + $r|=(~$n&1)<<$k++, $n>>=1 while $n; $r; } -- cgit From 65768e01278e2130696dedc43ecb66ffa415ef17 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 08:43:40 +0000 Subject: Update README.md --- challenge-191/james-smith/README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-191/james-smith/README.md b/challenge-191/james-smith/README.md index 324a5aa9e5..8bb07b095b 100644 --- a/challenge-191/james-smith/README.md +++ b/challenge-191/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 189](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith) | -[Next 191 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-191/james-smith) +[< Previous 190](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith) | +[Next 192 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-192/james-smith) -# The Weekly Challenge 190 +# The Weekly Challenge 191 You can find more information about this weeks, and previous weeks challenges at: -- cgit From c168e00d304e7ae57f59012beb6a94ef43bce7eb Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 10:06:53 +0000 Subject: Update ch-1.pl --- challenge-192/james-smith/perl/ch-1.pl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/challenge-192/james-smith/perl/ch-1.pl b/challenge-192/james-smith/perl/ch-1.pl index 4a347bc343..6526f74650 100644 --- a/challenge-192/james-smith/perl/ch-1.pl +++ b/challenge-192/james-smith/perl/ch-1.pl @@ -11,8 +11,13 @@ use Data::Dumper qw(Dumper); my @TESTS = ( [5,2],[4,3],[6,1] ); is( binary_flip( $_->[0] ), $_->[1] ) for @TESTS; +is( string_flip( $_->[0] ), $_->[1] ) for @TESTS; done_testing(); +sub string_flip { + oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r; +} + sub binary_flip { my($r,$k,$n) = (0,1,shift); $r|=(~$n&1)<<$k++, $n>>=1 while $n; -- cgit From 7bea4bc252197637e3081d3882187d9578b8c6b7 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 10:10:27 +0000 Subject: Update README.md --- challenge-192/james-smith/README.md | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/challenge-192/james-smith/README.md b/challenge-192/james-smith/README.md index 9faa97f314..b2d3bc04fb 100644 --- a/challenge-192/james-smith/README.md +++ b/challenge-192/james-smith/README.md @@ -21,6 +21,8 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/ja ## Solution +### Use maths... + 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. @@ -39,7 +41,21 @@ sub binary_flip { } ``` -So instead we need to shift off the last bit until we get the zero value +### Use strings... + +This can also be done by converting to a string and then coverting back again. + +``` +sub string_flip { + oct '0b'.sprintf('%b',$_[0])=~tr/01/10/r; +``` + +We use `tr` with the `r` option to return the result of the translation... + +### Performance... + +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. + # 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`*** -- cgit From 20a07ea3696dddf4bf4080f08a2bbe6031b6c15d Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 11:43:00 +0000 Subject: Update README.md --- challenge-192/james-smith/README.md | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/challenge-192/james-smith/README.md b/challenge-192/james-smith/README.md index b2d3bc04fb..7c47f95f78 100644 --- a/challenge-192/james-smith/README.md +++ b/challenge-192/james-smith/README.md @@ -54,7 +54,26 @@ We use `tr` with the `r` option to return the result of the translation... ### Performance... -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. +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. + # Task 2 - Equal Distribution -- cgit From 96da103ba96c50d324397c33e79626cdcf977182 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 21 Nov 2022 11:44:01 +0000 Subject: Update ch-1.pl --- challenge-192/james-smith/perl/ch-1.pl | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/challenge-192/james-smith/perl/ch-1.pl b/challenge-192/james-smith/perl/ch-1.pl index 6526f74650..b2e18ab4be 100644 --- a/challenge-192/james-smith/perl/ch-1.pl +++ b/challenge-192/james-smith/perl/ch-1.pl @@ -6,12 +6,13 @@ use warnings; use feature qw(say); use Test::More; use Benchmark qw(cmpthese timethis); -use Data::Dumper qw(Dumper); +use Inline 'C'; my @TESTS = ( [5,2],[4,3],[6,1] ); is( binary_flip( $_->[0] ), $_->[1] ) for @TESTS; is( string_flip( $_->[0] ), $_->[1] ) for @TESTS; +is( c_flip( $_->[0] ), $_->[1] ) for @TESTS; done_testing(); sub string_flip { @@ -23,3 +24,15 @@ sub binary_flip { $r|=(~$n&1)<<$k++, $n>>=1 while $n; $r; } + +__END__ +__C__ +int c_flip(int n) { + int r=0; + int k=0; + while(n) { + r|=(1^n&1)<>=1; + } + return r; +} -- cgit