Generieren Sie den Code für das Pyramidenschema


32

Pyramid Scheme ist eine Sprache, die von @ ConorO'Brien entwickelt wird . In Pyramid Scheme sieht der von Ihnen geschriebene Code folgendermaßen aus:

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

Nun, dieser Code hat zwei offensichtliche Eigenschaften: Es ist schwierig zu analysieren und es ist schwierig zu schreiben. Conor hat das erste Problem gelöst, es wird jedoch Ihre Aufgabe sein, das zweite Problem zu lösen.


Der obige Code wird vom PyramidScheme-Interpreter in ein verschachteltes String-Array wie folgt verarbeitet:

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

Ihre Aufgabe ist es, ein Programm oder eine Funktion zu schreiben, die bei einem verschachtelten Array von Zeichenfolgen den neu erstellten PyramidScheme-Code ausgibt oder zurückgibt. Sie können davon ausgehen, dass das Eingabearray immer gültig ist.

Eine Pyramide ist ein gleichschenkliges Dreieck. Die Oberseite ist ^, die Seiten schräg weg mit /und abfallen \, und die Unterseite ist -. Die beiden unteren Ecken sind entweder leer oder enthalten den Anfang anderer Pyramiden, bei denen es sich um Argumente handelt. Die Mitte ist mit dem Namen der Pyramide gefüllt, wobei Zeilenumbrüche ignoriert werden.

So konvertiert der Parser den Code in ein verwendbares Format. Zunächst wird nach einer Pyramide der obersten Ebene gesucht. Wenn es keine Argumente akzeptiert, wird es mit einer einzelnen Zeichenfolge dargestellt und fortgesetzt. Andernfalls wird es als Array dargestellt["name",[arg1,arg2]] oder dargestellt ["name",[arg1]]. Die Argumente sind die Pyramiden links unten und rechts unten in der Pyramide, bei denen es sich entweder um eine Zeichenfolge oder um mehrere wie oben beschriebene Arrays handeln kann. Möglicherweise stellen Sie fest, dass dies etwas an Lisp erinnert. In diesem Fall haben Sie möglicherweise auch das schreckliche Wortspiel bemerkt, das der Name der Sprache ist. Nachdem die Pyramide vollständig dargestellt ist, fährt der Parser mit der nächsten fort.

Dies ist , der kürzeste Code gewinnt!

Testfälle: Dies sind nicht die einzigen gültigen Ausgaben, sondern Beispiele für gültige Ausgaben.

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

Beachten Sie im zweiten Testfall, dass sowohl die zweite als auch die dritte outPyramide a haben["chr", ["108"]] einen Parameter haben, der zu einem Pyramidenstapel zusammengefasst wird, der von zwei obersten gemeinsam genutzt wird. Dies ist eine gültige Optimierung, die Ihr Code möglicherweise unterstützt, die jedoch vollständig optional ist. Die Bewertung basiert nicht auf der Länge Ihrer Ausgabe.

Für die Neugierigen wird der erste Fall 9126 3aufgrund des impliziten Druckens von Pyramiden der obersten Ebene angezeigt, der zweite wird gedruckt Hello, und der letzte ist ein Syntaxfehler, der nur deshalb enthalten ist, weil er eine ordentliche Struktur aufweist.


Sie gehen davon aus , dass der Eingang nur druckbare ASCII enthält, ohne Leerzeichen ^, /, \, und -. Die Eingabe ist immer gültig und enthält mindestens eine Pyramide. Es gibt keine Begrenzung für die Größe des Arrays oder der Eingabezeichenfolgen. Sie können Ihren Code jedoch so schreiben, als ob der standardmäßige Ganzzahltyp Ihrer Sprache unendlich genau wäre und Ihr Computer über einen beliebigen Speicher verfügt. Wenn Sie Eingaben als einzelne Zeichenfolge verwenden, können Sie alles verwenden, was zumutbar ist (Komma, Leerzeichen usw.), sofern es sich um druckbare ASCII-Zeichen handelt und nicht" oder [], um Arrays abzugrenzen. Sie müssen keine eckigen Klammern einschließen, sondern mehrere durch Trennzeichen getrennte Arrays verwenden.

Ihre Ausgabe muss nicht golfen werden, Sie können zusätzlichen Platz einfügen oder Ihre Pyramiden größer als erforderlich machen. Pyramiden der obersten Ebene sollten sich in der ersten Zeile befinden. Die Ausgabe sollte eine Zeichenfolge mit Zeilenumbrüchen oder eine Liste von Zeichenfolgen sein.

Jeder, der eine Version seines Codes enthält, mit der die Pyramiden optimal golfen werden, kann eine Wiederholung in Form von positiven Stimmen / Kopfgeldern (aber wahrscheinlich nur positiven Stimmen) erhalten.


8
Sierpinski würde diese Sprache lieben.
mbomb007

4
Totally hat diese Challenge nicht
Pavel

@KodosJohnson Input kann ein natives Array sein.
Pavel

Wie kann man eine Funktion mit mehr als zwei Argumenten haben?
Destructible Lemon

@DestructibleWatermelon Die Eingabe enthält niemals ein Array, sodass zwei Argumente an eine Pyramide übergeben werden müssen, da dies im Pyramidenschema nicht möglich ist.
Pavel

Antworten:


26

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

Vielen Dank an @coredump für eine Reihe von Golf-Tricks. Beispielausgabe der Frage:

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

Hier ist die originale (meistens) 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)))

Probieren Sie es online!


Sie sollten in der Lage sein, viele Bytes abzuspielen, indem Sie unnötige Leerzeichen entfernen.
Clismique

2
Willkommen bei PPCG und schöne erste Antwort!
Kritixi Lithos

Einige Tipps zum Golfspielen von CL: In Loops kann "for" auch als "as" geschrieben werden. Sie können Leerzeichen vor und nach Klammern und doppelten Anführungszeichen entfernen. Sie können NIL durch ersetzen (). Sie können auch
Leservariablen

... loop while (not x)ist loop until x, (cdr (cdr x))ist (cddr x), (setf a b c d)ist kürzer als (setf a b)gefolgt von (setf c d), etc. Aber das ist schon eine gute Antwort
coredump

2
Eine Gesamtprämie von 350 Ruf ist bedeutend ... aber diese Antwort hat es verdient. Eine allgemeine Lisp-Antwort auf eine Frage zur Erstellung von Fragen für einen Lisp-Dialekt ... Wow.
wizzwizz4
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.