Merge pull request #4074 from wlmb/challenges

Solutions to challenge 112

5 files changed, 144 insertions, 0 deletions

diff --git a/challenge-112/wlmb/blog.txt b/challenge-112/wlmb/blog.txt
new file mode 100644
index 0000000000..30d1440d9c
--- /dev/null
+++ b/challenge-112/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/05/12/PWC112/
diff --git a/challenge-112/wlmb/perl/ch-1.pl b/challenge-112/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..e218544ad3
--- /dev/null
+++ b/challenge-112/wlmb/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 112
+# Task 1: Canonical path
+#
+# See https://wlmb.github.io/2021/05/12/PWC112/#task-1-canonical-path
+use strict;
+use warnings;
+use v5.12;
+use Cwd qw(cwd);
+
+my $cwd=cwd; # Current working directory, for relative paths
+for my $input(@ARGV){ #provide paths in @ARGV
+    my $path=$input;
+    $path = "$cwd/$path" unless $path=~m{^/}; # relative -> absolute path
+    $path.="/"; #add temporal trailing slash as guard
+    while($path=~s{//}{/}){}; # remove all //
+    while($path=~s{/\./}{/}){}; # remove all /.
+    while($path=~s{/[^/]+?/\.\./}{/}){}; # remove all /dir/..
+    while($path=~s{^/(\.\./)+}{/}){}; # remove all leading  /..
+    $path=~s{^(/.*)/$}{$1}; # remove trailing / if not first
+    say "Input: $input Output: $path";
+}
diff --git a/challenge-112/wlmb/perl/ch-2.pl b/challenge-112/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..67187ad3c9
--- /dev/null
+++ b/challenge-112/wlmb/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 112
+# Task 2: Climb stairs. Count ways.
+#
+# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
+  use strict;
+  use warnings;
+  use v5.12;
+  use Memoize;
+  foreach my $n(@ARGV){ # Number of steps from @ARGV
+      my $ways=0;
+      foreach my $n2(0..$n/2){
+	  my $n1=$n-2*$n2;
+	  $ways+=factorial($n1+$n2)/(factorial($n1)*factorial($n2));
+      }
+      say "Input: $n  Output: $ways";
+  }
+
+memoize('factorial');
+sub factorial {
+    my $x=shift @_; #assume non-negative integer
+    return 1 if $x==0 or $x==1;
+    return $x*factorial($x-1);
+}
diff --git a/challenge-112/wlmb/perl/ch-2a.pl b/challenge-112/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..ba4475eb14
--- /dev/null
+++ b/challenge-112/wlmb/perl/ch-2a.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 112
+# Task 2: Climb stairs. List ways.
+#
+# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
+  use strict;
+  use warnings;
+  use v5.12;
+  use List::Util qw(sum0);
+  foreach my $n(@ARGV){  # Number of steps from @ARGV
+      say "\nInput: $n\nCombinations:";
+      foreach my $n2(0..$n/2){
+	  my $n1=$n-2*$n2;
+	  my $total=$n1+$n2;
+	  my $combinator=combinator($total, $n1);
+	  while(my @combination=$combinator->()){
+	      say join ",", map {$_==0?"double":"single"} @combination;
+	  }
+      }
+  }
+
+  sub combinator { # produces combinations of n taken k at a time
+      my ($n,$k)=@_;
+      my @number=((1) x $k, (0) x ($n-$k)); # binary $n-bit number as array
+      my $done=0;
+      my $iter=0;
+      sub { #dumb but simple
+	  return if $done;
+	  return @number if $iter++==0; #first time through
+	  while(increment(@number)){
+	      return @number if sum0(@number)==$k;
+	  }
+	  $done=1;
+	  return;
+      }
+  }
+
+  sub increment {
+      $_[0]++; #use @_ directly to modify it
+      for(0..@_-2){
+	  return @_ if $_[$_] < 2;
+	  $_[$_]=0;  #carry to next digit
+	  ++$_[$_+1];
+      }
+      return @_ if $_[-1] < 2;
+  }
diff --git a/challenge-112/wlmb/perl/ch-2b.pl b/challenge-112/wlmb/perl/ch-2b.pl
new file mode 100755
index 0000000000..16d1b18d30
--- /dev/null
+++ b/challenge-112/wlmb/perl/ch-2b.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 112
+# Task 2: Climb stairs. List ways, second attempt try.
+#
+# See https://wlmb.github.io/2021/05/12/PWC112/#task-2-climb-stairs
+  use strict;
+  use warnings;
+  use v5.12;
+  use List::Util qw(sum0 first);
+  foreach my $n(@ARGV){  # Number of steps from @ARGV
+      say "\nInput: $n\nCombinations:";
+      foreach my $n2(0..$n/2){
+	  my $n1=$n-2*$n2;
+	  my $total=$n1+$n2;
+	  my $combinator=combinator($total, $n1);
+	  while(my @combination=$combinator->()){
+	      say join ",", map {$_==0?"double":"single"} @combination;
+	  }
+      }
+  }
+
+  sub combinator { # produces combinations of n taken k at a time
+      my ($n,$k)=@_;
+      my @number=((1) x $k, (0) x ($n-$k)); # binary $n-bit number as array
+      my $done=0;
+      my $iter=0;
+      sub {
+	  return if $done;
+	  return @number if $iter++==0; #first time through
+	  @number=following(@number);
+	  return @number if @number;
+	  $done=1;
+	  return;
+      }
+  }
+
+sub following {
+    my @number=@_;
+    my $first_10=first {$number[$_]==1 && $number[$_+1]==0} (0..@number-2);
+    return unless defined $first_10;
+    @number[$first_10, $first_10+1]=(0,1);
+    restart (@number[0..$first_10-1]);
+    return @number;
+}
+
+sub restart {
+    return unless @_;
+    my $ones=sum0 @_;
+    @_[0..$ones-1]=(1)x$ones;
+    @_[$ones..@_-1]=(0)x(@_-$ones);
+}