From 137914589b4efeb4175a49b6d06a56600b5994a9 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Tue, 9 Nov 2021 22:43:47 -0600 Subject: Add new solution --- challenge-138/wlmb/perl/ch-2.pl | 12 ++++++------ challenge-138/wlmb/perl/ch-2a.pl | 28 ++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 6 deletions(-) create mode 100755 challenge-138/wlmb/perl/ch-2a.pl 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; +} -- cgit