Merge pull request #1977 from PerlBoy1967/branch-for-challenge-070

Branch for challenge 070

2 files changed, 99 insertions, 0 deletions

diff --git a/challenge-070/perlboy1967/perl/ch-1.pl b/challenge-070/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..0e860062fe
--- /dev/null
+++ b/challenge-070/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 070
+#
+# Task 1 - Character Swapping
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+sub characterSwapping($$$);
+
+die "Minimal arguments is three" 
+  unless scalar(@ARGV) >=3 ;
+
+my ($S, $C, $O) = @ARGV;
+my $N = length($S);
+
+die "Invalid arguments given"
+  unless ($C >= 1 and 
+          $O >= 1 and 
+          $C <= $O and 
+          $C +$O <= $N and
+          $C <= $O);
+
+printf q{
+Input:
+  $S = '%s'
+  $C = %d
+  $O = %d 
+
+}, $S, $C, $O;
+
+my $s = characterSwapping($S, $C, $O);
+
+print qq{
+Output:
+  $s
+};
+
+
+sub characterSwapping($$$) {
+  my ($S, $C, $O) = @_;
+
+  my @s = split(//, $S);
+
+  print "Character Swapping:\n";
+
+  foreach my $i (1 .. $C) {
+    my @i = ($i % $N, ($i + $O) % $N);
+
+    print "  swap: $s[$i[0]] <=> $s[$i[1]] = ";
+
+    @s[@i] = @s[reverse @i];
+
+    print join('', @s)."\n";
+  }
+
+  return join('', @s);
+}
diff --git a/challenge-070/perlboy1967/perl/ch-2.pl b/challenge-070/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..edcf137275
--- /dev/null
+++ b/challenge-070/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 070
+#
+# Task 2 - Gray Code Sequence
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+sub genGrayCodeSequence($);
+
+my ($N) = @ARGV;
+
+die "Argument must be a positive number"
+  unless ($N =~ m#^\d+$#);
+
+my @g = genGrayCodeSequence($N);
+
+printf q{
+Input: $N = %d
+Output: [%s]
+}, $N, join(', ', @g);
+
+sub genGrayCodeSequence($) {
+  my ($N) = @_;
+
+  my @g = (0, 1);
+
+  for my $i (2 .. $N) {
+    map { $_ = "0$_" } @g;
+    map { m/^.(.*)/; push(@g, "1$1") } reverse @g;
+  }
+
+  map { $_ = oct("0b$_") } @g;
+}
+