Grow words from fertile vocabularies

Question

An incremental word chain is a sequence of words of a vocabulary such that each word is the result of either prepending or appending a single character to the previous word, ignoring capitalization. An example of such a chain can be found below.

I → is → his → hiss

Your task is to write a program that for a given vocabulary finds the longest incremental word chain. The input is provided from standard input a vocabulary as one word per line. The words are composed of the lowercase letters a to z only. The output of your program shall go to standard output and shall be one word per line a longest word chain of the input vocabulary, starting with the shortest word.

This is code golf, the solution with the least character count wins. Different forms of input or output are not possible, but the terms standard input and standard output may be interpreted in a reasonable way for the language you are solving this problem in.

Please demonstrate that your code works by publishing the longest word chain you find on the xz-compressed vocabulary found here. This vocabulary was generated by executing the following series of commands on the file british-english-insane from the SCOWL project in the C locale:

tr 'A-Z' 'a-z' <british-english-insane | sed -n '/^[a-z]*$/p' | sort -u | xz -9e >voc.xz

A solution in polynomial time is possible and highly appreciated.

Answer 1

Ruby 139 127

h={}
$<.map{|l|h[l.strip]=1}
v=->w,c=[]{w<?a?c:h[w]&&(v[w.chop,z=[w]+c]||v[w[1..-1],z])}
puts h.map{|k,_|v[k]||0}.max_by &:size

Runs in ~3.5 seconds and prints:

r
ra
rah
rahm
brahm
brahma
brahman
brahmani
brahmanis
brahmanism
brahmanisms

Answer 2

Ruby, 127

Runs in about 6.5 seconds. Uses a couple of cool tricks. ARGF ($< or stdin, really) is enumerable! If an array is passed as a block argument, it can be "exploded" and assigned to a parameter using {|w,| ... }. Notice the comma.

I found an even shorter solution which uses Array#& (set intersection) to do the lookup of words, but that runs extremely slow, unfortunately.

Thanks to w0lf for shaving off a few characters

D={}
$<.map{|l|D[l.strip!]=l}
puts D.map{|w,|c=[w]
w.chars.all?{w=c[0]
r=D[w.chop]||D[w[1..-1]]
r ?c=[r]+c :p}
c}.max_by &:size

Output

r
ra
rah
rahm
brahm
brahma
brahman
brahmani
brahmanis
brahmanism
brahmanisms

Readable version

D = {}
$<.lines { |l| D[l.strip] = l.strip }

chains = D.map do |word, _|
  chain = [word]

  word.chars.all? do
    word   = c.first
    result = D[w.chop] || D[w[1..-1]]

    result ? chain.unshift(result) : nil
  end
end

puts chains.max_by(&:size)

Answer 3

Python 2, 208 bytes

Here is a not very small solution. It firsts creates an index of the word parts, then recursively searches for the longest chain.

import sys
d={}
b=lambda k:d.setdefault(k,[]).append(e)
for e in sys.stdin:e=e[:-1];b(e[1:]);b(e[:-1])
def f(a):
 g=a
 for c in d.get(a[-1],[]):g=max(g,f(a+[c]),key=len)
 return g
for e in f([''])[1:]:print e

It returns:

a
ab
rab
arab
arabi
arabin
arabine
carabine
carabiner
carabinero
carabineros

in 6.2 seconds.

The code before minifier looks like this:

import sys

lookup = {}
addindex = lambda k: lookup.setdefault(k, []).append(word)

for word in sys.stdin :
    word = word[:-1];
    addindex(word[1:]);
    addindex(word[:-1])
print 'Indexed' # DEBUG

def find(wordlist):
    best = wordlist
    for newword in lookup.get(wordlist[-1], []) :
        best = max(best, find(wordlist+[newword]), key=len)
    return best

for word in find([''])[1:] :
    print word

Answer 4

Haskell, 175 Bytes

import Data.Set
main=interact$unlines.snd.maximum.g.lines
g l=Prelude.map(f(0,[]))l where f z@(d,r)w|notMember w(fromList l)=z|1<2=max(f(d+1,w:r)(tail w))(f(d+1,w:r)(init w))

finds

r
ra
ran
fran
franc
franci
francis
francisc
francisca
franciscan
franciscans

Spent about 30 bytes for the use of a Set data structure for efficient lookups but that are useless (in code golf!) otherwise.

How it works: for every word from the input build recursively a list with valid child words. Take the longest list and print it. A "child word" is the word with either first or last letter missing. It is "valid" if it's in the input. If both child words exist, take the one that builds the longer sublist.

Answer 5

J: 246 bytes

's p'=:(*(>./i)>:])|:(6 s:[:s:}.;}:)S:0 w[i=:6 s:v=:s:w=:~.a:,<;._2 fread'voc'
l=:[:,([:(#S:0)5 s:_6 s:])"0
f=:3 :'(y{~])^:(~:0:)^:a:"0 y'
q=:_6 s:]
d=:[:+/@:*"1 f
ds=:d s[dp=:d p
n=:(ds<:dp)}s,:p[m=:ds>.dp
echo}:"1 q(r{i),.(r=:([:I.]=>./)m){f n

output:

`franciscans `franciscan `francisca `francisc `francis `franci `franc `fran `fra `fr `f

Version with comments.