From aa64a9da8e325855e9d3e72bd571b16b90bbf78a Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Sat, 5 Jun 2021 00:08:16 -0500 Subject: Add comment --- challenge-115/wlmb/perl/ch-1.pl | 4 ++-- challenge-115/wlmb/perl/ch-1a.pl | 6 +++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/challenge-115/wlmb/perl/ch-1.pl b/challenge-115/wlmb/perl/ch-1.pl index a2accad0fd..7c3be5eee7 100755 --- a/challenge-115/wlmb/perl/ch-1.pl +++ b/challenge-115/wlmb/perl/ch-1.pl @@ -1,6 +1,6 @@ #!/usr/bin/env perl # Perl weekly challenge 115 -# Task 1: String Chain +# Task 1: String Chain. Connectivity matrix solution. # # See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain use strict; @@ -14,7 +14,7 @@ die "Usage ./ch-1.pl string1 [string2...]" unless @strings; my $C=zeroes(long,scalar(@strings), scalar(@strings)); #connectivity matrix map {my $f=$_;map {$C->slice("$f,$_").=follows($f, $_)} (0..@strings-1)}(0..@strings-1); -my $R=reduce {map{$_->diagonal(0,1).=0}($a,$b); $b x $a;} +my $R=reduce {map{$_->diagonal(0,1).=0}($a, $b); $b x $a;} ($C) x @strings; say "Input: ", join " ", @strings; say "Output: ", all($R->diagonal(0,1)>0); diff --git a/challenge-115/wlmb/perl/ch-1a.pl b/challenge-115/wlmb/perl/ch-1a.pl index a1edad7c3e..afc99d62a4 100755 --- a/challenge-115/wlmb/perl/ch-1a.pl +++ b/challenge-115/wlmb/perl/ch-1a.pl @@ -1,6 +1,6 @@ #!/usr/bin/env perl # Perl weekly challenge 115 -# Task 1: String Chain +# Task 1: String Chain. Build the circle. # # See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain use strict; @@ -23,21 +23,25 @@ say "Input: ", join " ", @strings; my $path=first {follows($_->[-1], $_->[0])} @paths; say "Output: ", defined $path?1:0; say "Path: ", join "-", @$path if defined $path; + sub follows { my ($from, $to)=@_; return substr($from,-1,1) eq substr($to,0,1); } + sub grow { my @paths=@_; my @new; push @new, grow_one($_) for @paths; return @new; } + sub grow_one { my $path=shift; my @new=grep {defined $_} map {add_to($path, $_)} @{$followers{$path->[-1]}}; return @new; } + sub add_to { my ($path, $string)=@_; return if any {$_ eq $string} @$path; # don't add duplicates -- cgit From c18fb21257876cc864357fa7a2237995c1f6b169 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Sat, 5 Jun 2021 00:08:30 -0500 Subject: Add third solution to challenge 1 --- challenge-115/wlmb/perl/ch-1b.pl | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100755 challenge-115/wlmb/perl/ch-1b.pl diff --git a/challenge-115/wlmb/perl/ch-1b.pl b/challenge-115/wlmb/perl/ch-1b.pl new file mode 100755 index 0000000000..089024cb56 --- /dev/null +++ b/challenge-115/wlmb/perl/ch-1b.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +# Perl weekly challenge 115 +# Task 1: String Chain. Königsberg bridges solution +# +# See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain +use strict; +use warnings; +use v5.12; +use Exporter::Renaming; # prevent name clashes +use List::Util Renaming=>[uniq=>'lu_uniq', reduce=>'lu_reduce', reductions=>undef]; +use PDL; +use PDL::NiceSlice; + +my @strings=@ARGV; +die "Usage ./ch-1.pl string1 [string2...]" unless @strings; +my @letters=lu_uniq map{(substr($_,0,1), substr($_,-1,1))} @strings; +my %index; +@index{@letters}=(0..@letters-1); +my $C=zeroes(scalar(@letters), scalar(@letters)); #connectivity matrix +$C->($_->[0],$_->[1]).=$C->($_->[0],$_->[1])+1 + foreach map { [$index{substr($_,0,1)},$index{substr($_,-1,1)}] } @strings; +my $balanced=all($C->sumover==$C->transpose->sumover); +my $final=lu_reduce {$a|$b} (reductions {$a x $b} (identity(scalar @letters), ($C) x (@letters-1))); +my $reachable=all($final!=0); +say "Input: ", join " ", @strings; +say "Output: ", $balanced &&$reachable? 1:0; -- cgit From 361db99262a1d5a011364490b727e8f381b73c98 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Sat, 5 Jun 2021 14:32:39 -0500 Subject: Confess mistake. --- challenge-115/wlmb/perl/ch-1.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-115/wlmb/perl/ch-1.pl b/challenge-115/wlmb/perl/ch-1.pl index 7c3be5eee7..91d51b3195 100755 --- a/challenge-115/wlmb/perl/ch-1.pl +++ b/challenge-115/wlmb/perl/ch-1.pl @@ -1,6 +1,6 @@ #!/usr/bin/env perl # Perl weekly challenge 115 -# Task 1: String Chain. Connectivity matrix solution. +# Task 1: String Chain. Connectivity matrix solution. Not quite correct. # # See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain use strict; -- cgit