आम लिस्प, 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))))
बीटा कमी
वेरिएबल्स PROGVका उपयोग करते हुए नए आम लिस्प प्रतीकों के साथ कमी के दौरान गतिशील रूप से बाध्य किया जाता है 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"
टेस्ट
मैं पायथन जवाब के रूप में एक ही परीक्षण सूट का पुन: उपयोग करता हूं:
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))
- EDIT I ने मेरे उत्तर को उसी तरह से समूहीकृत करने का व्यवहार किया है जैसा कि विज्ञापन के उत्तर में है , क्योंकि इसे लिखने के लिए कम बाइट खर्च होती है।
- शेष अंतर परीक्षण 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 के साथ, एक ही टेस्ट सूट को 10000 बार कॉल करने में 3.33 सेकंड लगते हैं।