From 74550468c9d1f4905cc41d187b999840116b4816 Mon Sep 17 00:00:00 2001 From: Matthias Muth Date: Sun, 16 Apr 2023 10:56:25 +0200 Subject: Challenge 212 solutions in Perl by Matthias Muth --- challenge-212/matthias-muth/README.md | 2 +- challenge-212/matthias-muth/perl/ch-1.pl | 37 ++++++++++++++++++ challenge-212/matthias-muth/perl/ch-2.pl | 64 ++++++++++++++++++++++++++++++++ 3 files changed, 102 insertions(+), 1 deletion(-) create mode 100755 challenge-212/matthias-muth/perl/ch-1.pl create mode 100755 challenge-212/matthias-muth/perl/ch-2.pl diff --git a/challenge-212/matthias-muth/README.md b/challenge-212/matthias-muth/README.md index fe15f8d3d3..92c38a2191 100644 --- a/challenge-212/matthias-muth/README.md +++ b/challenge-212/matthias-muth/README.md @@ -1,4 +1,4 @@ -**Challenge 211 solutions in Perl by Matthias Muth** +**Challenge 212 solutions in Perl by Matthias Muth**
(no blog post this time...) diff --git a/challenge-212/matthias-muth/perl/ch-1.pl b/challenge-212/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..c4585b7002 --- /dev/null +++ b/challenge-212/matthias-muth/perl/ch-1.pl @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 212 Task 1: Jumping Letters +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; + +sub jumping_letters { + my ( $word, $jump ) = @_; + + my $i = 0; + $word =~ s{([A-Z])|[a-z]}{ + my $base = ord( $1 ? 'A' : 'a' ); + chr( $base + ( ( ord( $& ) - $base ) + $jump->[$i++] ) % 26 ); + }eg; + return $word; +} + + +use Test::More; +use Data::Dump qw( pp ); + +do { + is jumping_letters( @{$_->{INPUT}} ), $_->{EXPECTED}, + "jumping_letters( " . pp( $_->{INPUT} ) . " ) == " . pp( $_->{EXPECTED} ); +} for ( + { INPUT => [ "Perl", [ 2,22,19,9 ] ], EXPECTED => "Raku" }, + { INPUT => [ "Raku", [ 24,4,7,17 ] ], EXPECTED => "Perl" }, +); + +done_testing; diff --git a/challenge-212/matthias-muth/perl/ch-2.pl b/challenge-212/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..9b5b26f2d0 --- /dev/null +++ b/challenge-212/matthias-muth/perl/ch-2.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 212 Task 2: Rearrange Groups +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; + +use Data::Dump qw( pp ); +use List::Util qw( min ); + +sub rearrange_groups { + my ( $list, $size ) = @_; + my %available; + + return -1 + if @$list % $size != 0; + + $available{$_}++ + for @$list; + + my @groups; + while ( %available ) { + push @groups, []; + my $first_element = min( keys %available ); + for ( $first_element .. $first_element + $size - 1 ) { + return -1 + unless $available{$_}; + push @{$groups[-1]}, $_; + delete $available{$_} + if --$available{$_} == 0; + } + } + return \@groups; +} + +use Test::More; + +do { + is_deeply rearrange_groups( @{$_->{INPUT}} ), $_->{EXPECTED}, + "rearrange_groups(" . pp( @{$_->{INPUT}} ) + . ") == " . pp( $_->{EXPECTED} ); +} for ( + { TEST => "Example 1", + INPUT => [ [ 1,2,3,5,1,2,7,6,3 ], 3 ], + EXPECTED => [ [ 1,2,3 ], [ 1,2,3 ], [ 5,6,7 ] ] }, + { TEST => "Example 2", + INPUT => [ [ 1,2,3 ], 2 ], + EXPECTED => -1 }, + { TEST => "Example 3", + INPUT => [ [ 1,2,4,3,5,3 ], 3 ], + EXPECTED => [ [ 1,2,3 ], [ 3,4,5 ] ] }, + { TEST => "Example 4", + INPUT => [ [ 1,5,2,6,4,7 ], 3 ], + EXPECTED => -1 }, +); + +done_testing; -- cgit From 2b3c6973d93eb33a0cd0d33f4b241655f270c1f3 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Mon, 17 Apr 2023 07:32:24 -0500 Subject: Update Readme 213 --- challenge-213/bob-lied/README | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-213/bob-lied/README b/challenge-213/bob-lied/README index dd9d61c433..ca4d14b3b4 100644 --- a/challenge-213/bob-lied/README +++ b/challenge-213/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 212 by Bob Lied +Solutions to weekly challenge 213 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-212/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-213/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-213/bob-lied -- cgit From 83530ce6d5410f67279d189e0167270561a436fc Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 17 Apr 2023 12:35:32 +0000 Subject: Initial 213 (Raku) --- challenge-213/mark-anderson/raku/ch-1.raku | 13 +++++++ challenge-213/mark-anderson/raku/ch-2.raku | 61 ++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+) create mode 100644 challenge-213/mark-anderson/raku/ch-1.raku create mode 100644 challenge-213/mark-anderson/raku/ch-2.raku diff --git a/challenge-213/mark-anderson/raku/ch-1.raku b/challenge-213/mark-anderson/raku/ch-1.raku new file mode 100644 index 0000000000..d3a64916d2 --- /dev/null +++ b/challenge-213/mark-anderson/raku/ch-1.raku @@ -0,0 +1,13 @@ +#!/usr/bin/env raku +use Test; + +is-deeply fun-sort(1,2,3,4,5,6), (2,4,6,1,3,5); +is-deeply fun-sort(1,2), (2,1); +is-deeply fun-sort(1), (1,); +is-deeply fun-sort(1,2,3,4,5,6,4,5,6), (2,4,4,6,6,1,3,5,5); + +sub fun-sort(*@a) +{ + my %c = @a.classify({ $_ %% 2 ?? 'even' !! 'odd' }); + flat (%c || Empty, %c || Empty)>>.sort +} diff --git a/challenge-213/mark-anderson/raku/ch-2.raku b/challenge-213/mark-anderson/raku/ch-2.raku new file mode 100644 index 0000000000..2aeb6a2b4a --- /dev/null +++ b/challenge-213/mark-anderson/raku/ch-2.raku @@ -0,0 +1,61 @@ +#!/usr/bin/env raku +use Test; + +is-deeply shortest-path(((1,2,6), (5,6,7)), 1,7), (1,2,6,7); +is-deeply shortest-path(((1,2,3), (4,5,6)), 2,5), -1; +is-deeply shortest-path(((1,2,3), (4,5,6), (3,8,9), (7,8)), 1,7), (1,2,3,8,7); + +# The graph from https://www.youtube.com/watch?v=T_m27bhVQQQ&t=360s +is-deeply shortest-path((, , , + , , + , , , + , , , + , , + , , , , + , , + , , ), 'A','H'), any(, + , + ); + +sub shortest-path($routes, $source, $destination is copy) +{ + my %graph = graph($routes); + my $from = $source; + my @queue; + my %path; + + until %path{$destination} + { + @queue.push: $from => $_ unless %path{$_} for %graph{$from}; + return -1 unless @queue; + %path{.value} = .key unless %path{.value} given @queue.head; + $from = @queue.shift.value + } + + reverse gather until $destination ~~ $source + { + take $destination; + $destination = %path{$destination}; + LAST { take $source } + } +} + +sub graph($routes) +{ + my %graph; + + for |$routes -> $r + { + %graph{$r[0]}.push: $r[1]; + + for 1..$r.end.pred + { + %graph{$r[$_]}.push: $r[.pred]; + %graph{$r[$_]}.push: $r[.succ] + } + + %graph{$r[$r.end]}.push: $r[$r.end.pred] + } + + %graph>>.values>>.unique>>.Slip +} -- cgit From bdfe0db0a9735b73e7e99ff50188290e08e1fab3 Mon Sep 17 00:00:00 2001 From: Paulo Custodio Date: Mon, 17 Apr 2023 14:49:08 +0100 Subject: Fix solution --- challenge-212/paulo-custodio/perl/ch-2.pl | 32 +++++++++++------------------- challenge-212/paulo-custodio/t/test-2.yaml | 4 ++-- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/challenge-212/paulo-custodio/perl/ch-2.pl b/challenge-212/paulo-custodio/perl/ch-2.pl index b2af1c85af..c783c3f817 100644 --- a/challenge-212/paulo-custodio/perl/ch-2.pl +++ b/challenge-212/paulo-custodio/perl/ch-2.pl @@ -33,26 +33,18 @@ use Modern::Perl; sub rearrange_groups { - my($count, @nums) = @_; - return -1 unless scalar(@nums) % $count == 0; - my $group_size = scalar(@nums) / $count; - @nums = sort {$a<=>$b} @nums; + my($size, @nums) = @_; + return -1 unless scalar(@nums) % $size == 0; + my %nums; $nums{$_}++ for @nums; my @output; - for my $i (0..$count-1) { + while (%nums) { + my $min = (sort {$a<=>$b} keys %nums)[0]; my @group; - my %seen; - my $j = 0; - while (scalar(@group) < $group_size) { - if (!$seen{$nums[$j]}++) { - push @group, $nums[$j]; - splice(@nums, $j, 1); - } - else { - $j++; - if ($j >= @nums) { - return -1; - } - } + for my $j ($min .. $min+$size-1) { + return -1 unless $nums{$j}; + push @group, $j; + $nums{$j}--; + delete $nums{$j} if $nums{$j}==0; } push @output, \@group; } @@ -75,5 +67,5 @@ sub print_groups { } my @nums = @ARGV; -my $count = pop(@nums); -print_groups(rearrange_groups($count, @nums)); +my $size = pop(@nums); +print_groups(rearrange_groups($size, @nums)); diff --git a/challenge-212/paulo-custodio/t/test-2.yaml b/challenge-212/paulo-custodio/t/test-2.yaml index 2e4b7e2d4c..af3ca6883c 100644 --- a/challenge-212/paulo-custodio/t/test-2.yaml +++ b/challenge-212/paulo-custodio/t/test-2.yaml @@ -10,11 +10,11 @@ output: -1 - setup: cleanup: - args: 1 2 4 3 5 3 2 + args: 1 2 4 3 5 3 3 input: output: (1,2,3), (3,4,5) - setup: cleanup: args: 1 5 2 6 4 7 3 input: - output: (1,2), (4,5), (6,7) + output: -1 -- cgit From 42059161021ef72af78ec792b171780dd384aee1 Mon Sep 17 00:00:00 2001 From: Leo Manfredi Date: Mon, 17 Apr 2023 14:45:06 +0000 Subject: Perl Solution for Task #1 --- challenge-213/manfredi/perl/ch-1.pl | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100755 challenge-213/manfredi/perl/ch-1.pl diff --git a/challenge-213/manfredi/perl/ch-1.pl b/challenge-213/manfredi/perl/ch-1.pl new file mode 100755 index 0000000000..821a48501e --- /dev/null +++ b/challenge-213/manfredi/perl/ch-1.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl + +use v5.36; + +say "challenge-213-task1"; + +# Task 1: Fun Sort +# You are given a list of positive integers. +# Write a script to sort the all even integers first then all odds in ascending order. + +while () { + chomp; + my @list = sort { $a <=> $b } split /,/; + my @even = grep { ! ($_ % 2) } @list; + my @odd = grep { $_ % 2 } @list; + my @out = (@even, @odd); + print "@out\n"; +} + + +__DATA__ +3,6,1,4,5,2 +1,2 +1 -- cgit From e28591a870a8056306a8d8acc9382848a1a70fff Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 17 Apr 2023 09:24:16 +0200 Subject: All tasks done --- challenge-213/luca-ferrari/blog-1.txt | 1 + challenge-213/luca-ferrari/blog-2.txt | 1 + challenge-213/luca-ferrari/blog-3.txt | 1 + challenge-213/luca-ferrari/blog-4.txt | 1 + challenge-213/luca-ferrari/blog-5.txt | 1 + challenge-213/luca-ferrari/blog-6.txt | 1 + challenge-213/luca-ferrari/postgresql/ch-1.plperl | 19 +++++++ challenge-213/luca-ferrari/postgresql/ch-1.sql | 30 +++++++++++ challenge-213/luca-ferrari/postgresql/ch-2.plperl | 59 +++++++++++++++++++++ challenge-213/luca-ferrari/postgresql/ch-2.sql | 64 +++++++++++++++++++++++ challenge-213/luca-ferrari/raku/ch-1.p6 | 12 +++++ challenge-213/luca-ferrari/raku/ch-2.p6 | 61 +++++++++++++++++++++ 12 files changed, 251 insertions(+) create mode 100644 challenge-213/luca-ferrari/blog-1.txt create mode 100644 challenge-213/luca-ferrari/blog-2.txt create mode 100644 challenge-213/luca-ferrari/blog-3.txt create mode 100644 challenge-213/luca-ferrari/blog-4.txt create mode 100644 challenge-213/luca-ferrari/blog-5.txt create mode 100644 challenge-213/luca-ferrari/blog-6.txt create mode 100644 challenge-213/luca-ferrari/postgresql/ch-1.plperl create mode 100644 challenge-213/luca-ferrari/postgresql/ch-1.sql create mode 100644 challenge-213/luca-ferrari/postgresql/ch-2.plperl create mode 100644 challenge-213/luca-ferrari/postgresql/ch-2.sql create mode 100644 challenge-213/luca-ferrari/raku/ch-1.p6 create mode 100644 challenge-213/luca-ferrari/raku/ch-2.p6 diff --git a/challenge-213/luca-ferrari/blog-1.txt b/challenge-213/luca-ferrari/blog-1.txt new file mode 100644 index 0000000000..ed3b199837 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-1.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task1 diff --git a/challenge-213/luca-ferrari/blog-2.txt b/challenge-213/luca-ferrari/blog-2.txt new file mode 100644 index 0000000000..b59a37dca6 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-2.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task2 diff --git a/challenge-213/luca-ferrari/blog-3.txt b/challenge-213/luca-ferrari/blog-3.txt new file mode 100644 index 0000000000..56ee76c923 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-3.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task1plperl diff --git a/challenge-213/luca-ferrari/blog-4.txt b/challenge-213/luca-ferrari/blog-4.txt new file mode 100644 index 0000000000..b6a7e179e4 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-4.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task2plperl diff --git a/challenge-213/luca-ferrari/blog-5.txt b/challenge-213/luca-ferrari/blog-5.txt new file mode 100644 index 0000000000..0b9f4baef7 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-5.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task1plpgsql diff --git a/challenge-213/luca-ferrari/blog-6.txt b/challenge-213/luca-ferrari/blog-6.txt new file mode 100644 index 0000000000..aa2fb4e372 --- /dev/null +++ b/challenge-213/luca-ferrari/blog-6.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/04/17/PerlWeeklyChallenge213.html#task2plpgsql diff --git a/challenge-213/luca-ferrari/postgresql/ch-1.plperl b/challenge-213/luca-ferrari/postgresql/ch-1.plperl new file mode 100644 index 0000000000..b04bcbe768 --- /dev/null +++ b/challenge-213/luca-ferrari/postgresql/ch-1.plperl @@ -0,0 +1,19 @@ +-- +-- Perl Weekly Challenge 213 +-- Task 1 +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc213; + +CREATE OR REPLACE FUNCTION +pwc213.task1_plperl( int[] ) +RETURNS int[] +AS $CODE$ + my ( $array ) = @_; + my @sorted; + @sorted = ( sort( grep( { $_ % 2 == 0 } $array->@* ) ), + sort( grep( { $_ % 2 != 0 } $array->@* ) ) ); + return [ @sorted ]; +$CODE$ +LANGUAGE plperl; diff --git a/challenge-213/luca-ferrari/postgresql/ch-1.sql b/challenge-213/luca-ferrari/postgresql/ch-1.sql new file mode 100644 index 0000000000..7f274c41e1 --- /dev/null +++ b/challenge-213/luca-ferrari/postgresql/ch-1.sql @@ -0,0 +1,30 @@ +-- +-- Perl Weekly Challenge 213 +-- Task 1 +-- +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc213; + +CREATE OR REPLACE FUNCTION +pwc213.task1_plpgsql( a int[] ) +RETURNS int[] +AS $CODE$ + WITH evens AS ( + SELECT array_agg( v ) as x + FROM ( SELECT v FROM unnest( a ) v + WHERE v % 2 = 0 + ORDER BY 1 + ) as v + ), odds AS ( + SELECT array_agg( v ) as x + FROM ( SELECT v FROM unnest( a ) v + WHERE v % 2 <> 0 + ORDER BY 1 ) as v + ) + SELECT array_cat( e.x, o.x ) + FROM evens e, odds o; + +$CODE$ +LANGUAGE sql; diff --git a/challenge-213/luca-ferrari/postgresql/ch-2.plperl b/challenge-213/luca-ferrari/postgresql/ch-2.plperl new file mode 100644 index 0000000000..5c826c931a --- /dev/null +++ b/challenge-213/luca-ferrari/postgresql/ch-2.plperl @@ -0,0 +1,59 @@ +-- +-- Perl Weekly Challenge 213 +-- Task 2 +-- See +-- + +/* +select * from pwc213.task2_plperl( 1, 7, + array[ + array[1,2,3]::int[], + array[4,5,6]::int[], + array[3,8,9]::int[], + array[6,7,8]::int[] + ]::int[][] ); + +*/ + +CREATE SCHEMA IF NOT EXISTS pwc213; + +CREATE OR REPLACE FUNCTION +pwc213.task2_plperl( int, int, int[][] ) +RETURNS SETOF int +AS $CODE$ + my ( $source, $destination, $routes ) = @_; + my @path; + + push @path, $source; + my ( $loop ) = 1; + my ( $current_route_index ) = 0; + while ( $loop ) { + my ( $current_route ) = $routes->@[ $current_route_index ]; + + # skip this route if there is not a match + $current_route_index++ and next if ( ! grep( { $_ == $path[ -1 ] } $current_route->@* ) ); + + for my $node ( $current_route->@* ) { + push @path, $node if ( ! grep( { $node == $_ } @path ) ); + + $loop = 0; + + # search for the next route + for my $next_route_index ( ( $current_route_index + 1 ) .. scalar( $routes->@* ) ) { + next if ( ! grep( { $node == $_ } $routes->@[ $next_route_index ]->@* ) ); + $current_route_index = $next_route_index; + $loop = 1; + last; + } + + last if $loop; + } + + last if $current_route_index > scalar( $routes->@* ); + } + + return undef if $path[ -1 ] != $destination; + return [ @path ]; + +$CODE$ +LANGUAGE plperl; diff --git a/challenge-213/luca-ferrari/postgresql/ch-2.sql b/challenge-213/luca-ferrari/postgresql/ch-2.sql new file mode 100644 index 0000000000..520debcff9 --- /dev/null +++ b/challenge-213/luca-ferrari/postgresql/ch-2.sql @@ -0,0 +1,64 @@ +-- +-- Perl Weekly Challenge 213 +-- Task 2 +-- +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc213; + +/* +CREATE OR REPLACE FUNCTION +pwc213.task2_plpgsql( s int, d int, routes int[] ) +RETURNS SETOF int +AS $CODE$ + SELECT pwc213.task2_plperl( s, d, routes ); +$CODE$ +LANGUAGE sql; +*/ + +CREATE OR REPLACE FUNCTION +pwc213.task2_plpgsql( s int, d int, routes int[] ) +RETURNS SETOF int +AS $CODE$ +DECLARE + slice_size int := 3; + current_route_index int; + current_route int[]; + next_route_index int; + next_node int; + need_loop boolean; + node int; + path int[]; +BEGIN + need_loop := true; + current_route_index := 1; +<> + WHILE need_loop LOOP + FOREACH node IN ARRAY routes[ current_route_index : current_route_index ] LOOP + RETURN NEXT node; + IF node = d THEN + EXIT; + END IF; + + need_loop := false; + FOR next_route_index IN current_route_index + 1 .. array_length( routes, 1 ) LOOP + FOREACH next_node IN ARRAY routes[ next_route_index : next_route_index ] LOOP + IF next_node = node THEN + current_route_index := next_route_index; + need_loop := true; + CONTINUE rescan; + END IF; + END LOOP; + END LOOP; + END LOOP; + END LOOP; + + IF node <> d THEN + RAISE EXCEPTION 'Cannot find the path!'; + END IF; + + return; +END +$CODE$ +LANGUAGE plpgsql; diff --git a/challenge-213/luca-ferrari/raku/ch-1.p6 b/challenge-213/luca-ferrari/raku/ch-1.p6 new file mode 100644 index 0000000000..ddb2238999 --- /dev/null +++ b/challenge-213/luca-ferrari/raku/ch-1.p6 @@ -0,0 +1,12 @@ +#!raku + +# +# Perl Weekly Challenge 213 +# Task 1 +# +# See +# + +sub MAIN( *@n where { @n.elems == @n.grep( { $_ ~~ Int && $_ > 0 } ).elems } ) { + ( @n.grep( * %% 2 ).sort.join( ',' ) ~ ',' ~ @n.grep( * !%% 2 ).sort.join( ',' ) ).say; +} diff --git a/challenge-213/luca-ferrari/raku/ch-2.p6 b/challenge-213/luca-ferrari/raku/ch-2.p6 new file mode 100644 index 0000000000..936a61356d --- /dev/null +++ b/challenge-213/luca-ferrari/raku/ch-2.p6 @@ -0,0 +1,61 @@ +#!raku + +# +# Perl Weekly Challenge 213 +# Task 2 +# +# See +# +# +# raku raku/ch-2.p6 1 7 "1 2 3 | 4 5 6 | 3 8 9 | 7 8 " +# 1 -> 2 -> 3 -> 8 -> 7 + + +sub MAIN( Int $source, Int $destination, $r ) { + my @routes; + my @current; + for $r.comb( :skip-empty ) { + next if ! $_; + + if $_ ~~ "|" { + @routes.push: [@current]; + @current = (); + next; + } + + @current.push: $_.Int if ( $_.Int > 0 ); + + } + + @routes.push: [@current] if ( @current ); + + my ( $source-index, $destination-index ); + for 0 ..^ @routes.elems -> $index { + $source-index = $index and next if ( @routes[ $index ].grep( $source ) ); + $destination-index = $index and next if ( @routes[ $index ].grep( $destination ) ); + } + + + my @current-path; + my $next-route = $source-index; + my $loop = True; + while ( $loop ) { + for @routes[ $next-route ].Array -> $node { + @current-path.push: $node if ( ! @current-path.grep( * ~~ $node ) ); + + $loop = False; + for $next-route ^..^ @routes.elems -> $jump-to { + + if ( @routes[ $jump-to ].grep( { $_ ~~ $node } ) ) { + $next-route = $jump-to; + $loop = True; + last; + } + } + + last if $loop; + } + } + + @current-path.join( ' -> ' ).say; +} -- cgit From 016a442062080d3f5281c389883b48ac114dda66 Mon Sep 17 00:00:00 2001 From: dcw Date: Mon, 17 Apr 2023 17:52:19 +0100 Subject: imported my C solutions to challenge 212 a day late and tweaked some comments in README files and ch-2.pl --- challenge-212/duncan-c-white/C/.cbuild | 1 - challenge-212/duncan-c-white/C/Makefile | 18 ++ challenge-212/duncan-c-white/C/README | 25 +++ challenge-212/duncan-c-white/C/args.c | 234 ++++++++++++++++++++++++++ challenge-212/duncan-c-white/C/args.h | 12 ++ challenge-212/duncan-c-white/C/ch-1.c | 79 +++++++++ challenge-212/duncan-c-white/C/ch-2.c | 245 ++++++++++++++++++++++++++++ challenge-212/duncan-c-white/C/parseints.c | 114 +++++++++++++ challenge-212/duncan-c-white/C/parseints.h | 1 + challenge-212/duncan-c-white/C/printarray.c | 39 +++++ challenge-212/duncan-c-white/C/printarray.h | 1 + challenge-212/duncan-c-white/README | 8 +- challenge-212/duncan-c-white/perl/ch-2.pl | 59 +++++-- 13 files changed, 814 insertions(+), 22 deletions(-) create mode 100644 challenge-212/duncan-c-white/C/Makefile create mode 100644 challenge-212/duncan-c-white/C/README create mode 100644 challenge-212/duncan-c-white/C/args.c create mode 100644 challenge-212/duncan-c-white/C/args.h create mode 100644 challenge-212/duncan-c-white/C/ch-1.c create mode 100644 challenge-212/duncan-c-white/C/ch-2.c create mode 100644 challenge-212/duncan-c-white/C/parseints.c create mode 100644 challenge-212/duncan-c-white/C/parseints.h create mode 100644 challenge-212/duncan-c-white/C/printarray.c create mode 100644 challenge-212/duncan-c-white/C/printarray.h diff --git a/challenge-212/duncan-c-white/C/.cbuild b/challenge-212/duncan-c-white/C/.cbuild index 835981f6f1..a14ec76520 100644 --- a/challenge-212/duncan-c-white/C/.cbuild +++ b/challenge-212/duncan-c-white/C/.cbuild @@ -1,5 +1,4 @@ BUILD = ch-1 ch-2 -BUILD = ch-1 CFLAGS = -Wall -g #LDFLAGS = -lm #CFLAGS = -g diff --git a/challenge-212/duncan-c-white/C/Makefile b/challenge-212/duncan-c-white/C/Makefile new file mode 100644 index 0000000000..1b34ccd3b2 --- /dev/null +++ b/challenge-212/duncan-c-white/C/Makefile @@ -0,0 +1,18 @@ +# Makefile rules generated by CB +CC = gcc +CFLAGS = -Wall -g +BUILD = ch-1 ch-2 + +all: $(BUILD) + +clean: + /bin/rm -f $(BUILD) *.o core a.out + +args.o: args.c +ch-1: ch-1.o args.o parseints.o printarray.o +ch-1.o: ch-1.c args.h parseints.h printarray.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 + diff --git a/challenge-212/duncan-c-white/C/README b/challenge-212/duncan-c-white/C/README new file mode 100644 index 0000000000..49cf0e852c --- /dev/null +++ b/challenge-212/duncan-c-white/C/README @@ -0,0 +1,25 @@ +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. + +However, ch-2.c is a complete rethink, as usual I solved ch-2.pl in a Perlish +idiomatic way using (for example) a hashset for distinct values and an +array of arrays for the output. Storage management in C is much harder, so +I decided to store the output sequences in the (reordered) list[nel] array, +i.e. an inplace solution because we already had the right amount of +storage allocated, storing size elements per sequence. This led me to +construct the desired output on the fly at the end. + +In addition, to make things simpler to reason about I decided to start by +sorting the entire list[nel] array via qsort - so from then I passed the +"sorted list[ nel]" array around instead. To check whether an element was +present in a sorted subarray, I used a simple "posisin( v, arr, s, f )" +function to check whether v is in arr[s..f], returning the position >= 0 +if found, or -1 if not found. This implemented distinct-ness and +set membership. + +These C versions use some of my regular support modules: +- my command-line argument processing module args.[ch], +- my csvlist-of-int parsing module parseints.[ch], and +- my int-array printing module printarray.[ch]. diff --git a/challenge-212/duncan-c-white/C/args.c b/challenge-212/duncan-c-white/C/args.c new file mode 100644 index 0000000000..20c21e6c30 --- /dev/null +++ b/challenge-212/duncan-c-white/C/args.c @@ -0,0 +1,234 @@ +#include +#include +#include +#include +#include +#include + + +bool debug = false; + + +// process_flag_noarg( name, argc, argv ); +// Process the -d flag, and check that there are no +// remaining arguments. +void process_flag_noarg( char *name, int argc, char **argv ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left != 0 ) + { + fprintf( stderr, "Usage: %s [-d]\n", name ); + exit(1); + } +} + + +// int argno = process_flag_n_args( name, argc, argv, n, argmsg ); +// Process the -d flag, and check that there are exactly +// n remaining arguments, return the index position of the first +// argument. If not, generate a fatal Usage error using the argmsg. +// +int process_flag_n_args( char *name, int argc, char **argv, int n, char *argmsg ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left != n ) + { + fprintf( stderr, "Usage: %s [-d] %s\n Exactly %d " + "arguments needed\n", name, argmsg, n ); + exit(1); + } + return arg; +} + + +// int argno = process_flag_n_m_args( name, argc, argv, min, max, argmsg ); +// Process the -d flag, and check that there are between +// min and max remaining arguments, return the index position of the first +// argument. If not, generate a fatal Usage error using the argmsg. +// +int process_flag_n_m_args( char *name, int argc, char **argv, int min, int max, char *argmsg ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left < min || left > max ) + { + fprintf( stderr, "Usage: %s [-d] %s\n Between %d and %d " + "arguments needed\n", name, argmsg, min, max ); + exit(1); + } + return arg; +} + + +// process_onenumarg_default( name, argc, argv, defvalue, &n ); +// Process the -d flag, and check that there is a single +// remaining numeric argument (or no arguments, in which case +// we use the defvalue), putting it into n +void process_onenumarg_default( char *name, int argc, char **argv, int defvalue, int *n ) +{ + char argmsg[100]; + sprintf( argmsg, "[int default %d]", defvalue ); + int arg = process_flag_n_m_args( name, argc, argv, 0, 1, argmsg ); + + *n = arg == argc ? defvalue : atoi( argv[arg] ); +} + + +// process_onenumarg( name, argc, argv, &n ); +// Process the -d flag, and check that there is a single +// remaining numeric argument, putting it into n +void process_onenumarg( char *name, int argc, char **argv, int *n ) +{ + int arg = process_flag_n_args( name, argc, argv, 1, "int" ); + + // argument is in argv[arg] + *n = atoi( argv[arg] ); +} + + +// process_twonumargs( name, argc, argv, &m, &n ); +// Process the -d flag, and check that there are 2 +// remaining numeric arguments, putting them into m and n +void process_twonumargs( char *name, int argc, char **argv, int *m, int *n ) +{ + int arg = process_flag_n_args( name, argc, argv, 2, "int" ); + + // arguments are in argv[arg] and argv[arg+1] + *m = atoi( argv[arg++] ); + *n = atoi( argv[arg] ); +} + + +// process_twostrargs() IS DEPRECATED: use process_flag_n_m_args() instead + + +// int arr[100]; +// int nel = process_listnumargs( name, argc, argv, arr, 100 ); +// Process the -d flag, and check that there are >= 2 +// remaining numeric arguments, putting them into arr[0..nel-1] +// and returning nel. +int process_listnumargs( char *name, int argc, char **argv, int *arr, int maxel ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left < 2 ) + { + fprintf( stderr, "Usage: %s [-d] list_of_numeric_args\n", name ); + exit(1); + } + if( left > maxel ) + { + fprintf( stderr, "%s: more than %d args\n", name, maxel ); + exit(1); + } + + // elements are in argv[arg], argv[arg+1]... + + if( debug ) + { + printf( "debug: remaining arguments are in arg=%d, " + "firstn=%s, secondn=%s..\n", + arg, argv[arg], argv[arg+1] ); + } + + int nel = 0; + for( int i=arg; i +#include +#include +#include +#include +#include + +#include "args.h" +#include "parseints.h" +#include "printarray.h" + + +int main( int argc, char **argv ) +{ + int argno = process_flag_n_m_args( "jumping-letters", argc, argv, + 2, 1000, "word intlist" ); + char *word = argv[argno++]; + int nel; + int *list = parse_int_args( argc, argv, argno, &nel ); + + if( debug ) + { + printf( "debug: word = %s, list: ", word ); + print_int_array( 60, nel, list, ',', stdout ); + putchar( '\n' ); + } + + int len = strlen(word); + + if( len != nel ) + { + fprintf( stderr, "jumping-letters: word (len %d) must be " + "same length as list (len %d)\n", len, nel ); + exit(1); + } + + for( int pos=0; pos < len; pos++ ) + { + char letter = word[pos]; + int offset = list[pos]; + if( debug ) + { + printf( "debug: pos: %d, letter: %c, offset: %d\n", + pos, letter, offset ); + } + int base = 0; + if( islower(letter) ) + { + base = 'a'; + } else if( isupper(letter) ) + { + base = 'A'; + } else + { + continue; + } + int lpos = letter-base; + offset = (offset + lpos) % 26; + if( debug ) + { + printf( "debug: letter=%c, base=%c, lpos=%d, " + "offset=%d\n", letter, base, lpos, offset ); + } + letter = offset+base; + word[pos] = letter; + if( debug ) + { + printf( "debug: newletter=%c\n", letter ); + } + } + + printf( "%s\n", word ); + free( list ); + return 0; +} diff --git a/challenge-212/duncan-c-white/C/ch-2.c b/challenge-212/duncan-c-white/C/ch-2.c new file mode 100644 index 0000000000..d718969906 --- /dev/null +++ b/challenge-212/duncan-c-white/C/ch-2.c @@ -0,0 +1,245 @@ +// +// Task 2: Rearrange Groups (into sequences) +// +// C version. +// + +#include +#include +#include +#include +#include + +#include "args.h" +#include "parseints.h" +#include "printarray.h" + + +// qsort comparator for int elements +int intcompare( const void *a, const void *b ) +{ + int *ai = (int *)a; + int *bi = (int *)b; + return *ai - *bi; +} + + +// +// int p = posisin( v, slist, spos, epos ); +// Attempt to find (the first instance of) v in slist[spos..epos]. If +// we find it, return the position of the first v. If not, return -1. +// +int posisin( int v, int *slist, int spos, int epos ) +{ + for( int i=spos; i<=epos; i++ ) + { + if( slist[i] == v ) return i; + } + return -1; +} + + +// +// bool found = find_seq_at( nel, slist[], spos, size, pos[] ); +// Find a single size-element sequence X, X+1, X+2.. X+size-1 starting +// at spos. If such a sequence can be found, store the slist[i] index +// positions in pos[size] and return true, otherwise return false. +// +bool find_seq_at( int nel, int *slist, int spos, int size, int *pos ) +{ + pos[0] = spos; + int wantval = slist[spos]; + for( int i=1; i0 && posisin( slist[i], slist, 0, i-1 ) >= 0 ) + { + continue; + } + // x-1 must not be present + if( i>0 && posisin( slist[i]-1, slist, 0, i-1 ) >= 0 ) + { + continue; + } + #if 0 + if( debug ) + { + printf( "debug: found distinct value %d at pos %d\n", + slist[i], i ); + } + #endif + if( find_seq_at( nel, slist, i, size, pos ) ) + { + return true; + } + } + return false; +} + + + +// +// reorder( nel, slist, size, pos ); +// Given slist[0..nel-1] and a sequence found at pos[0..size-1], +// reorder the slist so that the sequence is at the front. +// +void reorder( int nel, int *slist, int size, int *pos ) +{ + for( int i=0; i=i; j-- ) + { + slist[j+1] = slist[j]; + } + slist[i] = v; + } + } +} + + +// +// bool done = find_all_sequences( slist, nel, size ); +// Attempt to find all sequences (each of length size and +// comprising X, X+1, X+2..X+size-1) from sorted slist[nel], +// modifying slist[] so that the sequences are stored at the +// front of slist[], +// ie the first size-elements in slist[] will be the first +// sequence, etc. +// Return true if this can be successfully done, or false if it can't. +// +bool find_all_sequences( int *slist, int nel, int size ) +{ + if( nel % size != 0 ) return false; + + int nseqs = nel / size; + + for( int seqno=1; seqno <= nseqs; seqno++ ) + { + if( debug ) + { + printf( "debug: seq pass %d, slist is ", seqno ); + print_int_array( 60, nel, slist, ',', stdout ); + putchar( '\n' ); + } + int pos[size]; // positions of sequence elements + bool found = find_isolated_seq_posns( size, slist, nel, pos ); + if( ! found ) + { + if( debug ) + { + printf( "debug: failed to find a sequence\n" ); + } + return false; + } + if( debug ) + { + printf( "debug: found seq " ); + for( int i=0; i0 ) putchar( ',' ); + printf( "%d", slist[pos[i]] ); + } + printf( " at posns " ); + for( int i=0; i0 ) putchar( ',' ); + printf( "%d", pos[i] ); + } + putchar( '\n' ); + } + reorder( nel, slist, size, pos ); + if( debug ) + { + printf( "debug: have reordered slist " ); + print_int_array( 60, nel, slist, ',', stdout ); + putchar( '\n' ); + } + // move array ptr over the new sequence + nel -= size; + slist += size; + } + return true; +} + + +int main( int argc, char **argv ) +{ + int argno = process_flag_n_m_args( "rearrange-groups", argc, argv, + 2, 1000, "groupsize intlist" ); + int size = atoi(argv[argno++]); + + int nel; + int *list = parse_int_args( argc, argv, argno, &nel ); + + if( debug ) + { + printf( "debug: size=%d, list: ", size ); + print_int_array( 60, nel, list, ',', stdout ); + putchar( '\n' ); + } + + qsort( list, nel, sizeof(int), &intcompare ); + + if( debug ) + { + printf( "debug: sorted list: " ); + print_int_array( 60, nel, list, ',', stdout ); + putchar( '\n' ); + } + + bool done = find_all_sequences( list, nel, size ); + + if( done ) + { + int *lp = list; + for( int i=0; i0 ) fputs( ", ", stdout ); + putchar( '(' ); + for( int j=0; j0 ) putchar( ',' ); + printf( "%d", *lp++ ); + } + putchar( ')' ); + } + putchar( '\n' ); + } else + { + printf( "-1\n" ); + } + + free( list ); + + return 0; +} diff --git a/challenge-212/duncan-c-white/C/parseints.c b/challenge-212/duncan-c-white/C/parseints.c new file mode 100644 index 0000000000..3e820eb334 --- /dev/null +++ b/challenge-212/duncan-c-white/C/parseints.c @@ -0,0 +1,114 @@ +// Simple routine to parse one or more arguments, +// looking for individual ints or comma-separated +// lists of ints. +// + +#include +#include +#include +#include +#include +#include + +#include "args.h" +#include "printarray.h" +#include "parseints.h" + +typedef struct +{ + int nel; // current number of elements + int maxel; // maximum number of elements allocated + int *list; // malloc()d list of integers +} intlist; + + +// +// intlist il.. then initialize il.. then: +// add_one( element, &il ); +// +static void add_one( int x, intlist *p ) +{ + if( p->nel > p->maxel ) + { + p->maxel += 128; + p->list = realloc( p->list, p->maxel ); + assert( p->list != NULL ); + } + #if 0 + if( debug ) + { + printf( "PIA: appending %d to result at " + "pos %d\n", x, p->nel ); + } + #endif + p->list[p->nel++] = x; +} + + +// +// intlist il.. then initialize il.. then: +// add_one_arg( argstr, &il ); +// +static void add_one_arg( char *argstr, intlist *p ) +{ + int x; + if( !check_int(argstr,&x) ) + { + fprintf( stderr, "PIA: arg %s must be int\n", argstr ); + exit(1); + } + add_one( x, p ); +} + + +// +// int nel; +// int *ilist = parse_int_args( argc, argv, argno, &nel ); +// process all arguments argv[argno..argc-1], extracting either +// single ints or comma-separated lists of ints from those arguments, +// accumulate all integers in a dynarray list, storing the total number +// of elements in nel. This list must be freed by the caller. +// Note that the list of elements used to be terminated by a -1 value, +// but I've commented this out from now on. +// +int *parse_int_args( int argc, char **argv, int argno, int *nel ) +{ + int *result = malloc( 128 * sizeof(int) ); + assert( result != NULL ); + intlist il = { 0, 128, result }; + + #if 0 + if( debug ) + { + printf( "PIA: parsing ints from args %d..%d\n", argno, argc-1 ); + } + #endif + for( int i=argno; i +#include + + +// print_int_array( maxw, nelements, results[], sep, outfile ); +// format results[0..nelements-1] as a separated +// list onto outfile with lines <= maxw chars long. +// produces a whole number of lines of output - without the trailing '\n' +void print_int_array( int maxw, int nel, int *results, char sep, FILE *out ) +{ + int linelen = 0; + for( int i=0; i maxw ) + { + fputc( '\n', out ); + linelen = 0; + } else if( i>0 ) + { + fputc( ' ', out ); + linelen++; + } + + linelen += len; + fprintf( out, "%s", buf ); + if( i0 ) + //{ + // fputc( '\n', out ); + //} +} diff --git a/challenge-212/duncan-c-white/C/printarray.h b/challenge-212/duncan-c-white/C/printarray.h new file mode 100644 index 0000000000..40efb83277 --- /dev/null +++ b/challenge-212/duncan-c-white/C/printarray.h @@ -0,0 +1 @@ +extern void print_int_array( int maxw, int nel, int * results, char sep, FILE * out ); diff --git a/challenge-212/duncan-c-white/README b/challenge-212/duncan-c-white/README index 89f2c82665..cbd23d4076 100644 --- a/challenge-212/duncan-c-white/README +++ b/challenge-212/duncan-c-white/README @@ -25,8 +25,8 @@ Example 2 MY NOTES: sounds very easy. Essentially ROT(n) for a different value of n for each letter. -GUEST LANGUAGE: As a bonus, I will have a go at translating ch-1.pl into C -but I'll do that tomorrow. +GUEST LANGUAGE: As a bonus, I've had a go at translating ch-2.pl into C, +look in the C/ directory for that. Task 2: Rearrange Groups @@ -65,5 +65,5 @@ consecutive-numbers isolated at the start, ie. where first(run)-1 is not present in the input? Then we should be able to: repeatedly pick any one run, add it to solution, remove it from input, repeat until input is empty. -GUEST LANGUAGE: As a bonus, I will have a go at translating ch-2.pl into C -but I'll do that tomorrow. +GUEST LANGUAGE: As a bonus, I've had a go at translating ch-2.pl into C, +look in the C/ directory for that. diff --git a/challenge-212/duncan-c-white/perl/ch-2.pl b/challenge-212/duncan-c-white/perl/ch-2.pl index 4cc4a901ee..68d1046a07 100755 --- a/challenge-212/duncan-c-white/perl/ch-2.pl +++ b/challenge-212/duncan-c-white/perl/ch-2.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl # -# Task 2: Rearrange Groups +# Task 2: Rearrange Groups (into sequences) # # You are given a list of integers and group size greater than zero. # @@ -118,28 +118,53 @@ fun find_isolated_seq( $size, @list ) -my @output; # array of size-tuples - -my $changed; -do +# +# my $done = find_all_sequences( \@list, $size, \@output ); +# Attempt to extract all sequences (each of length $size and +# comprising X, X+1, X+2..X+size-1) from @list, modifying it, +# and building @output - a list of size-tuples. Return true +# if it can be successfully done (leaving @list empty and the +# sequences in @output), false if it can't be done. +# +sub find_all_sequences ($$$) { - my @seq = find_isolated_seq( $size, @list ); - say "debug: list=", join(',',@list), ", found seq=", join(',',@seq) - if $debug; - $changed = @seq ? 1 : 0; - if( $changed ) + my( $listref, $size, $outputref ) = @_; + + if( @$listref % $size != 0 ) + { + return 0; + } + + my $nseqs = @$listref / $size; + + foreach my $seqno (1..$nseqs) { - push @output, \@seq; - @list = remove_one_of_seq( \@seq, @list ); + my @seq = find_isolated_seq( $size, @$listref ); + say "debug: list=", join(',',@$listref), ", found seq=", + join(',',@seq) + if $debug; + if( @seq == 0 ) + { + say( "debug: failed to find a sequence, leftover list". + " is: ", join(',',@$listref) ) if $debug; + return 0; + } + push @$outputref, \@seq; + @$listref = remove_one_of_seq( \@seq, @$listref ); + say( "debug: output: ", join(', ', + map { '('. join(',',@$_). ')' } @$outputref + ), ", list=",join(',',@$listref) ) + if $debug; } - say( "debug: output: ", join(', ', map { '('. join(',',@$_). ')' } @output), ", list=",join(',',@list) ) - if $debug; + return 1; +} + -} while( $changed && @list ); +my @output; # array of size-tuples -say( "debug: leftover list is: ", join(',',@list) ) if $debug; +my $done = find_all_sequences( \@list, $size, \@output ); -if( @list == 0 ) +if( $done ) { say join(', ', map { '('. join(',',@$_). ')' } @output); } else -- cgit From acc52c0dd214084fbc028f2be6af3d07a1d60324 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Mon, 17 Apr 2023 11:51:02 -0600 Subject: Solve PWC213 --- challenge-213/wlmb/blog.txt | 2 ++ challenge-213/wlmb/perl/ch-1.pl | 15 +++++++++++++++ challenge-213/wlmb/perl/ch-2.pl | 33 +++++++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+) create mode 100644 challenge-213/wlmb/blog.txt create mode 100755 challenge-213/wlmb/perl/ch-1.pl create mode 100755 challenge-213/wlmb/perl/ch-2.pl diff --git a/challenge-213/wlmb/blog.txt b/challenge-213/wlmb/blog.txt new file mode 100644 index 0000000000..5468e199f6 --- /dev/null +++ b/challenge-213/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/04/17/PWC213/ + diff --git a/challenge-213/wlmb/perl/ch-1.pl b/challenge-213/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..71f15d4c8a --- /dev/null +++ b/challenge-213/wlmb/perl/ch-1.pl @@ -0,0 +1,15 @@ +#!/usr/bin/env perl +# Perl weekly challenge 213 +# Task 1: Fun Sort +# +# See https://wlmb.github.io/2023/04/17/PWC213/#task-1-fun-sort +use v5.36; +use POSIX qw(floor); +use List::Util qw(all); + +die <<~"FIN" unless @ARGV; + Usage: $0 N1 [N2...] + to fun-sort the integers N1 N2... + FIN +die "Input should be non-negative integers" unless all {floor($_)==$_ && $_>=0} @ARGV; +say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV; diff --git a/challenge-213/wlmb/perl/ch-2.pl b/challenge-213/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..383fb0dedf --- /dev/null +++ b/challenge-213/wlmb/perl/ch-2.pl @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +# Perl weekly challenge 213 +# Task 2: Shortest Route +# +# See https://wlmb.github.io/2023/04/17/PWC213/#task-2-shortest-route +use v5.36; +use List::UtilsBy qw(min_by); +die <<~"FIN" unless @ARGV >= 3; + Usage: $0 start dest R1 [R2...] + to find shortest route from start to dest following the routes R1 R2... + Each route is specified as a space separated string of node labels + FIN +my $start=shift; +my $dest=shift; +my @routes=map {[split " "]} @ARGV; +my %neighbors; +for my $r(@routes){ # set table of neighbors + $neighbors{$r->[$_]}{$r->[$_+1]}=$neighbors{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2; +} +my %distance_from; +my @nodes=([$dest,0]); +while(my $n=shift @nodes){ + my ($current, $distance)=@$n; + $distance_from{$current}=$distance; + push @nodes, map {[$_, $distance+1]} + grep {not defined $distance_from{$_}} + keys %{$neighbors{$current}}; +} +my @shortest; +push @shortest, my $current=$start if defined $distance_from{$start}; +push @shortest, $current=min_by {$distance_from{$_}} grep {defined $distance_from{$_}} + keys %{$neighbors{$current}} while(defined $current && $current!=$dest); +say @shortest?(join " ", @shortest):"No solution"; -- cgit From 4e6d5862cacf9530a8673728caa70e97a3fbf273 Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 17 Apr 2023 21:48:46 +0000 Subject: w213 - Task 1 & 2 --- challenge-213/perlboy1967/perl/ch1.pl | 34 ++++++++++++++++++++ challenge-213/perlboy1967/perl/ch2.pl | 59 +++++++++++++++++++++++++++++++++++ 2 files changed, 93 insertions(+) create mode 100755 challenge-213/perlboy1967/perl/ch1.pl create mode 100755 challenge-213/perlboy1967/perl/ch2.pl diff --git a/challenge-213/perlboy1967/perl/ch1.pl b/challenge-213/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..f971f8fb10 --- /dev/null +++ b/challenge-213/perlboy1967/perl/ch1.pl @@ -0,0 +1,34 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 213 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-213 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Fun Sort +Submitted by: Mohammad S Anwar + +You are given a list of positive integers. + +Write a script to sort the all even integers first then all odds in ascending order. + +=cut + +use v5.16; + +use common::sense; + +use Test::More; +use Test::Deep qw(cmp_deeply); + +sub evenOddSort { + sort { (($a & 1) <=> ($b & 1)) || ($a <=> $b) } @_; +} + +cmp_deeply([evenOddSort(1,2,3,4,5,6)],[2,4,6,1,3,5]); +cmp_deeply([evenOddSort(1,2)],[2,1]); +cmp_deeply([evenOddSort(1)],[1]); + +done_testing; diff --git a/challenge-213/perlboy1967/perl/ch2.pl b/challenge-213/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..6c3ffb03de --- /dev/null +++ b/challenge-213/perlboy1967/perl/ch2.pl @@ -0,0 +1,59 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 213 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-213 + +Author: Niels 'PerlBoy' van Dijke + +Task 2: Shortest Route +Submitted by: Mohammad S Anwar + +You are given a list of bidirectional routes defining a network of nodes, as well +as source and destination node numbers. + +Write a script to find the route from source to destination that passes through +fewest nodes. + +=cut + +use v5.16; + +use common::sense; + +use Paths::Graph; +use List::MoreUtils qw(slide); + +use Test::More; +use Test::Deep qw(cmp_deeply); + +sub shortestRoute ($$\@) { + my ($o,$d,$ar) = @_; + my (%v,%g); + + for (@$ar) { + slide { + push(@{$v{$a}},$b); + push(@{$v{$b}},$a); + } @$_; + } + + for my $n (keys %v) { + map { $g{$n}{$_} = 1 } @{$v{$n}}; + } + + my $o = Paths::Graph->new(-origin => $o, -destiny => $d, -graph => \%g); + my @p = $o->shortest_path(); + + return (scalar @p == 1 and defined $p[0][1] ? $p[0] : undef); +} + +cmp_deeply(shortestRoute(1,7,@{[[1,2,6],[5,6,7]]}), + [1,2,6,7]); +cmp_deeply(shortestRoute(2,5,@{[[1,2,3],[4,5,6]]}), + undef); +cmp_deeply(shortestRoute(1,7,@{[[1,2,3],[4,5,6],[3,8,9],[7,8]]}), + [1,2,3,8,7]); + +done_testing; -- cgit From 274b7ea9884e80ab5ebddb0d3c1de8815da63533 Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 17 Apr 2023 22:15:24 +0000 Subject: Task 2 - More condensed --- challenge-213/perlboy1967/perl/ch2.pl | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/challenge-213/perlboy1967/perl/ch2.pl b/challenge-213/perlboy1967/perl/ch2.pl index 6c3ffb03de..3c26e59c5c 100755 --- a/challenge-213/perlboy1967/perl/ch2.pl +++ b/challenge-213/perlboy1967/perl/ch2.pl @@ -30,21 +30,15 @@ use Test::Deep qw(cmp_deeply); sub shortestRoute ($$\@) { my ($o,$d,$ar) = @_; - my (%v,%g); + my %g; for (@$ar) { slide { - push(@{$v{$a}},$b); - push(@{$v{$b}},$a); + ($g{$a}{$b},$g{$b}{$a}) = (1,1); } @$_; } - for my $n (keys %v) { - map { $g{$n}{$_} = 1 } @{$v{$n}}; - } - - my $o = Paths::Graph->new(-origin => $o, -destiny => $d, -graph => \%g); - my @p = $o->shortest_path(); + my @p = Paths::Graph->new(-origin => $o, -destiny => $d, -graph => \%g)->shortest_path; return (scalar @p == 1 and defined $p[0][1] ? $p[0] : undef); } -- cgit From f1186e64cbf6f59757c30790db1d787fd1efc06a Mon Sep 17 00:00:00 2001 From: Leo Manfredi Date: Tue, 18 Apr 2023 08:43:31 +0000 Subject: Python Solution for Task #1 --- challenge-213/manfredi/python/ch-1.py | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100755 challenge-213/manfredi/python/ch-1.py diff --git a/challenge-213/manfredi/python/ch-1.py b/challenge-213/manfredi/python/ch-1.py new file mode 100755 index 0000000000..25a1e70ea3 --- /dev/null +++ b/challenge-213/manfredi/python/ch-1.py @@ -0,0 +1,24 @@ +#!/usr/bin/env python3 +# Python 3.9.2 on Debian GNU/Linux 11 (bullseye) + +print('challenge-213-task1') + +# Task 1: Fun Sort +# You are given a list of positive integers. +# Write a script to sort the all even integers first then all odds in ascending order. + +def fun_sort(items: list[int]) -> list[int]: + items.sort() + out_even = [item for item in items if not item % 2 ] + out_odd = [item for item in items if item % 2 ] + out_even.extend(out_odd) + return out_even + +def main(): + print(fun_sort([3, 6, 1, 4, 5, 2])) + print(fun_sort([1, 2])) + print(fun_sort([1])) + + +if __name__ == '__main__': + main() -- cgit From 34b524d2e3fd8b7a66bece0efa41b0b9ffcc5821 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 18 Apr 2023 11:31:53 -0500 Subject: Week 213 solutions --- challenge-213/bob-lied/perl/ch-1.pl | 80 +++++++++++++++++++ challenge-213/bob-lied/perl/ch-2.pl | 150 ++++++++++++++++++++++++++++++++++++ 2 files changed, 230 insertions(+) create mode 100644 challenge-213/bob-lied/perl/ch-1.pl create mode 100644 challenge-213/bob-lied/perl/ch-2.pl diff --git a/challenge-213/bob-lied/perl/ch-1.pl b/challenge-213/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..943607a940 --- /dev/null +++ b/challenge-213/bob-lied/perl/ch-1.pl @@ -0,0 +1,80 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 213 Task 1 Fun Sort +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of positive integers. +# Write a script to sort the all even integers first then all odds in +# ascending order. +# Example 1 Input: @list = (1,2,3,4,5,6) Output: (2,4,6,1,3,5) +# Example 2 Input: @list = (1,2) Output: (2,1) +# Example 3 Input: @list = (1) Output: (1) +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $DoTest = 0; + +GetOptions("test" => \$DoTest); +exit(!runTest()) if $DoTest; + +say "(", join(",", funSort(@ARGV)->@*), ")"; + +# Single sort with separation in sort function +sub funSort(@list) +{ + return [ sort { (($a & 1) <=> ($b & 1)) || ($a <=> $b) } @list ]; +} + +# Sort, then partition +sub funSort_part(@list) +{ + use List::MoreUtils qw/part/; + use List::Flatten qw/flat/; + + return [ grep { defined } flat part { $_ % 2 } sort { $a <=> $b} @list ]; +} + +# Partition, then sort each piece +sub funSort_partB(@list) +{ + use List::MoreUtils qw/part/; + my @sorted; + for my $sub ( part { $_ % 2} @list ) + { + next unless defined $sub; + push @sorted, sort { $a <=> $b } $sub->@*; + } + return \@sorted; +} + +sub runTest +{ + use Test2::V0; + + is( funSort(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1"); + is( funSort(1,2 ), [2,1], "Example 2"); + is( funSort(1 ), [1 ], "Example 3"); + is( funSort(3,7,5,9,1 ), [1,3,5,7,9], "Odds"); + is( funSort(2 ), [2 ], "Evens 1"); + is( funSort(2,8,4,6 ), [2,4,6,8], "Evens 2"); + + is( funSort_part(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1"); + is( funSort_part(1,2 ), [2,1], "Example 2"); + is( funSort_part(1 ), [1 ], "Example 3"); + is( funSort_part(3,7,5,9,1 ), [1,3,5,7,9], "Odds"); + is( funSort_part(2 ), [2 ], "Evens 1"); + is( funSort_part(2,8,4,6 ), [2,4,6,8], "Evens 2"); + + is( funSort_partB(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1"); + is( funSort_partB(1,2 ), [2,1], "Example 2"); + is( funSort_partB(1 ), [1 ], "Example 3"); + is( funSort_partB(3,7,5,9,1 ), [1,3,5,7,9], "Odds"); + is( funSort_partB(2 ), [2 ], "Evens 1"); + is( funSort_partB(2,8,4,6 ), [2,4,6,8], "Evens 2"); + + done_testing; +} diff --git a/challenge-213/bob-lied/perl/ch-2.pl b/challenge-213/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..5b2544f5cb --- /dev/null +++ b/challenge-213/bob-lied/perl/ch-2.pl @@ -0,0 +1,150 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 213 Task 2 Shortest Route +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of bidirectional routes defining a network of nodes, +# as well as source and destination node numbers. +# Write a script to find the route from source to destination that passes +# through fewest nodes. +# Example 1: Input: @routes = ([1,2,6], [5,6,7]) $source = 1 $destination = 7 +# Output: (1,2,6,7) +# Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6 +# then jump to route [5,6,7] and takes the route 6 -> 7. +# So the final route is (1,2,6,7) +# Example 2: Input: @routes = ([1,2,3], [4,5,6]) $source = 2 $destination = 5 +# Output: -1 +# Example 3: Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8]) $source = 1 $destination = 7 +# Output: (1,2,3,8,7) +# Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3 +# then jump to route [3,8,9] and takes the route 3 -> 8 +# then jump to route [7,8] and takes the route 8 -> 7 +# So the final route is (1,2,3,8,7) +# ----------------------------------- +# Flatten the set of routes to form the entire graph, then do a path +# search in the total graph. +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; +my $Source; +my $Destination; + +package Graph; +{ +use builtin qw/true false/; no warnings "experimental::builtin"; + + use Moo; + use Carp qw/confess/; + + has adj => ( is => 'rw', default => sub{ {} } ); + + sub show($self) + { + for my $node ( sort keys %{$self->{adj}} ) + { + say "$node --> [ ", join(",", sort $self->{adj}{$node}->@*), " ]";; + } + } + + sub addNode($self, $n) + { + $self->{adj}{$n} //= []; + } + + sub addEdge($self, $v1, $v2) + { + $self->addNode($v1); + my $neighbors = $self->{adj}{$v1}; + push @{$neighbors}, $v2 unless grep { $_ == $v2 } $neighbors->@*; + return $self; + } + + sub hasNode($self, $n) + { + return exists $self->{adj}{$n}; + } + + sub route($self, $source, $destination) + { + no warnings "experimental::builtin"; + use List::Util qw/uniq/; + return [ $source] if ( $source == $destination ); + + # Breadth-first search + my @path; + my @queue = ( $source ); + my %seen; + + while ( @queue ) + { + my $node = shift @queue; + push @path, $node; + + my $neighbors = $self->{adj}{$node}; + for my $neighbor ( grep { !$seen{$_} } $neighbors->@* ) + { + say "Q:[@queue] P:[@path] n:$neighbor" if $Verbose; + if ( $neighbor == $destination ) + { + return [ @path, $neighbor ]; + } + push @queue, $neighbor; + } + + $seen{$node} = true; + } + return []; + } +} + +package main; + +use Graph; + +sub shortestRoute($segments, $source, $destination) +{ + my $g = Graph->new; + for my $route ( $segments->@* ) + { + my $v1 = shift @$route; + $g->addNode($v1); + while ( @$route ) + { + my $v2 = shift @$route; + $g->addEdge($v1,$v2)->addEdge($v2,$v1); + $v1 = $v2; + } + } + $g->show if $Verbose; + return [] unless $g->hasNode($source) && $g->hasNode($destination); + return $g->route($source, $destination); +} + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, + "source:i" => \$Source, "dest:i" => \$Destination); +exit(!runTest()) if $DoTest; + +my @routeList; +push @routeList, [ split(",", $_) ] for @ARGV; + +say "(", join(",", shortestRoute(\@routeList, $Source, $Destination)->@*), ")"; + +sub runTest +{ + use Test2::V0; + + is( shortestRoute( [[1,2,6],[5,6,7]], 1, 7), [1,2,6,7], "Example 1"); + is( shortestRoute( [[1,2,3],[4,5,6]], 3, 6), [], "Example 2"); + is( shortestRoute( [[1,2,3],[4,5,6],[3,8,9],[7,8]], 1, 7), [1,2,3,8,7], "Example 3"); + is( shortestRoute( [[1,2,6,7],[5,6,7],[1,2,6,7]], 1, 7), [1,2,6,7], "Redundant edges"); + is( shortestRoute( [[1,2,3]], 2, 2), [2], "Going nowhere"); + is( shortestRoute( [[2]], 2, 2), [2], "Going nowhere faster"); + + done_testing; +} -- cgit From ec3eb82c6fbf7b795c2646713b23538127571937 Mon Sep 17 00:00:00 2001 From: Mohammad S Anwar