Générer du code de schéma pyramidal

32

Pyramid Scheme est un langage développé par @ ConorO'Brien . Dans Pyramid Scheme, le code que vous écrivez ressemble à ceci:

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

Maintenant, ce code a deux qualités évidentes: il est difficile à analyser et difficile à écrire. Conor a résolu le premier, mais ce sera votre travail de résoudre ce deuxième problème.


Le code ci-dessus est traité par l'interpréteur PyramidScheme dans un tableau de chaînes imbriqué, comme ceci:

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

Votre tâche consiste à écrire un programme ou une fonction qui, à partir d'un tableau imbriqué de chaînes, génère ou renvoie le code PyramidScheme recréé. Vous pouvez supposer que le tableau d'entrée sera toujours valide.

Une pyramide est un triangle isocèle. Le haut est ^, les côtés sont inclinés en diagonale avec /et \, et le bas est -. Les deux coins inférieurs sont vides ou contiennent le début d'autres pyramides, qui sont des arguments. Le milieu est rempli du nom de la pyramide, ignorant les sauts de ligne.

Voici comment l'analyseur convertit le code dans un format utilisable. Tout d'abord, il recherche une pyramide de niveau supérieur. S'il ne prend aucun argument, il le représente avec une seule chaîne et passe à autre chose. Sinon, il représente un tableau ["name",[arg1,arg2]]ou ["name",[arg1]]. Les arguments sont les pyramides en bas à gauche et en bas à droite de la pyramide, qui peuvent être soit des chaînes, soit plusieurs tableaux décrits comme ci-dessus. Vous remarquerez peut-être que cela ressemble un peu à Lisp, auquel cas vous avez peut-être également remarqué le jeu de mots terrible qu'est le nom de la langue. Une fois la pyramide entièrement représentée, l'analyseur passe à la suivante.

C'est le , le code le plus court gagne!

Cas de test: ce ne sont pas les seules sorties valides, ce sont des exemples de sorties valides.

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

Remarquez que dans le deuxième cas de test, la deuxième et la troisième outpyramide ont toutes deux ["chr", ["108"]]un paramètre, qui est réduit en une pile de pyramides partagée par deux de niveau supérieur. Il s'agit d'une optimisation valide que votre code peut prendre en charge, mais elle est complètement facultative; la notation n'est pas basée sur la longueur de votre sortie.

Pour les curieux, le premier cas s'affiche en 9126 3raison de l'impression implicite de pyramides de haut niveau, le second s'imprime Helloet le dernier est une erreur de syntaxe, incluse simplement parce qu'elle a une structure soignée.


Vous pouvez supposer que l'entrée ne contient que des caractères ASCII imprimables, à l' exclusion des espaces, ^, /, \et -. L'entrée sera toujours valide et contiendra au moins une pyramide. Il n'y a pas de limite sur la taille du tableau ou des chaînes d'entrée, mais vous pouvez écrire votre code comme si le type d'entier par défaut de votre langue était d'une précision infinie et que votre ordinateur avait une mémoire arbitraire. Si vous prenez l'entrée comme une seule chaîne, vous pouvez utiliser n'importe quoi de raisonnable (virgule, espace, etc. tant qu'il est en ascii imprimable et non "ou []) pour délimiter les tableaux. Vous n'avez pas besoin d'inclure des crochets entourant le tout, et prenez plutôt plusieurs tableaux séparés par votre délimiteur.

Votre sortie n'a pas besoin d'être jouée au golf, vous pouvez insérer de l'espace supplémentaire ou agrandir vos pyramides. Les pyramides de Toplevel devraient être sur la première ligne. La sortie doit être une chaîne avec des retours à la ligne ou une liste de chaînes.

Toute personne qui ne comprend une version de leur code qui de manière optimale les pyramides joue au golf peut recevoir une certaine représentant sous forme de upvotes / primes (mais probablement upvotes).

Pavel
la source
8
Sierpinski adorerait cette langue.
mbomb007
4
Totally n'a pas posté ce défi parce que je suis trop paresseux pour formater correctement les triangles ...
Pavel
@KodosJohnson Input peut être un tableau natif.
Pavel
comment pouvez-vous avoir une fonction avec plus de deux arguments?
Destructible Lemon
@DestructibleWatermelon L'entrée ne contiendra jamais un tableau tel qu'il faudra passer deux arguments à une pyramide, car cela est impossible dans Pyramid Scheme.
Pavel

Réponses:

26

Lisp commun - 2524 1890 octets

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

Merci à @coredump pour un certain nombre d'astuces de golf. Exemple de sortie de la 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\   /   \     
/     \  -----     
-------            

Voici la version originale, (principalement) non golfée:

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

Essayez-le en ligne!

Neil Lindquist
la source
Vous devriez pouvoir jouer à de nombreux octets en supprimant les espaces inutiles.
clismique
2
Bienvenue chez PPCG et belle première réponse!
Kritixi Lithos
Quelques conseils pour jouer au golf CL: en boucles, "pour" peut également s'écrire "comme"; vous pouvez supprimer des espaces avant et après les parenthèses et les guillemets doubles; vous pouvez remplacer NIL par (); vous pouvez également utiliser des variables de lecteur, parfois
coredump
... loop while (not x)est loop until x, (cdr (cdr x))est (cddr x), (setf a b c d)est plus court que (setf a b)suivi (setf c d), etc. Mais c'est déjà une bonne réponse
coredump
2
Une prime totale de 350 points de réputation est importante ... mais cette réponse le mérite. Une réponse Lisp commune à une question sur la construction de questions pour un dialecte Lisp ... Wow.
wizzwizz4