Solutions to PWC114

3 files changed, 50 insertions, 0 deletions

diff --git a/challenge-114/wlmb/blog.txt b/challenge-114/wlmb/blog.txt
new file mode 100644
index 0000000000..32c14eb0dc
--- /dev/null
+++ b/challenge-114/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/05/24/PWC114/
diff --git a/challenge-114/wlmb/perl/ch-1.pl b/challenge-114/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..89805afb89
--- /dev/null
+++ b/challenge-114/wlmb/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+  # Perl weekly challenge 114
+  # Task 1:
+  #
+  # See https://wlmb.github.io/2021/05/24/PWC114/#task-1-next-palindrome-number
+  use strict;
+  use warnings;
+  use v5.12;
+  use Scalar::Util qw(looks_like_number);
+  use POSIX qw(floor);
+
+  foreach my $N(@ARGV){
+      die "Usage: ./ch-1.pl n m ... with positive integer arguments"
+	  unless looks_like_number $N and $N>=0 and $N==floor $N;
+      say "Input: $N, Output: ", palindrome(split '', $N+1);
+  }
+  sub palindrome {
+      my @digits=@_;
+      return @digits if @digits==1;
+      return ($digits[0]) x 2 if @digits==2 and $digits[0]>=$digits[1];
+      return ($digits[0]+1) x 2 if @digits==2 and $digits[0]<$digits[1];
+      return ($digits[0], palindrome(@digits[1..@digits-2]), $digits[0])
+	  if $digits[0]>=$digits[-1];
+      my @M=palindrome(split('', join('', @digits[1..@digits-2])+1));
+      return ($digits[0],@M,$digits[0]) if @M==@digits-2;
+      return ($digits[0]+1, ((0)x(@digits-2), $digits[0]+1));
+  }
diff --git a/challenge-114/wlmb/perl/ch-2.pl b/challenge-114/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..7776a051dc
--- /dev/null
+++ b/challenge-114/wlmb/perl/ch-2.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 114
+# Task 2: Higher integer set bits
+#
+# See https://wlmb.github.io/2021/05/24/PWC114/#task-2-next-palindrome-number
+use strict;
+use warnings;
+use v5.12;
+use Scalar::Util qw(looks_like_number);
+use POSIX qw(floor);
+
+foreach my $N(@ARGV){
+    die "Usage: ./ch-2.pl n m ... with positive integer arguments"
+	unless looks_like_number $N and $N>0 and $N==floor $N;
+    #convert to binary and add leading 0
+    my $binary="0". sprintf("%b", $N);
+    my $next_binary=$binary;
+    #replace least significant 01 to 10 and shift following 1's to the right
+    $next_binary=~s/01(1*)(0*)$/10$2$1/;
+    my $next_dec=sprintf "%d", oct("0b$next_binary"); #convert to decimal
+    say "$N ($binary)=>$next_dec ($next_binary)";
+}