Merge pull request #5194 from wlmb/challenges

Add new solution

2 files changed, 34 insertions, 6 deletions

diff --git a/challenge-138/wlmb/perl/ch-2.pl b/challenge-138/wlmb/perl/ch-2.pl
index 2832040d55..4fe8e7a600 100755
--- a/challenge-138/wlmb/perl/ch-2.pl
+++ b/challenge-138/wlmb/perl/ch-2.pl
@@ -22,7 +22,7 @@ sub splits { # array of all possible ways to split a string
     my $counter=0;
     my @splits=();
     while(defined (my $split=one_split($string, $counter++))){
-	push @splits, $split;
+        push @splits, $split;
     }
     return @splits;
 }
@@ -35,11 +35,11 @@ sub one_split { # produce the n-th way to split a string
     my @chars=split "", $string;
     my @current=();
     for(0..$#chars){
-	unshift @current, pop @chars;
-	if(pop @binary_counter){
-	    unshift @split, join '', @current;
-	    @current=();
-	}
+        unshift @current, pop @chars;
+        if(pop @binary_counter){
+            unshift @split, join '', @current;
+            @current=();
+        }
     }
     unshift @split, join '', @current if @current;
     return [@split];
diff --git a/challenge-138/wlmb/perl/ch-2a.pl b/challenge-138/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..60d4f3b52c
--- /dev/null
+++ b/challenge-138/wlmb/perl/ch-2a.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 138
+# Task 2: Split number
+#
+# See https://wlmb.github.io/2021/11/09/PWC138/#task-2-split-number
+use v5.12;
+use warnings;
+use integer;
+use List::Util qw(sum0);
+use List::MoreUtils qw(pairwise);
+use POSIX qw(floor);
+N:
+    foreach my $N(@ARGV){
+        my $sqrt=floor sqrt($N);
+        say("$_ is not a perfect square"),next unless $sqrt**2==$N;
+        foreach(0..2**(length($N)-1)-1){
+            say("Input: $N Output: 1"), next N if sum0(one_split($N,$_))==$sqrt;
+        }
+        say "Input: $N Output: 0";
+}
+
+sub one_split { # produce the n-th way to split a string
+    my ($string, $counter)=@_;
+    my @binary_counter=map {$_?"-":""}
+         split "", sprintf "%0".length($string)."b", $counter;
+    my @chars=split "", $string;
+    return split "-", join "", pairwise {"$a$b" }@binary_counter, @chars;
+}