RosettaCodeData/Task/Last-letter-first-letter/Mathematica/last-letter-first-letter.math
2015-11-18 06:14:39 +00:00

21 lines
1.1 KiB
Text

longestChain[list_] :=
NestWhileList[
Append @@@
Select[DeleteDuplicatesBy[
Tuples[{#, list}], {#[[1, 1]], #[[2]]} &], ! MemberQ @@ # &&
StringTake[#[[1, -1]], -1] == StringTake[#[[2]], 1] &] &,
List /@ list, # != {} &][[-2, 1]];
Print[longestChain[{"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"}]];