Last letter-first letter: Difference between revisions

=={{header|Clojure}}==

<lang clojure>(ns rosetta-code.last-letter-first-letter

(:require clojure.string))

(defn by-first-letter

"Returns a map from letters to a set of words that start with that letter"

[words]

(into {} (map (fn [[k v]]

[k (set v)]))

(group-by first words)))

(defn longest-path-from

"Find a longest path starting at word, using only words-by-first-letter for successive words.

Returns a pair of [length list-of-words] to describe the path."

[word words-by-first-letter]

(let [words-without-word (update words-by-first-letter (first word)

disj word)

next-words (words-without-word (last word))]

(if (empty? next-words)

[1 [word]]

(let [sub-paths (map #(longest-path-from % words-without-word) next-words)

[length words-of-path] (apply max-key first sub-paths)]

[(inc length) (cons word words-of-path)]))))

(defn longest-word-chain

"Find a longest path among the words in word-list, by performing a longest path search

starting at each word in the list."

[word-list]

(let [words-by-letter (by-first-letter word-list)]

(apply max-key first

(pmap #(longest-path-from % words-by-letter)

word-list))))

(defn word-list-from-file [file-name]

(let [contents (slurp file-name)

words (clojure.string/split contents #"[ \n]")]

(filter #(not (empty? %)) words)))

(time (longest-word-chain (word-list-from-file "pokemon.txt")))</lang>

Evaluating the last line:

<lang clojure>"Elapsed time: 2867.337816 msecs"

[23

("machamp"

"pinsir"

"relicanth"

"heatmor"

"registeel"

"landorus"

"seaking"

"girafarig"

"gabite"

"exeggcute"

"emboar"

"rufflet"

"trapinch"

"haxorus"

"simisear"

"remoraid"

"darmanitan"

"nosepass"

"scrafty"

"yamask"

"kricketune"

"emolga"

"audino")]</lang>

It initially ran in about 5 seconds, then I changed <code>map</code> to <code>pmap</code> (parallel map) in <code>longest-word-chain</code>.

This gave a nice speedup for a dual core laptop; the speedup for parallel searches was over 3x on a server.

=={{header|PicoLisp}}==

<lang PicoLisp>(de pokemonChain (File)

(let Names (make (in File (while (read) (link @))))

(for Name Names

(let C (last (chop Name))

(set Name

(filter '((Nm) (pre? C Nm)) Names) ) ) )

(let Res NIL

(for Name Names

(let Lst NIL

(recur (Name Lst)

(if (or (memq Name Lst) (not (val (push 'Lst Name))))

(when (> (length Lst) (length Res))

(setq Res Lst) )

(mapc recurse (val Name) (circ Lst)) ) ) ) )

(flip Res) ) ) )</lang>

Test:

<pre>

: (pokemonChain "pokemon.list")

-> (machamp petilil landorus scrafty yamask kricketune emboar registeel loudred

darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking

girafarig gabite exeggcute emolga audino)

: (length @)

-> 23

</pre>

=={{header|Perl 6}}==

A breadth-first search that uses disk files to avoid memory exhaustion. Each candidate sequence is encoded at one character per name, so to avoid reuse of names we merely have to make sure there are no repeat characters in our encoded string. (The encoding starts at ASCII space for the first name, so newline is not among the encoded characters.)

<lang perl6>my @names = <

audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon

cresselia croagunk darmanitan deino emboar emolga exeggcute gabite

girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan

kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine

nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2

porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking

sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko

tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask

>;

my @last = @names.map: {.substr(*-1,1).ord }

my @succs = [] xx 128;

for @names.kv -> $i, $name {

my $ix = $name.ord; # $name.substr(0,1).ord

push @succs[$ix], $i;

}

my $OUT = open "llfl.new", :w orelse .die;

$OUT.print: chr($_ + 32),"\n" for 0 ..^ @names;

close $OUT;

my $new = +@names;

my $len = 1;

while $new {

say "Length { $len++ }: $new candidates";

shell 'mv llfl.new llfl.known';

my $IN = open "llfl.known" orelse .die;

my $OUT = open "llfl.new", :w orelse .die;

$new = 0;

loop {

my $cand = $IN.get // last;

for @succs[@last[$cand.ord - 32]][] -> $i {

my $ic = chr($i + 32);

next if $cand ~~ /$ic/;

$OUT.print: $ic,$cand,"\n";

$new++;

}

}

$IN.close;

$OUT.close;

}

my $IN = open "llfl.known" orelse .die;

my $eg = $IN.lines.pick;

say "Length of longest: ", $eg.chars;

say join ' ', $eg.ords.reverse.map: { @names[$_ - 32] }</lang>

{{out}}

<pre>Length 1: 70 candidates

Length 2: 172 candidates

Length 3: 494 candidates

Length 4: 1288 candidates

Length 5: 3235 candidates

Length 6: 7731 candidates

Length 7: 17628 candidates

Length 8: 37629 candidates

Length 9: 75122 candidates

Length 10: 139091 candidates

Length 11: 236679 candidates

Length 12: 367405 candidates

Length 13: 516210 candidates

Length 14: 650916 candidates

Length 15: 733915 candidates

Length 16: 727566 candidates

Length 17: 621835 candidates

Length 18: 446666 candidates

Length 19: 260862 candidates

Length 20: 119908 candidates

Length 21: 40296 candidates

Length 22: 10112 candidates

Length 23: 1248 candidates

Length of longest: 23

machamp petilil loudred darmanitan nosepass simisear rufflet trapinch heatmor registeel landorus starly yamask kricketune exeggcute emboar relicanth haxorus seaking girafarig gabite emolga audino</pre>