Word stays a word after taking away a letter

Question

This is a repost of this challenge

---

Challenge

There is an old, popular riddle:

Find an English word with 8 letters that, taken away one letter, creates a new valid word. Repeat that until there are no letters left.

Example solution:

starting
staring
string
sting
sing
sin
in
I

Your task is to write a program, which takes a dictionary and outputs the longest word, that still occurs in the dictionary after repeatedly taking away a letter.

Rules

• All words will be lower case and contain only ASCII-letters
• If multiple valid words have the same length you can output any one of those
• The dictionary will never be empty
• If there isn't any solution in the dictionary, then you have to output nothing/return an empty list/a falsey value
• You're allowed to output a list representing the process of removing each letter (eg.['this', 'his', 'is', 'i'])
• Default Loopholes apply
• This is code-golf, so the shortest answer wins!

Examples

In: ['this', 'hat', 'his', 'hi', 'is', 'i', 'a', 'at']
Out: this

In: ['pings', 'aid', 'ping', 'ad', 'i', 'in', 'a']
Out: aid

In: ['a', 'ab', 'bac']
Out: ab

In: ['a', 'aa', 'aaaa']
Out: aa

In: ['as', 'i', 'his', 'that', 'ping', 'pin', 'in', 'was', 'at', 'this', 'what', 'is', 'it', 'and', 'a', 'in', 'can', 'if', 'an', 'hand', 'land', 'act', 'ask', 'any', 'part', 'man', 'mean', 'many', 'has', 'stand', 'farm', 'eat', 'main', 'wind', 'boat', 'ran', 'heat', 'east', 'warm', 'fact', 'fast', 'rain', 'art', 'heart', 'am', 'arm', 'sit', 'train', 'sat', 'gas', 'least', 'fit', 'flat', 'cat', 'bit', 'coast', 'sand', 'beat', 'hit', 'party', 'wing', 'wash', 'bat', 'meat', 'suit', 'fat', 'meant', 'coat', 'band', 'win', 'seat', 'hat', 'salt']
Possible outputs:
1. stand (stand -> sand -> and -> an -> a)
2. heart (heart -> heat -> eat -> at -> a)
3. train (train -> rain -> ran -> an -> a)
4. least (least -> east -> eat -> at -> a)
5. coast (coast -> coat -> cat -> at -> a)
6. party (party -> part -> art -> at -> a)
7. meant (meant -> meat -> eat -> at -> a)

Answer 1

Jelly, 14 bytes

ḊÐḟ¹-Ƥf¥Ƈ@Ƭ⁸ẎṪ

A monadic Link that accepts a list of lists of characters and returns a list of characters or zero (falsey) if no solution is possible.

Try it online!

How?

ḊÐḟ¹-Ƥf¥Ƈ@Ƭ⁸ẎṪ - Link: list of lists of characters (words), W
 Ðḟ            - filter out those for which:
Ḋ              -   dequeue (i.e. remove words of length > 1)
                 (let's call this list of single-character words S)
           ⁸   - with W as the right argument...
          Ƭ    - collect up input, I (initially S), while distinct applying:
         @     -   with swapped arguments - f(W, I):
        Ƈ      -     filter keep those (w in W) for which:
       ¥       -       last two links as a dyad - f(w, I):
     Ƥ         -         for overlapping outfixes (of w)...
    -          -         ...of size: -1 (i.e. outfixes of length one less)
   ¹           -         ...do: nothing
                         (i.e. get all potential sub-words of w)
      f        -         filter keep -> sub-words which are in I
                         (an empty list is falsey)
                   -> words in W which can be shorted to any of those in I
                 -> reachable word lists ordered by word-length plus an empty list
            Ẏ  - tighten -> list of all words reached
             Ṫ - tail -> (one of) the longest one(s) or 0 if empty

...that's some pretty serious Jelly right there I reckon.

Answer 2

Retina, 45 bytes

N^$`
$.&
+Gml`.|(.*).(.*)(?=(?s).+^\1\2$)
0G`

Try it online! Explanation:

N^$`
$.&

Sort the list of words in descending order of length.

+Gml`.|(.*).(.*)(?=(?s).+^\1\2$)

Repeatedly delete words of two or more letters that cannot be reduced to another word in the list by the deletion of a letter.

0G`

Keep only the first (i.e. longest) (if any) word.

Answer 3

JavaScript (ES6), 91 bytes

f=(a,p=o='',n)=>p[n]||a.map(w=>w!=p&p.match([...w,,].join`?`)==p&&f(a,w,-~n),o[n]?0:o=p)&&o

Try it online!

How?

We start from the empty string and try to build the longest possible word from there. This is more efficient than taking each word and trying to reach the empty string because we'd need to keep track of the original word, or at least its length.

When looking for a word \$w\$ of \$n+1\$ characters which is a valid successor of a previous word \$p\$ of \$n\$ characters, it would be easier to do something like:

[...w].some((_,i)=>p==w.slice(0,i)+w.slice(i+1))

But this is quite verbose.

Instead, we look for a word \$w\$ which contains all the letters of \$p\$ in order but is not equal to \$p\$:

w!=p&p.match([...w,,].join`?`)==p

The problem is that \$w\$ may contain more than just one additional letter. For instance, we can go directly from man to meant. So we have to check its length afterwards, but we keep track of the current expected length in \$n\$ anyway to avoid the use of .length and this is still overall shorter.

Commented

f = (                // f is a recursive function taking:
  a,                 //   a[] = input dictionary
  p =                //   p = previous word in the chain, initially empty
  o = '',            //   o = output
  n                  //   n = expected length of the previous word
) =>                 //
p[n] ||              // abort if p is too long
a.map(w =>           // otherwise, for each word w in a[]:
  w != p &           //   force the test to fail if w is equal to p
  p.match(           //   build a pattern consisting of:
    [...w,,].join`?` //     each letter of w followed by a '?'
  )                  //   if this regular expression applied to p
  == p               //   is matching p (which means that p can be obtained
  &&                 //   by taking some letters of w in order):
    f(a, w, -~n),    //     do a recursive call with p = w and n + 1
                     //   before the loop starts:
  o[n] ? 0           //     do nothing if the length of o is greater than n
       : o = p       //     otherwise, update o to p
)                    // end of map()
&& o                 // return the final output

Answer 4

Python 3, 96 95 bytes

Thanks to movatica for a byte saved!

f=lambda d,w='':max([f(d,c)for c in d if{w}&{c[:i]+c[i+1:]for i in range(len(c))}]+[w],key=len)

Try it online!

Answer 5

Vyxal, 14 bytes

~₃≬£⁰'ẏ⋎¥↔;İft

Try it Online!

Answer 6

Zsh, 98 bytes

A=($@)
f()for ((i=0;i++<$#w;))(w[i]=;((!#w||A[(I)$w]))&&f)&&break
for w;(($#w>$#a))&&f&&a=$w
<<<$a

Try it online!

A=($@)      # save the arguments so we don't have to pass them in the recursive calls

f() # { <- implicit
    for ((i=0;i++<$#w;))
        (   # enter a subshell, so changes to $w here
            # and $i in the recursive call won't affect their values here
            w[i]=
            ((!#w||A[(I)$w])) &&  # if $w is empty or is found in $A,
                f                 # recurse. If f exited truthy,
        ) && break                # then the subshell exits truthy, and we break
# } <- implicit

for w                             # for each word
   (($#w > $#a)) && f &&          # if it is the longest word found so far, 
      a=$w                        # set it as our answer

<<<$a                             # output our answer

Answer 7

Python3, 130 bytes:

lambda d:max([i for i in d if f(i,d)],key=len)
f=lambda x,d:len(x)==1 or any(f(T,d)for i in range(len(x))if(T:=x[:i]+x[i+1:])in d)

Try it online!

Answer 8

J, 43 bytes

0{](#~1*@#.(1=#&>)+]e."1(1<\.])&>)^:_@\:#&>

Try it online!

-4 bytes thanks to Neil's clever idea

My original approach was to construct an adjacency matrix and self multiply it to a fixed a point, and then use the final column as a mask on the sorted input.

But it turned that Neil's idea was slightly shorter.

In both approaches, we get to use 1<\.] J's outfix adverb to produce all the possible strings with 1 character deleted.

Answer 9

Charcoal, 26 bytes

⊞υωＦθ≔⁺υΦθ‹№υκ⊙κ№υΦκ⁻μξυ⊟υ

Try it online! Link is to verbose version of code. Explanation:

⊞υω

Start with a list of just the empty string.

Ｆθ

Loop enough times.

≔⁺υΦθ‹№υκ⊙κ№υΦκ⁻μξυ

Append all words that don't yet exist in the list but which do when one of their letters is removed to the list.

⊟υ

Output the last word from the list.

If the input was in ascending order of length then it would be only 20 bytes:

⊞υωＦθＦ⊙ι№υΦι⁻λν⊞υι⊟υ

Try it online! Link is to verbose version of code.

Answer 10

05AB1E, 16 bytes

éæéʒ€gāQ}ʒü.LP}θ

Pretty slow for big input-lists.

Outputs the sequence of the longest word instead of just the longest word (e.g. ["a","ad","aid"] instead of aid).

Try it online or verify the first two test cases.

Explanation:

é         # Sort the (implicit) input-list on length (smallest to largest)
 æ        # Pop and push the powerset of this list
  é       # Sort that by length as well
   ʒ      # Filter this list of lists by:
    €g    #  Get the length of each word in the list
      ā   #  Push a list in the range [1,list-length] (without popping the list itself)
       Q  #  Check if both lists are the same
   }ʒ     # After the first filter: filter again:
     ü    #  For each overlapping pair of words:
      .L  #   Calculate the Levenshtein distance
        P #  Product: check if all Levenshtein distances are 1
    }θ    # After the filter: pop and leave the last/longest list
          # (which is output implicitly as result)

Answer 11

Haskell, 118 bytes

d#w=any(\y->y==[]||y`elem`d&&d#y)[take i w++drop(i+1)w|(i,c)<-zip[0..]w]
f d=snd$maximum$[(length x,x)|x<-filter(d#)d]

Attempt This Online!