(relacionado: um , dois , três )

Um acróstico é um estilo de poema / escrita em que o caractere inicial de cada linha, quando lido na vertical, também produz uma palavra ou mensagem. Por exemplo,

Together
Everyone
Achieves
More

também soletra a palavra TEAMquando a primeira coluna é lida verticalmente.

Acrósticos são um subconjunto de mesósticos s, onde a palavra vertical pode estar em qualquer lugar nas palavras horizontais. Por exemplo, o exemplo TEAMacima também pode ser escrito como um mesóstico da seguinte maneira

   togeTher
everyonE
       Achieves
       More

junto com várias outras variações.

O desafio aqui será produzir um acróstico ou mesóstico a partir de uma determinada lista de palavras de entrada.

Entrada

• Uma lista de palavras em qualquer formato adequado .
• A lista conterá apenas palavras feitas com letras minúsculas [a-z].
• A lista é garantida para formar um acróstico ou um mesóstico (não há necessidade de lidar com dados falsos).
• Uma das palavras na entrada formará a palavra vertical, enquanto as demais formarão as palavras horizontais - parte do desafio aqui é encontrar a palavra vertical apropriada, para que não possa ser usada separadamente.

Saída

• O acróstico ou mesóstico da arte ASCII formado a partir das palavras de entrada, gravadas em STDOUT ou retornadas, em qualquer formato razoável.
• A palavra vertical correspondente deve ser maiúscula (como nos exemplos).
• Espaços iniciais para alinhar a palavra vertical são necessários . Os espaços à direita e as novas linhas à esquerda / à direita são opcionais. Espaços iniciais extras também são bons, desde que as palavras estejam alinhadas corretamente.
• Se tanto um acróstico e mesóstico são possíveis, saída única o acróstico.
• Se mais de um acróstico / mesóstico for possível, seu código poderá gerar um ou todos eles.

Regras

• Um programa completo ou uma função são aceitáveis.
• As brechas padrão são proibidas.
• Isso é código-golfe, portanto todas as regras usuais de golfe se aplicam e o código mais curto (em bytes) vence.

Exemplos

['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

Pitão, 52 49 47 46 bytes

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

Experimente online.

Provavelmente isso é muito jogável. Imprime vários espaços principais.

Braquilog , 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

Experimente online!

(Leva meio minuto, então seja paciente.)

JavaScript (ES6), 255 263 269 286

Editar 17 bytes salvos como número arbitrário de espaços à esquerda é permitido
Edit2 alguns embaralhar, 6 bytes salvos
Edit3 retornar uma lista de cadeia em vez de uma única corda com novas linhas (comentário OP a resposta de feersum), 8 mais bytes salvos

Para cada palavra na lista de entrada, eu uso um DFS recursivo para encontrar todos os possíveis mesósticos / acrósticos. Cada um é armazenado como uma matriz com a palavra e a posição da letra alvo dentro da palavra. Todos os resultados encontrados são salvos na matriz de resultados global na posição 1 (se for um acróstico) ou 0 se for um mesóstico.

Após a verificação completa de todas as palavras, obtenho o resultado na última posição na matriz e construo e retorno sua representação ascii art.

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)))

Menos golfe

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)
  )
)

Teste

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>

Perl6, 287 277 269 bytes

my @w=$*IN.words;my ($q,$r)=gather for ^@w {my @[email protected]($_);my \[email protected];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}

Mathematica 10.0, 139 bytes

Uma função sem nome retornando uma lista de linhas:

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

Exemplo de uso:

Em [144]: = f = Classificar [{q = Máximo [p = Posição mínima / @ @@@ ({z = {## 2}, #} ​​)], Matriz ["" &, q- # 2 ] ToUpperCase ~ MapAt ~ ## & @@@ ({z, p} )} & @@@ Permutações @ Caracteres @ #] [[1,2]] &;

Em [145]: = f @ {"late", "ballroom", "bigorna", "to", "head"} // Coluna

 ... várias páginas de avisos ... 

Out [145] = quarto de banho
            Bigorna
            Para
           cabeça

Estou procurando sugestões de melhores maneiras de capitalizar. Encontrei uma função muito boa MapAtpara colocar a letra em maiúscula na string.

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

Retorna uma lista de cadeias de espaço preenchidas, por exemplo, f ["late","ballroom","anvil","to","head"]-> [" baLlroom"," Anvil"," To"," hEad"]ou mais compatíveis com a exibição:

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

fseleciona as palavras que são escritas horizontalmente junto com uma lista de compensações. hpreenche cada palavra de acordo com o deslocamento correspondente e insere a letra maiúscula. Em detalhe:

                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 

Python, 249 bytes

Provavelmente ainda é muito jogável

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]

Pega e retorna uma lista de lista de caracteres.
- por exemplo, " bAllroom"é[' ',' ',' ','b','A','l','l','r','o','o','m']

Sempre retorna o primeiro resultado e verifica em uma ordem em que todos os acrósticos são verificados primeiro.

Veja todos os casos de teste impressos no formato de exibição em ideone

Aqui está uma forma funcional mais legível que faz o mesmo (exceto que retorna o primeiro resultado imediatamente, em vez de avaliar e depois retornar o primeiro resultado):

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:]
                       ]

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}}

Solução de força bruta.

Como funciona

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

Cada candidato se parece com:

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

A transposição da lista de listas de candidatos é necessária para garantir que um acróstico, se existir, seja encontrado antes de qualquer mesóstico.