- Added solutions by Laurent Rosenfeld.

11 files changed, 218 insertions, 0 deletions

diff --git a/challenge-007/laurent-rosenfeld/blog.txt b/challenge-007/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..1594312528
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/05/perl-weekly-challenge-7-niven-numbers-and-word-ladders.html
diff --git a/challenge-007/laurent-rosenfeld/perl5/ch-1.sh b/challenge-007/laurent-rosenfeld/perl5/ch-1.sh
new file mode 100644
index 0000000000..20e97ea5ba
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl5/ch-1.sh
@@ -0,0 +1 @@
+perl -E 'for my $num(1..50) { my $sum = 0; $sum += $_ for (split //, $num); say $num if $num % $sum == 0;}'
diff --git a/challenge-007/laurent-rosenfeld/perl5/ch-1a.pl b/challenge-007/laurent-rosenfeld/perl5/ch-1a.pl
new file mode 100644
index 0000000000..90a9fb4904
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl5/ch-1a.pl
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+use feature qw/say/;
+
+for my $num(1..50) {
+    my $sum = 0;
+    for (split //, $num) {
+        $sum += $_;
+    }
+    say $num if $num % $sum == 0;
+}
diff --git a/challenge-007/laurent-rosenfeld/perl5/ch-2.pl b/challenge-007/laurent-rosenfeld/perl5/ch-2.pl
new file mode 100644
index 0000000000..ddc3c1b082
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl5/ch-2.pl
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use feature qw/say/;
+sub edit_distance {
+    my ($word1, $word2) = @_;
+    die "Words $word1 and $word2 have different lengths\n" unless length $word1 == length $word2;
+    my @w1 = split //, $word1;
+    my @w2 = split //, $word2;
+    my $dist = 0;
+    for my $i (0..$#w1) {
+        $dist++ if $w1[$i] ne $w2[$i];
+    }
+    return $dist;
+}
+for my $word_pair_ref (["cold", "cord"], ["cord", "core"], ["cord", "cord"],
+        ["cold", "warm"], ["kitten", "sittin"], ["kitten", "sitting"]) {
+    my ($w1, $w2) = @$word_pair_ref;
+    say "Distance between $w1 and $w2 is: \t", edit_distance ($w1, $w2);
+}
diff --git a/challenge-007/laurent-rosenfeld/perl5/ch-2a.pl b/challenge-007/laurent-rosenfeld/perl5/ch-2a.pl
new file mode 100644
index 0000000000..ec41946a3a
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl5/ch-2a.pl
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+use feature qw/say/;
+use Storable;
+use Data::Dumper;
+
+die "Please pass two words as parameters" unless @ARGV == 2;
+my ($word1, $word2)= @ARGV;
+my $length = length $word1;
+die "The two words must have the same length\n" if $length != length $word2;
+
+my $store_file = "word_store_$length";
+my ($store_ref, %words);
+if (-e $store_file) {
+    my $store_ref = retrieve($store_file);
+    %words = %$store_ref;
+} else {
+    my $file = "words$length.txt";
+    open my $IN, '<', $file or die "Cannot open $file$!";
+    while (my $word = <$IN>) {
+        chomp $word;
+        $words{$word} = [];
+        for my $key (keys %words) {
+            if (edit_distance($key, $word) == 1) {
+                push @{$words{$key}}, $word;
+                push @{$words{$word}}, $key;
+            }
+        }
+    }
+    close $IN;
+    my $orphans = "aloof_$length.txt";
+    open my $OUT, ">", $orphans or die "Cannot open file $orphans$!";
+    for my $key (keys %words){
+        if (scalar keys $words{$key} == 0) {
+            say $OUT "$key";
+            delete $words{$key};
+        }
+    }
+    close $OUT;
+    store \%words, $store_file;
+}
+
+my $max = $le   ngth * 2;
+
+sub edit_distance {
+    my ($word1, $word2) = @_;
+    # die "Words $word1 and $word2 ..." -> No longer needed as this is checked before
+    my @w1 = split //, $word1;
+    my @w2 = split //, $word2;
+    my $dist = 0;
+    for my $i (0..$#w1) {
+        $dist++ if $w1[$i] ne $w2[$i];
+    }
+    return $dist;
+}
+
+sub ladder {
+    my ($word1, $word2, $tmp_result) = @_;
+    return $tmp_result if $word1 eq $word2;
+    return [] if scalar @$tmp_result >= $max;
+    my @temp_solutions;
+    for my $word (@{$words{$word1}}) {
+        next if $word eq $word1;
+        next if grep { $_ eq $word } @$tmp_result; # not really needed but a bit faster
+        push @temp_solutions, [@$tmp_result, $word] and last if $word eq $word2;
+        my $new_tmp = ladder($word, $word2, [@$tmp_result, $word]);
+        next if scalar @$new_tmp == scalar @$tmp_result;
+        next unless scalar @$new_tmp;
+        push @temp_solutions, $new_tmp;
+    }
+    return [] unless @temp_solutions;
+    my $best_sol = (sort { scalar @$a <=> scalar @$b } @temp_solutions)[0];
+    $max = scalar @$best_sol if scalar @$best_sol < $max;
+    return $best_sol;
+}
+
+for ($word1, $word2) {
+    die "Word $_ not found\n" unless exists $words{$_};
+}
+my $ladder = ladder $word1, $word2, [$word1];
+
+if (@$ladder) {
+    say join "->", @$ladder;
+} else {
+    say "No ladder found for $word1 and $word2"
+}
diff --git a/challenge-007/laurent-rosenfeld/perl6/ch-1.sh b/challenge-007/laurent-rosenfeld/perl6/ch-1.sh
new file mode 100644
index 0000000000..436dd11dc0
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/ch-1.sh
@@ -0,0 +1 @@
+perl6 -e 'for 1..50 -> $num { my $sum = [+] $num.comb; say $num if $num %% $sum}'
diff --git a/challenge-007/laurent-rosenfeld/perl6/ch-1a.sh b/challenge-007/laurent-rosenfeld/perl6/ch-1a.sh
new file mode 100644
index 0000000000..8469829fcf
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/ch-1a.sh
@@ -0,0 +1 @@
+perl6 -e '.say if $_ %% [+] $_.comb for 1..50'
diff --git a/challenge-007/laurent-rosenfeld/perl6/ch-1b.p6 b/challenge-007/laurent-rosenfeld/perl6/ch-1b.p6
new file mode 100644
index 0000000000..a8be63bf49
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/ch-1b.p6
@@ -0,0 +1,7 @@
+use v6;
+.say for gather {
+    for 1..50 -> $num {
+        my $sum = [+] $num.comb;
+        take $num if $num %% $sum
+    }
+}
diff --git a/challenge-007/laurent-rosenfeld/perl6/ch-2.p6 b/challenge-007/laurent-rosenfeld/perl6/ch-2.p6
new file mode 100644
index 0000000000..a2f501e2d8
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/ch-2.p6
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl6
+
+use v6;
+use lib 'lib';
+use Store;
+
+die "Please pass two words as parameters" unless @*ARGS == 2;
+my ($word1, $word2)= @*ARGS;
+my $length = $word1.chars;
+die "The two words must have the same length\n" if $length != $word2.chars;
+
+my $max = 2 * $length;
+my $store-file = "word_store_$length";
+my ($stored, %words);
+if ($store-file.IO.e) {
+    retrieve %words, $store-file;
+} else {
+    for "words$length.txt".IO.lines -> $word {
+        %words{$word} = [];
+        for keys %words -> $key {
+            if (edit-distance($key, $word) == 1) {
+                push @(%words{$key}), $word;
+                push @(%words{$word}), $key;
+            }
+        }
+    }
+    %words = grep { $_.value.elems > 0 }, %words.pairs;
+    store %words, $store-file;
+}
+
+sub edit-distance (Str $word1, Str $word2) {
+    my @w1 = $word1.comb;
+    my @w2 = $word2.comb;
+    my $dist = 0;
+    $dist++ if @w1[$_] ne @w2[$_] for (0..@w1.end) ;
+    return $dist;
+}
+
+sub ladder (Str $word1, Str $word2, $tmp-result) {
+    return $tmp-result if ($word1 eq $word2);
+    return [] if @$tmp-result.elems >= $max;
+    my @temp-solutions;
+    for @(%words{$word1}) -> $word {
+        next if $word eq $word1;
+        next if grep { $_ eq $word }, @$tmp-result;
+        push @temp-solutions, [|@$tmp-result, $word] and last if $word eq $word2;
+        my $new_tmp = ladder($word, $word2, [|@$tmp-result, $word]);
+        next if @$new_tmp.elems == @$tmp-result.elems;
+        next unless @$new_tmp.elems;
+        push @temp-solutions, $new_tmp;
+    }
+    return [] if @temp-solutions.elems == 0;
+    my $best_sol = (sort { $_.elems }, @temp-solutions)[0];
+    $max = @$best_sol.elems if @$best_sol.elems < $max;
+    return $best_sol;
+}
+
+for ($word1, $word2) {
+    die "Word $_ not found\n" unless  %words{$_} :exists;
+}
+my $ladder = ladder $word1, $word2, [$word1];
+
+if (@$ladder) {
+    say join "->", @$ladder;
+} else {
+    say "No ladder found for $word1 and $word2"
+}
diff --git a/challenge-007/laurent-rosenfeld/perl6/lib/Store.pm6 b/challenge-007/laurent-rosenfeld/perl6/lib/Store.pm6
new file mode 100644
index 0000000000..83bd1313bd
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/lib/Store.pm6
@@ -0,0 +1,18 @@
+unit package Store;
+
+sub store (%hash, $file) is export {
+    # stores a hash or array as lines containing key et values
+    # such as: key | val1 val2 val3
+    my $out;
+    for %hash.kv -> $key, $val {
+        $out ~= "$key | $val \n";
+    }
+    spurt $file, $out;
+}
+sub retrieve (%hash, $file) is export {
+    # populates a hash of arrays with stored data
+    for $file.IO.lines -> $line {
+        my ($key, $val) = split /\s?\|\s?/, $line;
+        %hash{$key} = $val.words;
+    }
+}
diff --git a/challenge-007/laurent-rosenfeld/perl6/word_store_4 b/challenge-007/laurent-rosenfeld/perl6/word_store_4
new file mode 100644
index 0000000000..990c2ea31d
--- /dev/null
+++ b/challenge-007/laurent-rosenfeld/perl6/word_store_4
@@ -0,0 +1,6 @@
+yawl | bawl pawl wawl yawn yawp yaws yowl
+pled | fled bled pied plea peed gled pleb plod sled
+pita | dita pima pica pika pina pith pits pity vita
+keir | heir weir
+quag | quad quai quay
+frug | frig frog frag drug