Hasilkan kode Skema Piramida


32

Skema Piramida adalah bahasa yang dikembangkan oleh @ ConorO'Brien . Dalam Skema Piramida, kode yang Anda tulis terlihat seperti ini:

      ^         ^
     / \       /3\
    /   \      ---
   /  +  \
  ^-------^
 /9\     /3\
/123\    ---
-----

Sekarang, kode itu memiliki dua kualitas yang jelas: Sulit untuk diurai, dan sulit untuk menulis. Conor telah memecahkan yang pertama, namun tugas Anda untuk menyelesaikan masalah kedua itu.


Kode di atas diproses oleh interpreter PyramidScheme menjadi array string bersarang, seperti ini:

[["+", ["9123", "3"]], "3"]

Tugas Anda adalah menulis sebuah program atau fungsi, yang diberi serangkaian string, bersarang, atau mengembalikan kode PyramidScheme yang dibuat ulang. Anda dapat mengasumsikan bahwa array input akan selalu valid.

Piramida adalah segitiga sama kaki. Bagian atas adalah ^, sisi miring secara diagonal menjauh dengan /dan \, dan bagian bawahnya -. Dua sudut bawah kosong atau berisi awal dari piramida lain, yang merupakan argumen. Bagian tengah diisi dengan nama piramida, mengabaikan garis putus-putus.

Inilah cara pengurai mengubah kode menjadi format yang bisa digunakan. Pertama, memindai piramida tingkat atas. Jika tidak membutuhkan argumen, ia merepresentasikannya dengan string tunggal dan melanjutkan. Kalau tidak, itu mewakili sebagai array ["name",[arg1,arg2]]atau ["name",[arg1]]. Argumennya adalah piramida di kiri bawah dan kanan bawah piramida, yang bisa berupa string atau lebih array yang dijelaskan di atas. Anda mungkin memperhatikan bahwa ini agak mirip dengan Lisp, dalam hal ini Anda mungkin juga telah memperhatikan kata-kata buruk yang merupakan nama bahasa. Setelah piramida terwakili sepenuhnya, parser bergerak ke yang berikutnya.

Ini , kode terpendek menang!

Kasus Uji: Ini bukan satu-satunya output yang valid, ini adalah contoh dari output yang valid.

[["+", ["9123", "3"]], "3"]

      ^         ^
     / \       /3\
    /   \      ---
   /  +  \
  ^-------^
 /9\     /3\
/123\    ---
-----

[["out", [["chr", ["72"]], ["chr", ["101"]]]], ["out", [["chr", ["108"]]]], ["out", [["chr", ["108"]]]], ["out", [["chr", ["111"]]]]]

        ^      ^     ^     ^
       / \    / \   / \   / \
      /out\  /out\ /out\ /out\
     ^-----^ -----^----- -----^
    / \   / \    / \         / \
   /chr\ /chr\  /chr\       /chr\
  ^----- -----^ -----^     ^-----
 / \         / \    / \   / \
/72 \       /101\  /108\ /111\
-----       -----  ----- -----

[ ["+", [ ["asdfghjkl"], ["do", [ "1" ]] ]] ]

       ^
      / \
     / + \
    /     \
   ^-------^
  /a\     /d\
 /sdf\   /o  \
/ghjkl\ ^-----
-------/1\
       ---

Perhatikan dalam kasus uji kedua, outpiramida kedua dan ketiga memiliki ["chr", ["108"]]parameter, yang diciutkan menjadi satu tumpukan piramida yang dibagi oleh dua yang tingkat atas. Ini adalah pengoptimalan yang valid yang didukung oleh kode Anda, tetapi sepenuhnya opsional; penilaian tidak didasarkan pada panjang output Anda.

Bagi yang penasaran, kasing pertama ditampilkan 9126 3karena pencetakan implisit piramida tingkat atas, yang kedua dicetak Hello, dan yang terakhir adalah kesalahan sintaksis, termasuk hanya karena memiliki struktur yang rapi.


Anda mungkin menganggap bahwa input hanya berisi ASCII dicetak, tidak termasuk spasi, ^, /, \, dan -. Masukan akan selalu valid, dan mengandung setidaknya satu piramida. Tidak ada batasan pada ukuran array atau string input, namun Anda dapat menulis kode Anda seolah-olah jenis integer default bahasa Anda adalah ketepatan tak terbatas dan bahwa komputer Anda memiliki memori sewenang-wenang. Jika mengambil input sebagai string tunggal, Anda dapat menggunakan sesuatu yang masuk akal (koma, spasi, dll. Asalkan itu dalam ascii yang dapat dicetak dan tidak "atau []) untuk membatasi array. Anda tidak harus menyertakan tanda kurung yang mengelilingi semuanya, dan alih-alih mengambil beberapa array yang dipisahkan oleh pembatas Anda.

Output Anda tidak harus di-golf, Anda dapat memasukkan ruang ekstra atau membuat piramida Anda lebih besar dari yang diperlukan. Piramida Toplevel harusnya ada di baris pertama. Output harus berupa string dengan baris baru atau daftar string.

Siapapun yang melakukan menyertakan versi kode mereka yang optimal golfs piramida mungkin menerima beberapa rep dalam bentuk upvotes / karunia (tapi mungkin hanya upvotes).


8
Sierpinski akan menyukai bahasa ini.
mbomb007

4
Sama sekali tidak memposting tantangan ini karena saya terlalu malas untuk memformat segitiga dengan benar ...
Pavel

@KodosJohnson Input dapat berupa array asli.
Pavel

bagaimana Anda bisa memiliki fungsi dengan lebih dari dua argumen?
Lemon Destructible

@DestructibleWatermelon Input tidak akan pernah berisi array sehingga akan membutuhkan melewati dua argumen ke piramida, karena ini tidak mungkin dalam Skema Piramida.
Pavel

Jawaban:


26

Lisp Umum - 2524 1890 byte

(defun f(i)(let((s(loop as r in i collect(g r)))(n())(output""))(loop until n do(setf n T)(loop as r in s do(if(cdr r)(progn(setf output(c output(e r))(cdr r)(cdr(cdr r)))(setf n()))(setf output(c output(b(car r))))))(setf output(c output(format()"~%"))))output))(defun g(r)(if(stringp r)(d(m(length r))r)(if(<(length r)2)(d(m(length(car r)))(car r))(if(=(length(e r))1)(let((h(g(car(e r))))(p(d(m(length(car r)))(car r))))(let((o(+ 1(position #\^(e h))))(parent_length(car p)))(if(<(-(car h)o)parent_length)(l(cons(+ o parent_length)())(loop as n in(butlast(cdr p))collect(c(b o)n))(cons(c(subseq(e h)0 o)(car(last p)))())(loop as n in(cdr(cdr h))collect(c n(b (- parent_length(-(car h)o))))))(let((i(-(- o 1)parent_length)))(l(cons(car h)())(loop as n in(butlast(cdr p))collect(c(b o)n(b i)))(cons(c(subseq(nth 1 h)0 o)(car(last p))(b i))())(cddr h))))))(let((l-h(g(car(e r))))(r-h(g(e(e r)))))(let((ll(position #\^(e l-h)))(rl(position #\^(e r-h))))(let((lr(-(car l-h)ll 1))(rr(-(car r-h)rl 1)))(let((p(d(max(m(length(car r)))(ceiling(+ lr rl)2))(car r))))(let((m-pad(if(>(car p)(+ lr rl))(-(car p)lr rl)0)))(l(cons(+ ll 1(car p)1 rr)())(loop as n in(butlast(cdr p))collect(c(b(+ 1 ll))n(b(+ 1 rr))))(cons(c(subseq(e l-h)0(+ 1 ll))(car(last p))(subseq(e r-h)rl))())(loop as y in(append(cddr l-h)(make-list(length l-h):initial-element(b(car l-h))))as z in(append(cdr(cdr r-h))(make-list(length r-h):initial-element(b(car r-h))))collect(c y(b m-pad)z))))))))))))(defun d(r n)(cons(+(* 2 r)1)(l(cons(c(b r)"^"(b r))())(loop as i from 1 to r collect(c(b(- r i))"/"(subseq(c n(b(expt i 2)))(expt(- i 1)2)(expt i 2))"\\"(b(- r i))))(cons(make-string(+ 1(* 2 r)):initial-element #\-)()))))(defun m(l)(+ 1(floor(sqrt l))))(defun b(n)(make-string n :initial-element #\space))(defun c(&rest a)(apply 'concatenate 'string a))(defun l(&rest a)(apply 'concatenate 'list a))(defun e(tree)(nth 1 tree))

Terima kasih kepada @coredump untuk sejumlah trik golf. Sampel keluaran dari pertanyaan:

> (f '(("out" (("chr" ("72")) ("chr" ("101")))) ("out" (("chr" ("108")))) ("out" (("chr" ("108")))) ("out" (("chr" ("111"))))))
          ^               ^          ^          ^  
         /o\             /o\        /o\        /o\ 
        /ut \           /ut \      /ut \      /ut \
       /     \         ^-----     ^-----     ^-----
      /       \       /c\        /c\        /c\    
     ^---------^     /hr \      /hr \      /hr \   
    /c\       /c\   ^-----     ^-----     ^-----   
   /hr \     /hr \ /1\        /1\        /1\       
  ^-----    ^-----/08 \      /08 \      /11 \      
 /7\       /1\    -----      -----      -----      
/2  \     /01 \                                    
-----     -----                                    










> (f '( ("+" ( ("asdfghjkl") ("do" ( "1" )) )) ))
          ^        
         /+\       
        /   \      
       /     \     
      /       \    
     /         \   
    ^-----------^  
   /a\         /d\ 
  /sdf\       /o  \
 /ghjkl\     ^-----
/       \   /1\    
---------  /   \   
           -----   








> (f '(("+" ("9123" "3")) "3"))
       ^        ^  
      /+\      /3\ 
     /   \    /   \
    /     \   -----
   ^-------^       
  /9\     /3\      
 /123\   /   \     
/     \  -----     
-------            

Berikut ini adalah versi asli, (kebanyakan) ungolfed:

(defun f (input)
    (let ((trees (loop for tree in input collect (g tree)))
          (done nil)
          (output ""))
        (loop while (not done)
            do  (setf done T) 
                (loop for tree in trees
                    do  (if (cdr tree)
                            (progn
                                (setf output (conStr output (car (cdr tree))))
                                (setf (cdr tree) (cdr (cdr tree)))
                                (setf done nil))
                            (setf output (conStr output (blank (car tree))))))
                (setf output (conStr output  (format nil "~%"))))
        output))

;creates a single tree
;output is a list, first element is the length of each line, the rest are the lines of text
(defun g (tree)
    (if (stringp tree)
        ;strings should be drawn as just the pyramid for the name
        (draw-body (min-rows (length tree)) tree)

        (if (< (length tree) 2)
            ;lists with no arguments should be drawn as just the pyramid for the name
            (draw-body (min-rows (length (car tree))) (car tree))
            (if (= (length (car (cdr tree))) 1)
                ;single child
                (let ((child (g (car (car (cdr tree))))) (parent (draw-body (min-rows (length (car tree))) (car tree))))
                    (let ((parent_offset (+ 1 (position #\^ (first-line child)))) (parent_length (car parent)))
                        (if (< (- (car child) parent_offset) parent_length)
                            (let ((child-fill (- parent_length (- (car child) parent_offset))))
                                (concatenate 'list 
                                    (cons (+ parent_offset parent_length) nil)
                                    (loop for line in (butlast (cdr parent))
                                        collect (conStr (blank parent_offset) line))
                                    (cons (conStr (subseq (nth 1 child) 0 parent_offset) (car (last parent))) nil)
                                    (loop for line in (cdr (cdr child))
                                        collect (conStr line (blank child-fill)))))
                            (let ((parent-fill (- (- parent_offset 1) parent_length)))
                                (concatenate 'list 
                                    (cons (car child) nil)
                                    (loop for line in (butlast (cdr parent))
                                        collect (conStr (blank parent_offset) line (blank parent-fill)))
                                    (cons (conStr (subseq (nth 1 child) 0 parent_offset) (car (last parent)) (blank parent-fill)) nil)
                                    (cdr (cdr child)))))))
                ;two children
                (let ((l-child (g (car (car (cdr tree))))) (r-child (g (car (cdr (car (cdr tree)))))))
                    (let ((lc-l-width (position #\^ (first-line l-child))) (rc-l-width (position #\^ (first-line r-child))))
                        (let ((lc-r-width (- (car l-child) lc-l-width 1)) (rc-r-width (- (car r-child) rc-l-width 1)))
                            (let ((parent (draw-body (max (min-rows (length (car tree))) (ceiling (+ lc-r-width rc-l-width) 2)) (car tree))))
                                (let ((m-pad (if (> (car parent) (+ lc-r-width rc-l-width))
                                            (- (car parent) lc-r-width rc-l-width)
                                            0)))
                                    (concatenate 'list
                                        (cons (+ lc-l-width 1 (car parent) 1 rc-r-width) nil)
                                        (loop for line in (butlast (cdr parent))
                                            collect (conStr (blank (+ 1 lc-l-width)) line (blank (+ 1 rc-r-width))))
                                        (cons (conStr (subseq (first-line l-child) 0 (+ 1 lc-l-width)) (car (last parent)) (subseq (first-line r-child) rc-l-width)) nil)
                                        (loop for left in (append (cdr (cdr l-child)) (make-list (length l-child) :initial-element (blank (car l-child))))
                                            for right in (append (cdr (cdr r-child)) (make-list (length r-child) :initial-element (blank (car r-child))))
                                            collect (conStr left (blank m-pad) right))))))))))))


;create a single pyramid
; output is a list, first element is the length of each line, the rest are the lines of text
(defun draw-body (rows name)
    (print rows)
    (print name)
    (cons (+ (* 2 rows) 1)
        (concatenate 'list (cons (conStr (blank rows) "^" (blank rows)) nil)
            (loop for i from 1 to rows
                collect (conStr (blank (- rows i)) "/" (subseq (conStr name (blank (expt i 2))) (expt (- i 1) 2) (expt i 2)) "\\" (blank (- rows i))))
            (cons (make-string (+ 1 (* 2 rows)) :initial-element #\-) nil))))

(defun min-rows (l)
    (+ 1 (floor (sqrt l))))

(defun blank (n)
    (make-string n :initial-element #\space))

(defun conStr (&rest args)
    (apply 'concatenate 'string args))

(defun first-line (tree)
    (car (cdr tree)))

Cobalah secara Online!


Anda harus bisa bermain golf banyak byte dengan menghapus spasi yang tidak perlu.
clismique

2
Selamat datang di PPCG dan jawaban pertama yang bagus!
Kritixi Lithos

Beberapa tips untuk bermain golf CL: in loop, "for" juga bisa ditulis "as"; Anda dapat menghapus spasi sebelum dan sesudah tanda kurung dan tanda kutip ganda; Anda dapat mengganti NIL dengan (); Anda juga dapat menggunakan variabel pembaca, terkadang
coredump

... loop while (not x)is loop until x, (cdr (cdr x))is (cddr x), (setf a b c d)lebih pendek dari (setf a b)diikuti oleh (setf c d), dll. Tetapi ini sudah merupakan jawaban yang bagus
coredump

2
Jumlah total 350 reputasi adalah penting ... tetapi jawaban ini layak untuk itu. A Common Lisp menjawab pertanyaan tentang menyusun pertanyaan untuk dialek Lisp ... Wow.
wizzwizz4
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.