(terkait: satu , dua , tiga )

Sebuah akrostik adalah gaya puisi / menulis di mana karakter awal setiap baris, ketika membaca secara vertikal, juga menghasilkan sebuah kata atau pesan. Sebagai contoh,

Together
Everyone
Achieves
More

juga menjabarkan kata TEAMsaat kolom pertama dibaca secara vertikal.

Akrostik adalah himpunan bagian dari mesostik , di mana kata vertikal dapat berada di mana saja dalam kata-kata horisontal. Sebagai contoh, yang di TEAMatas juga bisa ditulis sebagai mesostik sebagai berikut

   togeTher
everyonE
       Achieves
       More

bersama dengan beberapa variasi lainnya.

Tantangannya di sini adalah menghasilkan akrostik atau mesostik dari daftar kata input yang diberikan.

Memasukkan

• Daftar kata-kata dalam format apa pun yang sesuai .
• Daftar ini hanya akan berisi kata-kata yang dibuat dari huruf kecil [a-z].
• Daftar dijamin untuk membentuk akrostik atau mesostik (tidak perlu menangani input palsu).
• Salah satu kata dalam input akan membentuk kata vertikal, sedangkan sisanya membuat kata horizontal - bagian dari tantangan di sini adalah menemukan kata vertikal yang sesuai, sehingga tidak dapat diambil secara terpisah.

Keluaran

• ASCII-art akrostik atau mesostik terbentuk dari kata-kata input, ditulis ke STDOUT atau dikembalikan, dalam format apa pun yang masuk akal.
• Kata vertikal yang sesuai harus ditulis dengan huruf besar (seperti dalam contoh).
• Memimpin ruang untuk mendapatkan kata vertikal untuk berbaris tepat yang diperlukan . Ruang tertinggal, dan garis depan utama / belakang opsional. Ekstra ruang terkemuka baik-baik saja juga, asalkan kata-kata menyelaraskan dengan benar.
• Jika kedua akrostik dan mesostic yang mungkin, keluaran hanya akrostik.
• Jika lebih dari satu akrostik / mesostik dimungkinkan, kode Anda dapat menampilkan salah satu atau semuanya.

Aturan

• Program lengkap atau fungsi dapat diterima.
• Celah standar dilarang.
• Ini adalah kode-golf sehingga semua aturan golf biasa berlaku, dan kode terpendek (dalam byte) menang.

Contohnya

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

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

Cobalah online.

Ini mungkin sangat golf. Ini mencetak banyak ruang terkemuka.

Brachylog , 145 byte

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

Cobalah online!

(Butuh setengah menit, jadi bersabarlah.)

JavaScript (ES6), 255 263 269 286

Edit 17 byte yang disimpan sebagai jumlah arbitrase dari ruang utama diperbolehkan
Edit2 beberapa pengocokan, 6 byte yang disimpan
Edit3 mengembalikan daftar string, bukan string tunggal dengan baris baru (komentar OP untuk jawaban feersum), 8 byte lebih tersimpan

Untuk setiap kata dalam daftar input, saya menggunakan DFS rekursif untuk menemukan semua kemungkinan mesostik / akrostik. Masing-masing disimpan sebagai array dengan kata dan posisi surat target di dalam kata. Setiap hasil yang ditemukan disimpan dalam array hasil global di posisi 1 (jika itu akrostik) atau 0 jika itu mesostik.

Setelah pemindaian lengkap untuk semua kata, saya mendapatkan hasilnya pada posisi terakhir dalam array dan membangun dan mengembalikan representasi seni ascii-nya.

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

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

Uji

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

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}

Mathematica 10.0, 139 bytes

Fungsi yang tidak disebutkan namanya mengembalikan daftar baris:

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

Contoh penggunaan:

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

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

 ... beberapa halaman peringatan ... 

Keluar [145] = baLlroom
            Landasan
            Untuk
           kepala

Saya mencari saran tentang cara yang lebih baik untuk melakukan kapitalisasi. Saya menemukan fungsi yang sangat bagus MapAtuntuk huruf besar dalam string.

Haskell, 214 206 204 202 byte

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

Mengembalikan daftar string ruang-empuk, mis. f ["late","ballroom","anvil","to","head"]-> [" baLlroom"," Anvil"," To"," hEad"]atau lebih ramah layar:

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

fmemilih kata-kata yang ditulis secara horizontal bersama dengan daftar offset. hmembalut setiap kata sesuai dengan offset yang sesuai dan menyisipkan huruf besar. Secara terperinci:

                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 byte

Mungkin masih sangat golf

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]

Mengambil dan mengembalikan daftar karakter.
- misalnya " bAllroom"adalah[' ',' ',' ','b','A','l','l','r','o','o','m']

Hanya pernah mengembalikan hasil pertama dan memeriksa dalam urutan sedemikian rupa sehingga semua akrostik diperiksa terlebih dahulu.

Lihat semua test case yang dicetak dalam format tampilan pada ideone

Berikut ini adalah bentuk fungsional yang lebih mudah dibaca yang melakukan hal yang sama (kecuali ia mengembalikan hasil pertama segera daripada mengevaluasi dan kemudian mengembalikan hasil pertama):

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 byte

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

Solusi brute-force.

Bagaimana itu bekerja

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

Setiap kandidat terlihat seperti:

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

Transposing daftar daftar kandidat diperlukan untuk memastikan bahwa akrostik, jika ada, ditemukan sebelum mesostik.