Piramit Şeması kodunu üret


32

Pyramid Scheme @ ConorO'Brien tarafından geliştirilen bir dildir . Piramit Düzeninde, yazdığınız kod şöyle görünür:

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

Şimdi, bu kodun iki belirgin özelliği var: Ayrıştırılması zor ve yazması zor. Conor ilki çözdü, ancak bu ikinci sorunu çözmek sizin işiniz olacak.


Yukarıdaki kod PyramidScheme yorumlayıcısı tarafından aşağıdaki gibi iç içe bir dizge halinde işlenir:

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

Göreviniz, iç içe dizgeler dizisi verilen, yeniden oluşturulan PyramidScheme kodunu çıkaran veya veren bir program veya işlev yazmaktır. Giriş dizisinin her zaman geçerli olacağını varsayabilirsiniz.

Bir piramit ikizkenar üçgendir. En iyi olan ^çapraz uzak tarafını eğimi, /ve \ve alt edilir -. İki alt köşe ya boştur ya da argümanlar olan diğer piramitlerin başlangıcını içerir. Orta, piramitlerin ismiyle doludur, satır sonlarını görmezden gelir.

Ayrıştırıcı kodu kullanılabilir bir biçime dönüştürür. İlk olarak, bir üst seviye piramit tarar. Argüman almazsa, onu tek bir dizeyle temsil eder ve devam eder. Aksi takdirde, temsil eden bir dizi ["name",[arg1,arg2]]veya ["name",[arg1]]. Argümanlar, piramidin sol alt ve sağ altındaki piramitler olup, yukarıda belirtildiği gibi sicim ya da daha fazla dizi olabilir. Bunun biraz Lisp'e benzediğini fark edebilirsiniz, bu durumda dil adı olan korkunç kelimeyi de fark etmiş olabilirsiniz. Piramit tamamen temsil edildikten sonra ayrıştırıcı bir sonrakine geçer.

Bu , en kısa kod kazanır!

Test Durumları: Bunlar sadece geçerli çıktılar değil, bunlar geçerli çıktılara örnek.

[["+", ["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\
       ---

İkinci test durumunda, ikinci ve üçüncü outpiramidin her ikisi de ["chr", ["108"]], iki üst seviye olan tarafından paylaşılan bir piramit yığına daraltılan bir parametresi olarak bulunur. Bu, kodunuzun destekleyebileceği geçerli bir optimizasyondur, ancak tamamen isteğe bağlıdır; puanlama, çıktınızın uzunluğuna bağlı değildir.

Meraklı için, ilk vaka 9126 3üst düzey piramitlerin örtük şekilde basılmasından kaynaklanıyor, ikincisi yazdırıyor Hellove sonuncusu da sadece düzgün bir yapıya sahip olduğundan sözdizimi hatası.


Sen girişi sadece yazdırılabilir ASCII hariç boşluklar içerdiğini varsayalım olabilir ^, /, \ve -. Giriş her zaman geçerli olacak ve en az bir piramit içerecektir. Dizinin büyüklüğü veya giriş dizgisi sınırlaması yoktur, ancak kodunuzu dilinizin varsayılan tamsayı türü sonsuz hassasiyetmiş gibi ve bilgisayarınızın keyfi belleğine sahipmiş gibi yazabilirsiniz. Tek bir dize olarak girdi alıyorsanız, dizileri sınırlandırmak için makul herhangi bir şey (virgül, boşluk, vb. Basılabilir şekilde "veya değil []) kullanabilirsiniz. Tüm şeyi çevreleyen köşeli parantezler dahil etmek zorunda değilsiniz, bunun yerine sınırlayıcınızla ayrılmış çoklu diziler almanız gerekmez.

Çıktınızın golf oynamak zorunda olması gerekmez, fazladan boşluk ekleyebilir veya piramitlerinizi gereğinden fazla büyütebilirsiniz. Toplevel piramitler gereken ilk satırda olmak. Çıktı, yeni satırlı bir dize veya bir dize listesi olmalıdır.

Herkes yapar optimal piramitleri çoraplar kendi kod versiyonunu içerir upvotes / nimetlerini (ama muhtemelen sadece upvotes) şeklinde bazı temsilcisi alabilirsiniz.


8
Sierpinski bu dili çok severdi.
mbomb007

4
Tamamen bu mücadeleyi yayınlamadı çünkü üçgenleri düzgün biçimde biçimlendirmek için çok tembelim ...
Pavel

@KodosJohnson Girdi, yerel bir dizi olabilir.
Pavel,

ikiden fazla argüman içeren bir işleve nasıl sahip olabilirsiniz?
Yıkılabilir Limon

@DestructibleWatermelon Girdi, hiçbir zaman bir piramit için iki argümanın iletilmesini gerektirecek bir dizi içermez, çünkü bu, Piramit Düzeninde imkansızdır.
Pavel

Yanıtlar:


26

Ortak Lisp - 2524 1890 bayt

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

@Coredump'a birkaç golf oyunu için teşekkürler. Sorudan örnek çıktı:

> (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\   /   \     
/     \  -----     
-------            

Orijinal (çoğunlukla) ungolfed versiyonu:

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

Çevrimiçi Deneyin!


Gereksiz boşlukları kaldırarak çok sayıda bayttan golf yapabilmelisiniz.
clismique

2
PPCG'ye hoş geldiniz ve ilk güzel cevap!
Kritixi Lithos

CL golf için bazı ipuçları: “loop” da “for”, “as” olarak da yazılabilir; parantezlerden ve çift tırnaklardan önce ve sonra boşlukları kaldırabilirsiniz; NIL yerine (); ayrıca bazen okuyucu değişkenleri de kullanabilirsiniz
coredump

... loop while (not x)olduğu loop until x, (cdr (cdr x))olduğunu (cddr x), (setf a b c d)daha kısa (setf a b)takiben (setf c d), vb Ama bu zaten iyi bir cevaptır
coredump

2
Toplam 350 itibar ödülü önemli ... ama bu cevap haketti. Bir Lisp lehçesine soru sormakla ilgili bir soruya Genel Lisp cevabı ... Vay.
wizzwizz4
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.