(lié: un , deux , trois )

Un acrostiche est un style de poème / écriture où le caractère de début de chaque ligne, lu verticalement, produit également un mot ou un message. Par exemple,

Together
Everyone
Achieves
More

précise également le mot TEAMlorsque la première colonne est lue verticalement.

Les acrostiches sont un sous-ensemble de s mésostiques , où le mot vertical peut être n'importe où dans les mots horizontaux. Par exemple, TEAMcelui ci-dessus pourrait également être écrit comme un mésostique comme suit

   togeTher
everyonE
       Achieves
       More

ainsi que plusieurs autres variantes.

Le défi ici sera de produire un acrostiche ou mésostique à partir d'une liste donnée de mots d'entrée.

Contribution

• Une liste de mots dans n'importe quel format approprié .
• La liste ne contiendra que des mots en minuscules [a-z].
• La liste est garantie de former un acrostiche ou un mésostique (pas besoin de gérer de fausses entrées).
• L'un des mots dans l'entrée formera le mot vertical, tandis que les autres feront les mots horizontaux - une partie du défi ici est de trouver le mot vertical approprié, donc il ne peut pas être pris séparément.

Sortie

• Acrostiche ou mésostique de l'art ASCII formé à partir des mots saisis, écrits dans STDOUT ou retournés, dans n'importe quel format raisonnable.
• Le mot vertical correspondant doit être en majuscule (comme dans les exemples).
• Des espaces de tête pour aligner correctement le mot vertical sont nécessaires . Les espaces de fin et les nouvelles lignes de début / fin sont facultatifs. Les espaces de tête supplémentaires sont également très bien, tant que les mots s'alignent correctement.
• Si à la fois un acrostiche et un mésostique sont possibles, sortez uniquement l'acrostique.
• Si plusieurs acrostiches / mésostiques sont possibles, votre code peut en générer une partie ou la totalité.

Règles

• Un programme complet ou une fonction sont acceptables.
• Les failles standard sont interdites.
• Il s'agit de code-golf, donc toutes les règles de golf habituelles s'appliquent et le code le plus court (en octets) l'emporte.

Exemples

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

Pyth, 52 49 47 46 octets

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

Essayez-le en ligne.

C'est probablement très jouable au golf. Il imprime un tas d'espaces de premier plan.

Brachylog , 145 octets

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

Essayez-le en ligne!

(Cela prend une demi-minute, alors soyez patient.)

JavaScript (ES6), 255 263 269 286

Modifier 17 octets enregistrés en tant que nombre arbitraire d'espaces de tête est autorisé
Modifier2 certains brassages, 6 octets enregistrés
Modifier3 retourner une liste de chaînes au lieu d'une seule chaîne avec des retours à la ligne (commentaire OP à la réponse de feersum), 8 octets supplémentaires enregistrés

Pour chaque mot de la liste d'entrée, j'utilise un DFS récursif pour trouver tous les mésostiques / acrostiches possibles. Chacun est stocké sous forme de tableau avec la position du mot et de la lettre cible à l'intérieur du mot. Chaque résultat trouvé est enregistré dans le tableau de résultats global à la position 1 (s'il s'agit d'un acrostiche) ou 0 s'il s'agit d'un mésostique.

Après l'analyse complète de tous les mots, j'obtiens le résultat à la dernière position dans le tableau et je crée et renvoie sa représentation 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)))

Moins golfé

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

Tester

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 ​​octets

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 octets

Une fonction sans nom renvoyant une liste de lignes:

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

Exemple d'utilisation:

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

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

 ... plusieurs pages d'avertissements ... 

Out [145] = baLlroom
            Enclume
            À
           tête

Je cherche des suggestions sur de meilleures façons de faire la capitalisation. J'ai trouvé une fonction très agréable MapAtpour mettre en majuscule la lettre dans la chaîne.

Haskell, 214 206 204 202 octets

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

Renvoie une liste de chaînes remplies d'espace, par exemple f ["late","ballroom","anvil","to","head"]-> [" baLlroom"," Anvil"," To"," hEad"]ou plus adaptées à l'affichage:

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

fsélectionne les mots écrits horizontalement avec une liste de décalages. hremplit chaque mot selon le décalage correspondant et insère la lettre majuscule. En détail:

                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 octets

Probablement encore très 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]

Prend et renvoie une liste de liste de caractères.
- par exemple " bAllroom"est[' ',' ',' ','b','A','l','l','r','o','o','m']

Retourne uniquement le premier résultat et vérifie dans un ordre tel que toutes les acrostiches soient vérifiées en premier.

Voir tous les cas de test imprimés au format d'affichage sur ideone

Voici une forme fonctionnelle plus lisible qui fait de même (sauf qu'elle renvoie immédiatement le premier résultat plutôt que d'évaluer puis de renvoyer le premier résultat):

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 octets

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

Solution de force brute.

Comment ça marche

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

Chaque candidat ressemble à:

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

La transposition de la liste des listes de candidats est nécessaire pour s'assurer qu'un acrostiche, s'il existe, se retrouve avant tout mésostique.