Merge pull request #4509 from wlmb/challenges

Solutions to PWC121

6 files changed, 183 insertions, 0 deletions

diff --git a/challenge-121/wlmb/blog.txt b/challenge-121/wlmb/blog.txt
new file mode 100644
index 0000000000..19d3dcd719
--- /dev/null
+++ b/challenge-121/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/07/12/PWC121/
diff --git a/challenge-121/wlmb/perl/ch-1.pl b/challenge-121/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..b156a1110d
--- /dev/null
+++ b/challenge-121/wlmb/perl/ch-1.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 121
+# Task 1: Invert bit
+#
+# See https://wlmb.github.io/2021/07/12/PWC121/#task-1-invert-bit
+use strict;
+use warnings;
+use v5.12;
+use List::Util qw(pairs);
+use POSIX qw(round);
+foreach(pairs @ARGV){
+    my ($n,$b)=map {round $_} @$_; # Assure integer
+    say("Wrong range: 0<=$n<=255 && 1<=$b<=8?"), next
+        unless 0<=$n<=255 && 1<=$b<=8; # ??
+    my $r=(1<<($b-1))^$n; # Count bits from 1, not 0
+    say "Number: $n, Bit: $b, Output: $r";
+}
diff --git a/challenge-121/wlmb/perl/ch-2-helper.pl b/challenge-121/wlmb/perl/ch-2-helper.pl
new file mode 100755
index 0000000000..699d053b81
--- /dev/null
+++ b/challenge-121/wlmb/perl/ch-2-helper.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 121
+# Task 2: The travelling salesman. Auxiliary program
+#
+# See https://wlmb.github.io/2021/07/12/PWC121/#task-2-the-travelling-salesman
+use strict;
+use warnings;
+use v5.12;
+use PDL;
+foreach(@ARGV){
+    my $m=random($_,$_);
+    $m->diagonal(0,1).=0; # zero the diagonal
+    $m= ($m+$m->transpose)/2; #symmetrize (?)
+    # Format:
+    print "\'[", join(',', map {'['. join(',', @$_).']'} @{unpdl $m}), "]\' ";
+}
diff --git a/challenge-121/wlmb/perl/ch-2.pl b/challenge-121/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..625227ef9d
--- /dev/null
+++ b/challenge-121/wlmb/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 121
+# Task 2: The travelling salesman
+#
+# See https://wlmb.github.io/2021/07/12/PWC121/#task-2-the-travelling-salesman
+use strict;
+use warnings;
+use v5.12;
+use PDL; # Perl data language
+
+foreach(@ARGV){
+    #Assume the matrix is of the form [[m00,m01,m02..],[m10,m11,...]...]
+    my $M=pdl($_);
+    say("Require square matrix"), next unless $M->ndims==2 and $M->dim(0)==$M->dim(1);
+    say("Self distances should be null"), next unless all($M->diagonal(0,1)==0);
+    my $N=$M->dim(0); # number of cities
+    my $iterate=permutator($N);
+    my $best_tour;
+    my $shortest_length;
+    while(my @cities=$iterate->()){ # for each possible trip
+	my $tour=pdl(@cities);
+	my $indices=pdl($tour->rotate(-1), $tour)->transpose; #pair next city to current city
+	my $length=$M->indexND($indices)->sumover; # get distances for this trip and sum
+	($best_tour, $shortest_length)=($tour, $length)
+	    if !defined $shortest_length || $length<$shortest_length;
+    }
+    $best_tour=append($best_tour,0); #go back to the first city
+    say "\nInput $M\nBest tour: $best_tour\nShortest length: $shortest_length";
+    say("Strange metric: Length A->B not equal Length B->A")
+        unless all $M==$M->transpose;
+}
+
+  sub permutator { #returns an iterator for permutations
+      my $n_items=(shift)-1;
+      my @items=1..$n_items;
+      my $n=0;
+      my $done=0;
+      sub {
+	  return if $done;
+	  my $which=$n; #next item to transpose
+	  return 0,@items if $n++ == 0; #return first time through
+	  my $with_whom=1; #with whom to permute
+	  while($with_whom<=$n_items&&$which%$with_whom==0){
+	      $which/=$with_whom;
+	      ++$with_whom;
+	  }
+	  $done=1, return if $with_whom >$n_items; #no more transpositions
+	  $which=$with_whom-$which%$with_whom;
+	  #use negative indices to transpose rightmost first
+	  @items[-$with_whom+1..-1]=reverse @items[-$with_whom+1..-1]; #reorder
+	  @items[-$which,-$with_whom]=@items[-$with_whom,-$which]; # transpose
+	  return 0,@items
+      }
+  }
diff --git a/challenge-121/wlmb/perl/ch-2a.pl b/challenge-121/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..20945defc6
--- /dev/null
+++ b/challenge-121/wlmb/perl/ch-2a.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 121
+# Task 2: The travelling salesman. Simulated Annealing
+#
+# See https://wlmb.github.io/2021/07/12/PWC121/#task-2-the-travelling-salesman
+use strict;
+use warnings;
+use v5.12;
+use PDL;
+
+die "Usage: ./ch-2a.pl cities steps high low data" unless @ARGV==5;
+my ($cities, $steps, $high, $low, $data)=@ARGV;
+open(my $fh, '>', $data) or die "Couldn't open $data: $!";
+srand(0); #seed, for tests
+my $M=random($cities, $cities); # generate distances matrix
+$M->diagonal(0,1).=0; # zero the diagonal
+$M= ($M+$M->transpose)/2; #symmetrize (?)
+my $L0=$high; # starting 'temperature'
+my $L_stop=$low;
+my $factor=($low/$high)**(1/$steps);
+my $route=pdl(0..$cities-1); #initial route
+my $L=distance($route);
+while($L0>$L_stop){
+    my $new_route=step($route);
+    my $new_L=distance($route);
+    my $dL=$new_L-$L;
+    if($dL<=0 || random(1)<exp(-$dL/$L0)){
+	$route=$new_route; # accept
+	$L=$new_L;
+    }
+    say $fh $L;
+    $L0*=$factor;
+}
+my $best_route=append($route, 0);
+say "Distance table: $M\nSteps: $steps\nCities: $cities\nRoute: $best_route\nLength: $L";
+
+sub step {
+    my $i=random(2)*($cities-1)+1;
+    my $new_route=$route->copy;
+    $new_route->index($i).=$new_route->index($i->rotate(1));
+    return $new_route;
+}
+
+sub distance {
+    my $r=shift;
+    my $indices=pdl($r->rotate(-1),$r)->transpose;
+    return $M->indexND($indices)->sumover;
+}
diff --git a/challenge-121/wlmb/perl/ch-2b.pl b/challenge-121/wlmb/perl/ch-2b.pl
new file mode 100755
index 0000000000..c4a4c29070
--- /dev/null
+++ b/challenge-121/wlmb/perl/ch-2b.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 121
+# Task 2: The travelling salesman. Simulated Annealing
+#
+# See https://wlmb.github.io/2021/07/12/PWC121/#task-2-the-travelling-salesman
+use strict;
+use warnings;
+use v5.12;
+use PDL;
+
+die "Usage: ./ch-2a.pl cities steps high low data" unless @ARGV==5;
+my ($cities, $steps, $high, $low, $data)=@ARGV;
+open(my $fh, '>', $data) or die "Couldn't open $data: $!";
+srand(0); #seed, for tests
+my $locations=random(2,$cities); #positions of cities in a plane
+my $M=(($locations->dummy(2)-$locations->dummy(1))**2)->sumover->sqrt; # euclidean distances
+my $L0=$high; # starting 'temperature'
+my $L_stop=$low;
+my $factor=($low/$high)**(1/$steps);
+my $route=pdl(0..$cities-1); #initial route
+my $L=distance($route);
+while($L0>$L_stop){
+    my $new_route=step($route);
+    my $new_L=distance($route);
+    my $dL=$new_L-$L;
+    if($dL<=0 || random(1)<exp(-$dL/$L0)){
+	$route=$new_route; # accept
+	$L=$new_L;
+    }
+    say $fh $L;
+    $L0*=$factor;
+}
+my $best_route=append($route, 0);
+say "Distance table: $M\nSteps: $steps\nCities: $cities\nRoute: $best_route\nLength: $L";
+
+sub step {
+    my $i=random(2)*($cities-1)+1;
+    my $new_route=$route->copy;
+    $new_route->index($i).=$new_route->index($i->rotate(1));
+    return $new_route;
+}
+
+sub distance {
+    my $r=shift;
+    my $indices=pdl($r->rotate(-1),$r)->transpose;
+    return $M->indexND($indices)->sumover;
+}