15
\$\begingroup\$

When I was younger, I use to play a word game called Word chain. It was very simple. The first player chooses a word; the next player says another word that starts with the same letter the previous word ended with. This goes on forever until somebody gives up! Trick is, you cannot use the same word twice (unless everybody forgot that word was even used!). Usually we play with a certain topic to make it harder. But now, I want you to make a program to do this for me.

Challenge

Write a full program or function to find all longest possible word chains using a given set of words and start word.

This is , so the shortest code wins!

Input

There are two inputs: a list and a start word. The start word will not be in the list. The inputs are all lowercase ASCII, and the list will not contain duplicate words.

Output

All sequences of words from the list such that:

  • The start word is the first word in the sequence.

  • Each subsequent word starts with the same letter as the last letter of the previous word.

  • The length of the sequence is the longest possible.

If there are multiple longest sequences, output all of them.

The sequence does not necessarily need to contain all of the list words. Sometimes that is not possible (see testcases). Again, no word can be used twice!

Testcases

In: [hello, turtle, eat, cat, people] artistic
Out:  [artistic, cat, turtle, eat]
In: [lemonade, meatball, egg, grape] ham 
Out: [ham, meatball, lemonade, egg, grape]
In: [cat, cute, ewok] attic
Out: [attic, cute, ewok]
In:[cat, cute, ewok, kilo, to, otter] attic
Out: [attic, cute, ewok, kilo, otter]
In:[cat, today, yoda, attic] ferret
Out: [ferret, today, yoda, attic, cat]
In: [cancel, loitering, gnocchi, improv, vivic, child, despair, rat, tragic, chimney, rex, xylophone] attic
Out: [[attic, child, despair, rat, tragic, cancel, loitering, gnocchi, improv, vivic, chimney], [attic, cancel, loitering, gnocchi, improv, vivic, child, despair, ra', tragic, chimney]]
In: [cat, today, yoda, artistic, cute, ewok, kilo, to, otter] attic
Out: [attic, cat, today, yoda, artistic, cute, ewok, kilo, otter]
\$\endgroup\$
  • 4
    \$\begingroup\$ @downvoters can you please explain how I can improve my question? \$\endgroup\$ – TanMath Jan 6 '16 at 23:22
  • \$\begingroup\$ @user81655 sure \$\endgroup\$ – TanMath Jan 7 '16 at 0:20
  • 2
    \$\begingroup\$ Can you add a test case with multiple output sequences? \$\endgroup\$ – isaacg Jan 7 '16 at 0:26
  • \$\begingroup\$ @isaacg Sure! working on it \$\endgroup\$ – TanMath Jan 7 '16 at 2:24
  • \$\begingroup\$ @isaacg Added! (15 character limit fulfilled...) \$\endgroup\$ – TanMath Jan 7 '16 at 4:30
8
\$\begingroup\$

Pyth, 25 23 bytes

.MlZfqhMtTeMPT+Lzs.pMyQ

Test suite

A brute force solution. Far too slow for some of the larger test cases.

Input in the form:

attic
["cat", "today", "yoda", "to", "otter"] 

Output in the form:

[['attic', 'cat', 'today', 'yoda'], ['attic', 'cat', 'to', 'otter']]

Explanation:

.MlZfqhMtTeMPT+Lzs.pMyQ
                           Q = eval(input()) (The list of words)
                           z = input()       (The starting word)
                     yQ    All subsets of the input.
                  .pM      All permutations of the subsets.
                 s         Flatten.
              +Lz          Add the starting word to the front of each list.
                           This is all possible sequences.
    f                      Filter on
     q                     The equality of
      hMtT                 The first character of each word but the first
          eMPT             The last character of each word but the last
.MlZ                       Take only the lists of maximal length.
\$\endgroup\$
  • 2
    \$\begingroup\$ Can you add an explanation? \$\endgroup\$ – TanMath Jan 7 '16 at 2:40
  • \$\begingroup\$ Your code runs forever for the multiple output sequence example \$\endgroup\$ – TanMath Jan 7 '16 at 4:36
  • 3
    \$\begingroup\$ @TanMath no it's just exponential time, so it's very slow. \$\endgroup\$ – isaacg Jan 7 '16 at 6:19
  • 5
    \$\begingroup\$ Code golf: The art of making an otherwise fast program run in exponential time just to save a few bytes :P \$\endgroup\$ – Arcturus Jan 7 '16 at 22:37
  • 1
    \$\begingroup\$ @RikerW I think it's also worth recalling Martin's "Code Review: Making code slightly less wrong / Code Golf: Making code slightly less long" comment from chat here. \$\endgroup\$ – Arcturus Jan 7 '16 at 22:41
4
\$\begingroup\$

JavaScript (ES6), 164 bytes

f=(l,s,r=[[]])=>l.map((w,i)=>w[0]==s.slice(-1)&&(x=l.slice(),x.splice(i,1),o=f(x,w),a=o[0].length,b=r[0].length,r=a>b?o:a<b?r:r.concat(o)))&&r.map(q=>[s].concat(q))

Explanation

A recursive function that checks how long the output list will for all possible choices.

Returns an array of arrays of words.

f=(l,s,r=[[]])=>            // l = list, s = starting word, r is not passed (it is
                            //     here so that it is not defined globally)
  l.map((w,i)=>             // for each word w at index i
    w[0]==s.slice(-1)&&(    // if the first letter is the same as the last letter:
      x=l.slice(),          // x = clone of the list of words
      x.splice(i,1),        // remove the current word
      o=f(x,w),             // get the list of words starting from the current word
      a=o[0].length,
      b=r[0].length,
      r=a>b?o:              // if o is longer, set r to o
        a<b?r:              // if o is shorter, keep r
        r.concat(o)         // if o is same, add it to r
    )
  )
  &&r.map(q=>[s].concat(q)) // return a list of longest lists with the starting word

Test

Default parameter not used in test to make it more cross-browser compatible.

f=(l,s,r)=>l.map((w,i)=>w[0]==s.slice(-1)&&(x=l.slice(),x.splice(i,1),o=f(x,w),a=o[0].length,b=r[0].length,r=a>b?o:a<b?r:r.concat(o)),r=[[]])&&r.map(q=>[s].concat(q))
Word list (space separated) = <input type="text" id="list" value="cancel loitering gnocchi improv vivic child despair rat tragic chimney rex xylophone" /><br />
Starting word = <input type="text" id="word" value="attic" /><br />
<button onclick="result.textContent=f(list.value.split(' '),word.value).join('\n')">Go</button>
<pre id="result"></pre>

\$\endgroup\$
  • \$\begingroup\$ I think you could use pop instead of splice and o[r.length]? instead of o.length>r.length?. \$\endgroup\$ – grc Jan 7 '16 at 0:54
  • \$\begingroup\$ @grc Thanks, I really like the o[r.length] tip! I don't know how I could use pop though. \$\endgroup\$ – user81655 Jan 7 '16 at 1:02
  • \$\begingroup\$ Ah nvm - I thought pop could take an index as its first argument like in python. \$\endgroup\$ – grc Jan 7 '16 at 1:05
  • \$\begingroup\$ This solution is invalid for multiple output sequences \$\endgroup\$ – TanMath Jan 7 '16 at 4:32
  • \$\begingroup\$ @TanMath Fixed, although it breaks one of the test cases. \$\endgroup\$ – user81655 Jan 7 '16 at 4:57
3
\$\begingroup\$

Python, 104

def f(d,w):
 a=[[w]]
 while a:b=a;a=[x+[y]for x in a for y in set(d)-set(x)if x[-1][-1]==y[0]]
 return b

I think it should work now...

Try it online.

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

Perl 5 , 275 bytes

Probably not golfed as much as it can be, but, hey, it's nonwinning anyway, right?

use List::Util max;use List::MoreUtils uniq,before;use Algorithm::Permute permute;$i=pop;permute{push@c,[@ARGV]}@ARGV;for$c(@c){unshift@$c,$i;push @{$d{before{(substr$c->[$_],-1)ne(substr$c->[1+$_],0,1)}keys$c}},$c}for$m(max keys%d){say for uniq map{"@$_[0..$m+1]"}@{$d{$m}}}

Use it thus:

$ perl -M5.010 chain.pl cat tin cot arc
arc cat tin
arc cot tin

Warning! Use of this script on a long list requires lots of memory! It worked great for me on seven (six plus the extra one) but not on thirteen (twelve plus one).

It removes the final input, generates an array of arrayrefs, where the arrayrefs are all the permutations, and adds the initial word back on at the start. Then it pushes each such permutation onto another arrayref which is the value of a hash with key the amount of the array that has the chaining property desired. It then finds the maximum such key and prints out all the arrays.

\$\endgroup\$
0
\$\begingroup\$

C, 373 bytes

g(char*y){printf("%s, ",y);}z(char*w){int i,k=-1,v=0,j=sizeof(c)/sizeof(c[0]);int m[j],b=0;for(i=0;i<j;i++){m[v++]=c[i][0]==w[strlen(w)-1]?2:1;if(u[i]==6)m[v-1]=1;if(strcmp(w,c[i]))k=i;}printf("%s",w);for(i=0;i<j;i++){if(m[i]!=1){if(v+i!=j){g(s);for(;b<j;b++){if(u[b]==6)g(c[b]);}}else printf(", ");u[i]=6;z(c[i]);u[i]=1;}else v+=-1;}if(k!=-1)u[k]=1;if(v==0)printf(" ; ");}

I believe there is probably a lot more golfing I could do here so I will probably update it.

De-golf

char *c[9]={"cat","today","yoda","artistic","cute","ewok","kilo","to","otter"};
u[9]={-1};
char *s="attic";

g(char*y){printf("%s, ",y);}
z(char*w){
   int i,k=-1,v=0,j=sizeof(c)/sizeof(c[0]);
   int m[j],b=0;
   for(i=0;i<j;i++){
      m[v++]=c[i][0]==w[strlen(w)-1]?i:-1;
      if(u[i]==6)m[v-1]=-1;
      if(strcmp(w,c[i]))k=i;
   }
   printf("%s",w);
   for(i=0;i<j;i++){
      if(m[i]!=-1){
         if(v+i!=j){
            g(s);
            for(;b<j;b++){
                if(u[b]==6)g(c[b]);
             }
         }else printf(", ");
         u[i]=6;
         z(c[i]);
         u[i]=-1;
      } else v+=-1;
   }
   if(k!=-1)u[k]=-1;
   if(v==0)printf(" ; ");
}

main(){
   z(s);
   printf("\n");
   return 0;
}

Ideone link - If I didn't do this right just let me know :D

\$\endgroup\$
  • \$\begingroup\$ could you add an ideone link for testing? \$\endgroup\$ – TanMath Jan 7 '16 at 22:25
  • \$\begingroup\$ Yeah I will update my answer with it @TanMath \$\endgroup\$ – Danwakeem Jan 7 '16 at 23:25
  • \$\begingroup\$ The link should contain the golfed code, not the ungolfed version. That way, we can confirm the golfed version which you are submitting for the challenge works. \$\endgroup\$ – TanMath Jan 7 '16 at 23:40

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.