Last letter-first letter: Difference between revisions

From Rosetta Code
Content added Content deleted
(Updated second D entry)
(Added BBC BASIC)
Line 131: Line 131:
emolga
emolga
audino</pre>
audino</pre>
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<lang bbcbasic> DIM names$(69)
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"
maxPathLength% = 0
maxPathLengthCount% = 0
maxPathExample$ = ""
FOR i% = 0 TO DIM(names$(),1)
SWAP names$(0), names$(i%)
PROClastfirst(names$(), 1)
SWAP names$(0), names$(i%)
NEXT
PRINT "Maximum length = " ; maxPathLength%
PRINT "Number of solutions with that length = " ; maxPathLengthCount%
PRINT "One such solution: " ' maxPathExample$
END
DEF PROClastfirst(names$(), offset%)
LOCAL i%, l%
IF offset% > maxPathLength% THEN
maxPathLength% = offset%
maxPathLengthCount% = 1
ELSE IF offset% = maxPathLength% THEN;
maxPathLengthCount% += 1
maxPathExample$ = ""
FOR i% = 0 TO offset%-1
maxPathExample$ += names$(i%) + CHR$13 + CHR$10
NEXT
ENDIF
l% = ASCRIGHT$(names$(offset% - 1))
FOR i% = offset% TO DIM(names$(),1)
IF ASCnames$(i%) = l% THEN
SWAP names$(i%), names$(offset%)
PROClastfirst(names$(), offset%+1)
SWAP names$(i%), names$(offset%)
ENDIF
NEXT
ENDPROC</lang>
'''Output:'''
<pre>
Maximum length = 23
Number of solutions with that length = 1248
One such solution:
machamp
pinsir
rufflet
trapinch
heatmor
remoraid
darmanitan
nosepass
starly
yamask
kricketune
exeggcute
emboar
relicanth
haxorus
simisear
registeel
landorus
seaking
girafarig
gabite
emolga
audino
</pre>

=={{header|Bracmat}}==
=={{header|Bracmat}}==
===Naive===
===Naive===
Line 315: Line 398:
petilil
petilil
machamp</pre>
machamp</pre>

=={{header|C}}==
=={{header|C}}==
From the D version.
From the D version.

Revision as of 18:44, 5 November 2012

Task
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.

Ada

<lang Ada>with Ada.Containers.Indefinite_Vectors, Ada.Text_IO;

procedure Lalefile is 

  package Word_Vec is new Ada.Containers.Indefinite_Vectors
    (Index_Type   => Positive,
     Element_Type => String);

  use type Word_Vec.Vector, Ada.Containers.Count_Type;

  type Words_Type is array (Character) of Word_Vec.Vector;

  procedure Read(Words: out Words_Type) is
     F: Ada.Text_IO.File_Type;
  begin
     Ada.Text_IO.Open(File => F, 
                      Name => "pokemon70.txt",
                      Mode => Ada.Text_IO.In_File);
     loop
        declare
           Word: String := Ada.Text_IO.Get_Line(F);
        begin
           exit when Word = "";
           Words(Word(Word'First)).Append(Word);
        end;
     end loop;
  exception
     when Ada.Text_IO.End_Error => null;
  end Read;

  procedure Write (List: Word_Vec.Vector; Prefix: String := "   ") is
     Copy: Word_Vec.Vector := List;
  begin
     loop
        exit when Copy.Is_Empty;
        Ada.Text_IO.Put_Line(Prefix & Copy.First_Element);
        Copy.Delete_First;
     end loop;
  end Write;

  function Run(Start: Character; Words: Words_Type) return Word_Vec.Vector is
     Result: Word_Vec.Vector := Word_Vec.Empty_Vector;
  begin
     for I in Words(Start).First_Index .. Words(Start).Last_Index loop
        declare
           Word: String := Words(Start).Element(I);
           Dupl: Words_Type := Words;
           Alternative : Word_Vec.Vector;
        begin
           Dupl(Start).Delete(I);
           Alternative := Word & Run(Word(Word'Last), Dupl);
           if Alternative.Length > Result.Length then
              Result := Alternative;
           end if;
        end;
     end loop;
     return Result;
  end Run;

  W: Words_Type;
  A_Vector: Word_Vec.Vector;
  Best: Word_Vec.Vector := Word_Vec.Empty_Vector;

begin 

  Read(W);
  Ada.Text_IO.Put("Processing ");
  for Ch in Character range 'a' .. 'z' loop
     Ada.Text_IO.Put(Ch & ", ");
     A_Vector := Run(Ch, W);
     if A_Vector.Length > Best.Length then
        Best := A_Vector;
     end if;
  end loop;
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line("Length of longest Path:" &
                         Integer'Image(Integer(Best.Length)));
  Ada.Text_IO.Put_Line("One such path:");
  Write(Best);

end Lalefile;</lang>

Output:

Processing a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z, 
Length of longest Path: 23
One such path:
   machamp
   petilil
   landorus
   scrafty
   yamask
   kricketune
   emboar
   registeel
   loudred
   darmanitan
   nosepass
   simisear
   relicanth
   heatmor
   rufflet
   trapinch
   haxorus
   seaking
   girafarig
   gabite
   exeggcute
   emolga
   audino

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> DIM names$(69) 

     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"
     
     maxPathLength% = 0
     maxPathLengthCount% = 0
     maxPathExample$ = ""
     
     FOR i% = 0 TO DIM(names$(),1)
       SWAP names$(0), names$(i%)
       PROClastfirst(names$(), 1)
       SWAP names$(0), names$(i%)
     NEXT
     PRINT "Maximum length = " ; maxPathLength%
     PRINT "Number of solutions with that length = " ; maxPathLengthCount%
     PRINT "One such solution: " ' maxPathExample$
     END
     
     DEF PROClastfirst(names$(), offset%)
     LOCAL i%, l%
     IF offset% > maxPathLength% THEN
       maxPathLength% = offset%
       maxPathLengthCount% = 1
     ELSE IF offset% = maxPathLength% THEN;
       maxPathLengthCount% += 1
       maxPathExample$ = ""
       FOR i% = 0 TO offset%-1
         maxPathExample$ += names$(i%) + CHR$13 + CHR$10
       NEXT
     ENDIF
     l% = ASCRIGHT$(names$(offset% - 1))
     FOR i% = offset% TO DIM(names$(),1)
       IF ASCnames$(i%) = l% THEN
         SWAP names$(i%), names$(offset%)
         PROClastfirst(names$(), offset%+1)
         SWAP names$(i%), names$(offset%)
       ENDIF
     NEXT
     ENDPROC</lang>

Output: 

Maximum length = 23
Number of solutions with that length = 1248
One such solution:
machamp
pinsir
rufflet
trapinch
heatmor
remoraid
darmanitan
nosepass
starly
yamask
kricketune
exeggcute
emboar
relicanth
haxorus
simisear
registeel
landorus
seaking
girafarig
gabite
emolga
audino

Bracmat

Naive

<lang bracmat>( 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
 : ?names

& 0:?max & :?sequence & ( lalefile 

 =   done todo A M Z Length first
   .   !arg:(!done.)&!done:?sequence
     |   !arg:(.?todo)
       & (   !todo
           :   ?A
               %@?M
               (?Z&lalefile$(!M.!A !Z)&~)
         | 
         )
     |   !arg:(@(%:? @?first) ?:?done.?todo)
       & :?M
       & (   !todo
           :   ?A
               @(%:!first ?:?M)
               ( ?Z
               & lalefile$(!M !done.!A !Z)
               & ~
               )
         |   !M:
           & !done:? [?Length
           & !Length:>!max:?max
           & !done:?sequence
         | 
         )
 )

& lalefile$(.!names) & out$("Length:" !max "Sequence:" !sequence) );</lang> Output (read from bottom to top): 

  Length:
  23
  Sequence:
  audino
  emolga
  exeggcute
  gabite
  girafarig
  seaking
  haxorus
  trapinch
  rufflet
  heatmor
  relicanth
  simisear
  nosepass
  darmanitan
  loudred
  registeel
  emboar
  kricketune
  yamask
  scrafty
  landorus
  petilil
  machamp

Optimized

Optimizations:

The whl loop transforms the flat list of names to, conceptually, a search tree with nodes at three levels. The lowest level contains the names. The top level contains the word's first letter and the second level contains its last letter. Words starting with a specific letter are all children of one single top node, speeding up search for candidates. Under a second level node all words have the same letter at the start and the same letter at the end. When looking for candidates it always suffices to take the first word and ignore the rest. This optimization eliminates all solutions that merely are the result of swapping pairs of words with the same begin and end. Notice that the tree is built using the 'smart' binary operators *, ^, + and \L (logarithm). Bracmat uses the commutative, distributive and associative laws to transform expressions containing these operators to canonical forms that fit the requiremens of the search tree. For example, the words in the list sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko tyrogue end up in this tree: 

    s
  ^ ( (.e)\L(sableye*scolipede)
    + (.g)\Lseaking
    + (.k)\Lspoink
    + (.n)\Lsilcoon
    + (.o)\Lsealeo
    + (.r)\Lsimisear
    + (.x)\Lsnorlax
    + (.y)\L(scrafty*snivy*starly)
    )
*   t
  ^ ( (.a)\Ltirtouga
    + (.e)\Ltyrogue
    + (.h)\Ltrapinch
    + (.o)\Ltreecko
    )

Another, less important, optimization is the way in which the last letter of a name is found, using the position pattern [ rather than the pattern that matches at most one letter, @.

The optimized version is about 4.5 times faster than the naive version.

<lang bracmat>( 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
 : ?names

& 1:?newnames & whl 

 ' ( !names:@(%?name:%@?first ? @?last) ?names
   & !first^(.!last)\L!name*!newnames:?newnames
   )

& !newnames:?names & 0:?max & :?sequence & ( lalefile 

 =     done todo A M Z Length first
     , Ms a z last candidates
   .   !arg:(!done.)&!done:?sequence
     |   !arg:(.?todo)
       & (   !todo
           :   ?A
             * %?first^?candidates
             * ( ?Z
               &   !candidates
                 :   ?a
                   + ?last\L(%?M*?Ms)
                   + ( ?z
                     & lalefile$(!M.!A*!first^(!a+!last\L!Ms+!z)*!Z)
                     & ~
                     )
               )
         | 
         )
     |   !arg:(@(%:? [-2 ?first) ?:?done.?todo)
       & :?M
       & (   !todo:?A*!first^%?candidates*?Z
           &   !candidates
             :   ?a
               + ?last\L(%?M*?Ms)
               + ( ?z
                 &   lalefile
                   $ (!M !done.!A*!first^(!a+!last\L!Ms+!z)*!Z)
                 & ~
                 )
         |   !M:
           & !done:? [?Length
           & !Length:>!max:?max
           & !done:?sequence
         | 
         )
 )

& lalefile$(.!names) & out$("Length:" !max "Sequence:" !sequence) );</lang> Output (read from bottom to top): 

  Length:
  23
  Sequence:
  audino
  emolga
  kricketune
  yamask
  scrafty
  haxorus
  trapinch
  rufflet
  simisear
  landorus
  registeel
  heatmor
  relicanth
  emboar
  exeggcute
  gabite
  girafarig
  seaking
  nosepass
  darmanitan
  loudred
  petilil
  machamp

C

From the D version. <lang c>#include <stdlib.h>

  1. include <string.h>
  2. include <stdio.h>
  3. 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;

const char** longest_path; size_t longest_path_len;


/// tally statistics void search(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
   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) {
           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(const char* items[], 

                       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++) {
       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++) {
       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(const 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() { 

   const 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"};
   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>

  1. include <stdlib.h>
  2. include <string.h>
  3. include <ctype.h>
  1. 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

Simple Version

Modified from the Go version: <lang d>import std.stdio, std.algorithm, std.string;

void search(string[] items, in int len, ref string[] longest) pure { 

   if (len > longest.length)
       longest = items[0 .. len].dup;
   immutable lastChar = items[len - 1][$ - 1];
   foreach (ref item; items[len .. $])
       if (item[0] == lastChar) {
           swap(items[len], item);
           search(items, len + 1, longest);
           swap(items[len], item);
       }

}

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".split(); 

   string[] solution;
   foreach (ref name; pokemon) {
       swap(pokemon[0], name);
       search(pokemon, 1, solution);
       swap(pokemon[0], name);
   }

   writefln("%-(%s\n%)", solution);

}</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

Runtime: about 0.9 seconds, dmd compiler.

Faster version

<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, in size_t minHead, 

           in 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
   immutable 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(in string[] words) { 

   auto heads = map!q{ a[0] }(words);
   immutable size_t minHead = reduce!min(heads);
   immutable size_t maxHead = reduce!max(heads);
   auto sequences = new Pair[][](maxHead - minHead + 1, 0);
   foreach (word; words) {
       const p = Pair(word, true); //*
       sequences[word[0] - minHead] ~= p;
   }

   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 -= pokemon.sort().uniq().copy(pokemon).length;

   const sol = findLongestChain(pokemon);
   writeln("Maximum path length: ", sol.length);
   writeln("Paths of that length: ", nSolutions);
   writeln("Example path of that length:");
   foreach (ch; std.range.chunks(sol, 7))
       writefln("  %-(%s %)", ch);

}</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.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. Note that 9!:21 and/or 9!:33 could also be used to prevent OS instability triggered by requesting too many resources.

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>

Java

<lang java>// derived from C final class LastLetterFirstLetter { 

   static int maxPathLength = 0;
   static int maxPathLengthCount = 0;
   static final StringBuffer maxPathExample = new StringBuffer(500);

   static final String[] 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"};

   static void recursive(String[] part, int offset) {
       if (offset > maxPathLength) {
           maxPathLength = offset;
           maxPathLengthCount = 1;
       } else if (offset == maxPathLength) {
           maxPathLengthCount++;
           maxPathExample.setLength(0);
           for (int i = 0; i < offset; i++) {
               maxPathExample.append((i % 5 == 0 ? "\n  " : " "));
               maxPathExample.append(part[i]);
           }
       }
       final char lastChar = part[offset - 1].charAt(part[offset - 1].length()-1);
       for (int i = offset; i < part.length; i++) {
           if (part[i].charAt(0) == lastChar) {
               String tmp = names[offset];
               names[offset] = names[i];
               names[i] = tmp;
               recursive(names, offset+1);
               names[i] = names[offset];
               names[offset] = tmp;
           }
       }
   }

   public static void main(String[] args) {
       for (int i = 0; i < names.length; i++) {
           String tmp = names[0];
           names[0] = names[i];
           names[i] = tmp;
           recursive(names, 1);
           names[i] = names[0];
           names[0] = tmp;
      }
      System.out.println("maximum path length        : " + maxPathLength);
      System.out.println("paths of that length       : " + maxPathLengthCount);
      System.out.println("example path of that length:" + maxPathExample);
   }

} </lang>

Output:

maximum path length        : 23
paths of that length       : 1248
example path of that length:
  machamp pinsir rufflet trapinch heatmor
  remoraid darmanitan nosepass starly yamask
  kricketune exeggcute emboar relicanth haxorus
  simisear registeel landorus seaking girafarig
  gabite emolga audino

ooRexx

This example is incorrect. Please fix the code and remove this message.

Details: first letter of the last word doesn't connect to the previous entry's last letter.

<lang ooRexx> -- create the searcher and run it searcher = .chainsearcher~new

class chainsearcher
method init
 expose max searchsize currentlongest

 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"

 pokemon = pokemon_names~makearray(" ")
 searchsize = pokemon~items
 currentlongest = 0
 say "searching" searchsize "names..."
 longestchain = .array~new
 -- run the sequence using each possible starting pokemon
 loop i = 1 to pokemon~items
     -- swap the ith name to the front of our list
     self~swap(pokemon, 1, i)
     -- run the chain from here
     self~searchChain(pokemon, longestchain, 2)
     -- swap the name back so we have the list in original form
     self~swap(pokemon, 1, i)
 end
 say "maximum path length:" longestchain~items
 say "paths of that length:" max
 say "example path of that length:"

 loop name over longestchain
     say "    "name
 end
method swap
 use arg list, a, b
 tmp = list[a]
 list[a] = list[b]
 list[b] = tmp

-- recursive search routine for adding to the chain

method searchChain
 expose max searchsize currentlongest
 use arg pokemon, longestchain, currentchain

 -- get the last character
 lastchar = pokemon[currentchain - 1]~right(1)
 -- now we search through all of the permutations of remaining
 -- matches to see if we can find a longer chain
 loop i = currentchain to searchsize
     -- for every candidate name from here, recursively extend the chain.
     if pokemon[i]~left(1) == lastchar then do
         if currentchain == currentLongest then max += 1
         -- have we now gone deeper than the current longest chain?
         else if currentchain > currentLongest then do
            -- chuck this result and refill with current set
            longestchain~empty
            longestchain~appendall(pokemon~section(1, currentchain))
            max = 1
            currentLongest = currentchain
         end
         -- perform the swap again
         self~swap(pokemon, currentchain, i)
         -- run the chain from here
         self~searchChain(pokemon, longestchain, currentchain + 1)
         -- swap the name back so we have the list in original form
         self~swap(pokemon, currentchain, i)
     end
 end

</lang> 

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
    ivysaur

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

Perl

This is rather 'one liner' code, not to be used in production.

The idea is to try all possible variants recursively.

  • First, it creates the map-like structure: first letter → array of (name + last letter).
  • During the cycle it uses @w as stack;
  • @m keeps the longest sequence which is copied from @w;
  • to prevent the words from appearing twice, they are (temporarily) deleted from the structure keeping the value in a stack variable.

<lang perl> /^(.).*(.)$/,$f{$1}{$_}=$2 for qw( 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 );

sub poke { my $h = $f{$_[0]}; for my $w (keys %$h) { my $v = $h->{$w}; delete $h->{$w}; push @w, $w; @m = @w if @w > @m; poke($v); pop @w; $h->{$w} = $v; } }

poke($_) for keys %f; print @m.": @m\n"; </lang> Output: 

23: machamp petilil landorus seaking girafarig gabite emboar registeel loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch haxorus scrafty yamask kricketune exeggcute emolga audino

Prolog

Works with SWI-Prolog and module lambda.pl written by Ulrich Neumerkel found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl <lang Prolog>:- use_module(library(lambda)).

- dynamic res/3.

last_first(Len, Nb, L) :- retractall(res(_,_,_)), assert(res(0, 0, [])), % compute all the lists of connected words last_first, res(Len, Nb, L1), % to have only the words maplist(\X^Y^(X = [Y, _, _]), L1, L).

% create the lists of connected words (initiate the first word) last_first :- init(L), forall(select(Word, L, L1), \+lance_p([Word | L1])).

% compute all the lists beginning with a word % memorize the longest lance_p(L) :- p(LF, L), retract(res(Len, Nb, Lst)), length(LF, Len1), ( Len1 > Len -> assert(res(Len1, 1, LF)) ; Len1 = Len -> Nb1 is Nb + 1, assert(res(Len, Nb1, Lst)) ; assert(res(Len, Nb, Lst))), fail.

% describe the property of the list of connected words p([A | T], [A | L]) :- select(B, L, L1), p0(A,B), T = [B | T1], p([B | T1], [B | L1]).

% a list with one element is valid p([_], _).


% are words conected ? p0([_, _, W], [_, W, _]).

% each word is associated with its first and last letters % audino --> [audino, a, o] init(L) :-

L0 = [ 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], maplist(init_, L0, L).

% audino --> [audino, a, o] init_(W, [W, F, L]) :- first_letter(W, F), last_letter(W, L).


first_letter(A, F) :- atom_chars(A, [F | _]).

last_letter(A, L) :- atom_chars(A, LC), reverse(LC, [L | _]). </lang> Output : 

?- time(last_first(Len, Nb, L)).
% 592,161,339 inferences, 125.690 CPU in 128.264 seconds (98% CPU, 4711284 Lips)
Len = 23,
Nb = 1248,
L = [machamp,petilil,landorus,scrafty,yamask,kricketune,emboar,registeel,loudred,darmanitan,nosepass,simisear,relicanth,heatmor,rufflet,trapinch,haxorus,seaking,girafarig,gabite,exeggcute,emolga,audino].

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.

REXX

Translation of: ooRexx

brute force version

(This program is modeled after the ooRexx version, with a bug fix.)

This REXX version allows a limit on the word scan (very useful for debugging), and
also has various speed optimizations. <lang rexx>/*REXX pgm to find longest path of word's last-letter ──► to 1st-letter.*/ @='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'
  1. =words(@)

parse arg limit .; if limit\== then #=limit /*allow a scan limit.*/ @.=; $$$= /*nullify array, and longest path*/ 

                 do i=1 for #         /*build a stemmed array from list*/
                 @.i=word(@,i)
                 end   /*i*/

soFar=0 /*the initial maximum path length*/ 

                 do j=1 for #
                 parse value @.1 @.j with @.j @.1
                 call scanner $$$,2
                 parse value @.1 @.j with @.j @.1
                 end   /*j*/

L=words($$$) say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" L'.' say; say 'One example path of that length is:' 

     do m=1  for L;     say left(,39) word($$$,m);     end   /*m*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────S subroutine────────────────────────*/ s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*──────────────────────────────────SCANNER subroutine (recursive)──────*/ scanner: procedure expose @. MP # soFar $$$; parse arg $$$,!; _=!-1 lastChar=right(@._,1) /*last char of penultimate word. */ 

 do i=!  to #                         /*scan for the longest word path.*/
 if left(@.i,1)==lastChar then        /*is the first-char = last-char? */
   do
   if !==soFar then MP=MP+1           /*bump the maximum paths counter.*/
               else if !>soFar then do; $$$=@.1            /*rebuild it*/
                                                 do n=2 to !-1
                                                 $$$=$$$ @.n
                                                 end   /*n*/
                                    $$$=$$$ @.i            /*add last. */
                                    MP=1;  soFar=!         /*new path. */
                                    end
   parse value @.! @.i with @.i @.!
   call scanner $$$,!+1               /*recursive scan for longest path*/
   parse value @.! @.i with @.i @.!
   end
 end    /*i*/

return /*exhausted this particular scan.*/</lang> output 

Of 70 words, 1248 paths have the maximum path length of 23.

One example path of that length 23 is:  machamp
                                        petilil
                                        landorus
                                        scrafty
                                        yamask
                                        kricketune
                                        emboar
                                        registeel
                                        loudred
                                        darmanitan
                                        nosepass
                                        simisear
                                        relicanth
                                        heatmor
                                        rufflet
                                        trapinch
                                        haxorus
                                        seaking
                                        girafarig
                                        gabite
                                        exeggcute
                                        emolga
                                        audino

optimized version

This optimized version has two major improvements:

  • removes dead words (words that cannot be used in a path)
  • stops scanning when a dead-end word is encountered.


With the full list of words being used, there're no dead words (but there are when a limit is used to shorten the list).
In the SCAN subroutine, a check is made to see if the word being used is a dead-end word,
and if so, the rest of the recursive scan is aborted and the the next word is scanned.

The optimized version is around 23% faster than the brute-force version. <lang rexx>/*REXX pgm to find longest path of word's last-letter ──► to 1st-letter.*/ @='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'
  1. =words(@)

parse arg limit .; if limit\== then #=limit /*allow a scan limit.*/ @.=; $$$=; ig=0 /*nullify array and longest path.*/ call build@. 

                   do v=# by -1 for # /*scrub list for unusuable words.*/
                   F= left(@.v,1)     /*first letter of the word.      */
                   L=right(@.v,1)     /* last    "    "  "    "        */
                   if !.1.F>1 | !.9.L>1 then iterate  /*is a dead word?*/
                   @=delword(@,v,1)                   /*delete from @. */
                   say 'ignorning dead word:' @.v;    ig=ig+1
                   end   /*v*/

if ig\==0 then do 

              call build@.
              say;     say 'ignoring' ig "dead word"s(ig)'.';     say
              end

soFar=0 /*the initial maximum path length*/ 

                 do j=1 for #
                 parse value @.1 @.j with @.j @.1
                 call scanner $$$,2
                 parse value @.1 @.j with @.j @.1
                 end   /*j*/

g=words($$$) say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" g'.' say; say 'One example path of that length is:' 

     do m=1  for g                    /*display a list of words.       */
     say left(,39) word($$$,m)
     end   /*m*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────BUILD suroutine─────────────────────*/ build@.:  !.=0; do i=1 for # /*build a stemmed array from list*/ 

                   @.i=word(@,i)
                   F= left(@.i,1);   !.1.F=!.1.F+1   /*count  1st chars*/
                   L=right(@.i,1);   !.9.L=!.9.L+1   /*count last chars*/
                   end   /*i*/

return /*──────────────────────────────────S subroutine────────────────────────*/ s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*──────────────────────────────────SCANNER subroutine (recursive)──────*/ scanner: procedure expose @. MP # !. soFar $$$; parse arg $$$,!; _=!-1 lastChar=right(@._,1) /*last char of penultimate word. */ if !.1.lastchar==0 then return /*is this a dead-end word ? */ 

 do i=!  to #                         /*scan for the longest word path.*/
 if left(@.i,1)==lastChar then        /*is the first-char = last-char? */
   do
   if !==soFar then MP=MP+1           /*bump the maximum paths counter.*/
               else if !>soFar then do; $$$=@.1            /*rebuild it*/
                                                 do n=2 to !-1
                                                 $$$=$$$ @.n
                                                 end   /*n*/
                                    $$$=$$$ @.i            /*add last. */
                                    MP=1;  soFar=!         /*new path. */
                                    end
   parse value @.! @.i with @.i @.!
   call scanner $$$,!+1               /*recursive scan for longest path*/
   parse value @.! @.i with @.i @.!
   end
 end    /*i*/

return /*exhausted this particular scan.*/</lang> output is the same as the brute force version.

Ruby

<lang ruby>def add_name(seq) 

 last_letter = seq[-1][-1]
 potentials = $first.include?(last_letter) ? ($first[last_letter] - seq) : []
 if potentials.empty?
   $sequences << seq
 else
   potentials.each {|name| add_name(seq + [name])}
 end

end

names = %w{ 

 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

} $first = names.group_by {|name| name[0]} $sequences = []

names.each {|name| add_name [name]}

max = $sequences.max_by {|seq| seq.length}.length max_seqs = $sequences.select {|seq| seq.length == max}

puts "there are #{$sequences.length} possible sequences" puts "the longest is #{max} names long" puts "there are #{max_seqs.length} such sequences. one is:" max_seqs.last.each_with_index {|name, idx| puts " %2d %s" % [idx+1, name]}</lang> outputs 

there are 2076396 possible sequences
the longest is 23 names long
there are 1248 such sequences. one is:
   1 machamp
   2 pinsir
   3 rufflet
   4 trapinch
   5 heatmor
   6 remoraid
   7 darmanitan
   8 nosepass
   9 starly
  10 yamask
  11 kricketune
  12 exeggcute
  13 emboar
  14 relicanth
  15 haxorus
  16 simisear
  17 registeel
  18 landorus
  19 seaking
  20 girafarig
  21 gabite
  22 emolga
  23 audino

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

  1. 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
Retrieved from "https://rosettacode.org/wiki/Last_letter-first_letter?oldid=186341"