生成金字塔方案代码

金字塔计划是@ ConorO'Brien开发的一种语言。在金字塔计划中，您编写的代码如下所示：

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

现在，该代码具有两个明显的特性：很难解析，也很难编写。Conor解决了第一个问题，但是解决第二个问题将是您的工作。

上面的代码由PyramidScheme解释器处理为嵌套的字符串数组，如下所示：

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

您的任务是编写一个给定嵌套字符串数组的程序或函数，输出或返回重新创建的PyramidScheme代码。您可以假设输入数组将始终有效。

金字塔是等腰三角形。顶部是^，侧面与/和对角倾斜\，底部是-。两个底角为空或包含其他金字塔的起点，它们是自变量。中间充满了金字塔的名称，忽略了换行符。

解析器将代码转换为可用格式的方式如下。首先，它会扫描顶级金字塔。如果不带参数，则用单个字符串表示它并继续前进。否则，它表示为数组["name",[arg1,arg2]]或["name",[arg1]]。参数是金字塔左下角和右下角的金字塔，它们可以是字符串，也可以是如上所述的更多数组。您可能会注意到它有点像Lisp，在这种情况下，您可能还注意到了语言名称的双关语。金字塔被完全表示后，解析器将移动到下一个金字塔。

这是代码高尔夫，最短的代码获胜！

测试用例：这些不是唯一有效的输出，它们是有效输出的示例。

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

请注意，在第二个测试案例中，第二个和第三个out金字塔都有一个["chr", ["108"]]作为参数，该金字塔被折叠成两个顶层堆栈共享的一个金字塔堆栈。这是您的代码可能支持的有效优化，但它是完全可选的。得分不是基于输出的长度。

出于好奇，第一种情况是9126 3由于隐式打印顶级金字塔而出现的，第二种情况Hello是由于语法错误而出现的，而第二种情况是由于语法结构整齐而出现的。

你可以假设输入只包含可打印的ASCII，不包括空格^，/，\，和-。输入将始终有效，并且至少包含一个金字塔。数组或输入字符串的大小没有限制，但是您可以编写代码，就像您的语言的默认整数类型是无限精度并且计算机具有任意内存一样。如果将输入作为单个字符串，则可以使用任何合理的值（逗号，空格等，只要它在可打印的ascii中而不是"or []）就可以分隔数组。您不必在整个内容周围包括方括号，而是使用由定界符分隔的多个数组。

您的输出不必打高尔夫球，可以插入额外的空间或使金字塔变大。顶级金字塔应该位于第一行。输出应该是带有换行符的字符串或字符串列表。

任何确实包含其代码版本的人都可以最佳地金字塔金字塔高尔夫，任何人都可以以投票/赏金的形式获得回报（但可能仅仅是投票）。

通用Lisp- 2524 1890字节

(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提供了许多高尔夫技巧。问题的样本输出：

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

这是原始的（主要是）非高尔夫版本：

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

在线尝试！