เสียงกระเพื่อมสามัญ 560 ไบต์
"ในที่สุดฉันก็พบว่ามีประโยชน์สำหรับPROGV"
(macrolet((w(S Z G #1=&optional(J Z))`(if(symbolp,S),Z(destructuring-bind(a b #1#c),S(if(eq a'L),G,J)))))(labels((r(S #1#(N 97))(w S(symbol-value s)(let((v(make-symbol(coerce`(,(code-char N))'string))))(progv`(,b,v)`(,v,v)`(L,v,(r c(1+ n)))))(let((F(r a N))(U(r b N)))(w F`(,F,U)(progv`(,b)`(,U)(r c N))))))(p()(do((c()(read-char()()#\)))q u)((eql c #\))u)(setf q(case c(#\S'(L x(L y(L z((x z)(y z))))))(#\K'(L x(L u x)))(#\I'(L a a))(#\((p)))u(if u`(,u,q)q))))(o(S)(w S(symbol-name S)(#2=format()"~A.~A"b(o c))(#2#()"~A(~A)"(o a)(o b)))))(lambda()(o(r(p))))))
Ungolfed
;; Bind S, K and I symbols to their lambda-calculus equivalent.
;;
;; L means lambda, and thus:
;;
;; - (L x S) is variable binding, i.e. "x.S"
;; - (F x) is function application
(define-symbol-macro S '(L x (L y (L z ((x z) (y z))))))
(define-symbol-macro K '(L x (L u x)))
(define-symbol-macro I '(L x x))
;; helper macro: used twice in R and once in O
(defmacro w (S sf lf &optional(af sf))
`(if (symbolp ,S) ,sf
(destructuring-bind(a b &optional c) ,S
(if (eq a 'L)
,lf
,af))))
;; R : beta-reduction
(defun r (S &optional (N 97))
(w S
(symbol-value s)
(let ((v(make-symbol(make-string 1 :initial-element(code-char N)))))
(progv`(,b,v)`(,v,v)
`(L ,v ,(r c (1+ n)))))
(let ((F (r a N))
(U (r b N)))
(w F`(,F,U)(progv`(,b)`(,U)(r c N))))))
;; P : parse from stream to lambda tree
(defun p (&optional (stream *standard-output*))
(loop for c = (read-char stream nil #\))
until (eql c #\))
for q = (case c (#\S S) (#\K K) (#\I I) (#\( (p stream)))
for u = q then `(,u ,q)
finally (return u)))
;; O : output lambda forms as strings
(defun o (S)
(w S
(princ-to-string S)
(format nil "~A.~A" b (o c))
(format nil (w b "(~A~A)" "(~A(~A))") (o a) (o b))))
Beta-ลดลง
ตัวแปรที่มีความผูกพันแบบไดนามิกในระหว่างการลดลงที่มีPROGVสัญลักษณ์ใหม่ Common MAKE-SYMBOLเสียงกระเพื่อมโดยใช้ วิธีนี้ช่วยให้หลีกเลี่ยงการตั้งชื่อการชน (เช่นการแรเงาที่ไม่พึงประสงค์ของตัวแปรที่ถูกผูกไว้) ฉันสามารถใช้งานได้GENSYMแต่เราต้องการมีชื่อที่เป็นมิตรกับผู้ใช้สำหรับสัญลักษณ์ นั่นคือเหตุผลที่สัญลักษณ์ถูกตั้งชื่อด้วยตัวอักษรจากaถึงz(ตามที่อนุญาตโดยคำถาม) Nแสดงถึงรหัสตัวอักษรของตัวอักษรต่อไปที่มีอยู่ในขอบเขตปัจจุบันและเริ่มต้นด้วย 97 หรือที่รู้จักaอาคา
นี่คือเวอร์ชันที่อ่านได้ง่ายกว่าของR(ไม่มีWแมโคร):
(defun beta-reduce (S &optional (N 97))
(if (symbolp s)
(symbol-value s)
(if (eq (car s) 'L)
;; lambda
(let ((v (make-symbol (make-string 1 :initial-element (code-char N)))))
(progv (list (second s) v)(list v v)
`(L ,v ,(beta-reduce (third s) (1+ n)))))
(let ((fn (beta-reduce (first s) N))
(arg (beta-reduce (second s) N)))
(if (and(consp fn)(eq'L(car fn)))
(progv (list (second fn)) (list arg)
(beta-reduce (third fn) N))
`(,fn ,arg))))))
ผลลัพธ์ระดับกลาง
แยกจากสตริง:
CL-USER> (p (make-string-input-stream "K(K(K(KK)))"))
((L X (L U X)) ((L X (L U X)) ((L X (L U X)) ((L X (L U X)) (L X (L U X))))))
ลด:
CL-USER> (r *)
(L #:|a| (L #:|a| (L #:|a| (L #:|a| (L #:|a| (L #:|b| #:|a|))))))
(ดูร่องรอยของการดำเนินการ)
พริตตี้พิมพ์:
CL-USER> (o *)
"a.a.a.a.a.b.a"
การทดสอบ
ฉันใช้ชุดการทดสอบเดียวกันกับคำตอบของ Python:
Input Output Python output (for comparison)
1. KSK a.b.c.a(c)(b(c)) a.b.c.a(c)(b(c))
2. SII a.a(a) a.a(a)
3. S(K(SI))K a.b.b(a) a.b.b(a)
4. S(S(KS)K)I a.b.a(a(b)) a.b.a(a(b))
5. S(S(KS)K)(S(S(KS)K)I) a.b.a(a(a(b))) a.b.a(a(a(b)))
6. K(K(K(KK))) a.a.a.a.a.b.a a.b.c.d.e.f.e
7. SII(SII) ERROR ERROR
ตัวอย่างการทดสอบที่ 8 ใหญ่เกินไปสำหรับตารางด้านบน:
8. SS(SS)(SS)
CL a.b.a(b)(c.b(c)(a(b)(c)))(a(b.a(b)(c.b(c)(a(b)(c))))(b))
Python a.b.a(b)(c.b(c)(a(b)(c)))(a(d.a(d)(e.d(e)(a(d)(e))))(b))
- แก้ไขฉันอัปเดตคำตอบของฉันเพื่อให้มีพฤติกรรมการจัดกลุ่มเช่นเดียวกับในคำตอบของ aditsuเนื่องจากมีค่าใช้จ่ายน้อยกว่าในการเขียนไบต์
- ความแตกต่างที่เหลือสามารถมองเห็นได้สำหรับการทดสอบ 6 และ 8 ผลที่
a.a.a.a.a.b.aถูกต้องและไม่ได้ใช้เป็นตัวอักษรมากเป็นคำตอบที่งูใหญ่ที่ผูกไปa, b, cและdไม่ได้อ้างถึง
ประสิทธิภาพ
วนรอบ 7 การทดสอบที่ผ่านไปแล้วและรวบรวมผลลัพธ์ทันที (ผลลัพธ์ SBCL):
Evaluation took:
0.000 seconds of real time
0.000000 seconds of total run time (0.000000 user, 0.000000 system)
100.00% CPU
310,837 processor cycles
129,792 bytes consed
ทำแบบทดสอบเดียวกันหลายร้อยครั้งนำไปสู่ ... "เธรดหน่วยเก็บข้อมูลภายในหมดลง" ใน SBCL เนื่องจากข้อ จำกัด ที่ทราบเกี่ยวกับตัวแปรพิเศษ ด้วย CCL การเรียกชุดการทดสอบเดียวกัน 10,000 ครั้งใช้เวลา 3.33 วินาที