- Added solutions by Wanderdoc.

2 files changed, 92 insertions, 0 deletions

diff --git a/challenge-048/wanderdoc/perl/ch-1.pl b/challenge-048/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..2c28fb81a8
--- /dev/null
+++ b/challenge-048/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+There are 50 people standing in a circle in position 1 to 50. The person standing at position 1 has a sword. He kills the next person i.e. standing at position 2 and pass on the sword to the immediate next i.e. person standing at position 3. Now the person at position 3 does the same and it goes on until only one survives.
+Write a script to find out the survivor.
+=cut
+
+=notes
+This is a special case of the Josephus problem. I already had an array solution for it (rotate per modulo and shift in a loop). The recent solution preserves the initial structure and modifies the elements only. At the same time I tried to make it general (for the different numbers). The 1-indexed data structure is assumed so there would be off by one differences with the 0-indexed solutions.
+=cut
+
+use Getopt::Long; 
+use List::Util qw(first);
+
+my %par = (h => 50, w => 2, s => 1);
+
+GetOptions( "howmany|h=i"   => \$par{h}, 
+              "which|w=i"   => \$par{w}, 
+           "survived|s=i"   => \$par{s}) 
+or die("Error in command line!\n");
+die "All numbers must be positive!$/" if defined first { $_ <= 0 } values %par;
+
+
+
+my $people = '';
+vec($people, $_, 1) = 1 for 1 .. $par{h};
+my $sword = 1; # 1-indexed by specification.
+while ( unpack ('%32b*', $people) > $par{s} )
+{
+     my $counter = 0;
+     while ( $counter < $par{w} - 1 )
+     {
+          $sword++; 
+          rotate(\$sword);
+          $counter++ if  1 == vec($people, $sword, 1);
+     }
+
+
+     vec($people, $sword, 1) = 0; 
+     print $sword, ' '; # To comment out on big numbers!
+     $sword++ and rotate(\$sword) while ( 0 == vec($people, $sword, 1) );
+}
+
+my @survived = grep 1 == vec($people, $_, 1), 1 .. $par{h};
+print "$/Survived: ", join(" ", @survived), $/;
+
+
+sub rotate
+{
+     ${$_[0]} %= $par{h} if ( ${$_[0]} > $par{h} );
+}
+
+# With -h 23482 -w 3343 -s 3: 1088 1336 13318 (s. jq on Rosetta).
+# Comment out printing the sequence before running!
\ No newline at end of file
diff --git a/challenge-048/wanderdoc/perl/ch-2.pl b/challenge-048/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..3d12d0e11b
--- /dev/null
+++ b/challenge-048/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to print all Palindrome Dates between 2000 and 2999. The format of date is mmddyyyy. For example, the first one was on October 2, 2001 as it is represented as 10022001.
+=cut
+
+use Time::Piece;
+use Time::Seconds;
+
+
+
+
+
+
+my $START = "01.01.2000";
+my $STOP  = "12.31.2999";
+my $INPUT_FORMAT = "%m.%d.%Y";
+
+my $t1 = Time::Piece->strptime($START, $INPUT_FORMAT);
+my $t2 = Time::Piece->strptime($STOP , $INPUT_FORMAT);
+
+my $counter;
+
+
+while ( $t1 <= $t2  )
+{
+      # Bypass the invalide months ( += ONE_YEAR would be wrong!):
+     ((reverse $t1->yy) + 0) > 12 and 
+          $t1 = Time::Piece->strptime("12.31." . $t1->year , $INPUT_FORMAT);
+     my $output_mdy = $t1->mdy('');
+     print join("\t", ++$counter, $output_mdy), $/ 
+          if $output_mdy eq reverse $output_mdy;
+     $t1 += ONE_DAY;
+}
\ No newline at end of file