From f9854512e9ecd6689181bd31631eb966c51ac7a7 Mon Sep 17 00:00:00 2001
From: wanderdoc <wanderdoc@googlemail.com>
Date: Sun, 7 Nov 2021 16:22:20 +0100
Subject: Solutions to challenge-137

---
 challenge-137/wanderdoc/perl/ch-1.pl | 37 ++++++++++++++++++++
 challenge-137/wanderdoc/perl/ch-2.pl | 65 ++++++++++++++++++++++++++++++++++++
 2 files changed, 102 insertions(+)
 create mode 100644 challenge-137/wanderdoc/perl/ch-1.pl
 create mode 100644 challenge-137/wanderdoc/perl/ch-2.pl

diff --git a/challenge-137/wanderdoc/perl/ch-1.pl b/challenge-137/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..d46f5135f9
--- /dev/null
+++ b/challenge-137/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to find all the years between 1900 and 2100 which is a Long Year. A year is Long if it has 53 weeks.
+
+Expected Output
+
+1903, 1908, 1914, 1920, 1925, 1931, 1936, 1942, 1948, 1953, 1959, 1964, 1970, 1976, 1981, 1987, 1992, 1998, 2004, 2009, 2015, 2020, 2026, 2032, 2037, 2043, 2048, 2054, 2060, 2065, 2071, 2076, 2082, 2088, 2093, 2099
+=cut
+
+
+
+
+
+
+
+use Time::Piece;
+
+my @expected = (1903, 1908, 1914, 1920, 1925, 1931, 1936, 1942, 1948, 1953, 1959, 1964, 1970, 1976, 1981, 1987, 1992, 1998, 2004, 2009, 2015, 2020, 2026, 2032, 2037, 2043, 2048, 2054, 2060, 2065, 2071, 2076, 2082, 2088, 2093, 2099);
+my %exp;
+@exp{@expected} = ();
+
+
+
+for my $year ( 1900 .. 2100 )
+{
+     my $last_day_of_year = Time::Piece->strptime("${year}-12-31", "%Y-%m-%d");
+     if ( 53 == $last_day_of_year->week )
+     {
+          print $year, $/;
+          warn "Year missed: $year.$/" if not exists $exp{$year};
+          delete $exp{$year};
+     }
+}
+warn "Year $_ was not discovered.$/" for keys %exp;
\ No newline at end of file
diff --git a/challenge-137/wanderdoc/perl/ch-2.pl b/challenge-137/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..cbad1cd06d
--- /dev/null
+++ b/challenge-137/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a number, 10 <= $n <= 1000. Write a script to find out if the given number is Lychrel number. To keep the task simple, we impose the following rules:
+a. Stop if the number of iterations reached 500.
+b. Stop if you end up with number >= 10_000_000.
+According to wikipedia:
+    A Lychrel number is a natural number that cannot form a palindrome through the iterative process of repeatedly reversing its digits and adding the resulting numbers.
+=cut
+
+
+
+
+
+
+use bigint accuracy => 50;
+sub lychrel
+{
+     my $num = $_[0]; 
+     $num += 0;
+     my $palindrome = scalar reverse $num;
+     return $num + $palindrome;
+}
+
+
+sub is_palindrome
+{
+     return ($_[0] eq scalar reverse $_[0]) ? 1 : 0;
+}
+
+my @candidates;
+
+for my $i ( 10 .. 1_000 )
+{
+     print "$i "; # , $/;
+     print "is palindrome itself.$/" and next if (is_palindrome($i));
+
+
+     my $counter;
+     my $break_flag = 0;
+     my $num = $i;
+
+     while ( not is_palindrome($num) )
+     {
+          $num = lychrel($num);
+          $counter++;
+
+          if (500 == $counter)  { $break_flag = 1; last; };
+          if (1e50 <= $num) { $break_flag = 2; last; };
+     }
+
+     my $statement = $break_flag > 0 ? ": stopped after " : ": palindrome $num after ";
+     $statement .= $break_flag == 1 ? "the number reached  $num." : 
+               "$counter iterations.";
+     print $statement, $/;
+
+     if ( not is_palindrome($num) ) { push @candidates, [$i, $counter, $num]; }
+}
+
+for my $cand ( @candidates )
+{
+     print join(' ', $cand->[0], 'is Lychrel-candidate after', $cand->[1], 'iterations:', $cand->[2]), $/;
+}
\ No newline at end of file
-- 
cgit