%  Find the largest integer divisible by all it's digits, with no digit repeated.
%  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%  We go for a generic algorithm here.  Test for divisibility is done by
%  calculating the least common multiplier for all digits, and testing
%  whether a candidate can be divided by the LCM without remainder.
%
%  Instead of iterating numbers and checking whether the number has
%  repeating digits, it is more efficient to generate permutations of
%  digits and then convert to a number.  Doing it this way reduces search
%  space greatly.
%
% Notes:
%  For decimal numbers we could improve times by testing only numbers
%  of length 7 (since 5x2=10 and 0 is not one of our digits, and 9x2=18
%  which needs 2 digits to store), but that sort of logic does not
%  hold for hexadecimal numbers.
%  We could also explicitly eliminate odd numbers, but the double validity
%  check actually slows us down very slightly instead of speeding us up.

:- dynamic
	trial/1.       % temporarily store digit combinations here.

gcd(X, X, X).  % Calculate greatest common divisor
gcd(M, N, X) :- N > M, B is N-M, gcd(M,B,X).
gcd(M, N, X) :- N < M, A is M-N, gcd(A,N,X).

lcm(A, B, LCM) :- gcd(A,B,GCD), LCM is A * B / GCD.

lcm([H], H).   % Calculate least common multiplier
lcm([A|T], LCM) :- lcm(T, B), !, lcm(A,B,LCM).

mkint(_, Val, [], Val).     % Result = Val where list is empty
mkint(Radix, Val, [H|T], Int) :-  % (((I0*10+I1)*10+I2)*10+In)...
	V0 is Val*Radix+H, !, mkint(Radix, V0, T, Int).

% Turn a list of digits into an integer number using Radix.
mkint(Radix, [H|T], Int) :- mkint(Radix, H, T, Int).

domain(0, []).       % For example, domain(5) is [1,2,3,4,5]
domain(N, [N|Digits]) :-
   succ(N0, N), !, domain(N0, Digits).

trial(0, Digits, Digits).   % generates a combination of digits to test
trial(N, D, Digits) :-      % remove N digits, and find remaining combinations
    append(L0,[_|L1],D), succ(N0, N), trial(N0, L1, Dx),
    append(L0, Dx, Digits). % trial(1, [3,2,1], D) -> D=[2,1]; D=[3,1]; D=[3,2].

make_trials(_,_) :- retractall(trial(_)), fail.
make_trials(N,Domain) :- trial(N, Domain, Digits), asserta(trial(Digits)), fail.
make_trials(_,_).           % trials are stored highest values to lowest

combinations(Radix, NDigits) :-  % Precalculate all possible digit combinations
    succ(R0, Radix), domain(R0, Domain), Nskip is R0 - NDigits,
    make_trials(Nskip, Domain).

test(Radix, Digits, LCM, Number) :-  % Make an integer and check for divisibility
   mkint(Radix, Digits, Number), 0 is Number mod LCM.

bignum(Radix, Number) :-
   succ(R0, Radix), between(1,R0,N), NDigits is Radix - N,    % loop decreasing length
   combinations(Radix, NDigits),            % precalc digit combos with length=NDigits
   trial(Digits), lcm(Digits, LCM),         % for a combination, calculate LCM
   permutation(Digits, Trial),              % generate a permutation
   test(Radix, Trial, LCM, Number).         % test for divisibility

largest_decimal(N) :- bignum(10, N), !.
largest_hex(N, H) :- bignum(16, N), !, sformat(H, '~16r', [N]).


'''Largest number divisible by its digits'''

from itertools import (chain, permutations)
from functools import (reduce)
from math import (gcd)

# main :: IO ()
def main():
    '''Tests'''

    # (Division by zero is not an option, so 0 and 5 are omitted)
    digits = [1, 2, 3, 4, 6, 7, 8, 9]

    # Least common multiple of the digits above
    lcmDigits = reduce(lcm, digits)

    # Any 7 items drawn from the digits above,
    # including any two of [1, 4, 7]
    sevenDigits = ((delete)(digits)(x) for x in [1, 4, 7])

    print(
        max(
            (
                intFromDigits(x) for x
                in concatMap(permutations)(sevenDigits)
            ),
            key=lambda n: n if 0 == n % lcmDigits else 0
        )
    )

# intFromDigits :: [Int] -> Int
def intFromDigits(xs):
    '''An integer derived from an
       ordered list of digits.
    '''
    return reduce(lambda a, x: a * 10 + x, xs, 0)

# ----------------------- GENERIC ------------------------

# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
    '''A concatenated list over which a function has been
       mapped. The list monad can be derived by using a
       function f which wraps its output in a list,
       (using an empty list to represent computational failure).
    '''
    def go(xs):
        return chain.from_iterable(map(f, xs))
    return go

# delete :: Eq a => [a] -> a -> [a]
def delete(xs):
    '''xs with the first instance of
       x removed.
    '''
    def go(x):
        ys = xs.copy()
        ys.remove(x)
        return ys
    return go

# lcm :: Int -> Int -> Int
def lcm(x, y):
    '''The smallest positive integer divisible
       without remainder by both x and y.
    '''
    return 0 if (0 == x or 0 == y) else abs(
        y * (x // gcd(x, y))
    )

# MAIN ---
if __name__ == '__main__':
    main()


largest_LynchBell_number <- function(from, to){
  from = round(from)
  to = round(to)
  to_chosen = to

  if(to > 9876432) to = 9876432  #cap the search space to this number

  LynchBell = NULL

  range <- to:from #search starting from the end of the range
  range <- range[range %% 5 != 0] #reduce search space

  for(n in range){
    splitted <- strsplit(toString(n), "")[[1]]
    if("0" %in% splitted | "5" %in% splitted) next
    if (length(splitted) != length(unique(splitted))) next

    for (i in splitted) {
      if(n %% as.numeric(i) != 0) break
      if(which(splitted == i) == length(splitted)) LynchBell = n
    }
    if(!is.null(LynchBell)) break
  }

  message(paste0("The largest Lynch-Bell numer between ", from, " and ", to_chosen, " is ", LynchBell))
  return(LynchBell)
}

#Verify (in less than 2 seconds)
for(i in 10^(1:8)){
  largest_LynchBell_number(1, i)
}


my $magic-number = 9 * 8 * 7;                        # 504

my $div = 9876432 div $magic-number * $magic-number; # largest 7 digit multiple of 504 < 9876432

for $div, { $_ - $magic-number } ... * -> $test {    # only generate multiples of 504
    next if $test ~~ / <[05]> /;                     # skip numbers containing 0 or 5
    next if $test ~~ / (.).*$0 /;                    # skip numbers with non unique digits

    say "Found $test";                               # Found a solution, display it
    for $test.comb {
        printf "%s / %s = %s\n", $test, $_, $test / $_;
    }
    last
}


Red []
t0: now/time/precise    ;; measure runtime
lbn: 98764321 + 1       ;; because digit 5 is ruled out, this is the highest 8 digit number
                        ;; possible, add 1 because only even numbers are possible

check: func [tos [ string! ]] [               ;; function to check if number is divideable by
  foreach ele tos [                           ;; all of its digits
      div: to-integer  ele - #"0"             ;; convert asci digit to integer
      unless lbn % div = 0 [ return false ]   ;; fail at first false condition ( unless = if not...)
  ]
 true                                         ;; true if all digits passed
]

forever [
  lbn: lbn - 2                  ;; only even numbers could be possible results
  if find tos: to-string lbn  "0" [continue]  ;; no "0" allowed
  if find tos "5" [continue]                  ;; "5" also excluded
  unless tos = unique tos [ continue ]        ;; only unique digits allowed
  unless check tos [continue]                 ;; passed check ?
  print lbn                                   ;; first hit is result
  probe now/time/precise - t0                 ;; display runtime
  halt
]


/*REXX program finds the largest (decimal) integer divisible by all its decimal digits. */
$= 7 * 8 * 9                                     /*a # that it must divide the found #. */
t= 0                                             /*the number of divisibility trials.   */
     do #=9876432 % $ * $        by -$           /*search from largest number downwards.*/
     if # // $             \==0  then iterate    /*Not divisible?   Then keep searching.*/
     if verify(50, #, 'M') \==0  then iterate    /*does it contain a  five  or a  zero? */
     t= t+1                                      /*curiosity's sake, track # of trials. */
            do j=1  for length(#) - 1            /*look for a possible duplicated digit.*/
            if pos( substr( #, j, 1), #, j+1) \==0  then iterate #
            end   /*j*/                          /* [↑]  Not unique? Then keep searching*/
                                                 /* [↓]  superfluous, but check anyways.*/
            do v=1  for length(#)                /*verify the # is divisible by all digs*/
            if # // substr(#, v, 1)           \==0  then iterate #
            end   /*v*/                          /* [↑]  ¬divisible?  Then keep looking.*/
     leave                                       /*we found a number, so go display it. */
     end         /*#*/

say 'found '   #    "  (in "   t   ' trials)'    /*stick a fork in it,  we're all done. */


# Project : Largest number divisible by its digits

for n = 9867000  to 9867400
    numbers = list(9)
    for t=1 to 9
        numbers[t] = 0
    next
    flag = 1
    flag2 = 1
    flag3 = 1
    str=string(n)
    for m=1 to len(str)
        if number(str[m]) > 0
           numbers[number(str[m])] = numbers[number(str[m])] + 1
        else
           flag2 = 0
        ok
    next
    if flag2 = 1
       for p=1 to 9
           if numbers[p] = 0 or numbers[p] = 1
           else
              flag = 0
           ok
       next
       if flag = 1
          for x=1 to len(str)
              if n%(number(str[x])) != 0
                 flag3 = 0
              ok
          next
          if flag3 = 1
             see n + nl
          ok
       ok
    ok
next


magic_number = 9*8*7
div          = 9876432.div(magic_number) * magic_number
candidates   = div.step(0, -magic_number)

res = candidates.find do |c|
  digits = c.digits
  (digits & [0,5]).empty? && digits == digits.uniq
end

puts "Largest decimal number is #{res}"


import scala.collection.mutable

def largestDecimal: Int = Iterator.from(98764321, -1).filter(chkDec).next
def chkDec(num: Int): Boolean = {
  val set = mutable.HashSet[Int]()
  num.toString.toVector.map(_.asDigit).forall(d => (d != 0) && (num%d == 0) && set.add(d))
}


func largest_number(base) {

    var digits = @(base ^.. 1)

    digits.each {|k|
        digits.variations(k, {|*a|
            var n = Number(a.join, base)
            if (a.all {|d| d.divides(n) }) {
                return n
            }
        })
    }
}

say largest_number(10)   #=> 9867312


' Largest number divisible by its digits - base10 - VBScript
	s=7*8*9  	'reasonable assumption
	m=9876432   'reasonable assumption
	for i=(m\s)*s to 1 step -s
		if instr(i,"5")=0 and instr(i,"0")=0 then  '5 or 0 impossible
			b=false: j=1
			while j<=len(i)-1 and not b
				if instr(j+1,i,mid(i,j,1))<>0 then b=true  'no duplicated digit
				j=j+1
			wend
			if not b then
				j=1
				while j<=len(i) and not b
					if (i mod mid(i,j,1))<>0 then b=true  'divisible by all digits
					j=j+1
				wend
				if not b then exit for
			end if
		end if
	next
	wscript.echo i


Module Module1

    Function ChkDec(num As Integer) As Boolean
        Dim sett As New HashSet(Of Integer)
        Return num.ToString() _
            .Select(Function(c) Asc(c) - Asc("0")) _
            .All(Function(d) (d <> 0) AndAlso (num Mod d = 0) AndAlso sett.Add(d))
    End Function

    Sub Main()
        Dim result = Enumerable.Range(0, 98764321) _
            .Reverse() _
            .Where(AddressOf ChkDec) _
            .First()
        Console.WriteLine(result)
    End Sub

End Module


var divByAll = Fn.new { |n, digits| digits.all { |d| n%(d-48) == 0 } }

var magic = 9 * 8 * 7
var high = (9876432/magic).floor * magic
var i = high
while (i >= magic) {
    if (i%10 != 0) {  // can't end in '0'
        var s = "%(i)"
        if (!s.contains("0") && !s.contains("5")) { // can't contain '0' or '5'
            var set = {}
            var sd = [] // list of distinct digits
            for (b in s.bytes) {
                if (set[b] == null) {
                    set[b] = true
                    sd.add(b)
                }
            }
            if (sd.count == s.count) { // digits must be unique
                if (divByAll.call(i, sd)) {
                    System.print("Largest decimal number is %(i)")
                    return
                }
            }
        }
    }
    i = i - magic
}


int Digits;     \bit array

func AllDiv(N); \Return 'true' if N is divisible by its digits
int  N, D;
[for D:= 9 downto 2 do
    if 1<<D & Digits then
        if rem(N/D) # 0 then return false;
return true;
];

func Unique(N); \Return 'true' if N contains unique digits
int  N;
[Digits:= 1;    \disallow 0
while N do
    [N:= N/10;
    if 1<<rem(0) & Digits then return false;
    Digits:= 1<<rem(0) ! Digits;
    ];
return true;
];

int N;
[N:= 987654312; \largest possible number divisible by (2*3)
loop    [if Unique(N) then
            if AllDiv(N) then
                [IntOut(0, N);
                quit;
                ];
        N:= N-6;
        ];
]


const magic_number=9*8*7; # 504
const div=9876432 / magic_number * magic_number; #largest 7 digit multiple of 504 < 9876432

foreach test in ([div..0,-magic_number]){
   text:=test.toString();
   if(text.holds("0","5"))		 continue; # skip numbers containing 0 or 5
   if(text.unique().len()!=text.len())   continue; # skip numbers with non unique digits
   if(test.split().filter1('%.fp(test))) continue; # skip numbers that don't divide evenly by all digits

   println("Found ",test); # Found a solution, display it
   foreach d in (test.split()){
      println("%s / %s = %s".fmt(test,d, test/d));
   }
   break;
}


F order_words(words)
   DefaultDict[Char, Set[String]] byfirst
   L(word) words
      byfirst[word[0]].add(word)
   R byfirst

F linkfirst(&byfirst; sofar)
   assert(!sofar.empty)
   V chmatch = sofar.last.last
   V options = byfirst[chmatch] - Set(sofar)

   I options.empty
      R sofar
   E
      V alternatives = options.map(word -> linkfirst(&@byfirst, @sofar [+] [word]))
      R max(alternatives, key' s -> s.len)

F llfl(words)
   V byfirst = order_words(words)
   R max((words.map(word -> linkfirst(&@byfirst, [word]))), key' s -> s.len)

V pokemon_str = ‘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’
V pokemon = pokemon_str.split((‘ ’, "\n"))
V l = llfl(pokemon)
L(i) (0 .< l.len).step(8)
   print(l[i .< i + 8].join(‘ ’))
print(l.len)


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;


all$ = "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 check(list$, rest$)

    LOCAL x

    FOR x = 1 TO AMOUNT(rest$)
        IF RIGHT$(list$, 1) = LEFT$(TOKEN$(rest$, x), 1) THEN check(APPEND$(list$, 0, TOKEN$(rest$, x)), DEL$(rest$, x))
    NEXT

    IF AMOUNT(list$) > total THEN
        total = AMOUNT(list$)
        result$ = list$
    END IF

END SUB

FOR z = 1 TO AMOUNT(all$)
    CALL check(TOKEN$(all$, z), DEL$(all$,z))
NEXT

PRINT total, ": ", result$

PRINT NL$, "Speed: ", TIMER, " msecs."


dim names$(1)
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" }

global names$, lnames, index, maxlen, first, last
maxlen = 0

lnames = names$[?]-1
dim index(names$[?])
dim first(names$[?])
dim last(names$[?])
for t = 0 to lnames
	index[t] = t
	last[t] = asc(right(names$[t],1))
	first[t] = asc(left(names$[t],1))
next t

# try each name as the first name on the list
for t = 0 to lnames
   call swapindex(0,t)
   call downlevel(1)
   call swapindex(0,t)
next t

end

subroutine downlevel(lev)
   #print n$[?] + " " + lev
   if lev <= lnames then
      for t = lev to lnames
         if last[index[lev-1]] = first[index[t]] then
            call swapindex(lev,t)
            if lev >= maxlen then
               maxlen = lev
               call showsolution(lev)
            end if
            call downlevel(lev+1)
            call swapindex(lev,t)
         end if
      next t
   end if
end subroutine

subroutine showsolution(l)
   print l+1;
   for t = 0 to l
      print " " + names$[index[t]];
   next t
   print
end subroutine

subroutine swapindex(a, b)
   # swap element a and bin in the array index (used to swap names$)
   t = index[a]
   index[a] = index[b]
   index[b] = t
end subroutine


      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


(   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)
);


#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;

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


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


#include <iostream>
#include <string>
#include <vector>

struct last_letter_first_letter {
    size_t max_path_length = 0;
    size_t max_path_length_count = 0;
    std::vector<std::string> max_path_example;

    void search(std::vector<std::string>& names, size_t offset) {
        if (offset > max_path_length) {
            max_path_length = offset;
            max_path_length_count = 1;
            max_path_example.assign(names.begin(), names.begin() + offset);
        } else if (offset == max_path_length) {
            ++max_path_length_count;
        }
        char last_letter = names[offset - 1].back();
        for (size_t i = offset, n = names.size(); i < n; ++i) {
            if (names[i][0] == last_letter) {
                names[i].swap(names[offset]);
                search(names, offset + 1);
                names[i].swap(names[offset]);
            }
        }
    }

    void find_longest_chain(std::vector<std::string>& names) {
        max_path_length = 0;
        max_path_length_count = 0;
        max_path_example.clear();
        for (size_t i = 0, n = names.size(); i < n; ++i) {
            names[i].swap(names[0]);
            search(names, 1);
            names[i].swap(names[0]);
        }
    }
};

int main() {
    std::vector<std::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"};
    last_letter_first_letter solver;
    solver.find_longest_chain(names);
    std::cout << "Maximum path length: " << solver.max_path_length << '\n';
    std::cout << "Paths of that length: " << solver.max_path_length_count << '\n';
    std::cout << "Example path of that length:\n  ";
    for (size_t i = 0, n = solver.max_path_example.size(); i < n; ++i) {
        if (i > 0 && i % 7 == 0)
            std::cout << "\n  ";
        else if (i > 0)
            std::cout << ' ';
        std::cout << solver.max_path_example[i];
    }
    std::cout << '\n';
}


(ns rosetta-code.last-letter-first-letter
  (:require clojure.string))

(defn by-first-letter
  "Returns a map from letters to a set of words that start with that letter"
  [words]
  (into {} (map (fn [[k v]]
                  [k (set v)]))
        (group-by first words)))

(defn longest-path-from
  "Find a longest path starting at word, using only words-by-first-letter for successive words.
  Returns a pair of [length list-of-words] to describe the path."
  [word words-by-first-letter]
  (let [words-without-word (update words-by-first-letter (first word)
                                   disj word)
        next-words (words-without-word (last word))]
    (if (empty? next-words)
      [1 [word]]
      (let [sub-paths (map #(longest-path-from % words-without-word) next-words)
            [length words-of-path] (apply max-key first sub-paths)]
        [(inc length) (cons word words-of-path)]))))

(defn longest-word-chain
  "Find a longest path among the words in word-list, by performing a longest path search
  starting at each word in the list."
  [word-list]
  (let [words-by-letter (by-first-letter word-list)]
    (apply max-key first
           (pmap #(longest-path-from % words-by-letter)
                 word-list))))

(defn word-list-from-file [file-name]
  (let [contents (slurp file-name)
        words (clojure.string/split contents #"[ \n]")]
    (filter #(not (empty? %)) words)))

(time (longest-word-chain (word-list-from-file "pokemon.txt")))


;;; return all the words that start with an initial letter

(defun filter-with-init (words init)
  (remove-if-not (lambda (word) (eql init (aref word 0))) words))

;;; produce a hash table whose key is the initial letter of a word and whose value is
;;; a list of the words that start with that initial letter

(defun group-by-first-letter (words)
  (let ((map_letters (make-hash-table))
        (inits (remove-duplicates (mapcar (lambda (word) (aref word 0)) words))))
    (dolist (init inits map_letters)
      (setf (gethash init map_letters) (filter-with-init words init)))
    ))

;;; Get the last letter in a word or array

(defun last-element (array) (aref array (- (length array) 1)))

;;; Produce a hash table whose key is a word and whose value is a list of the
;;; words that can follow that word

(defun get-followers (words)
  (let ((map-word-to-followers (make-hash-table :test 'equal))
        (init_hash (group-by-first-letter words)))
    (dolist (word words map-word-to-followers)
      (setf
       (gethash word map-word-to-followers)
       (gethash (last-element word) init_hash)))))

;;; Retrieve all the keys from a hash table

(defun keys (hashtbl)
  (let ((allkeys ()))
    (maphash #'(lambda (key val) (setf allkeys (cons key allkeys))) hashtbl)
    allkeys))

;;; Find the words which can follow a word and haven't been used yet.  The parameters are:
;;;    word - word being tested
;;;    followers - the hash table returned from get-followers
;;;    available - hash table with word as key and boolean indicating whether that word
;;;                has been used previously as value

(defun get-available-followers (word followers available)
  (if (null word)
      (keys followers)
      (remove-if-not #'(lambda (word) (gethash word available)) (gethash word followers))))

;;; Find the best in a list using an arbitrary test

(defun best (lst test)
  (let ((top (car lst)))
    (do
        ((rest (cdr lst) (cdr rest)))
        ((null rest) top)
      (if (funcall test (car rest) top) (setf top (car rest))))))

;;; Find the best path in a list

(defun best-list-path (paths)
  (best paths #'(lambda (path1 path2) (> (length path1) (length path2)))))

;;; Find the best path given all the supporting information we need

(defun best-path-from-available (word followers available depth path available-followers)
  (let ((results
         (mapcar #'(lambda (new-word)
                   (dfs-recurse new-word followers available (+ 1 depth) (cons word path)))
           available-followers)))
    (best-list-path results)))

;;; Recurse to find the best available path - the meat of the algorithm

(defun dfs-recurse (word followers available depth path)
  (let ((ret))
    ; Mark the word as unavailable
    (setf (gethash word available) nil)

    ; Find the longest path starting with word
    (let ((available-followers (get-available-followers word followers available)))
        (setf ret
         (if (null available-followers)
             (cons word path)
           (best-path-from-available word followers available depth path available-followers))))

    ; Mark the word as available again
    (setf (gethash word available) t)

    ; Return our longest path
    ret))

;;; Create the availability table

(defun make-available-table (words)
  (let
      ((available (make-hash-table)))
    (dolist (word words available) (setf (gethash word available) t))))

;;; Find the best path for a set of words

(defun best-path (words)
  (let
      ((followers (get-followers words))
       (available (make-available-table words)))
    (cdr (reverse (dfs-recurse nil followers available 0 nil)))))

;;; set up the words as a set of strings
(setf *words* (mapcar #'symbol-name
'(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)))

(setf *path* (best-path *words*))


import std.stdio, std.algorithm, std.string;

void trySwap(string[] items, ref string item, in size_t len, ref string[] longest)
pure nothrow @safe {
    swap(items[len], item);
    search(items, len + 1, longest);
    swap(items[len], item);
}

void search(string[] items, in size_t len, ref string[] longest)
pure nothrow @safe {
    if (len > longest.length)
        longest = items[0 .. len].dup;
    immutable lastChar = items[len - 1][$ - 1];
    foreach (ref item; items[len .. $])
        if (item[0] == lastChar)
            trySwap(items, item, len, longest);
}

void main() @safe {
    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)
        trySwap(pokemon, name, 0, solution);

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


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.


defmodule LastLetter_FirstLetter do
  def search(names) do
    first = Enum.group_by(names, &String.first/1)
    sequences = Enum.reduce(names, [], fn name,acc -> add_name(first, acc, [name]) end)
    max = Enum.max_by(sequences, &length/1) |> length
    max_seqs = Enum.filter(sequences, fn seq -> length(seq) == max end)
    IO.puts "there are #{length(sequences)} possible sequences"
    IO.puts "the longest is #{max} names long"
    IO.puts "there are #{length(max_seqs)} such sequences. one is:"
    hd(max_seqs) |> Enum.with_index |>
    Enum.each(fn {name, idx} ->
      :io.fwrite "  ~2w ~s~n", [idx+1, name]
    end)
  end

  defp add_name(first, sequences, seq) do
    last_letter = String.last(hd(seq))
    potentials = Map.get(first, last_letter, []) -- seq
    if potentials == [] do
      [Enum.reverse(seq) | sequences]
    else
      Enum.reduce(potentials, sequences, fn name, acc -> add_name(first, acc, [name | seq]) end)
    end
  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
)

LastLetter_FirstLetter.search(names)


-module( last_letter_first_letter ).

-export( [solve/1, task/0] ).

solve( Names ) ->
    Dict = lists:foldl( fun dict_append/2, dict:new(), Names ),
    Chains = construct_chains_in_parallel( Dict ),
%    Chains = [construct_chain_from_key(Dict, X) || X <- dict:fetch_keys(Dict)],
    lists:foldl( fun construct_chain_longest/2, [], Chains ).

task() -> solve( binary:split(names(), <<" ">>, [global]) ).

construct_chains_in_parallel( Dict ) ->
    My_pid = erlang:self(),
    Pids = [erlang:spawn( fun() -> My_pid ! {erlang:self(), construct_chain_from_key(Dict, X)} end) || X <- dict:fetch_keys(Dict)],
    [receive {X, Chain} -> Chain end || X <- Pids].

construct_chain_from_key( Dict, First_letter ) ->
	Names = construct_chain_names( dict:find(First_letter, Dict) ),
	construct_chain_from_names( Names, Dict, [] ).

construct_chain_from_names( [], _Dict, Best_chain ) -> Best_chain;
construct_chain_from_names( [{Name, Last_letter} | T], Dict, Best_chain ) ->
        New_dict = dict_delete( Name, Dict ),
        New_chain = [Name | construct_chain_from_key( New_dict, Last_letter )],
	construct_chain_from_names( T, Dict, construct_chain_longest(Best_chain, New_chain) ).

construct_chain_longest( Chain1, Chain2 ) when length(Chain1) > length(Chain2) -> Chain1;
construct_chain_longest( _Chain1, Chain2 ) -> Chain2.

construct_chain_names( {ok, {Name, Last_letter}} ) -> [{Name, Last_letter}];
construct_chain_names(	{ok, Values} ) -> Values;
construct_chain_names( error ) -> [].

dict_append( Name, Acc ) ->
	{First_letter, {Name, Last_letter}} = dict_item( Name ),
	dict:append( First_letter, {Name, Last_letter}, Acc ).

dict_item( <<First_letter, _T/binary>>=Name ) ->
	Until_last_letter = erlang:byte_size( Name ) - 1,
	<<_H:Until_last_letter/binary, Last_letter>> = Name,
	{First_letter, {Name, Last_letter}}.

dict_delete( <<First_letter, _T/binary>>=Name, Dict ) ->
	Name_last_letters = dict:fetch(First_letter, Dict),
	dict:store( First_letter, lists:keydelete(Name, 1, Name_last_letters), Dict ).

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


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


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


global words

procedure main()
    words := table()
    every word := genwords(&input) do {
        /words[word[1]] := []
        put(words[word[1]], word)
        }
    bP := []
    every p := getPath(!!words,[]) do if *\p > *bP then bP := copy(p)
    write("Longest: ",*bP)
    every writes((!bP||" ")|"\n")
end

procedure getPath(word, p)
    if word == !p then return p
    if /words[word[-1]] then suspend p <- p ||| [word]
    else suspend getPath(!words[word[-1]], p <- p ||| [word])
end

procedure genwords(f)
    while l := !f do
        l ? while tab(upto(&letters)) do suspend tab(many(&letters))\1
end


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
)


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


/**
 * Find the letter the word ends on
 * @param {string} word
 * @returns {string}
 */
const endsWith = word => word[word.length - 1];

/**
 * Remove the used elements from the candidate elements
 * @param {Array<string>} words Candidate words
 * @param {Array<string>} used Used words
 * @returns {*}
 */
const getCandidates = (words, used) => words.filter(e => !used.includes(e));

/**
 * Build a map of letters to words that start with that letter
 * @param {Array<string>} words
 * @returns {Map<string, Array<string>>}
 */
const buildLookup = words => {
  const lookup = new Map();
  words.forEach(e => {
    const start = e[0];
    lookup.set(start, [...(lookup.get(start) || []), e]);
  });
  return lookup;
};

/**
 * Main function
 * @param {Array<string>} names
 */
const findPaths = names => {
  const t0 = process.hrtime();
  console.log('Checking:', names.length, 'names');
  const lookup = buildLookup(names);

  let maxNum = 0;
  let maxPaths = [];

  const parseResult = arr => {
    if (typeof arr[0] === 'object') {
      arr.forEach(el => parseResult(el))
    } else {
      if (arr.length > maxNum) {
        maxNum = arr.length;
        maxPaths = [arr];
      }
      if (arr.length === maxNum) {
        maxPaths.push(arr)
      }
    }
  };

  const searchWords = (word, res) => {
    const cs = getCandidates(lookup.get(endsWith(word)) || [], res);
    return cs.length ? cs.map(e => searchWords(e, [...res, e])) : res;
  };

  names.forEach(word => {
    const res = searchWords(word, [word]);
    parseResult(res);
  });

  const t1 = process.hrtime(t0);
  console.info('Execution time (hr): %ds %dms', t1[0], t1[1] / 1000000);
  console.log('Max Path:', maxNum);
  console.log('Matching Paths:', maxPaths.length);
  console.log('Example Path:', maxPaths[0]);

};

const pokimon = ["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"];

findPaths(pokimon);


# convert a list of unique words to a dictionary
def dictionary:
  reduce .[] as $word ({}; .[$word[0:1]] += [$word]) ;

# remove "word" from the input dictionary assuming the key is already there:
def remove(word):
 .[word[0:1]] -= [word];


using IterTools.groupby

orderwords(words::Vector) = Dict(w[1][1] => Set(w) for w in groupby(first, words))
longest(a, b) = ifelse(length(a) > length(b), a, b)
function linkfirst(byfirst::Dict, sofar::Vector)
    @assert(!isempty(sofar))
    chmatch = sofar[end][end]
    if ! haskey(byfirst, chmatch) return sofar end
    options = setdiff(byfirst[chmatch], sofar)
    if isempty(options)
        return sofar
    else
        alternatives = ( linkfirst(byfirst, vcat(sofar, word)) for word in options )
        mx = reduce(longest, alternatives)
        return mx
    end
end
function llfl(words)
    byfirst = orderwords(words)
    alternatives = ( linkfirst(byfirst, [word]) for word in words )
    return reduce(longest, alternatives)
end

pokemon = String.(unique(split("""
    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
    """)))

l = llfl(pokemon)
println("Example of longest seq.:\n", join(l, ", "))
println("Max length: ", length(l)


// version 1.1.2

var maxPathLength = 0
var maxPathLengthCount = 0
val maxPathExample = StringBuilder(500)

val names = arrayOf(
    "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"
)

fun search(part: Array<String>, offset: Int) {
    if (offset > maxPathLength) {
        maxPathLength = offset
        maxPathLengthCount = 1
    }
    else if (offset == maxPathLength) {
        maxPathLengthCount++
        maxPathExample.setLength(0)
        for (i in 0 until offset) {
            maxPathExample.append(if (i % 5 == 0) "\n  " else " ")
            maxPathExample.append(part[i])
        }
    }
    val lastChar = part[offset - 1].last()
    for (i in offset until part.size) {
        if (part[i][0] == lastChar) {
            val tmp = names[offset]
            names[offset] = names[i]
            names[i] = tmp
            search(names, offset + 1)
            names[i] = names[offset]
            names[offset] = tmp
        }
    }
}

fun main(args: Array<String>) {
    for (i in 0 until names.size) {
        val tmp = names[0]
        names[0] = names[i]
        names[i] = tmp
        search(names, 1)
        names[i] = names[0]
        names[0] = tmp
    }
    println("Maximum path length         : $maxPathLength")
    println("Paths of that length        : $maxPathLengthCount")
    println("Example path of that length : $maxPathExample")
}


-- BUILDING:
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]]
words, inits, succs = {}, {}, {}
for word in pokemon:gmatch("%S+") do
  table.insert(words, word)
  local ch = word:sub(1,1)
  inits[ch] = inits[ch] or {}
  table.insert(inits[ch], word)
end
for _,word in pairs(words) do
  succs[word] = {}
  local ch = word:sub(-1,-1)
  if inits[ch] then
    for _,succ in pairs(inits[ch]) do
      if succ~=word then
        table.insert(succs[word],succ)
      end
    end
  end
end

-- SEARCHING:
function expand(list, used, answer)
  local word = list[#list]
  for _,succ in ipairs(succs[word]) do
    if not used[succ] then
      used[succ] = true
      list[#list+1] = succ
      if #list == answer.len then
        local perm = table.concat(list," ")
        answer.perms[perm] = perm
        answer.num = answer.num + 1
      elseif #list > answer.len then
        answer.len = #list
        local perm = table.concat(list," ")
        answer.perms = {[perm] = perm}
        answer.num = 1
      end
      expand(list, used, answer)
      list[#list] = nil
      used[succ] = nil
    end
  end
end
answers = {}
for _,word in ipairs(words) do
  local answer = { word=word, len=0, num=0, perms={} }
  answers[#answers+1] = answer
  expand({word}, {[word]=true}, answer)
end

-- REPORTING:
table.sort(answers, function(a,b) return a.len<b.len or (a.len==b.len and a.word<b.word) end)
print("first word   length   count   example")
print("----------   ------   -----   -------...")
for _,answer in pairs(answers) do
  local perm = next(answer.perms) or ""
  print(string.format("%10s   %6d   %5d   %s", answer.word, answer.len, answer.num, perm))
end


longestChain[list_] :=
  NestWhileList[
    Append @@@
      Select[DeleteDuplicatesBy[
        Tuples[{#, list}], {#[[1, 1]], #[[2]]} &], ! MemberQ @@ # &&
         StringTake[#[[1, -1]], -1] == StringTake[#[[2]], 1] &] &,
    List /@ list, # != {} &][[-2, 1]];
Print[longestChain[{"audino", "bagon", "baltoy", "banette", "bidoof",
    "braviary", "bronzor", "carracosta", "charmeleon", "cresselia",
    "croagunk", "darmanitan", "deino", "emboar", "emolga",
    "exeggcute", "gabite", "girafarig", "gulpin", "haxorus",
    "heatmor", "heatran", "ivysaur", "jellicent", "jumpluff",
    "kangaskhan", "kricketune", "landorus", "ledyba", "loudred",
    "lumineon", "lunatone", "machamp", "magnezone", "mamoswine",
    "nosepass", "petilil", "pidgeotto", "pikachu", "pinsir",
    "poliwrath", "poochyena", "porygon2", "porygonz", "registeel",
    "relicanth", "remoraid", "rufflet", "sableye", "scolipede",
    "scrafty", "seaking", "sealeo", "silcoon", "simisear", "snivy",
    "snorlax", "spoink", "starly", "tirtouga", "trapinch", "treecko",
    "tyrogue", "vigoroth", "vulpix", "wailord", "wartortle",
    "whismur", "wingull", "yamask"}]];


import tables

const 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"]

type
  Index = range[0..Names.len-1]
  IndexSet = set[Index]
  Successors = Table[Index, IndexSet]

const All = {Index.low..Index.high}   # All indexes.

func initSuccessors(): Successors {.compileTime.} =
  ## Build the mapping from name indexes to set of possible successor indexes.

  var names: Table[char, IndexSet]  # Map first char to IndexSet.
  for idx, name in Names:
    names.mgetOrPut(name[0], {}).incl(idx)
  for idx, name in Names:
    result[idx] = names.getOrDefault(name[^1]) - {idx}

# Mapping name index -> set of successor indexes.
const Succ = initSuccessors()

proc search(starts, available: IndexSet): seq[Index] =
  ## Search one of the longest sequence of indexes for given
  ## starting indexes and given available name indexes.
  var maxLen = -1
  for idx in starts * available:
    let list = search(Succ[idx], available - {idx})
    if list.len > maxLen:
      result = idx & list
      maxLen = list.len

let list = search(starts = All, available = All)
echo "Longest lists have length: ", list.len
echo "One of these lists is:"
for idx in list: echo Names[idx]


-- 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 - 1))
             longestchain~append(pokemon[i])
             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


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.


use strict;
my(%f,@m);

/^(.).*(.)$/,$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 {
    our @w;
    my $h = $f{$_[0]};
    for my $word (keys %$h) {
	my $v = $h->{$word};
	delete $h->{$word};
	push @w, $word;
	@m = @w if @w > @m;
	poke($v);
	pop @w;
	$h->{$word} = $v;
    }
}

poke($_) for keys %f;
print @m.": @m\n";


with javascript_semantics
constant 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"}

function word_chains()
    sequence first = repeat(0,256),             -- start of chains for a given letter
                                                -- first['a']=1, first['b']=2, first['c']=8, etc.
             snext = repeat(0,length(words))    -- chains of words starting with the same letter
                                                -- a: snext[1]=0, b: snext[2..7]={3,4,5,6,7,0}, etc.
    for i=1 to length(words) do
        integer ch = words[i][1]
        if first[ch]=0 then
            first[ch] = i
        end if
        for j=i+1 to length(words) do
            if words[j][1]=ch then
                snext[i] = j
                exit
            end if
        end for
    end for
    return {first,snext}
end function

constant {first,snext} = word_chains()

-- maintain words already taken as a linked list:
integer tstart
sequence taken = repeat(0,length(words))    -- 0=no, -1=end of chain, +ve=next

-- and keep a copy of the best for later
integer bstart
sequence best
integer maxn = 0, count

procedure find_path(integer ch, last, n)
    integer next = first[ch]
    while next!=0 do
        if taken[next]=0 then
            taken[last] = next
            taken[next] = -1
            find_path(words[next][$],next,n+1)
            taken[last] = -1
            taken[next] = 0
        end if
        next = snext[next]
    end while
    if n>maxn then
        bstart = tstart
        best = deep_copy(taken)
        maxn = n
        count = 1
    elsif n=maxn then
        count += 1
    end if
end procedure

atom t0=time()

for i=1 to length(words) do
    tstart = i
    taken[i] = -1
    find_path(words[i][$],i,1)
    taken[i] = 0
end for

printf(1,"Runtime: %2.3f seconds. Max length:%d, found %d of such, one of which is:\n",{time()-t0,maxn,count})
sequence res = {}
while bstart!=-1 do
    res = append(res,words[bstart])
    bstart = best[bstart]
end while
assert(length(res)=maxn)
printf(1,"%s\n",join_by(res,1,10," "))


go =>
  words(Words),

  % Words that starts with same letter as <this words>'s last letter.
  Starts = new_map(),
  foreach(Word in Words)
     S = [ Word2 : Word2 in Words, Word != Word2, Word.last() = Word2.first()],
     Starts.put(Word,S)
  end,

  % Sort the words according to lengths in decreasing order.
  Words2 = [W : W=_ in Starts.map_to_list().qsort(sort_len)],

  % Start the search
  MaxLen = _,
  Continue := true,
  foreach(Len in 2..Words.len, break(Continue == false))
     if play1(Words2,Starts,Len,_List) then
        MaxLen := Len
     else
        Continue := false
     end
  end,
  println(maxLen=MaxLen),

  % And present the result.
  println("\nGet some (5) solutions:"),
  get_some_solutions(Words2, Starts, MaxLen,5),

  println("\nNnumber of optimal solutions:"),
  NumSols = count_all(play1(Words2,Starts,MaxLen,_List)),
  println(num_sols=NumSols),
  nl.

% Check if it's possible to create a list of length Len.
play1(Words, Starts, Len, LLFL) :-
  LLFL1 = new_list(Len),
  select(LLFL1[1], Words, Rest),
  C = 2,
  while (C <= Len)
    Among = Starts.get(LLFL1[C-1]),
    Among != [],
    select(Word,Among,Rest2),
    not membchk(Word,LLFL1[1..C-1]),
    LLFL1[C] := Word,
    Rest := Rest2,
    C := C + 1
  end,
  LLFL = LLFL1.

% Print NumSols solutions
get_some_solutions(Words,Starts,FoundLen,NumSols) =>
  Map = get_global_map(),
  Map.put(count,1),
  play1(Words, Starts, FoundLen, LLFL),
  println(LLFL),
  C = Map.get(count),
  if C < NumSols then Map.put(count,C+1), fail end.

% qsort(List, SortFunction)
% returns a sorted list according to the sort function SortFunction.
qsort([],_F)    = [].
qsort([H|T],F) = qsort([E : E in T, call(F,E,H)], F)
                 ++ [H] ++
                 qsort([E : E in T, not call(F,E,H)],F).

% Sort according to length
sort_len((_K1=V1),(_K2=V2)) :-
  V1.len >= V2.len.

words(Words) =>
  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"
].


(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) ) ) )


:- 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 | _]).


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 racket

(define 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")

(struct word (first last string) #:prefab)
(define words
  (for/list ([str (string-split names)])
    (word (string->symbol (substring str 0 1))
          (string->symbol (substring str (sub1 (string-length str))))
          str)))

(define (find-longest last words)
  (for/fold ([best '()])
            ([w (in-list words)]
             #:when (or (not last) (eq? last (word-first w))))
    (define long (cons w (find-longest (word-last w) (remq w words))))
    (if (> (length long) (length best)) long best)))

(define longest (find-longest #f words))
(printf "Longest chain found has ~a words:\n  ~a\n"
        (length longest) (string-join (map word-string longest) " -> "))


my @names = <
    audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon
    cresselia croagunk darmanitan deino emboar emolga exeggcute gabite
    girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan
    kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine
    nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2
    porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking
    sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko
    tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask
>;

my @last = @names.map: {.substr(*-1,1).ord }
my @succs = [] xx 128;
for @names.kv -> $i, $name {
    my $ix = $name.ord; # $name.substr(0,1).ord
    push @succs[$ix], $i;
}

my $OUT = open "llfl.new", :w orelse .die;
$OUT.print: chr($_ + 32),"\n" for 0 ..^ @names;
close $OUT;
my $new = +@names;
my $len = 1;

while $new {
    say "Length { $len++ }: $new candidates";
    shell 'mv llfl.new llfl.known';
    my $IN = open "llfl.known" orelse .die;
    my $OUT = open "llfl.new", :w orelse .die;
    $new = 0;

    loop {
	my $cand = $IN.get // last;
	for @succs[@last[$cand.ord - 32]][] -> $i {
	    my $ic = chr($i + 32);
	    next if $cand ~~ /$ic/;
	    $OUT.print: $ic,$cand,"\n";
	    $new++;
	}
    }
    $IN.close;
    $OUT.close;
}

my $IN = open "llfl.known" orelse .die;
my $eg = $IN.lines.pick;
say "Length of longest: ", $eg.chars;
say join ' ', $eg.ords.reverse.map: { @names[$_ - 32] }


/*REXX program finds the  longest path of word's   last─letter ───► first─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'
#= words(@);        ig= 0;   !.= 0;    @.=       /*nullify array and the longest path.  */
parse arg limit .;  if limit\==''  then #=limit  /*allow user to specify a scan limit.  */
call [email protected]                                      /*build a stemmed array from the @ list*/
                do v=#  by -1  for #             /*scrub the @ list for unusable words. */
                parse var @.v  F  2  ''  -1  L   /*obtain first and last letter of word.*/
                if !.1.F>1  |  !.9.L>1  then iterate              /*is this a dead word?*/
                say 'ignoring dead word:'   @.v;      ig= ig + 1;      @= delword(@, v, 1)
                end   /*v*/                      /*delete dead word from  @ ──┘         */
$$$=                                             /*nullify the possible longest path.   */
if ig\==0  then do;   call [email protected];   say;   say 'ignoring'   ig   "dead word"s(ig).;   say
                end
MP= 0;  MPL= 0                                   /*the initial   Maximum Path Length.   */
                do j=1  for #                    /*              ─       ─    ─         */
                parse  value  @.1 @.j   with   @.j @.1;          call scan $$$, 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: '     word($$$, 1)
                do m=2  to g;      say left('', 36)     word($$$, m)
                end   /**/
exit 0                                            /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s:    if arg(1)==1  then return arg(3);    return word( arg(2) 's', 1)   /*a pluralizer.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
[email protected]:     do i=1  for #;     @.i=word(@, i)    /*build a stemmed array from the list. */
            F= left(@.i, 1);   !.1.F= !.1.F + 1  /*F:  1st char; !.1.F=count of 1st char*/
            L=right(@.i, 1);   !.9.L= !.9.L + 1  /*L: last   "   !.9.L=  "    " last  " */
            end   /*i*/;       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
scan: procedure expose @. # !. $$$ MP MPL;    parse arg $$$,!;                  p=! - 1
      parse var  @.p  ''  -1  LC                 /*obtain last character of previous @. */
      if !.1.LC==0  then return                  /*is this a  dead─end  word?           */
                                                 /* [↓]  PARSE obtains first char of @.i*/
         do i=!  to #;  parse var  @.i  p  2     /*scan for the longest word path.      */
         if p==LC  then do                       /*is the  first─character ≡ last─char? */
                        if !==MPL  then MP= MP+1 /*bump the  Maximum Paths  Counter.    */
                                   else if !>MPL  then do; [email protected].1           /*rebuild. */
                                                             do n=2  for !-2;  $$$=$$$ @.n
                                                             end   /*n*/
                                                           $$$=$$$   @.i     /*add last.*/
                                                           MP=1;   MPL=!     /*new path.*/
                                                       end
                        parse value  @.! @.i   with   @.i @.!;          call scan $$$, !+1
                        parse value  @.! @.i   with   @.i @.!
                        end
         end    /*i*/;             return        /*exhausted this particular scan.      */


F kosaraju(g)
   V size = g.len
   V vis = [0B] * size
   V l = [0] * size
   V x = size
   V t = [[Int]()] * size

   F visit(Int u) -> N
      I [email protected][u]
         @vis[u] = 1B
         L(v) @g[u]
            @visit(v)
            @t[v] [+]= u
         @x--
         @l[@x] = u

   L(u) 0 .< g.len
      visit(u)
   V c = [0] * size

   F assign(Int u, root) -> N
      I @vis[u]
         @vis[u] = 0B
         @c[u] = root
         L(v) @t[u]
            @assign(v, root)

   L(u) l
      assign(u, u)
   R c

V g = [[1], [2], [0], [1, 2, 4], [3, 5], [2, 6], [5], [4, 6, 7]]
print(kosaraju(g))


# Project : Last letter-first letter

ready = []
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"]
strbegin = "gabite"
strdir = "first"
nr = 1
add(ready,strbegin)
see strbegin + nl
while true
          if strdir = "first"
             strc = right(strbegin, 1)
             flag = 1
             nr = nr + 1
             if nr <= len(names)
                if left(names[nr],1) = strc
                   for n = 1 to len(ready)
                         if names[nr] = ready[n]
                            flag = 0
                         ok
                   next
                   if flag = 1
                      add(ready,names[nr])
                      see names[nr] + nl
                      strbegin = names[nr]
                      nr = 0
                      strdir = "last"
                      loop
                   ok
                ok
              ok
          else
             strc = right(strbegin, 1)
             flag = 1
             nr = nr + 1
             if nr <= len(names)
                if left(names[nr],1) = strc
                   for n = 1 to len(ready)
                         if names[nr] = ready[n]
                            flag = 0
                         ok
                   next
                   if flag = 1
                      add(ready,names[nr])
                      see names[nr] + nl
                      strbegin = names[nr]
                      nr = 0
                      strdir = "first"
                      loop
                   ok
                ok
             ok
          ok
end


class LastL_FirstL
  def initialize(names)
    @names = names.dup
    @first = names.group_by {|name| name[0]}
    @sequences = []
  end

  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

  def search
    @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]}
  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
}

lf = LastL_FirstL.new(names)
lf.search