Merge pull request #1612 from Firedrake/rogerbw-challenge-057

Solutions to challenge #57

3 files changed, 150 insertions, 0 deletions

diff --git a/challenge-057/roger-bell-west/perl5/ch-1.pl b/challenge-057/roger-bell-west/perl5/ch-1.pl
new file mode 100755
index 0000000000..e7f12faa92
--- /dev/null
+++ b/challenge-057/roger-bell-west/perl5/ch-1.pl
@@ -0,0 +1,40 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use List::Util qw(max);
+
+my @tree=qw(1 .2 ..4 ..5 .3 ..6 ..7);
+
+my %tree;
+{
+  my @parent;
+  foreach my $index (0..$#tree) {
+    $tree[$index] =~ /^(\.*)(\d+)/;
+    my ($depth,$val)=(length($1),$2);
+    $tree{$index}{value}=$val;
+    if ($depth>0) {
+      push @{$tree{$parent[$depth-1]}{children}},$index;
+    }
+    $parent[$depth]=$index;
+  }
+}
+
+foreach my $k (keys %tree) {
+  if (exists $tree{$k}{children}) {
+    @{$tree{$k}{children}}=reverse @{$tree{$k}{children}};
+  }
+}
+
+tdump(\%tree,0,0);
+
+sub tdump {
+  my ($tree,$index,$depth)=@_;
+  print '.' x $depth,$tree->{$index}{value},"\n";
+  if (exists $tree->{$index}{children}) {
+    foreach my $c (@{$tree->{$index}{children}}) {
+      tdump($tree,$c,$depth+1);
+    }
+  }
+}
diff --git a/challenge-057/roger-bell-west/perl5/ch-1a.pl b/challenge-057/roger-bell-west/perl5/ch-1a.pl
new file mode 100755
index 0000000000..76642c66db
--- /dev/null
+++ b/challenge-057/roger-bell-west/perl5/ch-1a.pl
@@ -0,0 +1,87 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use List::Util qw(max);
+
+my @tree=qw(1 .2 ..4 ..5 .3 ..6 ..7);
+
+my %tree;
+{
+  my @parent;
+  foreach my $index (0..$#tree) {
+    $tree[$index] =~ /^(\.*)(\d+)/;
+    my ($depth,$val)=(length($1),$2);
+    $tree{$index}{value}=$val;
+    if ($depth>0) {
+      push @{$tree{$parent[$depth-1]}{children}},$index;
+    }
+    $parent[$depth]=$index;
+  }
+}
+
+foreach my $k (keys %tree) {
+  if (exists $tree{$k}{children}) {
+    @{$tree{$k}{children}}=reverse @{$tree{$k}{children}};
+  }
+}
+
+my %d;
+my @t=([0,0]);
+while (@t) {
+  my $i=shift @t;
+  my ($index,$depth)=@{$i};
+  push @{$d{$depth}},$index;
+  if (exists $tree{$index}{children}) {
+    push @t,map {[$_,$depth+1]} @{$tree{$index}{children}};
+  }
+}
+
+my %c;
+my @out;
+my $d=max(keys %d);
+while (1) {
+  my @r;
+  if (@out) {
+    foreach my $i (0..$#{$d{$d}}) {
+      my $si=$tree{$d{$d}[$i]}{children}[0] or die "need a full tree";
+      $r[$i]=$c{$si}+2;
+    }
+  } else {
+    my $noffsets=scalar @{$d{$d}};
+    my $j=-2;
+    while ($noffsets) {
+      $j+=2;
+      push @r,$j;
+      $j+=4;
+      push @r,$j;
+      $noffsets-=2;
+    }
+  }
+  my $str=' ' x (max @r);
+  my $stru=' ' x ((max @r)-1);
+  my $m=0;
+  foreach my $i (0..$#{$d{$d}}) {
+    substr($str,$r[$i],1)=$tree{$d{$d}[$i]}{value};
+    $c{$d{$d}[$i]}=$r[$i];
+    unless ($d==0) {
+      if ($m%2==0) {
+        substr($stru,$r[$i]+1,1)='/';
+      } else {
+        substr($stru,$r[$i]-1,1)='\\';
+      }
+      $m++;
+    }
+  }
+  unshift @out,$str;
+  if ($d>0) {
+    unshift @out,$stru;
+  }
+  if ($d==0) {
+    last;
+  }
+  $d--;
+}
+
+print map {"$_\n"} @out;
diff --git a/challenge-057/roger-bell-west/perl5/ch-2.pl b/challenge-057/roger-bell-west/perl5/ch-2.pl
new file mode 100755
index 0000000000..6001ce9c38
--- /dev/null
+++ b/challenge-057/roger-bell-west/perl5/ch-2.pl
@@ -0,0 +1,23 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+my @input=qw(alphabet book carpet cadmium cadeau alpine);
+
+my @out;
+my %input=map {$_ => 1} @input;
+my $len=1;
+while (%input) {
+  my %k;
+  map {push @{$k{substr($_,0,$len)}},$_} keys %input;
+  foreach my $k (keys %k) {
+    if (scalar keys @{$k{$k}}==1) {
+      push @out,$k;
+      delete $input{$k{$k}[0]};
+    }
+  }
+  $len++;
+}
+
+print map {"$_\n"} sort @out;