From 22989b8ff6671f1df8125bbb46f7178d33ef5529 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 1 May 2023 12:29:09 +0100 Subject: Update README.md --- challenge-215/james-smith/README.md | 164 +++++++++--------------------------- 1 file changed, 39 insertions(+), 125 deletions(-) diff --git a/challenge-215/james-smith/README.md b/challenge-215/james-smith/README.md index babc174789..b5ed43623f 100644 --- a/challenge-215/james-smith/README.md +++ b/challenge-215/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 213](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-213/james-smith) | -[Next 215 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith) +[< Previous 214](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-214/james-smith) | +[Next 216 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-216/james-smith) -# The Weekly Challenge 214 - Another one rides the bus! +# The Weekly Challenge 215 You can find more information about this weeks, and previous weeks challenges at: @@ -13,150 +13,64 @@ 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-214/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith -# TASK #1: Rank Score +# TASK #1: Odd one Out -***You are given a list of scores (>=1). Write a script to rank each score in descending order. First three will get medals i.e. G (Gold), S (Silver) and B (Bronze). Rest will just get the ranking number.*** +***You are given a list of words (alphabetic characters only) of same size. Write a script to remove all words not sorted alphabetically and print the number of words in the list that are not alphabetically sorted.*** ## Solution -```perl -sub rank { - map { ['','G','S','B']->[$_] || $_ } - map { //; 1 + grep { $_ > $' } @_ } - @_ -} -``` +To solve this problem we loop though each string to make sure the letters in alphabetical order. -Simple solution we get the rank for each value by counting the number of elements greater than it and then coverting 1,2,3 to GSB +We note that if the words are less than 3 characters long then they will be default in alphabetical order so we return 0. -## Complex solution +Looping through the letters - we start by getting the signum of the difference between the first two letters (and store in `$f`). We then loop through the remaining letters comparing letter by letter. + + * If the letters are the same we do nothing; + * If the first two letter are different then we update the update the value of `$f` with the difference between the letter + * If we find that `$f` has a different signum then wer add 1 to the count and jump to the end of the loop ```perl -sub rank2 { - my $pos=0; - @_ = sort { $b->[0] <=> $a->[0] } - map { [$_,$pos++,1] } - @_; - $_[$_][2] = $_[$_][0] == $_[$_-1][0] - ? $_[$_-1][2] - : $_ + 1 for 1..$#_; - map { ['','G','S','B']->[$_->[2]] || $_->[2] } - sort { $a->[1] <=> $b->[1] } - @_ +sub non_alpha { + my $c = 0; + return 0 if length $_[0] <3; + for(@_) { + my($f,$s,@rest)=split//; + $f = $f cmp $s; + ($s ne $_) && ($f ||= $s cmp $_) != ($s cmp $_) ? ($c++,last) + : ($s=$_) + for @rest; + } + $c } + ``` -We effectively use a modified schwartzian transform. But instead of computing one index and sorting by it we then use 2nd index and sort by it. +# TASK #2: Number Placement - * Add to each element and attribute which is additional position & a second which is going to be used for rank {we initialise as 1}; - * Sort based on value so highest is first; - * Set the rank column - based on order; - * The first rank is 1 - subsequent ranks are the position in the list if different from the previous number OR the rank of the previous number. - * Sort again but this time on original position - * to put numbers back where they were; - * Finally extract the rank from the triple and map 1,2,3 to G,S,B +***You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). Write a script to find out if it is possible to replace 0 with 1 in the given list. The only condition is that you can only replace when there is no 1 on either side. Print 1 if it is possible otherwise 0.*** -# TASK #2: Collect Points +*Question - there are two intepretations o the question - whether the placements are done simultaneously or one after the other* -***You are given a list of numbers. You will perform a series of removal operations. For each operation, you remove from the list N (one or more) equal and consecutive numbers, and add to your score N × N. Determine the maximum possible score.*** +*In the former case any run of 3+ zeros can have `n-2` updates, but if it is the former it `(n-1)/2` ## Solution -A brute force approach is the easiet here - we look for sequences of digits - remove from the list and add the "collect" call on the list with the sequence removed.. And we collect the best score. But this is not particularly fast especially as the list grows. - -```perl -sub collect { ## We will use recursion here. we take out each number in - ## turn and pass it back to the function - return 0 unless @_; ## The score for an empty list is 0 - my $m = 0; ## Create a variable for the max value - for ( my $e = my $o = 0; $o<@_; ) { ## Loop from start to finish - - ## there is no inc as the $o = $e at - ## the does the same think - my $e = $o; ## Reset the end of the list to the start - $e++ while $_[$o]==$_[$e]; ## Increment until we get to a different value - sub { $m=$_[0] if $m<$_[0] }->( ## Use and IIFE to collect max value - ($e-$o)**2 + ## Add square of elements to value - collect( @_[ 0..$o-1, $e..$#_ ] ## for the reduced list - ), $o = $e; - } - $m; -} -``` - -## Cacheing - -By simply caching the result we can get a significant improvement in the examples we see around a 20-25x improvement, better improvements happen with larger examples, until at some point the cache will start eating into swap.. And things will tail off dramatically! - -```perl -sub collect { ## We will use recursion here. we take out each number in - ## turn and pass it back to the function - return 0 unless @_; ## The score for an empty list is 0 - my $k = "@_"; ##+++ Generate key for cache - return $cache->{$k} if exists $cache->{$k}; ##+++ Return cache value if exists - my $m = 0; ## Create a variable for the max value - for ( my $e = my $o = 0; $o<@_; ) { ## Loop from start to finish - - ## there is no inc as the $o = $e at - ## the does the same think - my $e = $o; ## Reset the end of the list to the start - $e++ while $_[$o]==$_[$e]; ## Increment until we get to a different value - sub { $m=$_[0] if $m<$_[0] }->( ## Use and IIFE to collect max value - ($e-$o)**2 + ## Add square of elements to value - collect( @_[ 0..$o-1, $e..$#_ ] ## for the reduced list - ), $o = $e; - } - $cache->{$k} = $m ##+++ Cache value & return -} -``` - -## Improving the algorithm +Both solutions are the same except for the calculation at the heart to compute the count. -Here we work out a minimum best score - removing all numbers except for the most frequent and that leaves us with the best score of `f * f + ( n - f)`. -We also at each stage work out the possible maximum score - this is `score + sum(f*f)` over the remaining frequences. If this is lower than the -current max score we do not progress any futher... +We loop through the numbers if we see a 1 we check to see how many previous 0's we've had and compute the number of insertions. If it is 0 we increment the count of 0's in a row. Note to make sure we include any last sequence of 0's we add a 1 on to the end of the list we are search. ```perl -sub _collect_fast { - my $s = shift; - return $s unless @_; ## Empty list return score - - ## same digits. - for ( my $e = my $o = 0; $o<@_; ) { ## We loop through - my $e = $o; ## the list for each - $e++ while $_[$o]==$_[$e]; ## sequence of same no. - - ## Compute the score so far $s + length of seq^2 - ## Compute max poss. score this + sum of squared - ## counts of other number frequencies - - my $ms = my $ts = $s + ($e-$o)**2; - my %f = ($_[$o] => $o-$e); - $f{$_}++ for @_; - $ms += $_ ** 2 for values %f; - - ## If the max possible score is > $m we compute - ## actual score and update max if > $m - - if($ms>$m) { - $ts = _collect_fast( $ts, @_[ 0..$o-1, $e..$#_ ] ); - ## And if it is greater than $m we update $m - $m = $ts if $ts > $m; - } - $o = $e; - } +sub insert_zero { + my($s,$c) = (0,shift); + $_ ? ( $c-= $s>2 && int(($s-1)/2), $s=0 ) : $s++ for @_,1; + $c>0?0:1; } -sub collect_fast { - return 0 unless @_; - my %f; - $m=0; - $f{$_}++ for @_; ## compute freq - $_>$m && ( $m=$_ ) for values %f; ## find largest - $m = $m*$m + @_-$m; ## Compute minimum-maximum - ## square of max freq - - ## count of remaining - _collect_fast(0,@_); ## Now do the real work - $m ## Return max (global variable) +sub insert_zero_simultaneous { + my($s,$c) = (0,shift); + $_ ? ( $c-= $s>2 && $s-2, $s=0 ) : $s++ for @_,1; + $c>0?0:1 } ``` -- cgit From 1f855572495837fbca94dda5f64741a3473d6f1b Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 1 May 2023 12:29:56 +0100 Subject: Create ch-1.pl --- challenge-215/james-smith/perl/ch-1.pl | 36 ++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 challenge-215/james-smith/perl/ch-1.pl diff --git a/challenge-215/james-smith/perl/ch-1.pl b/challenge-215/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..cf18bf5ca0 --- /dev/null +++ b/challenge-215/james-smith/perl/ch-1.pl @@ -0,0 +1,36 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; + +my @TESTS = ( + [ ['abc', 'xyz', 'tsu'], 1 ], + [ ['rat', 'cab', 'dad'], 3 ], + [ ['baa', 'ill', 'zzy', 'abc' ], 0 ], + [ ['x', 'y', 'z'], 0 ] +); + +my @TESTS2 = ( + [ [ 1, [1,0,0,0,1] ], 1 ], + [ [ 2, [1,0,0,0,1] ], 0 ], + [ [ 3, [1,0,0,0,0,0,0,0,1] ], 1 ], + [ [ 3, [1,0,0,0,0,0,0,0] ], 1], +); + +sub non_alpha { + my $c = 0; + return 0 if length $_[0] <3; + for(@_) { + my($f,$s,@rest)=split//;say $_; + $f = $f cmp $s; + ($s ne $_) && ($f ||= $s cmp $_) != ($s cmp $_) + ? ($c++,last) + : ($s=$_) for @rest; + } + $c +} + +is( non_alpha( @{$_->[0]} ), $_->[1] ) for @TESTS; +done_testing(); -- cgit From e008af14ea1b656efae1003a21fb8a760c4af78e Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 1 May 2023 12:30:28 +0100 Subject: Create ch-2.pl --- challenge-215/james-smith/perl/ch-2.pl | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 challenge-215/james-smith/perl/ch-2.pl diff --git a/challenge-215/james-smith/perl/ch-2.pl b/challenge-215/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..f01950dbd8 --- /dev/null +++ b/challenge-215/james-smith/perl/ch-2.pl @@ -0,0 +1,30 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; + +my @TESTS = ( + [ [ 1, [1,0,0,0,1] ], 1 ], + [ [ 2, [1,0,0,0,1] ], 0 ], + [ [ 3, [1,0,0,0,0,0,0,0,1] ], 1 ], + [ [ 3, [1,0,0,0,0,0,0,0] ], 1], +); + +sub insert_zero { + my($s,$c) = (0,shift); + $_ ? ( $c-= $s>2 && int( ($s-1)/2 ), $s=0 ) : $s++ for @_,1; + $c>0?0:1; +} + +sub insert_zero_simultaneous { + my($s,$c) = (0,shift); + $_ ? ( $c-= $s>2 && $s-2, $s=0 ) : $s++ for @_,1; + $c>0?0:1 +} + +is( insert_zero( $_->[0][0], @{$_->[0][1]} ), $_->[1] ) for @TESTS; +is( insert_zero_simultaneous( $_->[0][0], @{$_->[0][1]} ), $_->[1] ) for @TESTS; + +done_testing(); -- cgit From f61b48ddd1152f71a87316b1e98944a5b6222545 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 1 May 2023 12:31:00 +0100 Subject: Create blog.txt --- challenge-215/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-215/james-smith/blog.txt diff --git a/challenge-215/james-smith/blog.txt b/challenge-215/james-smith/blog.txt new file mode 100644 index 0000000000..3075c4480e --- /dev/null +++ b/challenge-215/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-215/james-smith/blog.txt -- cgit From 35a99f991daa099dd4b2b58e83736752ee4d0cf0 Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 1 May 2023 12:01:02 +0000 Subject: w215 - Task 1 & 2 --- challenge-215/perlboy1967/perl/ch1.pl | 35 ++++++++++++++++++++++++++++++ challenge-215/perlboy1967/perl/ch2.pl | 41 +++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100755 challenge-215/perlboy1967/perl/ch1.pl create mode 100755 challenge-215/perlboy1967/perl/ch2.pl diff --git a/challenge-215/perlboy1967/perl/ch1.pl b/challenge-215/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..e89225cda1 --- /dev/null +++ b/challenge-215/perlboy1967/perl/ch1.pl @@ -0,0 +1,35 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 215 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Odd one Out +Submitted by: Mohammad S Anwar + +You are given a list of words (alphabetic characters only) of same size. + +Write a script to remove all words not sorted alphabetically and print the number +of words in the list that are not alphabetically sorted. + +=cut + +use v5.16; + +use common::sense; + +use Test::More; + +sub oddOneOut { + grep { $_ ne join '',sort split //,$_ } @_; +} + +is(oddOneOut('abc','xyz','tsu'),1); +is(oddOneOut('rat','cab','dad'),3); +is(oddOneOut('x','y','z'),0); +is(oddOneOut('cd','add','loop'),0); + +done_testing; diff --git a/challenge-215/perlboy1967/perl/ch2.pl b/challenge-215/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..45f60ba88d --- /dev/null +++ b/challenge-215/perlboy1967/perl/ch2.pl @@ -0,0 +1,41 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 215 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 + +Task 2: Number Placement +Submitted by: Mohammad S Anwar + +You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). + +Write a script to find out if it is possible to replace 0 with 1 in the given list. The only +condition is that you can only replace when there is no 1 on either side. Print 1 if it is +possible otherwise 0. + +=cut + +use v5.16; + +use common::sense; + +use Test::More; + +sub numberPlacement ($@) { + my ($n,$s) = (shift @_,join '',@_); + + $n-- while ($s =~ s#000#010#); + + $n == 0 ? 1 : 0; +} + +is(numberPlacement(1,1,0,0,0,1),1); +is(numberPlacement(2,1,0,0,0,1),0); +is(numberPlacement(3,1,0,0,0,0,0,0,0,1),1); +is(numberPlacement(1),0); +is(numberPlacement(1,0),0); +is(numberPlacement(1,0,0),0); +is(numberPlacement(1,0,0,0),1); + +done_testing; -- cgit From f4adf3185025eae906e2c9b33e8e016e2393b6ee Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 1 May 2023 12:08:27 +0000 Subject: Task 2 - Minor optimization --- challenge-215/perlboy1967/perl/ch2.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/challenge-215/perlboy1967/perl/ch2.pl b/challenge-215/perlboy1967/perl/ch2.pl index 45f60ba88d..f75a0f18e4 100755 --- a/challenge-215/perlboy1967/perl/ch2.pl +++ b/challenge-215/perlboy1967/perl/ch2.pl @@ -25,7 +25,7 @@ use Test::More; sub numberPlacement ($@) { my ($n,$s) = (shift @_,join '',@_); - $n-- while ($s =~ s#000#010#); + $n-- while ($n and $s =~ s#000#010#); $n == 0 ? 1 : 0; } @@ -33,6 +33,7 @@ sub numberPlacement ($@) { is(numberPlacement(1,1,0,0,0,1),1); is(numberPlacement(2,1,0,0,0,1),0); is(numberPlacement(3,1,0,0,0,0,0,0,0,1),1); +is(numberPlacement(0),1); is(numberPlacement(1),0); is(numberPlacement(1,0),0); is(numberPlacement(1,0,0),0); -- cgit From 2561b1ab51d2f5dad96afd46d55d90b51f1d7c0c Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 1 May 2023 13:14:42 +0000 Subject: Task 2 - Optimize using pos() --- challenge-215/perlboy1967/perl/ch2.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-215/perlboy1967/perl/ch2.pl b/challenge-215/perlboy1967/perl/ch2.pl index f75a0f18e4..f96be14650 100755 --- a/challenge-215/perlboy1967/perl/ch2.pl +++ b/challenge-215/perlboy1967/perl/ch2.pl @@ -24,8 +24,8 @@ use Test::More; sub numberPlacement ($@) { my ($n,$s) = (shift @_,join '',@_); - - $n-- while ($n and $s =~ s#000#010#); + + while ($n and $s =~ m#000#g) { $n--; pos($s)-- } $n == 0 ? 1 : 0; } -- cgit From 8b8f9a276446f9a6cf710bedbbaa16f4da36b65b Mon Sep 17 00:00:00 2001 From: Peter Campbell Smith Date: Mon, 1 May 2023 14:18:48 +0100 Subject: Week 215 submissions --- challenge-215/peter-campbell-smith/blog.txt | 1 + challenge-215/peter-campbell-smith/perl/ch-1.pl | 25 ++++++++++++++++++++++ challenge-215/peter-campbell-smith/perl/ch-2.pl | 28 +++++++++++++++++++++++++ 3 files changed, 54 insertions(+) create mode 100644 challenge-215/peter-campbell-smith/blog.txt create mode 100755 challenge-215/peter-campbell-smith/perl/ch-1.pl create mode 100755 challenge-215/peter-campbell-smith/perl/ch-2.pl diff --git a/challenge-215/peter-campbell-smith/blog.txt b/challenge-215/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..7cdb832f79 --- /dev/null +++ b/challenge-215/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/215 diff --git a/challenge-215/peter-campbell-smith/perl/ch-1.pl b/challenge-215/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..605d8dd561 --- /dev/null +++ b/challenge-215/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-05-01 +use utf8; # Week 215 task 1 - Odd one out +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +odd_one_out('abc', 'xyz', 'tsu'); +odd_one_out('rat', 'cab', 'dad'); +odd_one_out('x', 'y', 'z'); +odd_one_out('hippy', 'afoot', 'in', 'chilly', 'abbey'); +odd_one_out('write', 'a', 'script', 'to', 'remove', 'all', 'words', 'not', 'sorted', 'alphabetically'); +odd_one_out('abc', 'aBc', 'abC', 'bcA'); + +sub odd_one_out { + + my ($word, $count); + + $count = 0; + for $word (@_) { + $count ++ if lc($word) ne join('', sort split('', lc($word))); + } + say qq[\nInput: \@words = ('] . join(q[', '], @_) . q[')]; + say qq[Output: $count]; +} \ No newline at end of file diff --git a/challenge-215/peter-campbell-smith/perl/ch-2.pl b/challenge-215/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..149cba84e7 --- /dev/null +++ b/challenge-215/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,28 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-05-01 +use utf8; # Week 215 task 2 - Number placement +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +number_placement([1, 0, 0, 0, 1], 1); +number_placement([1, 0, 0, 0, 1], 2); +number_placement([0, 0, 1, 0, 0, 0, 1, 0, 0], 3); + +sub number_placement { + + my (@numbers, $count, $string, $j, $done); + + @numbers = @{$_[0]}; + $count = $_[1]; + + $string = join('', @numbers); + for $j (1 .. $count) { + $done ++ if ($string =~ s|000|010| or + $string =~ s|^00|10| or $string =~ s|00$|01|); + } + say qq[\nInput: \@numbers = (] . join(', ', @numbers) . + qq[), \$count = $count]; + say qq[Output: ] . ($done == $count ? 1 : 0); + +} \ No newline at end of file -- cgit From cd86d4b94a21f341a721d4ca702caf2c63c07063 Mon Sep 17 00:00:00 2001 From: Carlos Eduardo de Oliveira Date: Mon, 1 May 2023 11:34:15 -0300 Subject: solution to challenge 215 --- challenge-215/carlos-oliveira/perl/ch-1.pl | 20 +++++++++++++++++++ challenge-215/carlos-oliveira/perl/ch-2.pl | 31 ++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+) create mode 100644 challenge-215/carlos-oliveira/perl/ch-1.pl create mode 100644 challenge-215/carlos-oliveira/perl/ch-2.pl diff --git a/challenge-215/carlos-oliveira/perl/ch-1.pl b/challenge-215/carlos-oliveira/perl/ch-1.pl new file mode 100644 index 0000000000..6ad2db904e --- /dev/null +++ b/challenge-215/carlos-oliveira/perl/ch-1.pl @@ -0,0 +1,20 @@ +use strict; +use warnings; +use v5.36; + +use Test::More; + +sub out_with_the_odds ($words) { + my $original_size = @$words; + @$words = grep { + my @letters = sort split //, $_; + join('', @letters) eq $_; + } @$words; + return $original_size - @$words; +} + +is out_with_the_odds(['abc', 'xyz', 'tsu']), 1; +is out_with_the_odds(['rat', 'cab', 'dad']), 3; +is out_with_the_odds(['x', 'y', 'z']), 0; + +done_testing; diff --git a/challenge-215/carlos-oliveira/perl/ch-2.pl b/challenge-215/carlos-oliveira/perl/ch-2.pl new file mode 100644 index 0000000000..8f6f3a7c05 --- /dev/null +++ b/challenge-215/carlos-oliveira/perl/ch-2.pl @@ -0,0 +1,31 @@ +use strict; +use warnings; +use v5.36; +use builtin qw(true false); + +use Test::More; +use List::Util qw(all); + +sub place_ones ($placement_total, $numbers) { + my @numbers = @$numbers; + my $placement_count = 0; + my $interval = 2; + for ( + my $i = 0; + $i < @numbers - $interval && $placement_count < $placement_total; + $i++ + ) { + next unless all { $_ == 0 } @numbers[$i .. $i+$interval]; + $placement_count++; + # skip a number since the middle of this interval will be replaced with "1" + $i++; + } + return $placement_count == $placement_total; +} + +is place_ones(1, [1,0,0,0,1]), true; +is place_ones(2, [1,0,0,0,1]), false; +is place_ones(3, [1,0,0,0,0,0,0,0,1]), true; +is place_ones(4, [1,0,0,0,0,0,0,0,1]), false; + +done_testing; -- cgit From 19091e77f2aec8c216d330f6fa3ae967ab2b00bf Mon Sep 17 00:00:00 2001 From: David Ferrone Date: Mon, 1 May 2023 14:28:52 -0400 Subject: Week 215 --- challenge-215/zapwai/perl/ch-1.pl | 19 +++++++++++++++++++ challenge-215/zapwai/perl/ch-2.pl | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 challenge-215/zapwai/perl/ch-1.pl create mode 100644 challenge-215/zapwai/perl/ch-2.pl diff --git a/challenge-215/zapwai/perl/ch-1.pl b/challenge-215/zapwai/perl/ch-1.pl new file mode 100644 index 0000000000..4dee7fa3fc --- /dev/null +++ b/challenge-215/zapwai/perl/ch-1.pl @@ -0,0 +1,19 @@ +use v5.30.0; +my @words = ('abc', 'xyz', 'cab'); +my $count = 0; +my $output; +say "Input: \@words = @words"; +print "Output: "; +is_alph($_) foreach (@words); +say $count; +say $output . "can be removed." if ($output); +sub is_alph { + my $word = shift; + my @let = split("",$word); + foreach (0 .. $#let - 1) { + if ($let[$_] gt $let[$_ + 1]) { + $count++ ; + $output .= $word . " "; + } + } +} diff --git a/challenge-215/zapwai/perl/ch-2.pl b/challenge-215/zapwai/perl/ch-2.pl new file mode 100644 index 0000000000..4b1ec36e45 --- /dev/null +++ b/challenge-215/zapwai/perl/ch-2.pl @@ -0,0 +1,39 @@ +use v5.30.0; +my @numbers = (1,0,0,0,1); +my $count = 1; +say "Input: \@numbers = (" . join(",", @numbers) . "), \$count = $count"; +print "Output: "; +sub spaces { + my $n = shift; + return 0 if ($n < 0); + if ($n % 2 == 0) { + ($n - 2) / 2 + } else { + ($n - 1) / 2 + } +} + +my $land; +my $water; +my $length = 0; +my $total; +foreach (0 .. $#numbers) { + if ($numbers[$_] != '0') { + $land = 1; + if ($water) { + $total += spaces($length); + $water = 0; + } + + } else { + $length++; + if ($land) { + $land = 0; + $water = 1; + } + } +} + +my $ans = ($count <= $total) || 0; +say $ans; +say "There is room for $total placements."; -- cgit From c0b6e4278f3602c009e3562b1b5a146c73e1a312 Mon Sep 17 00:00:00 2001 From: Thomas Köhler Date: Mon, 1 May 2023 21:19:48 +0200 Subject: Add solution 215 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Thomas Köhler --- challenge-215/jeanluc2020/blog-1.txt | 1 + challenge-215/jeanluc2020/blog-2.txt | 1 + challenge-215/jeanluc2020/perl/ch-1.pl | 70 ++++++++++++++++++++ challenge-215/jeanluc2020/perl/ch-2.pl | 117 +++++++++++++++++++++++++++++++++ 4 files changed, 189 insertions(+) create mode 100644 challenge-215/jeanluc2020/blog-1.txt create mode 100644 challenge-215/jeanluc2020/blog-2.txt create mode 100755 challenge-215/jeanluc2020/perl/ch-1.pl create mode 100755 challenge-215/jeanluc2020/perl/ch-2.pl diff --git a/challenge-215/jeanluc2020/blog-1.txt b/challenge-215/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..1cd27ff2eb --- /dev/null +++ b/challenge-215/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-215-1.html diff --git a/challenge-215/jeanluc2020/blog-2.txt b/challenge-215/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..5e02beed19 --- /dev/null +++ b/challenge-215/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-215-2.html diff --git a/challenge-215/jeanluc2020/perl/ch-1.pl b/challenge-215/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..e7db19a229 --- /dev/null +++ b/challenge-215/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,70 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-215/#TASK1 +# +# Task 1: Odd one Out +# =================== +# +# You are given a list of words (alphabetic characters only) of same size. +# +# Write a script to remove all words not sorted alphabetically and print the +# number of words in the list that are not alphabetically sorted. +# +## Example 1 +## +## Input: @words = ('abc', 'xyz', 'tsu') +## Output: 1 +## +## The words 'abc' and 'xyz' are sorted and can't be removed. +## The word 'tsu' is not sorted and hence can be removed. +# +## Example 2 +## +## Input: @words = ('rat', 'cab', 'dad') +## Output: 3 +## +## None of the words in the given list are sorted. +## Therefore all three needs to be removed. +# +## Example 3 +## +## Input: @words = ('x', 'y', 'z') +## Output: 0 +# +############################################################ +## +## discussion +## +############################################################ +# +# We look at each word in the list. If it's sorted, we keep it. +# At the end, the amount of removed words is the difference +# in length of the original list and the "keep" list. + +use strict; +use warnings; + +odd_one_out('abc', 'xyz', 'tsu'); +odd_one_out('rat', 'cab', 'dad'); +odd_one_out('x', 'y', 'z'); + +sub odd_one_out { + my @words = @_; + print "Input: (" . join(",", @words) . ")\n"; + my @keep = (); + foreach my $word (@words) { + push @keep, $word if is_sorted($word); + } + my $removed = scalar(@words) - scalar(@keep); + print "Output: $removed\n"; +} + +# a word is sorted if it is the same after sorting +# all of its characters, so we split each word into +# its characters, sort them, and join them back into +# a word again +sub is_sorted { + my $word = shift; + my $sorted_word = join("", sort(split //, $word)); + return $word eq $sorted_word; +} + diff --git a/challenge-215/jeanluc2020/perl/ch-2.pl b/challenge-215/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..ee0da2108b --- /dev/null +++ b/challenge-215/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,117 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-215/#TASK2 +# +# Task 2: Number Placement +# ======================== +# +# You are given a list of numbers having just 0 and 1. You are also +# given placement count (>=1). +# +# Write a script to find out if it is possible to replace 0 with 1 +# in the given list. The only condition is that you can only replace +# when there is no 1 on either side. Print 1 if it is possible +# otherwise 0. +# +## Example 1: +## +## Input: @numbers = (1,0,0,0,1), $count = 1 +## Output: 1 +## +## You are asked to replace only one 0 as given count is 1. +## We can easily replace middle 0 in the list i.e. (1,0,1,0,1). +# +## Example 2: +## +## Input: @numbers = (1,0,0,0,1), $count = 2 +## Output: 0 +## +## You are asked to replace two 0's as given count is 2. +## It is impossible to replace two 0's. +# +## Example 3: +## +## Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3 +## Output: 1 +# +############################################################ +## +## discussion +## +############################################################ +# +# So, if we can replace $count 0's with 1's, we should print 1, +# otherwise 0. number_placement() will do that, calling the +# can_replace() function to check the possibility. +# can_replace() replaces one 0 with a 1 via the replace() function, +# and if that worked, calls itself recursively with the new array +# and $count - 1. +# replace() short-circuits its execution by replacing the first +# possible 0 that can be replaced and then returning the resulting +# new array, leaving everything else for the recursive calls of the +# can_replace() function and subsequent replace() calls + +use strict; +use warnings; + +number_placement( [1,0,0,0,1], 1); +number_placement( [1,0,0,0,1], 2); +number_placement( [1,0,0,0,0,0,0,0,1], 3); + +sub number_placement { + my ($numbers, $count) = @_; + print "Input: (" . join(",", @$numbers), "), $count\n"; + die "Illegal count" unless $count > 0; + print "Output: "; + if(can_replace($numbers, $count)) { + print "1\n"; + } else { + print "0\n"; + } +} + +sub can_replace { + my ($numbers, $count) = @_; + return 1 unless $count; # nothing left to do, all replacements done + my $new_numbers = replace($numbers); + if($new_numbers) { + return can_replace($new_numbers, $count - 1); + } + return 0; +} + +# replace one 0 with a 1 in the given array. +# We do this by finding the first 0 that we can +# replace. Once that is replaced, we return the +# new array with the replacement in place. If we +# can't replace a 0 with a 1, we return undef +# to signal this fact +sub replace { + my $numbers = shift; + my $new_numbers = [ @$numbers ]; + my $last_idx = scalar(@$numbers) - 1; + foreach my $i (0..$last_idx) { + my $can_replace = 0; + if($numbers->[$i] == 0) { + $can_replace = 1; + if($i > 0) { + if($numbers->[$i-1] == 0) { + $can_replace = 1; + } else { + $can_replace = 0; + } + } + if($i < $last_idx && $can_replace) { + if($numbers->[$i+1] == 0) { + $can_replace = 1; + } else { + $can_replace = 0; + } + } + if($can_replace) { + $new_numbers->[$i] = 1; + return $new_numbers; + } + } + } + return undef; +} -- cgit From dd95a52513c3e127588be0a077347ad8cd9f9882 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Sun, 30 Apr 2023 21:20:03 +0200 Subject: Challenge 145 task 1 --- challenge-145/jo-37/perl/ch-1.pl | 55 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100755 challenge-145/jo-37/perl/ch-1.pl diff --git a/challenge-145/jo-37/perl/ch-1.pl b/challenge-145/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..220093fa67 --- /dev/null +++ b/challenge-145/jo-37/perl/ch-1.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0 '!float'; +use PDL; +use experimental 'signatures'; + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <dummy(0))->sclr; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is dot_product([1, 2, 3], [4, 5, 6]), 32, 'example'; + } + + SKIP: { + skip "tests" unless $tests; + } + + done_testing; + exit; +} -- cgit From 360dd21eeecc7276b8fa0c6dd7dc4412fe3eeb96 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Sun, 30 Apr 2023 23:16:29 +0200 Subject: Challenge 146 task 2 --- challenge-146/jo-37/perl/ch-2.pl | 69 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100755 challenge-146/jo-37/perl/ch-2.pl diff --git a/challenge-146/jo-37/perl/ch-2.pl b/challenge-146/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..aedafe7fdd --- /dev/null +++ b/challenge-146/jo-37/perl/ch-2.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0; +use experimental 'signatures'; + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <@*); + local $, = ' '; + say map {join '/', @$_} @parents; +} + + +### Implementation + +# The child nodes are made from the parent's +# - numerator and numerator + denominator +# - numerator + denominator and denominator +# In reverse, the parent depends on the order of the child's denominator +# and numerator and may be reconstructed easily. +sub curious_parent ($d, $n) { + $d < $n ? [$d, $n - $d] : [$d - $n, $n]; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + my $parent = curious_parent(3, 5); + is $parent, [3, 2], 'example 1 parent'; + is curious_parent(@$parent), [1, 2], 'example 1 grandparent'; + + $parent = curious_parent(4, 3); + is $parent, [1, 3], 'example 2 parent'; + is curious_parent(@$parent), [1, 2], 'example 2 grandparent'; + } + + SKIP: { + skip "tests" unless $tests; + } + + done_testing; + exit; +} -- cgit From 24fbfdf83065251a1280a215b98ee37703c0c9a0 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 1 May 2023 17:13:09 +0200 Subject: Challenge 147 task 1 --- challenge-147/jo-37/perl/ch-1.pl | 70 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100755 challenge-147/jo-37/perl/ch-1.pl diff --git a/challenge-147/jo-37/perl/ch-1.pl b/challenge-147/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..bef3fd8a26 --- /dev/null +++ b/challenge-147/jo-37/perl/ch-1.pl @@ -0,0 +1,70 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0; +use warnings FATAL => 'all'; +use Math::Prime::Util qw(fromdigits todigits is_prime); +use Data::Dump qw(dd pp); +use experimental 'signatures'; + +our ($tests, $examples, $base); +$base ||= 10; + +run_tests() if $tests || $examples; # does not return + +die < Date: Mon, 1 May 2023 22:15:04 +0200 Subject: cleanup --- challenge-147/jo-37/perl/ch-1.pl | 2 -- 1 file changed, 2 deletions(-) diff --git a/challenge-147/jo-37/perl/ch-1.pl b/challenge-147/jo-37/perl/ch-1.pl index bef3fd8a26..674a46beff 100755 --- a/challenge-147/jo-37/perl/ch-1.pl +++ b/challenge-147/jo-37/perl/ch-1.pl @@ -2,9 +2,7 @@ use v5.24; use Test2::V0; -use warnings FATAL => 'all'; use Math::Prime::Util qw(fromdigits todigits is_prime); -use Data::Dump qw(dd pp); use experimental 'signatures'; our ($tests, $examples, $base); -- cgit From 6fe30982ea29f09a1d01c69d5c4fa791b53f96cd Mon Sep 17 00:00:00 2001 From: "E. Choroba" Date: Mon, 1 May 2023 23:31:39 +0200 Subject: Add solutions to 215: Odd one Out & Number Placement by E. Choroba --- challenge-215/e-choroba/perl/ch-1.pl | 18 ++++++++++++++++++ challenge-215/e-choroba/perl/ch-2.pl | 16 ++++++++++++++++ 2 files changed, 34 insertions(+) create mode 100755 challenge-215/e-choroba/perl/ch-1.pl create mode 100755 challenge-215/e-choroba/perl/ch-2.pl diff --git a/challenge-215/e-choroba/perl/ch-1.pl b/challenge-215/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..6aaa049639 --- /dev/null +++ b/challenge-215/e-choroba/perl/ch-1.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub odd_one_out(@words) { + scalar grep { + my $word = $_; + grep substr($word, $_ - 2, 1) gt substr($word, $_ - 1, 1), + 2 .. length $word + } @words +} + +use Test::More tests => 3; + +is odd_one_out('abc', 'xyz', 'tsu'), 1, 'Example 1'; +is odd_one_out('rat', 'cab', 'dad'), 3, 'Example 2'; +is odd_one_out('x', 'y', 'z'), 0, 'Example 3'; diff --git a/challenge-215/e-choroba/perl/ch-2.pl b/challenge-215/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..3d90d73307 --- /dev/null +++ b/challenge-215/e-choroba/perl/ch-2.pl @@ -0,0 +1,16 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub number_placement($list, $count) { + (() = "@$list" =~ /0 0(?= 0)/g) >= $count ? 1 : 0 +} + +use Test::More tests => 3 + 1; +is number_placement([1, 0, 0, 0, 1], 1), 1, 'Example 1'; +is number_placement([1, 0, 0, 0, 1], 2), 0, 'Example 2'; +is number_placement([1, 0, 0, 0, 0, 0, 0, 0, 1], 3), 1, 'Example 3'; + +# Why /0(?= 0 0)/ is wrong: +is number_placement([1, 0, 0, 0, 0, 0, 0, 1], 3), 0, 'Edge case'; -- cgit From 448069bf4361bbb59a9036e21fedc8e233b82837 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Mon, 1 May 2023 19:16:37 -0600 Subject: Solve PWC215 --- challenge-215/wlmb/blog.txt | 2 ++ challenge-215/wlmb/perl/ch-1.pl | 11 +++++++++++ challenge-215/wlmb/perl/ch-2.pl | 21 +++++++++++++++++++++ 3 files changed, 34 insertions(+) create mode 100644 challenge-215/wlmb/blog.txt create mode 100755 challenge-215/wlmb/perl/ch-1.pl create mode 100755 challenge-215/wlmb/perl/ch-2.pl diff --git a/challenge-215/wlmb/blog.txt b/challenge-215/wlmb/blog.txt new file mode 100644 index 0000000000..e3c5c1f96a --- /dev/null +++ b/challenge-215/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/05/01/PWC215/ + diff --git a/challenge-215/wlmb/perl/ch-1.pl b/challenge-215/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..857a09ea08 --- /dev/null +++ b/challenge-215/wlmb/perl/ch-1.pl @@ -0,0 +1,11 @@ +#!/usr/bin/env perl +# Perl weekly challenge 215 +# Task 1: Odd one Out +# +# See https://wlmb.github.io/2023/05/01/PWC215/#task-1-odd-one-out +use v5.36; +die <<~"FIN" unless @ARGV; + Usage: $0 W1 [W2...] + to count words whose letters are not sorted + FIN +say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV; diff --git a/challenge-215/wlmb/perl/ch-2.pl b/challenge-215/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..380aa5febd --- /dev/null +++ b/challenge-215/wlmb/perl/ch-2.pl @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +# Perl weekly challenge 215 +# Task 2: Number Placement +# +# See https://wlmb.github.io/2023/05/01/PWC215/#task-2-number-placement +use v5.36; +die <<~"FIN" unless @ARGV==2; + Usage: $0 N S + to find if I can replace N 1's in the string S consisting of 0's and 1's + Only 0's that don't have a 1 to their left nor right may be replaced. + FIN +my $count=shift; +my $copy=my $orig=shift; +for($copy){ # localize + die "Only 0's and 1's allowed. Invalid input: $_" unless /^[01]*$/; + s/^/0/; # add leading and trailing 0's + s/$/0/; + my $replacements=0; + $replacements++ while s/000/010/; # count replacements + say "Count: $count, string: $orig -> ", $replacements>=$count? 1:0; +} -- cgit From 3f928391e6f2ec77a88d2bf5109e196712f958ab Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Tue, 2 May 2023 10:39:20 +0200 Subject: Task 1 done --- challenge-215/luca-ferrari/raku/ch-1.p6 | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 challenge-215/luca-ferrari/raku/ch-1.p6 diff --git a/challenge-215/luca-ferrari/raku/ch-1.p6 b/challenge-215/luca-ferrari/raku/ch-1.p6 new file mode 100644 index 0000000000..b07ae596b0 --- /dev/null +++ b/challenge-215/luca-ferrari/raku/ch-1.p6 @@ -0,0 +1,13 @@ +#!raku + +# +# Perl Weekly Challenge 215 +# Task 1 +# +# See +# + +sub MAIN( *@words where { @words.grep( * ~~ / ^ <[a..zA..Z]>+ $ / ).elems == @words.elems } ) { + + say ( @words.elems - @words.grep( { $_ ~~ $_.comb.sort.join } ).elems ); +} -- cgit From 83bd69b92aeb695617190c4a9325c0b9134b42fa Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Tue, 2 May 2023 10:49:12 +0200 Subject: Task 2 done --- challenge-215/luca-ferrari/raku/ch-2.p6 | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 challenge-215/luca-ferrari/raku/ch-2.p6 diff --git a/challenge-215/luca-ferrari/raku/ch-2.p6 b/challenge-215/luca-ferrari/raku/ch-2.p6 new file mode 100644 index 0000000000..0394342968 --- /dev/null +++ b/challenge-215/luca-ferrari/raku/ch-2.p6 @@ -0,0 +1,29 @@ +#!raku + +# +# Perl Weekly Challenge 215 +# Task 2 +# +# See +# + +sub MAIN( :$count is copy where { $count >= 0 } , + *@digits is copy where { @digits.grep( 0 <= *.Int <= 1 ).elems == @digits.elems } ) { + + my $done = False; + while $count { + $done = False; + for 1 ..^ @digits.elems - 1 { + if ( @digits[ $_ ] == 0 && @digits[ $_ - 1 ] == 0 && @digits[ $_ + 1 ] == 0 ) { + @digits[ $_ ] = 1; + $count--; + $done = True; + } + } + + '0'.say and exit if ! $done; + } + + '1'.say and exit if ! $count; + '0'.say; +} -- cgit From c92cb1c1af10625442e0070399f06c01f98b2e8f Mon Sep 17 00:00:00 2001 From: dcw Date: Tue, 2 May 2023 09:55:01 +0100 Subject: belatedly completed the C translation of task 2 (challenge 214) --- challenge-214/duncan-c-white/C/.cbuild | 2 +- challenge-214/duncan-c-white/C/Makefile | 4 +- challenge-214/duncan-c-white/C/README | 2 +- challenge-214/duncan-c-white/C/ch-2.c | 159 ++++++++++++++++++++++++++++++ challenge-214/duncan-c-white/README | 5 +- challenge-214/duncan-c-white/perl/ch-2.pl | 9 +- 6 files changed, 170 insertions(+), 11 deletions(-) create mode 100644 challenge-214/duncan-c-white/C/ch-2.c diff --git a/challenge-214/duncan-c-white/C/.cbuild b/challenge-214/duncan-c-white/C/.cbuild index 835981f6f1..c168e34403 100644 --- a/challenge-214/duncan-c-white/C/.cbuild +++ b/challenge-214/duncan-c-white/C/.cbuild @@ -1,5 +1,5 @@ BUILD = ch-1 ch-2 -BUILD = ch-1 +#BUILD = ch-1 CFLAGS = -Wall -g #LDFLAGS = -lm #CFLAGS = -g diff --git a/challenge-214/duncan-c-white/C/Makefile b/challenge-214/duncan-c-white/C/Makefile index 3a6ebb224c..6ac7c0c23c 100644 --- a/challenge-214/duncan-c-white/C/Makefile +++ b/challenge-214/duncan-c-white/C/Makefile @@ -1,7 +1,7 @@ # Makefile rules generated by CB CC = gcc CFLAGS = -Wall -g -BUILD = ch-1 +BUILD = ch-1 ch-2 all: $(BUILD) @@ -11,6 +11,8 @@ clean: args.o: args.c ch-1: ch-1.o args.o parseints.o printarray.o rank.o ch-1.o: ch-1.c args.h parseints.h printarray.h rank.h +ch-2: ch-2.o args.o parseints.o printarray.o +ch-2.o: ch-2.c args.h parseints.h printarray.h parseints.o: parseints.c args.h parseints.h printarray.h printarray.o: printarray.c rank.o: rank.c rank.h diff --git a/challenge-214/duncan-c-white/C/README b/challenge-214/duncan-c-white/C/README index ba67141dfe..70410cd471 100644 --- a/challenge-214/duncan-c-white/C/README +++ b/challenge-214/duncan-c-white/C/README @@ -1,4 +1,4 @@ -Thought I'd also have a go at translating ch-1.pl and ch-2.pl (coming soon) into C.. +Thought I'd also have a go at translating ch-1.pl and ch-2.pl into C.. Both C versions produce very similar (non-debugging and debugging) output to the Perl originals. diff --git a/challenge-214/duncan-c-white/C/ch-2.c b/challenge-214/duncan-c-white/C/ch-2.c new file mode 100644 index 0000000000..4671058c9a --- /dev/null +++ b/challenge-214/duncan-c-white/C/ch-2.c @@ -0,0 +1,159 @@ +// Task 2: Collect Points +// +// C translation + +#include +#include +#include +#include +#include +#include + +#include "args.h" +#include "parseints.h" +#include "printarray.h" + + +typedef struct { int startpos, len; } pair; + + +// +// pair moves[nel]; +// int nmoves = all_possible_first_moves( list, nel, moves ); +// Find all possible first (immediate) moves - each move being +// a (startpos,len) pairs - and store them into moves[nel] +// and then return the number of moves found. +// +int all_possible_first_moves( int *list, int nel, pair *moves ) +{ + int nmoves = 0; + int pos = 0; + pair *mp = moves; + do + { + int currval = list[pos]; + int len = 0; + int startpos; + for( startpos=pos; pos < nel && list[pos]==currval; pos++ ) + { + len++; + } + mp->startpos = startpos; + mp->len = len; + nmoves++; + mp++; + } while( pos < nel ); + return nmoves; +} + + +int bestsc; +char bestmoves[1024]; + + +// +// find_all( currsc, currmoves, list, nel ); +// Find all possible sequences of moves removing item-sequences +// from list[nel], given that the current score to this point is currsc, +// and the current move string to this point is currmoves, and +// track the best (highest scoring) move sequence in bestsc & bestmoves +// +void find_all( int currsc, char *currmoves, int *list, int nel ) +{ + if( nel == 0 ) + { + if( debug ) + { + printf( "debug: found solution, currsc=%d, bestsc=%d\n", + currsc, bestsc ); + } + if( currsc > bestsc ) + { + bestsc = currsc; + strcpy( bestmoves, currmoves ); + if( debug ) + { + printf( "debug: found new best, bestsc=%d, " + "bestmoves=%s\n", bestsc, bestmoves ); + } + } + return; + } + + pair moves[nel]; + int nmoves = all_possible_first_moves( list, nel, moves ); + + for( int m=0; m Date: Tue, 2 May 2023 11:19:33 +0200 Subject: Task 1 plperl done --- challenge-215/luca-ferrari/postgresql/ch-1.plperl | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 challenge-215/luca-ferrari/postgresql/ch-1.plperl diff --git a/challenge-215/luca-ferrari/postgresql/ch-1.plperl b/challenge-215/luca-ferrari/postgresql/ch-1.plperl new file mode 100644 index 0000000000..c131788df4 --- /dev/null +++ b/challenge-215/luca-ferrari/postgresql/ch-1.plperl @@ -0,0 +1,20 @@ +-- +-- Perl Weekly Challenge 215 +-- Task 1 +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc215; + +CREATE OR REPLACE FUNCTION +pwc215.task1_plperl( text[] ) +RETURNS SETOF text +AS $CODE$ + my ( $words ) = @_; + for ( $words->@* ) { + return_next( $_ ) if ( $_ eq join( '', sort( split( //, $_ ) ) ) ); + } + +return undef; +$CODE$ +LANGUAGE plperl; -- cgit From 30c20702df85ea5c5c9470634fedbeb954360884 Mon Sep 17 00:00:00 2001 From: Mohammad S Anwar Date: Tue, 2 May 2023 10:38:05 +0100 Subject: - Added solutions by James Smith. - Added solutions by Niels van Dijke. - Added solutions by Peter Campbell Smith. - Added solutions by Carlos Oliveira. - Added solutions by David Ferrone. - Added solutions by Thomas Kohler. - Added solutions by Jorg Sommrey. - Added solutions by E. Choroba. - Added solutions by W. Luis Mochan. --- challenge-215/perlboy1967/perl/ch-1.pl | 35 + challenge-215/perlboy1967/perl/ch-2.pl | 42 + challenge-215/perlboy1967/perl/ch1.pl | 35 - challenge-215/perlboy1967/perl/ch2.pl | 42 - stats/pwc-challenge-145.json | 321 ++-- stats/pwc-challenge-146.json | 244 +-- stats/pwc-challenge-147.json | 527 ++--- stats/pwc-current.json | 232 ++- stats/pwc-language-breakdown-summary.json | 68 +- stats/pwc-language-breakdown.json | 2986 ++++++++++++++--------------- stats/pwc-leaders.json | 814 ++++---- stats/pwc-summary-1-30.json | 42 +- stats/pwc-summary-121-150.json | 32 +- stats/pwc-summary-151-180.json | 52 +- stats/pwc-summary-181-210.json | 48 +- stats/pwc-summary-211-240.json | 116 +- stats/pwc-summary-241-270.json | 54 +- stats/pwc-summary-271-300.json | 54 +- stats/pwc-summary-31-60.json | 50 +- stats/pwc-summary-61-90.json | 112 +- stats/pwc-summary-91-120.json | 98 +- stats/pwc-summary.json | 1780 ++++++++--------- 22 files changed, 3975 insertions(+), 3809 deletions(-) create mode 100755 challenge-215/perlboy1967/perl/ch-1.pl create mode 100755 challenge-215/perlboy1967/perl/ch-2.pl delete mode 100755 challenge-215/perlboy1967/perl/ch1.pl delete mode 100755 challenge-215/perlboy1967/perl/ch2.pl diff --git a/challenge-215/perlboy1967/perl/ch-1.pl b/challenge-215/perlboy1967/perl/ch-1.pl new file mode 100755 index 0000000000..e89225cda1 --- /dev/null +++ b/challenge-215/perlboy1967/perl/ch-1.pl @@ -0,0 +1,35 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 215 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Odd one Out +Submitted by: Mohammad S Anwar + +You are given a list of words (alphabetic characters only) of same size. + +Write a script to remove all words not sorted alphabetically and print the number +of words in the list that are not alphabetically sorted. + +=cut + +use v5.16; + +use common::sense; + +use Test::More; + +sub oddOneOut { + grep { $_ ne join '',sort split //,$_ } @_; +} + +is(oddOneOut('abc','xyz','tsu'),1); +is(oddOneOut('rat','cab','dad'),3); +is(oddOneOut('x','y','z'),0); +is(oddOneOut('cd','add','loop'),0); + +done_testing; diff --git a/challenge-215/perlboy1967/perl/ch-2.pl b/challenge-215/perlboy1967/perl/ch-2.pl new file mode 100755 index 0000000000..f96be14650 --- /dev/null +++ b/challenge-215/perlboy1967/perl/ch-2.pl @@ -0,0 +1,42 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 215 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 + +Task 2: Number Placement +Submitted by: Mohammad S Anwar + +You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). + +Write a script to find out if it is possible to replace 0 with 1 in the given list. The only +condition is that you can only replace when there is no 1 on either side. Print 1 if it is +possible otherwise 0. + +=cut + +use v5.16; + +use common::sense; + +use Test::More; + +sub numberPlacement ($@) { + my ($n,$s) = (shift @_,join '',@_); + + while ($n and $s =~ m#000#g) { $n--; pos($s)-- } + + $n == 0 ? 1 : 0; +} + +is(numberPlacement(1,1,0,0,0,1),1); +is(numberPlacement(2,1,0,0,0,1),0); +is(numberPlacement(3,1,0,0,0,0,0,0,0,1),1); +is(numberPlacement(0),1); +is(numberPlacement(1),0); +is(numberPlacement(1,0),0); +is(numberPlacement(1,0,0),0); +is(numberPlacement(1,0,0,0),1); + +done_testing; diff --git a/challenge-215/perlboy1967/perl/ch1.pl b/challenge-215/perlboy1967/perl/ch1.pl deleted file mode 100755 index e89225cda1..0000000000 --- a/challenge-215/perlboy1967/perl/ch1.pl +++ /dev/null @@ -1,35 +0,0 @@ -#!/bin/perl - -=pod - -The Weekly Challenge - 215 -- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 - -Author: Niels 'PerlBoy' van Dijke - -Task 1: Odd one Out -Submitted by: Mohammad S Anwar - -You are given a list of words (alphabetic characters only) of same size. - -Write a script to remove all words not sorted alphabetically and print the number -of words in the list that are not alphabetically sorted. - -=cut - -use v5.16; - -use common::sense; - -use Test::More; - -sub oddOneOut { - grep { $_ ne join '',sort split //,$_ } @_; -} - -is(oddOneOut('abc','xyz','tsu'),1); -is(oddOneOut('rat','cab','dad'),3); -is(oddOneOut('x','y','z'),0); -is(oddOneOut('cd','add','loop'),0); - -done_testing; diff --git a/challenge-215/perlboy1967/perl/ch2.pl b/challenge-215/perlboy1967/perl/ch2.pl deleted file mode 100755 index f96be14650..0000000000 --- a/challenge-215/perlboy1967/perl/ch2.pl +++ /dev/null @@ -1,42 +0,0 @@ -#!/bin/perl - -=pod - -The Weekly Challenge - 215 -- https://theweeklychallenge.org/blog/perl-weekly-challenge-215 - -Task 2: Number Placement -Submitted by: Mohammad S Anwar - -You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). - -Write a script to find out if it is possible to replace 0 with 1 in the given list. The only -condition is that you can only replace when there is no 1 on either side. Print 1 if it is -possible otherwise 0. - -=cut - -use v5.16; - -use common::sense; - -use Test::More; - -sub numberPlacement ($@) { - my ($n,$s) = (shift @_,join '',@_); - - while ($n and $s =~ m#000#g) { $n--; pos($s)-- } - - $n == 0 ? 1 : 0; -} - -is(numberPlacement(1,1,0,0,0,1),1); -is(numberPlacement(2,1,0,0,0,1),0); -is(numberPlacement(3,1,0,0,0,0,0,0,0,1),1); -is(numberPlacement(0),1); -is(numberPlacement(1),0); -is(numberPlacement(1,0),0); -is(numberPlacement(1,0,0),0); -is(numberPlacement(1,0,0,0),1); - -done_testing; diff --git a/stats/pwc-challenge-145.json b/stats/pwc-challenge-145.json index 92aab430a5..a5ddc1be8e 100644 --- a/stats/pwc-challenge-145.json +++ b/stats/pwc-challenge-145.json @@ -1,31 +1,16 @@ { - "subtitle" : { - "text" : "[Champions: 37] Last updated at 2022-01-16 10:25:50 GMT" - }, - "plotOptions" : { - "series" : { - "dataLabels" : { - "format" : "{point.y}", - "enabled" : 1 - }, - "borderWidth" : 0 - } - }, - "xAxis" : { - "type" : "category" - }, "tooltip" : { - "headerFormat" : "{series.name}
", "pointFormat" : "{point.name}: {point.y:f}
", + "headerFormat" : "{series.name}
", "followPointer" : 1 }, - "title" : { - "text" : "The Weekly Challenge - 145" + "yAxis" : { + "title" : { + "text" : "Total Solutions" + } }, "series" : [ { - "name" : "The Weekly Challenge - 145", - "colorByPoint" : 1, "data" : [ { "name" : "Abigail", @@ -33,14 +18,14 @@ "y" : 4 }, { + "drilldown" : "Adam Russell", "y" : 1, - "name" : "Adam Russell", - "drilldown" : "Adam Russell" + "name" : "Adam Russell" }, { + "drilldown" : "Alexander Pankoff", "y" : 1, - "name" : "Alexander Pankoff", - "drilldown" : "Alexander Pankoff" + "name" : "Alexander Pankoff" }, { "name" : "Andrew Shitov", @@ -53,99 +38,104 @@ "name" : "Andrezgz" }, { + "y" : 5, "drilldown" : "Arne Sommer", - "name" : "Arne Sommer", - "y" : 5 + "name" : "Arne Sommer" }, { - "name" : "Athanasius", "drilldown" : "Athanasius", - "y" : 2 + "y" : 2, + "name" : "Athanasius" }, { + "drilldown" : "Colin Crain", "y" : 3, - "name" : "Colin Crain", - "drilldown" : "Colin Crain" + "name" : "Colin Crain" }, { - "y" : 3, + "name" : "Dave Jacoby", "drilldown" : "Dave Jacoby", - "name" : "Dave Jacoby" + "y" : 3 }, { + "y" : 2, "drilldown" : "Duncan C. White", - "name" : "Duncan C. White", - "y" : 2 + "name" : "Duncan C. White" }, { + "drilldown" : "E. Choroba", "y" : 3, - "name" : "E. Choroba", - "drilldown" : "E. Choroba" + "name" : "E. Choroba" }, { - "name" : "Feng Chang", + "y" : 1, "drilldown" : "Feng Chang", - "y" : 1 + "name" : "Feng Chang" }, { - "y" : 6, "name" : "Flavio Poletti", + "y" : 6, "drilldown" : "Flavio Poletti" }, { - "name" : "Ian Goodnight", + "y" : 2, "drilldown" : "Ian Goodnight", - "y" : 2 + "name" : "Ian Goodnight" }, { - "y" : 1, "name" : "Jake", - "drilldown" : "Jake" + "drilldown" : "Jake", + "y" : 1 }, { + "y" : 5, "drilldown" : "Jaldhar H. Vyas", - "name" : "Jaldhar H. Vyas", - "y" : 5 + "name" : "Jaldhar H. Vyas" }, { - "y" : 3, "name" : "James Smith", + "y" : 3, "drilldown" : "James Smith" }, { + "drilldown" : "Jan Krnavek", "y" : 2, - "name" : "Jan Krnavek", - "drilldown" : "Jan Krnavek" + "name" : "Jan Krnavek" + }, + { + "y" : 1, + "drilldown" : "Jorg Sommrey", + "name" : "Jorg Sommrey" }, { "name" : "Laurent Rosenfeld", - "drilldown" : "Laurent Rosenfeld", - "y" : 6 + "y" : 6, + "drilldown" : "Laurent Rosenfeld" }, { - "drilldown" : "Luca Ferrari", "name" : "Luca Ferrari", + "drilldown" : "Luca Ferrari", "y" : 6 }, { "drilldown" : "Mark Anderson", - "name" : "Mark Anderson", - "y" : 1 + "y" : 1, + "name" : "Mark Anderson" }, { - "y" : 2, "name" : "Mark Senn", + "y" : 2,