Merge pull request #132 from jmaslak/jmaslak-7.2

Joelle's solutions for 7.2

2 files changed, 208 insertions, 0 deletions

diff --git a/challenge-007/joelle-maslak/perl5/ch-2.pl b/challenge-007/joelle-maslak/perl5/ch-2.pl
new file mode 100755
index 0000000000..6aaccd1ba0
--- /dev/null
+++ b/challenge-007/joelle-maslak/perl5/ch-2.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/env perl
+use v5.26;
+use strict;
+use warnings;
+
+# Turn on method signatures
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use autodie;
+
+if ( @ARGV < 2 or @ARGV > 3 ) {
+    die("Provide start word, end word, and, optionally, word filename");
+}
+
+my $src  = $ARGV[0];
+my $dst  = $ARGV[1];
+my $file = $ARGV[2] // '/usr/share/dict/words';
+
+#
+# Copyright (C) 2019 Joelle Maslak
+# All Rights Reserved - See License
+#
+
+# Some changes between the challenge assumptions and what this handles:
+#
+# Words in the word list don't have to be the same length as the start
+# and end words.  Words in the list that differ in length from the
+# start/end words are just excluded from consideration.
+#
+# This doesn't care if the words in the list are alphabetical.
+#
+# Duplicates in the world list won't cause an issues.
+
+MAIN: {
+    die ("Words must be same length") if length($src) != length($dst);
+
+    if ($src eq $dst) {
+        say "$src";
+        exit;
+    }
+
+    if (length($src) == 1) {
+        say "$src $dst";
+        exit;
+    }
+
+    my (@srcword) = split //, $src;
+    my (@dstword) = split //, $dst;
+
+    open my $fh, '<', $file;
+    my @words;
+    while (my $line = <$fh>) {
+        chomp $line;
+        push @words, [ split //, fc($line) ];
+    }
+    close $fh;
+    @words = grep { scalar(@$_) == length($src) } sort @words;
+    if (! @words) { die("No words in word list that match the required length") }
+
+    my @pending;
+    push @pending, { word => [ @srcword ], path => [ ] };
+
+    state %paths;
+    $paths{$src} = [];
+
+    while (scalar(@pending)) {
+        my $checkword = shift @pending;
+        my $joinedcheck = join '', $checkword->{word}->@*;
+        my @potentials = find_one_off($checkword->{word}, \@words);
+
+        for my $potential (@potentials) {
+            # If we have found a path already, don't search along longer
+            # paths.
+            next if exists($paths{$dst}) and scalar($paths{$dst}->@*) < (scalar($checkword->{path}) + 1);
+           
+            my $joined = join '', @$potential;
+
+            # If we've visited a node already and it's got a shorter
+            # path (or even equal length), move on to the next potential
+            # word.
+            next if exists($paths{$joined}) and scalar($paths{$joined}->@*) <= (scalar($checkword->{path}->@*) + 1);
+
+            $paths{$joined} = [ $checkword->{path}->@* ];
+            push $paths{$joined}->@*, $joinedcheck;
+            my (@path) = grep { join('', $_->{word}) eq $joinedcheck } @pending;
+            if (scalar(@path) == 1) {
+                $path[0] = [ $checkword->{path}->@* ];
+                push $path[0]->@*, $joinedcheck;
+            } else {
+                push @pending, { word => $potential, path => [] };
+                $pending[-1]->{path} = [ $checkword->{path}->@* ];
+                push $pending[-1]->{path}->@*, $joinedcheck;
+            }
+        }
+    }
+
+    if (exists($paths{$dst})) {
+        say "Ladder found!";
+        say join(" ", $paths{$dst}->@*, $dst);
+    } else {
+        say "No ladder found";
+    }
+}
+
+sub find_one_off ( $current, $words ) {
+    return grep { notdifferent($current, $_) == scalar(@$current) - 1 } @$words;
+}
+
+sub notdifferent( $current, $word ) {
+    my $sum = 0;
+    for (my $i=0; $i<scalar(@$current); $i++) {
+        $sum++ if $current->[$i] eq $word->[$i];
+    }
+    return $sum;
+}
diff --git a/challenge-007/joelle-maslak/perl6/ch-2.p6 b/challenge-007/joelle-maslak/perl6/ch-2.p6
new file mode 100755
index 0000000000..6f16c9c4ba
--- /dev/null
+++ b/challenge-007/joelle-maslak/perl6/ch-2.p6
@@ -0,0 +1,92 @@
+#!/usr/bin/env perl6
+use v6;
+
+#
+# Copyright © 2019 Joelle Maslak
+# All Rights Reserved - See License
+#
+
+# Some changes between the challenge assumptions and what this handles:
+#
+# Words in the word list don't have to be the same length as the start
+# and end words.  Words in the list that differ in length from the
+# start/end words are just excluded from consideration.
+#
+# This doesn't care if the words in the list are alphabetical.
+#
+# Duplicates in the world list won't cause an issues.
+
+sub MAIN(Str:D $src, Str:D $dst, Str:D $file = '/usr/share/dict/words') {
+    die ("Words must be same length") if $src.chars ≠ $dst.chars;
+
+    if $src eq $dst {
+        say "$src";
+        exit;
+    }
+
+    if $src.chars == 1 {
+        say "$src $dst";
+        exit;
+    }
+
+    my @srcword = $src.comb;
+    my @dstword = $dst.comb;
+
+    my @words = $file.IO.lines.sort.unique.map( *.comb )».fc;
+    @words = @words.grep( *.elems == $src.chars );
+
+    my @pending.push: { word => @srcword, path => [ ] };
+    state %paths;
+    %paths<$srcword> = [];
+
+    while @pending.elems {
+        my $checkword = @pending.shift;
+        my $joinedcheck = $checkword<word>.join;
+        my @potentials = find_one_off($checkword<word>, @words);
+
+        for @potentials -> $potential {
+            # If we have found a path already, don't search along longer
+            # paths.
+            next if %paths{$dst}:exists and %paths{$dst}.elems < ($checkword<path>.elems + 1);
+           
+            my $joined = $potential.join;
+
+            # If we've visited a node already and it's got a shorter
+            # path (or even equal length), move on to the next potential
+            # word.
+            next if %paths{$joined}:exists and %paths{$joined}.elems ≤ ($checkword<path>.elems + 1);
+
+            %paths{$joined} = [ @($checkword<path>) ];
+            %paths{$joined}.push: $joinedcheck;
+            my $path = @pending.grep( { $^a<word>.join eq $joinedcheck } );
+            if $path.elems == 1 {
+                $path[0] = [ @($checkword<path>) ];
+                $path[0].push: $joinedcheck;
+            } else {
+                @pending.push: { word => $potential, path => [] };
+                @pending[*-1]<path> = [ @($checkword<path>) ];
+                @pending[*-1]<path>.push: $joinedcheck;
+            }
+        }
+    }
+
+    if %paths{$dst}:exists {
+        say "Ladder found!";
+        say %paths{$dst} ~ " " ~ $dst;
+    } else {
+        say "No ladder found";
+    }
+}
+
+sub find_one_off ( @current, @words ) {
+    return @words.grep( { notdifferent(@current, $^a) == @current.elems - 1 } );
+}
+
+sub notdifferent( @current, @word ) {
+    # return (@current Zeq @word).sum; # Slow...
+    my $sum = 0;
+    for ^@current.elems -> $i {
+        $sum++ if @current[$i] eq @word[$i];
+    }
+    return $sum;
+}