Add new solution to task 2

2 files changed, 52 insertions, 1 deletions

diff --git a/challenge-112/wlmb/perl/ch-1.pl b/challenge-112/wlmb/perl/ch-1.pl
index d7ad86aee9..e218544ad3 100755
--- a/challenge-112/wlmb/perl/ch-1.pl
+++ b/challenge-112/wlmb/perl/ch-1.pl
@@ -13,7 +13,7 @@ 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 //
+    while($path=~s{//}{/}){}; # remove all //
     while($path=~s{/\./}{/}){}; # remove all /.
     while($path=~s{/[^/]+?/\.\./}{/}){}; # remove all /dir/..
     while($path=~s{^/(\.\./)+}{/}){}; # remove all leading  /..
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);
+}