Last active
August 3, 2018 14:43
-
-
Save lizmat/8fff372998ed43d8d33ec38165bed290 to your computer and use it in GitHub Desktop.
LDWL solution with bonus, runs in about 8 seconds
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit sub MAIN($show-from is copy = *, $filename = "-"); | |
# Get the words in a hash and an array from longest -> shortest | |
my @words; | |
my %words = $filename.IO.lines.map: { @words[.chars].push($_); $_ => True } | |
@words = @words.reverse.map: { |$_ if $_ } # flatten them out | |
my $lock = Lock.new; # to serialize pushes to @ldwl and deletes from %words | |
my @ldwl; | |
# Generate a sequence of unique words with one letter missing from given word | |
sub dropone(\word) { | |
(^word.chars).map( { substr(word,0,$_) ~ substr(word,$_ + 1) } ).unique | |
} | |
# Recursive dig into the words | |
sub dig(@sofar is copy, $next) { | |
@sofar.push($next); | |
my int $deeper; | |
dig(@sofar, $_) # dig deeper | |
if %words{$_} && ++$deeper # if given a valid word | |
for dropone($next); # from all of the derived words | |
unless $deeper { | |
$lock.protect: { | |
@ldwl[+@sofar].push(@sofar); | |
%words{$next}:delete; # nothing below , no need to check later | |
} | |
} | |
} | |
# Test all of words as much in parallel as possible | |
race for @words { | |
dig([],$_) # start digging | |
if %words{$_} # if the word is still a target | |
} | |
# Adapt from which to list if we want only the last | |
$show-from = @ldwl.end if $show-from ~~ Whatever; | |
for $show-from ..^ @ldwl -> $chars { | |
say "chains of $chars elements:"; | |
say " $_" for @ldwl[$chars].list; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Seems to me the Perl 6 version is less verbose?