Generar código de esquema piramidal

32

Pyramid Scheme es un lenguaje desarrollado por @ ConorO'Brien . En Pyramid Scheme, el código que escribe se ve así:

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

Ahora, ese código tiene dos cualidades obvias: es difícil de analizar y es difícil de escribir. Conor ha resuelto el primero, sin embargo, será su trabajo resolver ese segundo problema.


El intérprete PyramidScheme procesa el código anterior en una matriz de cadenas anidadas, como esta:

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

Su tarea es escribir un programa o función que, dado un conjunto anidado de cadenas, genera o devuelve el código PyramidScheme recreado. Puede suponer que la matriz de entrada siempre será válida.

Una pirámide es un triángulo isósceles. La parte superior es ^, los lados se inclinan diagonalmente con /y \, y la parte inferior es -. Las dos esquinas inferiores están vacías o contienen el comienzo de otras pirámides, que son argumentos. El centro está lleno con el nombre de la pirámide, ignorando los saltos de línea.

Así es como el analizador convierte el código a un formato utilizable. Primero, busca una pirámide de nivel superior. Si no toma argumentos, lo representa con una sola cadena y continúa. De lo contrario, representa es como una matriz ["name",[arg1,arg2]]o ["name",[arg1]]. Los argumentos son las pirámides en la parte inferior izquierda e inferior derecha de la pirámide, que pueden ser cadenas o más matrices descritas anteriormente. Puede notar que esto se parece un poco a Lisp, en cuyo caso también puede haber notado el juego de palabras horrible que es el nombre del idioma. Una vez que la pirámide está totalmente representada, el analizador pasa a la siguiente.

Este es el , ¡el código más corto gana!

Casos de prueba: estos no son los únicos resultados válidos, estos son ejemplos de resultados válidos.

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

Observe que en el segundo caso de prueba, la segunda y la tercera outpirámide tienen ["chr", ["108"]]un parámetro, que se contrae en una pila de pirámide compartida por dos de nivel superior. Esta es una optimización válida que su código puede admitir, pero es completamente opcional; la puntuación no se basa en la longitud de su salida.

Para los curiosos, el primer caso se muestra 9126 3debido a la impresión implícita de pirámides de nivel superior, el segundo se imprime Helloy el último es un error de sintaxis, incluido solo porque tiene una estructura ordenada.


Usted puede asumir que la entrada sólo contiene ASCII imprimible, excluyendo espacios, ^, /, \, y -. La entrada siempre será válida y contendrá al menos una pirámide. No hay límite en el tamaño de la matriz o las cadenas de entrada, sin embargo, puede escribir su código como si el tipo entero predeterminado de su idioma fuera de precisión infinita y que su computadora tenga memoria arbitraria. Si toma la entrada como una sola cadena, puede usar cualquier cosa razonable (coma, espacio, etc., siempre que esté en ascii imprimible y no "o []) para delimitar las matrices. No tiene que incluir corchetes que rodean todo el asunto y, en su lugar, tomar múltiples matrices separadas por su delimitador.

Su salida no tiene que ser golfizada, puede insertar espacio extra o hacer que sus pirámides sean más grandes de lo necesario. Las pirámides de Toplevel deberían estar en la primera línea. La salida debe ser una cadena con nuevas líneas o una lista de cadenas.

Cualquier persona que hace incluirá una versión de su código que juega golf de manera óptima las pirámides puede recibir algún representante en forma de upvotes / bondades (pero probablemente sólo upvotes).

Pavel
fuente
8
A Sierpinski le encantaría este lenguaje.
mbomb007
44
Totalmente de no publicar este reto porque soy demasiado perezoso para formato de triángulos adecuadamente ...
Pavel
@KodosJohnson Input puede ser una matriz nativa.
Pavel
¿Cómo puedes tener una función con más de dos argumentos?
Destructible Lemon
@DestructibleWatermelon La entrada nunca contendrá una matriz tal que requerirá pasar dos argumentos a una pirámide, ya que esto es imposible en Pyramid Scheme.
Pavel

Respuestas:

26

Lisp común - 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))

Gracias a @coredump por una serie de trucos de golf. Ejemplo de salida de la pregunta:

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

Aquí está la versión original, (en su mayoría) sin golf:

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

Pruébalo en línea!

Neil Lindquist
fuente
Debería poder jugar muchos bytes eliminando espacios innecesarios.
clismique
2
¡Bienvenido a PPCG y buena primera respuesta!
Kritixi Lithos
Algunos consejos para jugar al golf CL: en bucles, "for" también se puede escribir "como"; puede eliminar espacios antes y después de paréntesis y comillas dobles; puede reemplazar NIL por (); También puede usar variables de lectura, a veces
coredump
... loop while (not x)es loop until x, (cdr (cdr x))es (cddr x), (setf a b c d)es más corto que (setf a b)seguido (setf c d), etc. Pero esta ya es una buena respuesta
coredump
2
Una recompensa total de 350 reputación es significativa ... pero esta respuesta lo merece. Una respuesta común de Lisp a una pregunta sobre cómo construir preguntas para un dialecto de Lisp ... Wow.
wizzwizz4