18
\$\begingroup\$

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 , 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)
\$\endgroup\$
6
  • \$\begingroup\$ Sandbox \$\endgroup\$
    – mathcat
    Jul 1 at 18:24
  • \$\begingroup\$ May we output the list of words instead of just the word? E.g., instead of outputting aid it outputs ["aid","ad","a"]? \$\endgroup\$ Jul 3 at 18:11
  • 1
    \$\begingroup\$ @KevinCruijssen seems fair \$\endgroup\$
    – mathcat
    Jul 3 at 18:25
  • \$\begingroup\$ Suggested test cases: ['a', 'ab', 'bac'] and ['a', 'aa', 'aaaa'], since solutions which turn the words to sets work for the given examples \$\endgroup\$ Jul 4 at 5:29
  • \$\begingroup\$ Shouldn't be ['a', 'ab', 'bac'] => ab and ['a', 'aa', 'aaaa'] => aa? \$\endgroup\$
    – matteo_c
    Jul 4 at 21:14

11 Answers 11

6
\$\begingroup\$

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.

\$\endgroup\$
1
  • 1
    \$\begingroup\$ Nice, I should allow false valyes thanks \$\endgroup\$
    – mathcat
    Jul 1 at 21:13
4
\$\begingroup\$

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.

\$\endgroup\$
4
\$\begingroup\$

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
\$\endgroup\$
4
\$\begingroup\$

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!

\$\endgroup\$
2
  • 1
    \$\begingroup\$ Save 1 byte by replacing the in search with a set operation \$\endgroup\$
    – movatica
    Jul 4 at 2:51
  • \$\begingroup\$ I've thought about using ({*w}<={*c})==len({*c}^{*w}), but it fails to account for the order of characters, or repeated characters. Is there a short way to fix for that? \$\endgroup\$ Jul 4 at 5:27
3
\$\begingroup\$

Vyxal, 14 bytes

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

Try it Online!

\$\endgroup\$
2
  • \$\begingroup\$ The bug seems to be fixed, so the 14 byter is valid \$\endgroup\$
    – lyxal
    Aug 7 at 12:22
  • \$\begingroup\$ @lyxal Weird, we never fixed the bug but we must have fixed it somehow \$\endgroup\$
    – Steffan
    Aug 7 at 18:54
2
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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!

\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

Charcoal, 26 bytes

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

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

⊞υω

Start with a list of just the empty string.

Fθ

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:

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

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

\$\endgroup\$
1
\$\begingroup\$

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)
\$\endgroup\$
1
\$\begingroup\$

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!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.