Last letter-first letter
You are encouraged to solve this task according to the task description, using any language you may know.
A certain childrens game involves starting with a word in a particular category. Each participant in turn says a word, but that word must begin with the final letter of the previous word. Once a word has been given, it cannot be repeated. If an opponent cannot give a word in the category, they fall out of the game. For example, with "animals" as the category,
Child 1: dog Child 2: goldfish Child 1: hippopotamus Child 2: snake ...
- Task Description
Take the following selection of 70 English Pokemon names (extracted from Wikipedia's list of Pokemon) and generate the/a sequence with the highest possible number of Pokemon names where the subsequent name starts with the final letter of the preceding name. No Pokemon name is to be repeated.
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
Extra brownie points for dealing with the full list of 646 names.
C
From the D version. <lang c>#include <stdlib.h>
- include <string.h>
- include <stdio.h>
- include <inttypes.h>
typedef struct {
uint16_t index; char last_char, first_char;
} Ref;
Ref* longest_path_refs; size_t longest_path_refs_len;
Ref* refs; size_t refs_len;
size_t n_solutions;
char** longest_path; size_t longest_path_len;
/// tally statistics
void search(const size_t curr_len) {
if (curr_len == longest_path_refs_len) { n_solutions++; } else if (curr_len > longest_path_refs_len) { n_solutions = 1; longest_path_refs_len = curr_len; memcpy(longest_path_refs, refs, curr_len * sizeof(Ref)); }
// recursive search const intptr_t last_char = refs[curr_len - 1].last_char; for (size_t i = curr_len; i < refs_len; i++) if (refs[i].first_char == last_char) { const Ref aux = refs[curr_len]; refs[curr_len] = refs[i]; refs[i] = aux; search(curr_len + 1); refs[i] = refs[curr_len]; refs[curr_len] = aux; }
}
void find_longest_chain(char **const items,
const size_t items_len) { refs_len = items_len; refs = calloc(refs_len, sizeof(Ref));
// enough space for all items longest_path_refs_len = 0; longest_path_refs = calloc(refs_len, sizeof(Ref));
for (size_t i = 0; i < items_len; i++) { const size_t itemsi_len = strlen(items[i]); if (itemsi_len <= 1) exit(1); refs[i].index = (uint16_t)i; refs[i].last_char = items[i][itemsi_len - 1]; refs[i].first_char = items[i][0]; }
// try each item as possible start for (size_t i = 0; i < items_len; i++) { const Ref aux = refs[0]; refs[0] = refs[i]; refs[i] = aux; search(1); refs[i] = refs[0]; refs[0] = aux; }
longest_path_len = longest_path_refs_len; longest_path = calloc(longest_path_len, sizeof(char*)); for (size_t i = 0; i < longest_path_len; i++) longest_path[i] = items[longest_path_refs[i].index];
free(longest_path_refs); free(refs);
}
int main() {
char* pokemon[] = {"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"}; const size_t pokemon_len = sizeof(pokemon) / sizeof(pokemon[0]);
find_longest_chain(pokemon, pokemon_len); printf("Maximum path length: %u\n", longest_path_len); printf("Paths of that length: %u\n", n_solutions); printf("Example path of that length:\n"); for (size_t i = 0; i < longest_path_len; i += 7) { printf(" "); for (size_t j = i; j < (i+7) && j < longest_path_len; j++) printf("%s ", longest_path[j]); printf("\n"); }
free(longest_path);
return 0;
}</lang> Output:
Maximum path length: 23 Paths of that length: 1248 Example path of that length: machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
Runtime: about 0.49 seconds, gcc compiler.
Approximate
For dealing with full list (646 names), here's an approximate method. Names are restricted to begin and end with a lower case letter, so for example in my input file "porygon2" is written as "porygon-two". It finds some chains with 300-odd length for 646 names, and found a chain with 23 for the 70 names (by luck, that is), and since it's basically a one-pass method, running time is next to none. C99 code. <lang c>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
- include <ctype.h>
- define forall(i, n) for (int i = 0; i < n; i++)
typedef struct edge { char s, e, *str; struct edge *lnk; } edge; typedef struct { edge* e[26]; int nin, nout, in[26], out[26];} node; typedef struct { edge *e, *tail; int len, has[26]; } chain;
node nodes[26]; edge *names, **tmp; int n_names;
/* add edge to graph */ void store_edge(edge *g) { if (!g) return; int i = g->e, j = g->s; node *n = nodes + j;
g->lnk = n->e[i];
n->e[i] = g, n->out[i]++, n->nout++; n = nodes + i, n->in[j]++, n->nin++; }
/* unlink an edge between nodes i and j, and return the edge */ edge* remove_edge(int i, int j) { node *n = nodes + i; edge *g = n->e[j]; if (g) { n->e[j] = g->lnk; g->lnk = 0; n->out[j]--, n->nout--;
n = nodes + j; n->in[i]--; n->nin--; } return g; }
void read_names() { FILE *fp = fopen("poke646", "rt"); int i, len; char *buf; edge *p;
if (!fp) abort();
fseek(fp, 0, SEEK_END); len = ftell(fp); buf = malloc(len + 1); fseek(fp, 0, SEEK_SET); fread(buf, 1, len, fp); fclose(fp);
buf[len] = 0; for (n_names = i = 0; i < len; i++) if (isspace(buf[i])) buf[i] = 0, n_names++;
if (buf[len-1]) n_names++;
memset(nodes, 0, sizeof(node) * 26); tmp = calloc(n_names, sizeof(edge*));
p = names = malloc(sizeof(edge) * n_names); for (i = 0; i < n_names; i++, p++) { if (i) p->str = names[i-1].str + len + 1; else p->str = buf;
len = strlen(p->str); p->s = p->str[0] - 'a'; p->e = p->str[len-1] - 'a'; if (p->s < 0 || p->s >= 26 || p->e < 0 || p->e >= 26) { printf("bad name %s: first/last char must be letter\n", p->str); abort(); } } printf("read %d names\n", n_names); }
void show_chain(chain *c) { printf("%d:", c->len); for (edge * e = c->e; e || !putchar('\n'); e = e->lnk) printf(" %s", e->str); }
/* Which next node has most enter or exit edges. */ int widest(int n, int out) { if (nodes[n].out[n]) return n;
int mm = -1, mi = -1; forall(i, 26) { if (out) { if (nodes[n].out[i] && nodes[i].nout > mm) mi = i, mm = nodes[i].nout; } else { if (nodes[i].out[n] && nodes[i].nin > mm) mi = i, mm = nodes[i].nin; } }
return mi; }
void insert(chain *c, edge *e) { e->lnk = c->e; if (!c->tail) c->tail = e; c->e = e; c->len++; }
void append(chain *c, edge *e) { if (c->tail) c->tail->lnk = e; else c->e = e; c->tail = e; c->len++; }
edge * shift(chain *c) { edge *e = c->e; if (e) { c->e = e->lnk; if (!--c->len) c->tail = 0; } return e; }
chain* make_chain(int s) { chain *c = calloc(1, sizeof(chain));
/* extend backwards */ for (int i, j = s; (i = widest(j, 0)) >= 0; j = i) insert(c, remove_edge(i, j));
/* extend forwards */ for (int i, j = s; (i = widest(j, 1)) >= 0; j = i) append(c, remove_edge(j, i));
for (int step = 0;; step++) { edge *e = c->e;
for (int i = 0; i < step; i++) if (!(e = e->lnk)) break; if (!e) return c;
int n = 0; for (int i, j = e->s; (i = widest(j, 0)) >= 0; j = i) { if (!(e = remove_edge(i, j))) break; tmp[n++] = e; }
if (n > step) { forall(i, step) store_edge(shift(c)); forall(i, n) insert(c, tmp[i]); step = -1; } else while (--n >= 0) store_edge(tmp[n]); } return c; }
int main(void) { int best = 0; read_names();
forall(i, 26) { /* rebuild the graph */ memset(nodes, 0, sizeof(nodes)); forall(j, n_names) store_edge(names + j);
/* make a chain from node i */ chain *c = make_chain(i); if (c->len > best) { show_chain(c); best = c->len; } free(c); }
printf("longest found: %d\n", best); return 0; }</lang>output<lang>read 646 names 307: voltorb breloom magikarp palpito... 308: voltorb bayleef forretress swinub b... 310: voltorb bayleef forretress sw... 312: voltorb breloom mandibuzz zek... 320: voltorb beldum mandibuzz zekrom m... 322: voltorb beldum mandibuzz zekrom murk... 323: voltorb breloom mandibuzz zekr... longest found: 323</lang>
C#
<lang csharp>using System; using System.Collections.Generic; using System.Linq; using System.Text;
namespace ConsoleApplication1 {
class Program { static void Main(string[] args) { string pokemon_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";
string[] pokemon = pokemon_names.Split(new char[]{' ','\n'}); List<string> chain = new List<string>(pokemon.Length);
for (int i = 0; i < pokemon.Length; i++) { swap(ref pokemon[0], ref pokemon[i]); Search( pokemon, chain, 1 ); swap(ref pokemon[0], ref pokemon[i]); }
foreach (string s in chain) Console.WriteLine(s);
Console.ReadKey(); }
static void Search(string[] pokemon, List<string> longest_chain, int len ) { if (len > longest_chain.Count) { longest_chain.Clear(); for (int i = 0; i < len; i++) longest_chain.Add(pokemon[i]); }
char lastchar = pokemon[len - 1][pokemon[len-1].Length - 1]; for (int i = len; i < pokemon.Length; i++) { if (pokemon[i][0] == lastchar) { swap(ref pokemon[i], ref pokemon[len]); Search(pokemon, longest_chain, len + 1); swap(ref pokemon[i], ref pokemon[len]); } } }
static void swap(ref string s1, ref string s2) { string tmp = s1; s1 = s2; s2 = tmp; } }
}</lang>
machamp petilil landorus sableye emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus scrafty yamask kricketune exeggcute emolga audino
D
Improved from the Go version: <lang d>import std.stdio,std.algorithm,std.string,std.range,std.typecons;
Tuple!(string[], int) findLongestChain(string[] items) {
string[] longestPath; int nSolutions;
void search(in int currLen) { if (currLen == longestPath.length) { nSolutions++; } else if (currLen > longestPath.length) { nSolutions = 1; longestPath = items[0 .. currLen].dup; }
// recursive search const dchar lastChar = items[currLen - 1][$ - 1]; foreach (i; currLen .. items.length) if (items[i][0] == lastChar) { swap(items[currLen], items[i]); search(currLen + 1); swap(items[currLen], items[i]); } }
// try each item as possible start foreach (i; 0 .. items.length) { swap(items[0], items[i]); search(1); swap(items[0], items[i]); }
return tuple(longestPath, nSolutions);
}
void main() {
auto pokemon = "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".tolower().split();
// remove duplicates pokemon.length -= copy(uniq(pokemon.sort()), pokemon).length;
auto sol_nsol = findLongestChain(pokemon); writeln("Maximum path length: ", sol_nsol[0].length); writeln("Paths of that length: ", sol_nsol[1]); writeln("Example path of that length:"); foreach (i; iota(0, cast(int)sol_nsol[0].length, 7)) writeln(" ", sol_nsol[0][i .. min(i+7, $)].join(" "));
}</lang> Output:
Maximum path length: 23 Paths of that length: 1248 Example path of that length: machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
Runtime: about 1.23 seconds, dmd compiler.
A more optimized solution (same output): <lang d>import std.stdio, std.algorithm, std.string,
std.range, std.typecons;
alias Tuple!(string, "word", bool, "unused") Pair;
int nSolutions;
void search(Pair[][] sequences, size_t minHead, string currWord,
string[] currentPath, size_t currentPathLen, ref string[] longestPath) {
currentPath[currentPathLen] = currWord; currentPathLen++;
if (currentPathLen == longestPath.length) { nSolutions++; } else if (currentPathLen > longestPath.length) { nSolutions = 1; longestPath = currentPath[0 .. currentPathLen].dup; }
// recursive search size_t lastCharIndex = currWord[$ - 1] - minHead; if (lastCharIndex < sequences.length) foreach (ref pair; sequences[lastCharIndex]) if (pair.unused) { pair.unused = false; search(sequences, minHead, pair.word, currentPath, currentPathLen, longestPath); pair.unused = true; }
}
string[] findLongestChain(string[] words) {
auto heads = map!q{ a[0] }(words); size_t minHead = reduce!min(heads); size_t maxHead = reduce!max(heads); auto sequences = new Pair[][](maxHead - minHead + 1, 0); foreach (word; words) sequences[word[0] - minHead] ~= Pair(word, true);
auto currentPath = new string[words.length]; string[] longestPath;
// try each item as possible start foreach (seq; sequences) foreach (ref pair; seq) { pair.unused = false; search(sequences, minHead, pair.word, currentPath, 0, longestPath); pair.unused = true; }
return longestPath;
}
void main() {
auto pokemon = "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".tolower().split();
// remove duplicates pokemon.length -= copy(uniq(pokemon.sort()), pokemon).length;
auto sol = findLongestChain(pokemon); writeln("Maximum path length: ", sol.length); writeln("Paths of that length: ", nSolutions); writeln("Example path of that length:"); foreach (i; iota(0, cast(int)sol.length, 7)) writeln(" ", sol[i .. min(i+7, $)].join(" "));
}</lang> Runtime: about 0.20 seconds, dmd compiler.
Delphi
Visual implementation, this unit is a VCL Form with a Memo, a Button, a Checkbox, a DataGrid, a DBMemo, a DataSource and a ClientDataSet with tree fields (length integer,count integer,list memo): <lang delphi>unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DBCtrls, DB, DBClient, Grids, DBGrids, ExtCtrls;
type
TLastLFirstL = class(TForm) Panel1: TPanel; Button1: TButton; Memo1: TMemo; DataSource1: TDataSource; ClientDataSet1: TClientDataSet; ClientDataSet1Longitud: TIntegerField; ClientDataSet1Cantidad: TIntegerField; ClientDataSet1Lista: TMemoField; Panel2: TPanel; DBMemo1: TDBMemo; DBGrid1: TDBGrid; Splitter1: TSplitter; CheckBox1: TCheckBox; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } FPokemons:TStrings; //internal list of words, taken from memo FIndex:TStrings; //index of words, based on starting letter FCurrList:TStrings; //current list of words being made FMax:integer; //max length of list found so far FCount:array of array[boolean]of integer; //counting of lists length ocurrences protected procedure BuildIndex; //build FIndex based on FPokemons contents procedure ClearIndex; //empty FIndex procedure PokeChain(starting:Char;mylevel:integer); //recursive procedure that builds words lists procedure BuildChains; //starts the lists building, by calling PokeChain for every FPokemons procedure AddCurrList; //called each time a list is "finished" (no more words to add to it) public { Public declarations } end;
var
LastLFirstL: TLastLFirstL;
implementation
{$R *.dfm}
{ TForm1 }
{ if the actual list is the longest found so far it is added to the dataset, otherwise its ocurrence is just counted} procedure TLastLFirstL.AddCurrList; var
i,cc: integer; foundit:boolean;
begin
with ClientDataSet1 do begin cc := FCurrList.Count; if cc <= FMax then begin //count it foundit := false; for i := 0 to High(FCount) do begin foundit := FCount[i][false] = cc; if foundit then begin FCount[i][true] := FCount[i][true] + 1; break; end; end; if not foundit then begin //length that we never add to the dataset i := High(FCount); SetLength(FCount,i+2); Inc(i); FCount[i][false] := cc; FCount[i][true] := 1; end; exit; end; //new longest list is FCurrList, add it to the dataset FMax := cc; SetLength(FCount,High(Fcount)+2); //make room for ocurrence count FCount[High(FCount)][false] := cc; FCount[High(FCount)][true] := 1; //actual dataset adding Append; Fields[0].AsInteger := cc; Fields[1].AsInteger := 0; Fields[2].AsString := FCurrList.Text; //first one is example one Post; end;
end;
{} procedure TLastLFirstL.BuildChains; var
stSeen:array of array[boolean] of char; poke:string; i:integer; tc:int64; filteqs:boolean; k: Integer;
begin
//do some cleaning before starting while not ClientDataSet1.IsEmpty do ClientDataSet1.Delete; Finalize(FCount); FMax := 0; filteqs := CheckBox1.Checked; //measure time tc := gettickcount; //each word is given the opportunity of starting a list if filteqs then begin //ignore words with same start and end as others already seen filteqs := False; for i := 0 to FPokemons.Count - 1 do begin poke := FPokemons[i]; for k := 0 to High(stSeen) do begin filteqs := (stSeen[k][false] = poke[1]) and (stSeen[k][true] = poke[length(poke)]); if filteqs then break; end; if filteqs then //already seen equivalent continue; FPokemons.Objects[i] := Pointer(1); FCurrList.Clear; //new list of words FCurrList.Add(poke); PokeChain(poke[length(poke)],2); //continue the list //register as seen, for future equivalents k := High(stSeen); SetLength(stSeen,k+2); Inc(k); stSeen[k][false] := poke[1]; stSeen[k][true] := poke[length(poke)]; FPokemons.Objects[i] := nil; end; Finalize(stSeen); end else begin for i := 0 to FPokemons.Count - 1 do begin poke := FPokemons[i]; FPokemons.Objects[i] := Pointer(1); FCurrList.Clear; //new list of words FCurrList.Add(poke); PokeChain(poke[length(poke)],2); //continue the list FPokemons.Objects[i] := nil; end; end; tc := gettickcount - tc; //don't consider dataset counting as part of the process //set actual counting of ocurrences on the dataset for i := 0 to High(FCount) do with ClientDataSet1 do begin if Locate('Longitud',FCount[i][false],[]) then Edit else begin Append; Fields[0].AsInteger := FCount[i][false]; Fields[2].AsString := 'No example preserved'; end; Fields[1].AsInteger := FCount[i][true]; Post; end; ClientDataSet1.IndexFieldNames := 'Longitud'; //show time taken Panel1.Caption := IntToStr(tc div 1000) + '.' + IntToStr(tc - (tc div 1000) * 1000) + ' segs.';
end;
{ builds an index based on the first letter of every word in consideration, because all we care about is the first and the last letter of every word. The index is a TStrings where each element is the starting letter and the corresponding object is a TList with all the indices of the words that starts with that letter. } procedure TLastLFirstL.BuildIndex; var
i,ii: Integer; poke:string; st,ed:char; List:TList; k: Integer; found:boolean;
begin
ClearIndex; //just in case is not the first execution if not Assigned(FIndex) then // just in case IS the first execution FIndex := TStringList.Create; for i := 0 to FPokemons.Count - 1 do begin poke := FPokemons[i]; st := poke[1]; ed := poke[Length(poke)]; ii := FIndex.IndexOf(st); if ii<0 then //first time we see this starting letter ii := FIndex.AddObject(st,TList.Create); List := TList(FIndex.Objects[ii]); found := false; if CheckBox1.Checked then begin //ignore equivalent words (same start, same end) //all the List are words with the same start, so lets check the end for k := 0 to List.Count - 1 do begin poke := FPokemons[integer(List[k])]; found := poke[Length(poke)] = ed; if found then break; end; end; if not found then // not checking equivalents, or firts time this end is seen List.Add(Pointer(i)); end;
end;
{ do your thing! } procedure TLastLFirstL.Button1Click(Sender: TObject); begin
Panel1.Caption := 'Calculating..'; FPokemons.Assign(Memo1.Lines); //words in the game BuildIndex; BuildChains;
end;
{ frees all the TList used by the index, clears the index } procedure TLastLFirstL.ClearIndex; var
i:integer;
begin
if not Assigned(FIndex) then exit; for i := 0 to FIndex.Count - 1 do begin TList(FIndex.Objects[i]).Free; end; FIndex.Clear;
end;
procedure TLastLFirstL.FormCreate(Sender: TObject); begin
FPokemons := TStringList.Create; FCurrList := TStringList.Create;
end;
procedure TLastLFirstL.FormDestroy(Sender: TObject); begin
FCurrList.Free; FPokemons.Free; ClearIndex; //IMPORTANT! FIndex.Free;
end;
{where the magic happens. Recursive procedure that adds a word to the current list of words. Receives the starting letter of the word to add, and the "position" of the word in the chain. The position is used to ensure a word is not used twice for the list. } procedure TLastLFirstL.PokeChain(starting: Char;mylevel:integer); var
i,ii,plevel:integer; List:TList; didit:boolean;
begin
application.processMessages; //don't let the interface die.. didit := False; //if we can't add another word, then we have reached the maximun length for the list ii := FIndex.IndexOf(starting); if ii >= 0 then begin //there are words with this starting letter List := TList(FIndex.Objects[ii]); for i := 0 to List.Count - 1 do begin ii := integer(List[i]); plevel := integer(FPokemons.Objects[ii]); // if the integer stored in the Object property is lower than mylevel, then this word is already in the list if (plevel > mylevel) or (plevel = 0) then begin // you can use the word //a try finally would be a good thing here, but... FCurrList.Add(FPokemons[ii]); //add the word to the list FPokemons.Objects[ii] := Pointer(mylevel); //signal is already in the list PokeChain(FPokemons[ii][length(FPokemons[ii])],mylevel+1); //add more words to the list FcurrList.Delete(FCurrList.Count-1); //already did my best, lets try with another word FPokemons.Objects[ii] := nil; //unsignal it, so it can be used "later" didit := True; //we did add one word to the list end; end; end; if not didit then //there is no way of making the list longer, process it AddCurrList;
end;
end.</lang> Runtime varies depending if you run the "optimized" version or not. Ranges from 6 to 18 seconds.
NOTE: "optimized" version is actually a different algorithm, but in most cases returns the same results.
Go
Depth first, starting with each possible name. <lang go>package main
import (
"fmt" "strings"
)
var pokemon = `audino bagon baltoy...67 names omitted...`
func main() {
// split text into slice representing directed graph var d []string for _, l := range strings.Split(pokemon, "\n") { d = append(d, strings.Fields(l)...) } fmt.Println("searching", len(d), "names...") // try each name as possible start for i := range d { d[0], d[i] = d[i], d[0] search(d, 1, len(d[0])) d[0], d[i] = d[i], d[0] } fmt.Println("maximum path length:", len(ex)) fmt.Println("paths of that length:", nMax) fmt.Print("example path of that length:") for i, n := range ex { if i%6 == 0 { fmt.Print("\n ") } fmt.Print(n, " ") } fmt.Println()
}
var ex []string var nMax int
func search(d []string, i, ncPath int) {
// tally statistics if i == len(ex) { nMax++ } else if i > len(ex) { nMax = 1 ex = append(ex[:0], d[:i]...) } // recursive search lastName := d[i-1] lastChar := lastName[len(lastName)-1] for j := i; j < len(d); j++ { if d[j][0] == lastChar { d[i], d[j] = d[j], d[i] search(d, i+1, ncPath+1+len(d[i])) d[i], d[j] = d[j], d[i] } }
}</lang> Output:
searching 70 names... maximum path length: 23 paths of that length: 1248 example path of that length: machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
Haskell
Note: This takes ~80 seconds to complete on my machine. <lang Haskell>import Data.List import qualified Data.ByteString.Char8 as B
allPokemon :: [B.ByteString] allPokemon = map B.pack $ words
"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"
growChains :: B.ByteString -> [B.ByteString] growChains pcs
| nextChainSet == [] = head pcs | otherwise = growChains nextChainSet where nextChainSet = pcs >>= findLinks findLinks pc = map (\x -> pc ++ [x]) $ filter (isLink $ last pc) (allPokemon \\ pc) isLink pl pr = B.last pl == B.head pr
main = mapM_ B.putStrLn $ growChains $ map (\x -> [x]) allPokemon</lang> Output:
machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
A simpler version (no ByteString), about 2.4 times slower (GHC -O3), same output: <lang Haskell>import Data.List
allPokemon = words
"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"
growChains :: String -> [String] growChains pcs
| nextChainSet == [] = head pcs | otherwise = growChains nextChainSet where nextChainSet = pcs >>= findLinks findLinks pc = map (\x -> pc ++ [x]) $ filter (isLink $ last pc) (allPokemon \\ pc) isLink pl pr = last pl == head pr
main = mapM_ putStrLn $ growChains $ map (\x -> [x]) allPokemon</lang>
J
Here, we use a brute force breadth-first search. Unless we know ahead of time how long "longest" is, we must try all possibilities to ensure that an unchecked possibility is not longer than a possibility which we have found.
<lang j>pokenames=: ;:0 :0-.LF
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
)
seqs=: 3 :0
links=. <@I. _1 =/&({&>&y) 0 next=. ,.i.#links while.#next do. r=. next assert. 1e9>*/8,$r next=. (#~ (-: ~.)"1) >;<@(] <@,"1 0 links {::~ {:)"1 r end. r
)</lang>
The line assert. 1e9>*/8,$r
was added to avoid a very bad behavior from microsoft windows which appeared on different arguments, when intermediate results became too large (the machine would have to be rebooted when intermediate results became an order of magnitude larger than the available physical memory). By ensuring that the program would end before consuming that much virtual memory, this behavior from the operating system can be avoided.
With this procedure we are able to conduct the entire search for this list of names:
<lang j>$R=: seqs pokenames 1248 23</lang>
With this data set, we have 1248 sequences of names which have the longest possible length, and those sequences are 23 names long. Here's one of them:
<lang j> >pokenames {~{.R machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino </lang>
OpenEdge/Progress
The following gets the job done, but the time taken (40 minutes) is somewhat worrying when compared to other language solutions. So I am not going after the brownie points just yet...
<lang progress>DEFINE VARIABLE cpokemon AS CHARACTER INITIAL "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".
DEFINE TEMP-TABLE tt NO-UNDO
FIELD cname AS CHARACTER FIELD cfirst AS CHARACTER FIELD clast AS CHARACTER FIELD lused AS LOGICAL FIELD ilength AS INTEGER FIELD imax AS INTEGER FIELD cchain AS CHARACTER
INDEX ttname cname INDEX ttfirst cfirst lused INDEX ttlast clast lused .
DEFINE VARIABLE ii AS INTEGER NO-UNDO.
DO ii = 1 TO NUM-ENTRIES( cpokemon, " " ):
CREATE tt. ASSIGN tt.cname = ENTRY( ii, cpokemon, " " ) tt.cfirst = SUBSTRING( tt.cname, 1, 1 ) tt.clast = SUBSTRING( tt.cname, LENGTH( tt.cname ), 1 ) .
END.
FUNCTION getChain RETURNS INTEGER (
i_cname AS CHARACTER, i_clast AS CHARACTER, i_ilength AS INTEGER, i_cchain AS CHARACTER
):
DEFINE BUFFER tt FOR tt.
DEFINE VARIABLE lend_of_chain AS LOGICAL NO-UNDO INITIAL TRUE.
FOR EACH tt WHERE tt.cfirst = i_clast AND tt.lused = FALSE OR i_clast = "" : lend_of_chain = FALSE. tt.lused = TRUE. getChain( tt.cname, tt.clast, i_ilength + 1, i_cchain + tt.cname + " " ). tt.lused = FALSE. END. IF lend_of_chain THEN DO: FIND tt WHERE tt.cname = ENTRY( 1, i_cchain, " " ). IF i_ilength = tt.ilength THEN tt.imax = tt.imax + 1. ELSE IF i_ilength > tt.ilength THEN ASSIGN tt.ilength = i_ilength tt.cchain = i_cchain tt.imax = 1 . END.
END FUNCTION. /* getChain */
DEFINE VARIABLE itime AS INTEGER NO-UNDO EXTENT 2. DEFINE VARIABLE lcontinue AS LOGICAL NO-UNDO.
itime[1] = ETIME. getChain( "", "", 0, "" ). itime[2] = ETIME.
FOR EACH tt BY tt.ilength DESCENDING:
MESSAGE "Maximum path length:" tt.ilength SKIP "Paths of that length:" tt.imax SKIP(1) "Example path of that length:" tt.cchain SKIP(1) "Time taken:" STRING( INTEGER( ( itime[2] - itime[1] ) / 1000 ), "HH:MM:SS" ) VIEW-AS ALERT-BOX BUTTONS YES-NO TITLE tt.cname UPDATE lcontinue. IF lcontinue = FALSE THEN STOP.
END.</lang>
Output:
--------------------------- machamp --------------------------- Maximum path length: 23 Paths of that length: 1248 Example path of that length: machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino Time taken: 00:40:09 --------------------------- Yes No ---------------------------
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:
: (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
Python
<lang python>from collections import defaultdict
def order_words(words):
byfirst = defaultdict(set) for word in words: byfirst[word[0]].add( word ) #byfirst = dict(byfirst) return byfirst
def linkfirst(byfirst, sofar):
\ For all words matching last char of last word in sofar as FIRST char and not in sofar, return longest chain as sofar + chain
assert sofar chmatch = sofar[-1][-1] options = byfirst[chmatch] - set(sofar) #print(' linkfirst options: %r %r' % (chmatch, options)) if not options: return sofar else: alternatives = ( linkfirst(byfirst, list(sofar) + [word]) for word in options ) mx = max( alternatives, key=len ) #input('linkfirst: %r' % mx) return mx
def llfl(words):
byfirst = order_words(words) return max( (linkfirst(byfirst, [word]) for word in words), key=len )
if __name__ == '__main__':
pokemon = 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
pokemon = pokemon.strip().lower().split() pokemon = sorted(set(pokemon)) l = llfl(pokemon) for i in range(0, len(l), 8): print(' '.join(l[i:i+8])) print(len(l))</lang>
- Sample output
audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent 23
Alternative version
Adapted from the D version. This uses Psyco. <lang python>import psyco
nsolutions = 0
def search(sequences, ord_minc, curr_word, current_path,
current_path_len, longest_path): global nsolutions
current_path[current_path_len] = curr_word current_path_len += 1
if current_path_len == len(longest_path): nsolutions += 1 elif current_path_len > len(longest_path): nsolutions = 1 longest_path[:] = current_path[:current_path_len]
# recursive search last_char_index = ord(curr_word[-1]) - ord_minc if last_char_index >= 0 and last_char_index < len(sequences): for pair in sequences[last_char_index]: if not pair[1]: pair[1] = True search(sequences, ord_minc, pair[0], current_path, current_path_len, longest_path) pair[1] = False
def find_longest_chain(words):
ord_minc = ord(min(word[0] for word in words)) ord_maxc = ord(max(word[0] for word in words)) sequences = [[] for _ in xrange(ord_maxc - ord_minc + 1)] for word in words: sequences[ord(word[0]) - ord_minc].append([word, False])
current_path = [None] * len(words) longest_path = []
# try each item as possible start for seq in sequences: for pair in seq: pair[1] = True search(sequences, ord_minc, pair[0], current_path, 0, longest_path) pair[1] = False
return longest_path
def main():
global nsolutions
pokemon = """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""".lower().split()
# remove duplicates pokemon = sorted(set(pokemon))
sol = find_longest_chain(pokemon) print "Maximum path length:", len(sol) print "Paths of that length:", nsolutions print "Example path of that length:" for i in xrange(0, len(sol), 7): print " ", " ".join(sol[i : i+7])
psyco.full() main()</lang> Output:
Maximum path length: 23 Paths of that length: 1248 Example path of that length: machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
Run time: about 0.44 seconds with Psyco and Python 2.6.6.
Tcl
<lang tcl>proc search {path arcs} {
set solutions {} set c [string index [lindex $path end] end] set i -1 foreach arc $arcs {
incr i if {[string index $arc 0] ne $c} continue set soln [search [concat $path [list $arc]] [lreplace $arcs $i $i]] lappend solutions [list [llength $soln] $soln]
} if {[llength $solutions]} {
return [lindex [lsort -integer -decreasing -index 0 $solutions] 0 1]
} else {
return $path
}
} proc firstlast names {
set solutions {} set i -1 foreach initial $names {
incr i set soln [search [list $initial] [lreplace $names $i $i]] lappend solutions [list [llength $soln] $soln]
} return [lindex [lsort -integer -decreasing -index 0 $solutions] 0 1]
}
set 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
} set path [firstlast $names] puts "Path (length: [llength $path]): $path"</lang> Output:
Path (length 23): machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino
Ursala
<lang Ursala>#import std
mon =
~&*~ sep` mat` -[
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]-
poke = @iiDrzhK16rlXOASK24PiX ~&llrHiFPrYX^=rxS^|\~&iNCS *=+ ~&rlwNrlCQ^*D/~&+ @h
- show+
example = ~&h poke mon</lang>output:
machamp petilil landorus scrafty yamask kricketune emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus seaking girafarig gabite exeggcute emolga audino