28
\$\begingroup\$

(related: one, two, three)

An acrostic is a style of poem/writing where the beginning character of each line, when read vertically, also produces a word or message. For example,

Together
Everyone
Achieves
More

also spells out the word TEAM when the first column is read vertically.

Acrostics are a subset of mesostics, where the vertical word can be anywhere in the horizontal words. For example, the TEAM one above could also be written as a mesostic as follows

   togeTher
everyonE
       Achieves
       More

along with several other variations.

The challenge here will be to produce an acrostic or mesostic from a given list of input words.

Input

  • A list of words in any any suitable format.
  • The list will only contain words made from lowercase [a-z].
  • The list is guaranteed to form an acrostic or a mesostic (no need to handle bogus input).
  • One of the words in the input will form the vertical word, while the rest make the horizontal words - part of the challenge here is to find the appropriate vertical word, so it cannot be taken separately.

Output

  • The ASCII-art acrostic or mesostic formed from the input words, written to STDOUT or returned, in any reasonable format.
  • The corresponding vertical word must be capitalized (as in the examples).
  • Leading spaces to get the vertical word to line up appropriately are required. Trailing spaces, and leading/trailing newlines are optional. Extra leading spaces are fine as well, so long as the words align correctly.
  • If both an acrostic and mesostic are possible, output only the acrostic.
  • If more than one acrostic/mesostic is possible, your code can output any or all of them.

Rules

  • Either a full program or a function are acceptable.
  • Standard loopholes are forbidden.
  • This is so all usual golfing rules apply, and the shortest code (in bytes) wins.

Examples

['together', 'team', 'everyone', 'achieves', 'more']
Together
Everyone
Achieves
More

['aaa', 'aaa', 'aaa', 'aaa']
Aaa
Aaa
Aaa
# One output, or multiple (of the same) output is allowed

['aaa', 'aaa', 'aab', 'baa']
Aaa
Aaa
Baa
# This is the only allowed output, since others would be mesostic, which are lower priority

['live', 'every', 'love', 'very', 'ohio']
Live
Ohio
Very
Every
# Note that 'live' couldn't be the vertical word since then it would be a mesostic, which is lower priority output

['cow', 'of', 'fox']
cOw
 Fox
# A shorter mesostic test case

['late', 'ballroom', 'anvil', 'to', 'head']
anviL
   bAllroom
    To
   hEad
\$\endgroup\$
  • \$\begingroup\$ It seems that in the cases where an acrostic is produced, the list will be in that order? \$\endgroup\$ – Leaky Nun Aug 24 '16 at 19:51
  • \$\begingroup\$ Can you have a shorter mesostic testcase? \$\endgroup\$ – Leaky Nun Aug 24 '16 at 20:33
  • 1
    \$\begingroup\$ Are extra leading spaces allowed? \$\endgroup\$ – PurkkaKoodari Aug 25 '16 at 6:12
  • \$\begingroup\$ It doesn't say that the input is guaranteed to be sorted correctly, but judging from the test cases, they are. Are they? \$\endgroup\$ – aross Aug 25 '16 at 8:10
  • 2
    \$\begingroup\$ @Pietu1998 Sure, that's fine -- the important thing is that the words are lined up. I'll edit in that clarification. \$\endgroup\$ – AdmBorkBork Aug 25 '16 at 12:19
2
\$\begingroup\$

Pyth, 52 49 47 46 bytes

jm++*;-lsQhAd<HGr>HG4hhMDfhhShMTm.b,xNYNtdhd.p

Try it online.

This is probably very golfable. It prints a bunch of leading spaces.

\$\endgroup\$
6
\$\begingroup\$

Brachylog, 145 bytes

p~c[A:B:C],Bl1,A:CcP@pz:cahgB,P:1a~@nw|lL,?:laot:" "rjg:Ljb:sa:?z:cap~c[A:B:C],Bl1,A:Cc@pz:caZ:LmgB,Zl-yM,Z:M:Lz:2az:ca~@nw
bB,?h@u:Bc
b#=,?h@u|h

Try it online!

(Takes half a minute, so be patient.)

\$\endgroup\$
  • 1
    \$\begingroup\$ Looks like this took some effort to write :) Very nice! \$\endgroup\$ – Emigna Aug 24 '16 at 20:54
  • \$\begingroup\$ @TimmyD Fixed, thanks. \$\endgroup\$ – Leaky Nun Aug 24 '16 at 21:08
4
\$\begingroup\$

JavaScript (ES6), 255 263 269 286

Edit 17 bytes saved as arbitrary number of leading spaces is allowed
Edit2 some shuffling, 6 byte saved
Edit3 return a list of string instead of a single string with newlines (OP comment to feersum's answer), 8 more bytes saved

For each word in the input list, I use a recursive DFS to find all possibile mesostics/acrostics. Each one is stored as an array with word and target letter position inside the word. Every result found is saved in global result array at position 1 (if it's an acrostic) or 0 if it's a mesostic.

After the complete scan for all words, I get the result at last position in array and build and return its ascii art rapresentation.

l=>(l.map((w,i)=>(r=(p,v,i,a)=>(l[i]='.',w[p]?l.map((v,i)=>~(j=v.search(w[p]))&&r(p+1,v,i,a|j,m[p]=[j,v])):l[p+1]?0:s[+!a]=[...m],l[i]=v))(0,w,i,m=[]),s=[]),m=s.pop(),m.map(([j,v])=>' '.repeat((l+0).length-j)+v.slice(0,j)+v[j].toUpperCase()+v.slice(j+1)))

Less golfed

f=l=>(
  l.map((w,i)=>
    // r: recursive DFS function
    // defined here as it uses local w variable
    (r = (p,v,i,a) => (
     l[i] = '.'
     , w[p] 
     ? l.map(
       (v,i) => ~(j=v.search(w[p])) && 
                r(p+1, v, i, a|j, m[p] = [j,v])

     )
     : l[p+1] ? 0 // invalid if there are still unused words
              : s[+!a]=[...m] // a is 0 if acrostic
     , l[i] = v) 
    )(0, w, i, m=[])
  , s=[]),
  m = s.pop(), // get last result
  // m.map(([j]) => o = o<j ? j : o, o=0), // find offset for alignment
  // no need to find the optimal offset as leading blanks are allowed
  m.map(([j,v]) => ' '.repeat((l+0).length-j) 
                   + v.slice(0,j) 
                   + v[j].toUpperCase()
                   + v.slice(j+1)
  )
)

Test

f=l=>(l.map((w,i)=>(r=(p,v,i,a)=>(l[i]='.',w[p]?l.map((v,i)=>~(j=v.search(w[p]))&&r(p+1,v,i,a|j,m[p]=[j,v])):l[p+1]?0:s[+!a]=[...m],l[i]=v))(0,w,i,m=[]),s=[]),m=s.pop(),m.map(([j,v])=>' '.repeat((l+0).length-j)+v.slice(0,j)+v[j].toUpperCase()+v.slice(j+1)))

console.log=x=>O.textContent+=x+'\n\n'

;[
 ['together', 'team', 'everyone', 'achieves', 'more']
,['aaa', 'aaa', 'aaa', 'aaa']
,['aaa', 'aaa', 'aab', 'baa']
,['live', 'every', 'love', 'very', 'ohio']
,['cow', 'of', 'fox']
,['late', 'ballroom', 'anvil', 'to', 'head']
].forEach(l=>console.log(f(l).join`\n`))
<pre id=O></pre>

\$\endgroup\$
3
\$\begingroup\$

Perl6, 287 277 269 bytes

my @w=$*IN.words;my ($q,$r)=gather for ^@w {my @v=@w.rotate($_);my \d=@v.shift;for @v.permutations {my @o=flat($_ Z d.comb).map:{$^a.index: $^b};take $_,@o if @o>>.defined.all}}.sort(*[1].sum)[0];for @$q Z @$r ->(\a,\b){say " "x($r.max -b)~a.substr(0,b)~a.substr(b).tc}
\$\endgroup\$
3
\$\begingroup\$

Mathematica 10.0, 139 bytes

An unnamed function returning a list of lines:

Sort[{q=Max[p=Min/@Position@@@({z={##2},#})],Array[" "&,q-#2]<>ToUpperCase~MapAt~##&@@@({z,p})}&@@@Permutations@Characters@#][[1,2]]&

Example usage:

In[144]:= f = Sort[{q=Max[p=Min/@Position@@@({z={##2},#})],Array[" "&,q-#2]ToUpperCase~MapAt~##&@@@({z,p})}&@@@Permutations@Characters@#][[1,2]]&;

In[145]:= f @ {"late","ballroom","anvil","to","head"} // Column

 ... several pages of warnings ... 

Out[145]= baLlroom
            Anvil
            To
           hEad

I'm looking for suggestions on better ways to do the capitalization. I found a very nice function MapAt for capitalizing the letter in the string.

\$\endgroup\$
  • \$\begingroup\$ Sure, functions can return multiline strings as a list of strings. \$\endgroup\$ – AdmBorkBork Aug 25 '16 at 19:18
2
\$\begingroup\$

Haskell, 214 206 204 202 bytes

import Data.List
z=zipWith
h i j t|(u,v:w)<-splitAt j t=([1..sum i-j]>>" ")++u++toEnum(fromEnum v-32):w
f x=uncurry(z=<<h)$sort[(head<$>z elemIndices w l,l)|w:l<-permutations x,(True<$w)==z elem w l]!!0

Returns a list of space padded strings, e.g. f ["late","ballroom","anvil","to","head"] -> [" baLlroom"," Anvil"," To"," hEad"] or more display friendly:

*Main> mapM_ putStrLn $ f ["late", "ballroom", "anvil", "to", "head"]
 baLlroom
   Anvil
   To
  hEad

f selects the words that are written horizontally together with a list of offsets. h pads each word according to the corresponding offset and inserts the uppercase letter. In detail:

                permutations x       -- for each permutation of the input list x
         w:l<-                       -- bind w to the first word and l to the rest
             (True<$w)==z elem w l   -- keep it if the list of other words
                                     -- containing the next letter of w
                                     -- equals (length w) times True, i.e. we have
                                     -- as many matching letters as letters in w.
                                     -- This rules out combinations shortcut by zipWith

                                     -- for all the remaining w and l make a pair
         head<$>z elemIndices w l    -- the first element of the list of list of
                                     -- indices where the letter appears in the word 
                                l    -- and l itself
   sort                              -- sort the pairs (all 0 indices, i.e. acrostics
                                     -- go first)
                               !!0   -- pick the first
                                     -- now we have a pair like
                                     -- ([2,0,0,1],["ballroom","anvil","to","head"])
 uncurry(z=<<h)                      -- loop over (index,word) and 
                                     -- provide the third parameter for h 



 h i j t                             -- h takes the list of indices and
                                     -- an index j and a word t
       (u,v:w)<-splitAt j t          -- split the word at the index and bind
                                     --   u: part before the split
                                     --   v: letter at the split
                                     --   w: part after the split
         [1..sum i-j]>>" "           -- the spaces to pad
           ++ u                      -- followed by u
           ++ toEnum(fromEnum v-32)  -- and uppercase v
           :                         -- and w 
\$\endgroup\$
2
\$\begingroup\$

Python, 249 bytes

Probably still very golfable

from itertools import*;e=enumerate;lambda l:[[[' ']*(max(j for k,(j,c)in o[1:])-i)+l[k][:i]+[c.upper()]+l[k][i+1:]for k,(i,c)in o[1:]]for p in product(*[list(e(w))for w in l])for o in permutations(list(e(p)))if[c for k,(i,c)in o[1:]]==l[o[0][0]]][0]

Takes and returns a list of list of characters.
- e.g. " bAllroom" is [' ',' ',' ','b','A','l','l','r','o','o','m']

Only ever returns the first result and checks in an order such that all the acrostics are checked first.

See all test cases printed in the display format on ideone


Here is a more readable functional form that does the same (except it returns the first result immediately rather than evaluating and then returning the first result):

from itertools import*
def f(l):
    for p in product(*[list(enumerate(w)) for w in l]):
        for o in permutations(list(enumerate(p))):
            if [c for k,(i,c) in o[1:]] == l[o[0][0]]:
                return [ [' '] * (max(j for k,(j,c) in o[1:]) - i)
                       + l[k][:i]
                       + [c.upper()]
                       + l[k][i+1:]
                       for k, (i, c) in o[1:]
                       ]
\$\endgroup\$
1
\$\begingroup\$

Perl 6, 177 bytes

->\a{for first({.[0] eq[~] .[1]»[1]},map |*,[Z] map {.[0]X [X] map {.comb[(^$_,$_,$_^..* for ^.chars)]},.[1..*]},a.permutations)[1] ->$/ {say [~] " "x a.comb-$0,|$0,$1.uc,|$2}}

Brute-force solution.

How it works

-> \a {
    for first({.[0] eq[~] .[1]»[1]},          # For the first valid candidate
            map |*, [Z]                       # among the transposed
            map {                             # lists of candidates
                .[0] X [X] map {
                    .comb[(^$_,$_,$_^..* for ^.chars)]
                }, .[1..*]
            },
            a.permutations                    # for all permutations of the input:
        )[1] ->$/ {
        say [~] " "x a.comb-$0,|$0,$1.uc,|$2  # Print the candidate as ASCII art.
    }
}

Each candidate looks like:

"of", (("c"),"o",("w")), ((),"f",("o","x"))

Transposing the list of lists of candidates is necessary to ensure that an acrostic, if it exists, is found before any mesostic.

\$\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.