From 6fe28881264c36899a129c9b8f22b23145587da1 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 31 Oct 2022 06:45:12 +0000 Subject: first pass at code --- challenge-189/james-smith/perl/ch-1.pl | 28 +++++++++++++++++++++++ challenge-189/james-smith/perl/ch-2.pl | 41 ++++++++++++++++++++++++++++++++++ 2 files changed, 69 insertions(+) create mode 100644 challenge-189/james-smith/perl/ch-1.pl create mode 100644 challenge-189/james-smith/perl/ch-2.pl diff --git a/challenge-189/james-smith/perl/ch-1.pl b/challenge-189/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..d6c993b8ea --- /dev/null +++ b/challenge-189/james-smith/perl/ch-1.pl @@ -0,0 +1,28 @@ +#!/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 = ( + [ [qw(e m u g)], 'b', 'e' ], + [ [qw(d c e f)], 'a', 'c' ], + [ [qw(j a r)], 'o', 'r' ], + [ [qw(d c a f)], 'a', 'c' ], + [ [qw(t g a l)], 'v', 'v' ], +); + +is( greater_char($_->[0],$_->[1]), $_->[2] ) foreach @TESTS; + +done_testing(); + +sub greater_char { + my $best; + $_ gt $_[1] && !( defined $best && $_ ge $best ) && ($best=$_) for @{$_[0]}; + return $best || $_[1]; +} + diff --git a/challenge-189/james-smith/perl/ch-2.pl b/challenge-189/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..8910117e24 --- /dev/null +++ b/challenge-189/james-smith/perl/ch-2.pl @@ -0,0 +1,41 @@ +#!/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,3,3,2], '3 3' ], + [ [1,2,1,3], '1 2 1' ], + [ [1,1,2,3,2], '1 1' ], + [ [2,1,2,1,1], '1 2 1 1' ], +); + +is( "@{[ array_degree( @{$_->[0]} ) ]}", $_->[1] ) foreach @TESTS; + +done_testing(); + +sub sc { + my($v,%f)=0; + $f{$_}++ for @_; + ($_>$v)&&($v=$_) for values %f; + $v +} + +sub array_degree { + my( $start, $end, $target ) = ( 0, $#_, sc( @_ ) ); + for my $st ( 0 .. @_ - $target + 1 ) { + for ( $st + $target - 1 .. $#_ ) { + last if $_ - $st > $end - $start; + next unless sc( @_[ $st .. $_ ] ) == $target; + $start=$st, $end=$_; + last; + } + } + @_[$start..$end]; +} + -- cgit From 9852dcbc9b039c5374b01176ba5fadf04a924857 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 31 Oct 2022 06:49:35 +0000 Subject: first push --- challenge-189/james-smith/README.md | 109 ++++++++++-------------------------- challenge-189/james-smith/blog.txt | 1 + 2 files changed, 31 insertions(+), 79 deletions(-) create mode 100644 challenge-189/james-smith/blog.txt diff --git a/challenge-189/james-smith/README.md b/challenge-189/james-smith/README.md index 12cd98cc2f..b4c067b345 100644 --- a/challenge-189/james-smith/README.md +++ b/challenge-189/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 187](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-187/james-smith) | -[Next 189 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith) +[< Previous 188](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-188/james-smith) | +[Next 190 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-190/james-smith) -# The Weekly Challenge 188 +# The Weekly Challenge 189 You can find more information about this weeks, and previous weeks challenges at: @@ -13,100 +13,51 @@ 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-188/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith -# Task 1 - Divisible Pairs +# Task 1 - Greater Character -***You are given list of integers `@list` of size `$n` and divisor `$k`. Write a script to find out count of pairs in the given list that satisfies the following rules.*** +***You are given an array of characters (a..z) and a target character. Write a script to find out the smallest character in the given array lexicographically greater than the target character.*** ## Solution -We will try a number of different solutions. From some golfed solutions to a longer hand version... - - * The first version - we use a `while` loop to shift entries off the list. (This gives us the `$i<$j` constraint). We then use grep to get all the valid values and them to the count. - * The second version replaces the `grep` with a `for` loop (and uses the `||` trick to avoid an inner `if`. - * The 3rd - is a very muched golfed solution - in avoiding an array variable for the list. This unfortunately makes the function destructive in that it empties the array, inside and outside the function. - * The 4th - makes a local copy of the array - so is non-destructive - * The 5th - we don't pass an arrayref - but an array (and we put the `$k` variable at the front of the list - * Finally using indexes rather than `shifting`.... - ```perl - -## Use grep for inner loop - -sub divisible_pairs { - my( $c, $k, @l ) = ( 0, $_[1], @{$_[0]} ); - while(@l>1){ - my $a = shift@l; - $c+=grep{ !(($a+$_)%$k) } @l; - } - $c -} - -## Use for for inner loop - -sub divisible_pairs_x { - my( $c, $k, @l ) = ( 0, $_[1], @{$_[0]} ); - while(@l>1){ - $a = shift@l; - ($a+$_)%$k || $c++ for @l; - } - $c -} - -sub dp { 0 + map { $a = pop @{$_[0]}; grep { !(($a+$_)% $_[1]) } @{$_[0]} } 1..@{$_[0]} } -sub dp_nd { my @T=@{$_[0]}; 0 + map { $a = pop @T; grep { !(($a+$_)%$_[1]) } @T} 1..@T } -sub dp_other { $b=shift; 0+map{$a=pop;grep{!(($a+$_)%$b)}@_}1..@_ } - -sub dp_index { - my( $t,$list,$k ) = (0,@_); - for my $i (0..$#$list-1) { - ($list->[$i]+$list->[$_]) % $k || $t++ for $i+1..$#$list; - } - $t +sub greater_char { + my $best; + $_ gt $_[1] && !( defined $best && $_ ge $best ) && ($best=$_) for @{$_[0]}; + return $best || $_[1]; } ``` -### Performance - -We have the following results: - -| version | Rate | Rel performance | -| :---------------- | ---: | --------------: | -| divisible_pairs_x | 150k | 1.45x | -| dp_other | 133k | 1.30x | -| divisible_pairs | 130k | 1.30x | -| dp_nd | 124k | 1.20x | -| dp_index | 117k | 1.15x | -| dp | 103k | 1.00x | +# Task 2 - Array Degree -The fastest method is the using `while`/`shift` for the outer loop and `for` for the inner loop. Using this we don't need the additional overhead of an index - as seen by the fact that the indexed version is only faster than the contrived grep solution. - -# Task 2 - Total Zero - -***You are given two positive integers $x and $y. Write a script to find out the number of operations needed to make both ZERO. Each operation is made up either of the followings:*** +***You are given an array of 2 or more non-negative integers. Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array. The degree of an array is the maximum frequency of an element in the array.*** ## Solution -We can just step through one at a time - where we subtract either `y` from `x` or `x` from `y` repeatedly and increment the count. +We first define the "score" function `sc` which works out the degree of teh array. -We can also short cut this - by reducing `y` to `y%x` or `x` to `x%y`, and increasing `t` by `|y/x|`... - -This version - even for the example data is around 20-25% faster. For larger `x` & `y` we see a much greater increase in performance... +We then loop through all contigous array splice (this has size `$n x ($n-1)`) looking for the smallets with the same score. ```perl -sub total_zero { - my( $t, $x, $y ) = ( 0, @_ ); - $x>$y ? ( $t += int($x/$y), $x %= $y ) - : ( $t += int($y/$x), $y %= $x ) while $x && $y; - $t +sub sc { + my($v,%f)=0; + $f{$_}++ for @_; + ($_>$v)&&($v=$_) for values %f; + $v } -sub total_one_step { - my($t,$x,$y) = (0,@_); - $x>$y ? ( $t++, $x-=$y ) - : ( $t++, $y-=$x ) while $x && $y; - $t +sub array_degree { + my( $start, $end, $target ) = ( 0, $#_, sc( @_ ) ); + for my $st ( 0 .. @_ - $target + 1 ) { + for ( $st + $target - 1 .. $#_ ) { + last if $_ - $st > $end - $start; + next unless sc( @_[ $st .. $_ ] ) == $target; + $start=$st, $end=$_; + last; + } + } + @_[$start..$end]; } ``` diff --git a/challenge-189/james-smith/blog.txt b/challenge-189/james-smith/blog.txt new file mode 100644 index 0000000000..1b87e33612 --- /dev/null +++ b/challenge-189/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/james-smith -- cgit From 59222b04463bc0d4d1184346719f527e40fdeca7 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 31 Oct 2022 07:41:35 +0000 Subject: added o(n) solution --- challenge-189/james-smith/perl/ch-2.pl | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/challenge-189/james-smith/perl/ch-2.pl b/challenge-189/james-smith/perl/ch-2.pl index 8910117e24..ad63c9f77e 100644 --- a/challenge-189/james-smith/perl/ch-2.pl +++ b/challenge-189/james-smith/perl/ch-2.pl @@ -15,10 +15,15 @@ my @TESTS = ( [ [2,1,2,1,1], '1 2 1 1' ], ); -is( "@{[ array_degree( @{$_->[0]} ) ]}", $_->[1] ) foreach @TESTS; +is( "@{[ array_degree_linear( @{$_->[0]} ) ]}", $_->[1] ) for @TESTS; +is( "@{[ array_degree( @{$_->[0]} ) ]}", $_->[1] ) for @TESTS; done_testing(); +cmpthese( 200_000, { + 'n^2' => sub { array_degree( @{$_->[0]} ) for @TESTS }, + 'n' => sub { array_degree_linear( @{$_->[0]} ) for @TESTS }, +}); sub sc { my($v,%f)=0; $f{$_}++ for @_; @@ -39,3 +44,23 @@ sub array_degree { @_[$start..$end]; } +sub array_degree_linear { + my($c,$max_freq,%f)=(0,0); + + ## For each number compute the frequency and the maximum/minimum index... + ( $f{$_} = $f{$_} ? [$f{$_}[0]+1,$f{$_}[1],$c] : [1,$c,$c] ), $c++ for @_; + + ## Find the maximum frequency... + ($_->[0]>$max_freq)&&($max_freq=$_->[0]) for values %f; + + ## Seek optimal value + my $best = [$_[0],0,$#_]; + + ## If the number is max_frequency - we see it's length if less than the length + ## o best - and if so replace best.. + + ($_->[0]==$max_freq) && ($best->[2]-$best->[1] > $_[2]-$_[1] ) && ( $best = $_ ) for values %f; + + ## Return the slice of the array... + @_[ $best->[1]..$best->[2] ] +} -- cgit From 9a98cade1d196fd7493941f9829cd2a59234a46c Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 31 Oct 2022 10:30:10 +0000 Subject: O(n) solution improved --- challenge-189/james-smith/README.md | 42 ++++++++++++++++++++++++++++++++++ challenge-189/james-smith/perl/ch-2.pl | 29 +++++++++++++---------- 2 files changed, 59 insertions(+), 12 deletions(-) diff --git a/challenge-189/james-smith/README.md b/challenge-189/james-smith/README.md index b4c067b345..1231b69039 100644 --- a/challenge-189/james-smith/README.md +++ b/challenge-189/james-smith/README.md @@ -22,6 +22,8 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-189/ja ## Solution +This is relatively simple - if the letter matches the requirement that it is bigger than the test value, we just keep track of the lowest value, if it is less than this we set that as the best solution and continue: + ```perl sub greater_char { my $best; @@ -61,3 +63,43 @@ sub array_degree { @_[$start..$end]; } ``` + +## Solution 2 - an improvement. + +The nested loop makes the above problem `O(n^2)`. The question is "Can we make it `O(n)`?". Fortunately the answer to that is **YES**. + +Firstly we note that for any array. The shortest length sub-slice which contains the most of one particular number will always start +and end with the same digit! This gives us a way in to the `O(n)` solution. + +As we loop through the elemens - we don't just store the count of time seen, but the location of the first occurance and the location +of the last. (the first for loop) + +Now to find the shortest best solution we loop through the values of this array. + +If the frequency _(first value)_ is greater than the best solution so far we replace the best value. + +If the frequency is the same, and the length _( third value - second value + 1 )_ is less then we also update the best value. Note in the code we don't include the + 1 - as it appears on both sides so we cancel it out. + +Finally we as above return the slice from start to end... + +```perl +sub array_degree_linear { + my($c,%f)=0; + + ( $f{$_} = $f{$_} ? [ $f{$_}[0]+1 , $f{$_}[1], $c ] : [ 1, $c, $c ] ), $c++ for @_; + + my( $best, @rest ) = values %f; + + for( @rest ) { + $best = $_ if $_->[0] > $best->[0] + || $best->[0] == $_->[0] + && $_->[2]-$_->[1] < $best->[2] - $best->[1]; + } + + @_[ $best->[1]..$best->[2] ] +} +``` + +## Performance + +Testing on the test arrays, even when `n` is in the 3-5 range the second solution is approxmately 2.7 times faster than the naive solution. diff --git a/challenge-189/james-smith/perl/ch-2.pl b/challenge-189/james-smith/perl/ch-2.pl index ad63c9f77e..cc94926ec6 100644 --- a/challenge-189/james-smith/perl/ch-2.pl +++ b/challenge-189/james-smith/perl/ch-2.pl @@ -20,7 +20,7 @@ is( "@{[ array_degree( @{$_->[0]} ) ]}", $_->[1] ) for @TESTS; done_testing(); -cmpthese( 200_000, { +cmpthese( 80_000, { 'n^2' => sub { array_degree( @{$_->[0]} ) for @TESTS }, 'n' => sub { array_degree_linear( @{$_->[0]} ) for @TESTS }, }); @@ -41,26 +41,31 @@ sub array_degree { last; } } - @_[$start..$end]; + @_[$start..$end] } sub array_degree_linear { - my($c,$max_freq,%f)=(0,0); + my($c,%f)=0; + + ## For each number compute the frequency + ## and the maximum/minimum index... - ## For each number compute the frequency and the maximum/minimum index... ( $f{$_} = $f{$_} ? [$f{$_}[0]+1,$f{$_}[1],$c] : [1,$c,$c] ), $c++ for @_; - ## Find the maximum frequency... - ($_->[0]>$max_freq)&&($max_freq=$_->[0]) for values %f; + ## Find the maximum frequency, with + ## shortest length! - ## Seek optimal value - my $best = [$_[0],0,$#_]; + my( $best, @rest ) = values %f; - ## If the number is max_frequency - we see it's length if less than the length - ## o best - and if so replace best.. + for( @rest ) { + $best = $_ if $_->[0] > $best->[0] + || $best->[0] == $_->[0] + && $_->[2]-$_->[1] < $best->[2] - $best->[1]; + } - ($_->[0]==$max_freq) && ($best->[2]-$best->[1] > $_[2]-$_[1] ) && ( $best = $_ ) for values %f; + ## Return the best value.... - ## Return the slice of the array... @_[ $best->[1]..$best->[2] ] } + + -- cgit From 1408cc38ce33fbc4e562346caba9f20d0ecce338 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 31 Oct 2022 13:00:29 +0000 Subject: some white space --- challenge-189/james-smith/perl/ch-2.pl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/challenge-189/james-smith/perl/ch-2.pl b/challenge-189/james-smith/perl/ch-2.pl index cc94926ec6..7191a2bc71 100644 --- a/challenge-189/james-smith/perl/ch-2.pl +++ b/challenge-189/james-smith/perl/ch-2.pl @@ -45,12 +45,12 @@ sub array_degree { } sub array_degree_linear { - my($c,%f)=0; + my( $c, %f ) = 0; ## For each number compute the frequency ## and the maximum/minimum index... - ( $f{$_} = $f{$_} ? [$f{$_}[0]+1,$f{$_}[1],$c] : [1,$c,$c] ), $c++ for @_; + ( $f{$_} = $f{$_} ? [ $f{$_}[0] + 1, $f{$_}[1], $c ] : [ 1, $c, $c ] ), $c++ for @_; ## Find the maximum frequency, with ## shortest length! @@ -58,9 +58,9 @@ sub array_degree_linear { my( $best, @rest ) = values %f; for( @rest ) { - $best = $_ if $_->[0] > $best->[0] - || $best->[0] == $_->[0] - && $_->[2]-$_->[1] < $best->[2] - $best->[1]; + $best = $_ if $_->[0] > $best->[0] + || $_->[0] == $best->[0] + && $_->[2] - $_->[1] < $best->[2] - $best->[1]; } ## Return the best value.... -- cgit From 322a68e34e42c10603339fb533737506a03b3a1c Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 31 Oct 2022 16:26:31 +0000 Subject: Update README.md --- challenge-189/james-smith/README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/challenge-189/james-smith/README.md b/challenge-189/james-smith/README.md index 1231b69039..3a864bd1b7 100644 --- a/challenge-189/james-smith/README.md +++ b/challenge-189/james-smith/README.md @@ -103,3 +103,5 @@ sub array_degree_linear { ## Performance Testing on the test arrays, even when `n` is in the 3-5 range the second solution is approxmately 2.7 times faster than the naive solution. + +If we include the array `[1,2,3,...,99,100,100,99,...,3,2,1]` in our testing we can immediately see the issue with the first code and performance. In this case the naive solution has a rate of about `20` - `25` per second, where the latter `O(n)` solution can execute approximately `8000` - `8500`, this gives of betwween `350x` and `400x`. -- cgit