Generate Pyramid Scheme code

Question

Pyramid Scheme is a language being developed by @ConorO'Brien. In Pyramid Scheme, the code that you write looks like this:

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

Now, that code has two obvious qualities: It's difficult to parse, and it's difficult to write. Conor has solved the first one, however it will be your job to solve that second issue.

---

The above code is processed by the PyramidScheme interpreter into a nested string array, like this:

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

Your task is to write a program or function, which given a nested array of strings, outputs or returns the recreated PyramidScheme code. You may assume that the input array will always be valid.

A pyramid is an isosceles triangle. The top is ^, the sides slope diagonally away with / and \, and the bottom is -. The two bottom corners are either empty or contain the start of other pyramids, which are arguments. The middle is filled with the pyramid's name, ignoring line breaks.

Here's how the parser converts the code into a useable format. First, it scans for a top-level pyramid. If it takes no arguments, it represents it with a single string and moves on. Otherwise, it represents is as an array ["name",[arg1,arg2]] or ["name",[arg1]]. The arguments are the pyramids at the bottom left and bottom right of the pyramid, which may be either string or more arrays described as above. You may notice that this somewhat resembles Lisp, in which case you may also have noticed the awful pun that is the language name. After the pyramid is fully represented, the parser moves on to the next one.

This is code-golf, shortest code wins!

Test Cases: These are not the only valid outputs, these are example of valid outputs.

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

Notice in the second test case, the second and third out pyramid both have a ["chr", ["108"]] as a parameter, which is collapsed into one pyramid stack shared by two top-level ones. This is a valid optimization your code may support, but it is completely optional; scoring is not based on the length of your output.

For the curious, the first case displays 9126 3 due to implicit printing of toplevel pyramids, the second one prints Hello, and the last one is a syntax error, included just because it has a neat structure.

---

You may assume that the input only contains printable ASCII, excluding spaces, ^, /, \, and -. The input will always be valid, and contain at least one pyramid. There is no limit on the size of the array or the input strings, however you may write your code as if your language's default integer type was infinite precision and that your computer has arbitrary memory. If taking input as a single string, you may use anything reasonable (comma, space, etc. as long as it's in printable ascii and not " or []) to delimit arrays. You do not have to include brackets surrounding the entire thing, and instead take multiple arrays separated by your delimiter.

Your output does not have to be golfed, you may insert extra space or make your pyramids larger than necessary. Toplevel pyramids should be on the first line. Output should be a string with newlines or a list of strings.

Anyone who does include a version of their code which optimally golfs the pyramids may receive some rep in the form of upvotes/bounties (but probably just upvotes).

• mbomb007: Sierpinski would love this language.
• Pavel: Totally didn't post this challenge because I'm too lazy to format triangles properly...
• Pavel: @KodosJohnson Input can be a native array.
• Destructible Lemon: how can you have a function with more than two arguments?
• Pavel: @DestructibleWatermelon The input will never contain an array such that it will require passing two arguments to a pyramid, as this is impossible in Pyramid Scheme.

Answer 1

Common Lisp - (削除) 2524 (削除ここまで) 1890 bytes

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

Thanks to @coredump for a number of golfing tricks. Sample output from the question:

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

Here is the original, (mostly) ungolfed version:

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

Try it Online!

• clismique: You should be able to golf off a lot of bytes by removing unnecessary spaces.
• user41805: Welcome to PPCG and nice first answer!
• coredump: Some tips for golfing CL: in loops, "for" can also be written "as"; you can remove spaces before and after parentheses and double-quotes; you can replace NIL by (); you can also use reader variables, sometimes
• coredump: ... loop while (not x) is loop until x, (cdr (cdr x)) is (cddr x), (setf a b c d) is shorter than (setf a b) followed by (setf c d), etc. But this is already a good answer
• wizzwizz4: A total bounty of 350 reputation is significant... but this answer deserves it. A Common Lisp answer to a question about constructing questions for a Lisp dialect... Wow.

Answer 2

Python 3, ~41.3KB + tests and examples

So, I didn't realise this was a challenge, and I wrote a whole language which compiles into Pyramid scheme... 😅 It's called psll, and you can find it here. It has a bunch of bells and whistles, syntactic sugar constructs: functions (kinda) and strings, compiler optimisation etc.

This is not exactly a competing answer, but I feel it's heavily relevant so I should post it here.