Merge pull request #1761 from Firedrake/rogerbw-challenge-062

Solutions for challenge #62.

3 files changed, 165 insertions, 0 deletions

diff --git a/challenge-062/roger-bell-west/perl/ch-1.pl b/challenge-062/roger-bell-west/perl/ch-1.pl
new file mode 100755
index 0000000000..c31ed049db
--- /dev/null
+++ b/challenge-062/roger-bell-west/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Std;
+
+my %o;
+getopts('u',\%o);
+
+my %l;
+
+while (<>) {
+  chomp;
+  my @e=split /@/,$_;
+  my $k=lc($e[1]).'!'.$e[0];
+  if ($o{u}) {
+    delete $l{$k};
+  }
+  push @{$l{$k}},$_;
+}
+
+foreach my $k (sort keys %l) {
+  print map {"$_\n"} @{$l{$k}};
+}
diff --git a/challenge-062/roger-bell-west/perl/ch-2.pl b/challenge-062/roger-bell-west/perl/ch-2.pl
new file mode 100755
index 0000000000..b1f6ea85b8
--- /dev/null
+++ b/challenge-062/roger-bell-west/perl/ch-2.pl
@@ -0,0 +1,102 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use List::Util qw(max);
+use Data::Dumper;
+
+my $n=$ARGV[0] || 4;
+
+my @a;
+
+my $o;
+my $m=0;
+
+my @ap=([1,2],[0,2],[0,1]);
+
+do {
+  my $r=[];
+  my @u;
+  my $cm=-1;
+  if (@a) {
+    $r=shift @a;
+    foreach my $c (@{$r}) {
+      foreach my $api (0..2) {
+        $u[$api]{$c->[$ap[$api][0]]}{$c->[$ap[$api][1]]}=1;
+        $cm=max($cm,compose(@{$c}));
+      }
+    }
+  }
+  my $d=0;
+  foreach my $x (0..$n-1) {
+    foreach my $y (0..$n-1) {
+      if (exists $u[2]{$x}{$y}) {
+        next;
+      }
+      foreach my $z (0..$n-1) {
+        if (exists $u[1]{$x}{$z} || exists $u[0]{$y}{$z}) {
+          next;
+        }
+        if (compose($x,$y,$z)<=$cm) {
+          next;
+        }
+        my @k=(@{$r},[$x,$y,$z]);
+      OUTER:
+        foreach my $a (0..$#k-1) {
+          foreach my $b ($a+1..$#k) {
+            foreach my $api (0..2) {
+              my @ax=grep {$_ != $api} (0..2);
+              my $l=abs($k[$a][$ax[0]]-$k[$b][$ax[0]]);
+              if ($l ==
+                    abs($k[$a][$ax[1]]-$k[$b][$ax[1]]) &&
+                    ($k[$a][$api] == $k[$b][$api] ||
+                       $l==abs($k[$a][$api]-$k[$b][$api]))) {
+                @k=();
+                last OUTER;
+              }
+            }
+          }
+        }
+        if (@k) {
+          $d=1;
+          push @a,\@k;
+        }
+      }
+    }
+  }
+  unless ($d) {
+    my $n=scalar @{$r};
+    if ($n>$m) {
+      print "$n\n";
+      $m=$n;
+      $o=$r;
+    }
+  }
+} while (@a);
+
+if (defined $o) {
+  my @grid;
+  foreach my $x (0..$n-1) {
+    my $a;
+    foreach my $y (0..$n-1) {
+      my $b;
+      foreach my $z (0..$n-1) {
+        push @{$b},0;
+      }
+      push @{$a},$b;
+    }
+    push @grid,$a;
+  }
+
+  foreach my $q (@{$o}) {
+    $grid[$q->[0]][$q->[1]][$q->[2]]=1;
+  }
+
+  print Dumper(\@grid);
+}
+
+sub compose {
+  my ($x,$y,$z)=@_;
+  return $x*$n*$n+$y*$n+$z;
+}
diff --git a/challenge-062/roger-bell-west/raku/ch-1.p6 b/challenge-062/roger-bell-west/raku/ch-1.p6
new file mode 100755
index 0000000000..055454f681
--- /dev/null
+++ b/challenge-062/roger-bell-west/raku/ch-1.p6
@@ -0,0 +1,38 @@
+#! /usr/bin/perl6
+
+my $u=0;
+
+my @fn;
+for @*ARGS -> $p {
+  if ($p.IO.e) {
+    push @fn,$p;
+  } elsif ($p eq '-u') {
+    $u=1;
+  }
+}
+unless (@fn) {
+  push @fn,'-';
+}
+
+my %l;
+
+for @fn -> $fn {
+  my $fh=open :r,$fn;
+  for $fh.lines {
+    .chomp;
+    my @e=comb(/<-[@]>+/,$_);
+    my $k=lc(@e[1]) ~ '!' ~ @e[0];
+    if ($u) {
+      %l{$k}:delete;
+    }
+    push %l{$k},$_;
+  }
+  close $fh;
+}
+
+for (sort keys %l) -> $k {
+  my @q=%l{$k}.flat;
+  for @q -> $e {
+    say $e;
+  }
+}