From a54797c3cd52fac11700d96f1f5daf55470b108e Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 26 Dec 2022 01:04:00 +0000 Subject: Update ch-2.pl --- challenge-196/james-smith/perl/ch-2.pl | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/challenge-196/james-smith/perl/ch-2.pl b/challenge-196/james-smith/perl/ch-2.pl index b376f4322d..2ba3bacf88 100644 --- a/challenge-196/james-smith/perl/ch-2.pl +++ b/challenge-196/james-smith/perl/ch-2.pl @@ -13,10 +13,31 @@ my @TESTS = ( [ [1,3,5], '( )' ], ); -is( dmp( range( @{$_->[0]} ) ), $_->[1] ) for @TESTS; -is( dmp( range_v2( @{$_->[0]} ) ), $_->[1] ) for @TESTS; +is( dmp( range_v2( @{$_->[0]} ) ), $_->[1] ) for @TESTS; +is( dmp( range_map( @{$_->[0]} ) ), $_->[1] ) for @TESTS; +is( dmp( range( @{$_->[0]} ) ), $_->[1] ) for @TESTS; +is( dmp( range_for( @{$_->[0]} ) ), $_->[1] ) for @TESTS; + done_testing(); +cmpthese( -3, { + 2 => sub { range_v2( @{$_->[0]} ) for @TESTS }, + 3 => sub { range_map( @{$_->[0]} ) for @TESTS }, + 1 => sub { range( @{$_->[0]} ) for @TESTS }, + 4 => sub { range_for( @{$_->[0]} ) for @TESTS }, +} ); + +sub range_v2 { + my @r=[(shift)x 2]; + $_==$r[-1][1]+1 ? $r[-1][1]=$_ : push @r,[$_,$_] for @_; + grep { $_->[1] != $_->[0] } @r; +} + +sub range_map { + my $e = my $s = shift; + map { $_==$e+1 ? ($e = $_)x 0 :( $e-$s ? [$s,$e] : (), ($s=$e=$_)x 0 ) } @_,0; +} + sub range { my $s = my $e = shift, my @r; ($_[0]==$e+1) ? ( $e=shift ) : ( $s==$e || push(@r,[$s,$e]) , $e=$s=shift ) while @_; @@ -24,10 +45,11 @@ sub range { @r } -sub range_v2 { - my @r = [ (shift) x 2 ]; - $_ == $r[-1][1] + 1 ? $r[-1][1] = $_ : push @r, [$_,$_] for @_; - grep { $_->[1]-$_->[0] } @r +sub range_for { + my $s = my $e = shift, my @r; + ($_==$e+1) ? $e++ : ( $s==$e || push(@r,[$s,$e]) , $e=$s=$_ ) for @_; + push @r, [$s,$e] unless $s==$e; + @r } sub dmp { sprintf '( %s )', join ', ', map { sprintf '[%s]', join ',', @{$_} } @_ } -- cgit From dae0a10e23b470229e2440cd0683b3a90a1e4ca4 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 26 Dec 2022 01:06:51 +0000 Subject: Update README.md --- challenge-196/james-smith/README.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/challenge-196/james-smith/README.md b/challenge-196/james-smith/README.md index 2a84b66e88..5c485666aa 100644 --- a/challenge-196/james-smith/README.md +++ b/challenge-196/james-smith/README.md @@ -75,3 +75,19 @@ sub range_v2 { grep { $_->[1]-$_->[0] } @r } ``` + +### Version 3 + +Finally one last method - where we use `for` rather than `shift`/`while` which is the fastest... + +We just for over `@_`; If `$_` is equal to the `$end+1` we extend the region, o/w we push the interval if it is not "empty" (`$s==$e`), and start a new interval. +Finally at the end we add the last interval if non-empty. + +```perl +sub range_for { + my $s = my $e = shift, my @r; + ($_==$e+1) ? $e++ : ( $s==$e || push(@r,[$s,$e]) , $e=$s=$_ ) for @_; + push @r, [$s,$e] unless $s==$e; + @r +} +``` -- cgit From ef4abf511640753973a09531e3d6e4324d1b0d77 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 26 Dec 2022 14:34:43 +0000 Subject: Create ch-1.pl --- challenge-197/james-smith/perl/ch-1.pl | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 challenge-197/james-smith/perl/ch-1.pl diff --git a/challenge-197/james-smith/perl/ch-1.pl b/challenge-197/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..84b80e2164 --- /dev/null +++ b/challenge-197/james-smith/perl/ch-1.pl @@ -0,0 +1,17 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; + +my @TESTS = ( + [ [1,0,3,0,0,5], '1 3 5 0 0 0' ], + [ [1,6,4], '1 6 4' ], + [ [0,1,0,2,0], '1 2 0 0 0' ], + [ [(0,1) x 100 ], "@{[ (1)x 100, (0)x 100 ]}" ], +); + +is( "@{[ move_zero(@{$_->[0]}) ]}", $_->[1] ) for @TESTS; + +sub move_zero{grep({$_}@_),grep{!$_}@_} -- cgit From 684f9e08b3b18f4763e3634f00333bf35f4aebfa Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 26 Dec 2022 14:38:36 +0000 Subject: Create ch-2.pl --- challenge-197/james-smith/perl/ch-2.pl | 40 ++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 challenge-197/james-smith/perl/ch-2.pl diff --git a/challenge-197/james-smith/perl/ch-2.pl b/challenge-197/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..b16ae1d52e --- /dev/null +++ b/challenge-197/james-smith/perl/ch-2.pl @@ -0,0 +1,40 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; + +my @TESTS = ( + [ [1,1,2], 1 ], + [ [2,1,2], 0 ], + [ [1,1,1,2], 0 ], + [ [1,2,1,3,1,5], 1 ], + [ [1,2,1,3,1], 1 ], + [ [1,2], 1 ], + [ [2,1], 1 ], + [ [1], 1 ], + [ [1,5,1,1,6,4], 1 ], + [ [1,3,2,2,3,1], 1 ], + [ [2,3,1,3,1,2,1], 1 ], +); + + +is( check( wiggle_sort(@{$_->[0]}) ), $_->[1] ) for @TESTS; +done_testing(); + +sub wiggle_sort { + return @_ if @_<2; + @_ = sort { $a <=> $b } @_; + my @q = splice @_,(@_+1)/2; + return if @q < @_ && $_[1]==$q[0]; + return map { @q ? ( $_ == $q[0] ? (return) : $_,shift @q ) : $_ } @_; +} + +sub check { + return 0 unless @_; + my($t,$d) = (shift,1); + ($_<=>$t)!=$d?return 0:($t=$_,$d*=-1) for @_; + return 1; +} + -- cgit From e508071f909a22e0a9bd4bfe73f6f17ea6ba4641 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 26 Dec 2022 14:38:48 +0000 Subject: Update ch-1.pl --- challenge-197/james-smith/perl/ch-1.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/challenge-197/james-smith/perl/ch-1.pl b/challenge-197/james-smith/perl/ch-1.pl index 84b80e2164..f220e8c6b7 100644 --- a/challenge-197/james-smith/perl/ch-1.pl +++ b/challenge-197/james-smith/perl/ch-1.pl @@ -13,5 +13,6 @@ my @TESTS = ( ); is( "@{[ move_zero(@{$_->[0]}) ]}", $_->[1] ) for @TESTS; +done_testing(); sub move_zero{grep({$_}@_),grep{!$_}@_} -- cgit From 6e1c9e317422dd12254c50ec030107a637b04de4 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 30 Dec 2022 12:27:36 +0000 Subject: Update ch-2.pl --- challenge-197/james-smith/perl/ch-2.pl | 88 ++++++++++++++++++++++++++-------- 1 file changed, 67 insertions(+), 21 deletions(-) diff --git a/challenge-197/james-smith/perl/ch-2.pl b/challenge-197/james-smith/perl/ch-2.pl index b16ae1d52e..4ae40ad026 100644 --- a/challenge-197/james-smith/perl/ch-2.pl +++ b/challenge-197/james-smith/perl/ch-2.pl @@ -6,35 +6,81 @@ use feature qw(say); use Test::More; my @TESTS = ( - [ [1,1,2], 1 ], - [ [2,1,2], 0 ], - [ [1,1,1,2], 0 ], - [ [1,2,1,3,1,5], 1 ], - [ [1,2,1,3,1], 1 ], - [ [1,2], 1 ], - [ [2,1], 1 ], - [ [1], 1 ], - [ [1,5,1,1,6,4], 1 ], - [ [1,3,2,2,3,1], 1 ], - [ [2,3,1,3,1,2,1], 1 ], + [ [], 1 ], + [ [1,1,2,2], 1 ], + [ [1,1,2,2,2,3], 'Middle' ], + [ [1,1,1,2,2,3], 1 ], + [ [1,1,1,2,2,2], 1 ], + [ [1,2,2,3,3,3], 1 ], + [ [1,1,2,2,3,3,3], 1 ], + [ [1,1,2], 1 ], + [ [2,1,2], 'Top' ], + [ [1,1,1,2], 'Bottom' ], + [ [1,1,1,1,2,2,2], 1 ], + [ [1,1,1,2,2,2,2], 'Top' ], + [ [1,1,2,2,2,2,3], 'Middle' ], + [ [1,1,2,2,2,2,2,3,3], 'Middle' ], + [ [1,2,2,2,2,3,3], 'Middle' ], + [ [2,2,2,2,3,3,3], 1 ], + [ [2,2,2,3,3,3,3], 'Top' ], + [ [1,1,2,2,2,2], 'Top' ], + [ [1,2,2,2,2,3], 'Middle' ], + [ [2,2,2,2,3,3], 'Bottom' ], + [ [1,2,1,3,1,5], 1 ], + [ [1,2,1,3,1], 1 ], + [ [1,2], 1 ], + [ [2,1], 1 ], + [ [1], 1 ], + [ [1,5,1,1,6,4], 1 ], + [ [1,3,2,2,3,1], 1 ], + [ [1,3,2,2,2,3,1], 1 ], + [ [2,3,1,3,1,2,1], 1 ], ); -is( check( wiggle_sort(@{$_->[0]}) ), $_->[1] ) for @TESTS; +is( ch_strict( ws_strict( @{$_->[0]} ) ), $_->[1] ) for @TESTS; +is( ch_lax( ws_lax( @{$_->[0]} ) ), 1 ) for @TESTS; done_testing(); -sub wiggle_sort { +sub _ws { +## Does wiggle sort by splicing and interleaving sorted list... + my@q=splice @_,(@_+1)/2;map{$_,@q?shift@q:()}@_ + my@q=splice @_,0,$#_/2+1;map{$_,@_?shift:()}@q +} +sub ws_lax { +## Return "wiggle sorted list" - note we are using the lax <= => check here + @_<2?@_:_ws(sort{$a<=>$b}@_) +} + +sub ws_strict { +## Return "wiggle sorted list" or error message indicating if +## the problem number is the first number, last number or one +## of the other numbers... + return @_ if @_<2; - @_ = sort { $a <=> $b } @_; - my @q = splice @_,(@_+1)/2; - return if @q < @_ && $_[1]==$q[0]; - return map { @q ? ( $_ == $q[0] ? (return) : $_,shift @q ) : $_ } @_; + @_=sort{$a<=>$b} @_; + return $_[0] == $_[$#_/2+1] ? 'Bottom' # We can't have more than ceil(n/2) of the first number + : $_[0] == $_[$#_/2 ] ? _ws(@_) # But we can have ceil(n/2) of the first number + : $_[-1] == $_[$#_/2 ] ? 'Top' # We can't have more than floor(n/2) of the last number + : $_[-1] == $_[$#_/2+1] ? _ws(@_) # But we can have floor(n/2) of it + : (grep{$_[$_]==$_[$_+$#_/2]}0..@_/2-1) ? 'Middle' # We can't have equal or more than floor(n/2) of any other number + : _ws(@_) + ; } -sub check { +sub ch_strict { + return 1 unless @_; ## Empty array OK! + return $_[0] if $_[0]=~m/\D/; ## String - i.e. error - just return + my($t,$d) = (shift,1); ## Now checking list... + ($_<=>$t) != $d ? return 0:($t=$_,$d*=-1) for @_; + 1 +} + +sub ch_lax { return 0 unless @_; - my($t,$d) = (shift,1); - ($_<=>$t)!=$d?return 0:($t=$_,$d*=-1) for @_; - return 1; + my($t,$d)=(shift,1); ## Check list... + ($d?($t>$_):($t<$_))?return 0:($t=$_,$d=1-$d) for @_; + 1 } + -- cgit From 55e4c1f92416b1b48eaa776d8002e806155f14fe Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 30 Dec 2022 12:33:50 +0000 Subject: Update ch-2.pl --- challenge-197/james-smith/perl/ch-2.pl | 1 - 1 file changed, 1 deletion(-) diff --git a/challenge-197/james-smith/perl/ch-2.pl b/challenge-197/james-smith/perl/ch-2.pl index 4ae40ad026..2b43052f7a 100644 --- a/challenge-197/james-smith/perl/ch-2.pl +++ b/challenge-197/james-smith/perl/ch-2.pl @@ -44,7 +44,6 @@ done_testing(); sub _ws { ## Does wiggle sort by splicing and interleaving sorted list... - my@q=splice @_,(@_+1)/2;map{$_,@q?shift@q:()}@_ my@q=splice @_,0,$#_/2+1;map{$_,@_?shift:()}@q } sub ws_lax { -- cgit From 4f4f3e92ae4f200f5ca209dd57348a99cf386aa3 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 30 Dec 2022 12:40:24 +0000 Subject: Update README.md --- challenge-197/james-smith/README.md | 92 +++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 40 deletions(-) diff --git a/challenge-197/james-smith/README.md b/challenge-197/james-smith/README.md index 2a84b66e88..f6212bf7cd 100644 --- a/challenge-197/james-smith/README.md +++ b/challenge-197/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 195](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-195/james-smith) | -[Next 197 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-197/james-smith) +[< Previous 196](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-196/james-smith) | +[Next 198 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith) -# The Weekly Challenge 196 +# The Weekly Challenge 197 You can find more information about this weeks, and previous weeks challenges at: @@ -15,63 +15,75 @@ You can find the solutions here on github at: https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-196/james-smith -# Task 1 - Pattern 132 +# Task 1 - Move Zero -***You are given a list of integers, `@list`. Write a script to find out subsequence that respect Pattern 132. Return empty array if none found. Pattern 132 in a sequence `(a[i], a[j], a[k])` such that `i < j < k` and `a[i] < a[k] < a[j]`.*** +***You are given a list of integers, `@list`. Write a script to move all zero, if exists, to the end while maintaining the relative order of non-zero elements.*** ## Solution -There is no simple solution other than looking at all pairs. (With a caveat there is short cut by skipping the inner loop if `$a[$j] <= $a[$i]`. -For the outer loop we can shift off the array to get `$x = $a[i]`. We can't do this for the inner loop, so we have to use the index `$i`... -But we can use the value for the inner loop by using an array slice `@_[$i+1..$#_]` +I looked at a number of solutions for this - but it turns out that perl grep seems to be the best... ```perl -sub pattern132 { - while(my$x=shift@_){ - for my $i (0..$#_-1) { - next if $x > $_[$i]; - ($x<$_)&&($_<$_[$i])&&return $x,$_[$i],$_ for @_[$i+1..$#_] - } - } - () +sub move_zero{ + grep({$_}@_),grep{!$_}@_ } ``` +Using `$_` and `!$_` to pull the lists apart. Anything more complex in the grep slows it down more than you lose by doing the second `grep`. -# Task 2 - Range list +# Task 2 - Wiggle sort -***You are given a sorted unique integer array, `@array`. Write a script to find all possible Number Range i.e `[x, y]` represent range all integers from `x` and `y` (both inclusive). Each subsequence of two or more contiguous integers*** +***You are given a list of integers, `@list`. Write a script to perform Wiggle Sort on the given list. Wiggle sort would be such as:*** -## Solution - -We loop through the array one number at a time. We initialise our first interval as "`[$s,$e=$s]`" the `$s` is the first number. - -We then loop through each subsequence number in turn. +``` +list[0] < list[1] > list[2] < list[3]… +``` - * If the new number is one more than the current end of the interval, we update the end and go to the next. - * If it isn't we start a new interval "`[$s,$e=$s]`" - if the previous start and end had been different we push this to the results +## Solution -Finally at the end of the loop if there is an interval left it is pushed to the list.. +OK if we relax the condition with `<=`/`=>` rather than `<`/`>` we can always come up with a solution. The simplest way to do this is to split the list in two (using `splice` and then stitching them back together. (If it has an odd length we keep the first list as the longest!) ```perl -sub range { - my$s=my$e=shift,my @r; - ($_[0]==$e+1)?($e=shift):($s==$e||push(@r,[$s,$e]),$e=$s=shift)while @_; - push@r,[$s,$e]unless$s==$e; - @r +sub ws_lax { + return @_ if @_<2; ## Always works if 0/1 element. + my@q=splice @_,0,$#_/2+1; + map{$_,@_?shift:()}@q } ``` -### version 2 +If we wish to perform the strict version we have to test conditions for which there are no solution... -That version is a bit messi - far too many variables! + * If we have more than half (if even length) or *half + 1* (if odd) of the lowest digit we have no solution. + * o/w if we have exactly half (if even length) or *half + 1* (if odd) of the lowest digit we have a solution. + * o/w if we have more than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution + * o/w if we have exactly than half (if even length) or *half - 1* (if odd) of the highest digit we have no solution + * o/w if we have half or more (if even length) or *half - 1* or more (if odd) of any other digit we have no solution + * o/w we have a solution -This time we keep track of the intervals inside the result `@r`, we note that we don't need to discard the "empty" intervals while making the array - we can use grep to filter them out as we return the list. This makes the logic easier... - -We start with an "empty" interval `[ $_[0],$_[0] ]`, and then we loop through the array if there is a gap we create a new "empty" interval and push to the list - o/w we just extend the last interval in the list... As we only want the "non-empty" intervals we just `grep` this at the end. +This leads us to: ```perl -sub range_v2 { - my @r = [ (shift) x 2 ]; - $_ == $r[-1][1] + 1 ? $r[-1][1] = $_ : push @r, [$_,$_] for @_; - grep { $_->[1]-$_->[0] } @r +sub _ws { +## Does wiggle sort by splicing and interleaving sorted list... + my@q=splice @_,0,$#_/2+1;map{$_,@_?shift:()}@q +} + +sub ws_strict { +## Return "wiggle sorted list" or error message indicating if +## the problem number is the first number, last number or one +## of the other numbers... + + return @_ if @_<2; + @_=sort{$a<=>$b} @_; + return $_[0] == $_[$#_/2+1] ? 'Bottom' # We can't have more than ceil(n/2) of the first number + : $_[0] == $_[$#_/2 ] ? _ws(@_) # But we can have ceil(n/2) of the first number + : $_[-1] == $_[$#_/2 ] ? 'Top' # We can't have more than floor(n/2) of the last number + : $_[-1] == $_[$#_/2+1] ? _ws(@_) # But we can have floor(n/2) of it + : (grep{$_[$_]==$_[$_+$#_/2]}0..@_/2-1) ? 'Middle' # We can't have equal or more than floor(n/2) of any other number + : _ws(@_) + ; +} + +sub ws_lax { +## Return "wiggle sorted list" - note we are using the lax <= => check here + @_<2?@_:_ws(sort{$a<=>$b}@_) } ``` -- cgit From 9388a6188998ea2df686431da9597d33d0556f20 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 30 Dec 2022 12:41:20 +0000 Subject: Create blog.txt --- challenge-197/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-197/james-smith/blog.txt diff --git a/challenge-197/james-smith/blog.txt b/challenge-197/james-smith/blog.txt new file mode 100644 index 0000000000..b22c462609 --- /dev/null +++ b/challenge-197/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-197/james-smith -- cgit