Lisp को एक कंप्यूटर को लिखने के लिए सिखाने के लिए उपयोग
इस पोस्ट को मूल रूप से चीनी भाषा में लिखा गया था और CSDN पर प्रकाशित किया गया था, https://blog.csdn.net/lzw_java/article/details/11599993
बहुत से कोड और विचार “Ansi Common Lisp” P138~P141 पर आधारित हैं।
सवाल: अगर एक इंग्लिश टेक्स्ट दिया गया है, तो कंप्यूटर इसे समझने के बाद यह कैसे कर सकता है कि नया रैंडम लेकिन पढ़ने योग्य टेक्स्ट इसे आधार बनाकर बनाए? उदाहरण के लिए:
द नेशनल वेंटचर कैपिटल एसोसिएशन एस्टीमेट्स दैट वेल्थ एसोसिएटेड विद अ डील ए बिग स्पेंडिंग बाई रेग्युलेशन दैट विल स्पैंड वन अनदर’स मेन रीजन फॉर दिस प्रोजेक्ट्स ।
यह एक इंग्लिश टेक्स्ट है जो कंप्यूटर ने पॉल ग्राहम के कुछ लेखों से सीखने के बाद बना है। यह वर्ड “Venture” से एक वाक्य में फैल जाता है। आश्चर्यजनक तथ्य यह है कि टेक्स्ट अक्सर पढ़ने लायक है।
अल्गोरिथम: प्रत्येक वर्ड के बाद आने वाले वर्डों और उन पर दिखाई देने के संख्या को रिकॉर्ड करें। उदाहरण के लिए, अगर “आई लीव” में मूल टेक्स्ट में पांच बार दिखाई देता है और “आई वांट” तीन बार दिखाई देता है, और “आई” किसी दूसरे वर्ड के सामने नहीं आता है, तो जब “आई” को मिलता है, तो अगले वर्ड के रूप में “लेव” का चयन करने की 5/8 की संभावना होती है। अगर “लेव” चुना गया है, तो फिर “लेव” के बाद आने वाले वर्डों की जांच करें और प्रक्रिया को दोहराएं।
अब, हम लिस्प का उपयोग करके इस समस्या को हल करें।
लिस्प का सिम्बल प्रकार अलग अलग स्ट्रिंग्स और पंक्टुएशन मार्क्स को अच्छी तरह से रिकॉर्ड कर सकता है, इसलिए हम इसे रिकॉर्ड करने के लिए उपयोग करेंगे। हम built-in hashtable का उपयोग करके एक लिस्ट बनाने के लिए करेंगे:
(defparameter *words* (make-hash-table :size 10000))
हम इस लिस्ट को कैसे बनाएँगे?
(let ((prev '|.|))
(defun see (sym)
(let ((pair (assoc sym (gethash prev *words*))))
(if pair
(incf (cdr pair))
(push (cons sym 1) (gethash prev *words*))))
(setf prev sym)))
| वर्तमान वर्ड सीमबल है, और असोसिएटेड लिस्ट वोल्यू है। उदाहरण के लिए, “आई” के नीचे ( ( | लेव | . 5) ( | वांट | . 3) ) है। अगर वर्ड नही है, तो (वर्ड . 1) को पुश करें। |
हम कैसे एक वर्ड को रैंडम रूप से चुन सकते हैं?
(defun random-word (word ht)
(let* ((choices (gethash word ht))
(x (random (reduce #'+ choices :key #'cdr))))
(dolist (pair choices)
(decf x (cdr pair))
(if (minusp x)
(return (car pair))))))
यहां, रिड्यूस फंक्शन चतुराई से इस्तेमाल किया गया है।
अब, हम एक वर्ड को दोनों ओर से एक वाक्य में फैलाने के बारे में सोचते हैं?
1) पाठ को उल्टा कर एक उल्टा लिस्ट प्राप्त करें, उदाहरण के लिए, “आई लीव, आई वांट” को “लीव आई, वांट आई” बनाएं।
2) हैशटेबल को उल्टा कर, एक दूसरा हैशटेबल बनाएं, जहाँ बाद के वर्ड को सीम्बल के रूप में, और संभव पूर्ववर्ती वर्ड और उनका गिनती असोसिएशन लिस्ट बनाएं।
3) अपना भाग्य आजमाएं, एक पंक्चुअलेशन मार्क से वाक्य को बढ़ाने की कोशिश कीजिए जब तक कि दिया गया वर्ड नहीं दिखता है।
मैंने दूसरी विधि का उपयोग किया:
(defparameter *r-words* (make-hash-table :size 10000))
(defun push-words (w1 w2 n)
(push (cons w2 n) (gethash w1 *r-words*)))
(defun get-reversed-words () ; a cat -> cat a
(maphash #'(lambda (k lst)
(dolist (pair lst)
(push-words (car pair) k (cdr pair))))
*words*))
पहले हैशटेबल को ट्रांसवर्स करें, फिर हर जोड़ी को उनके क्रम को उल्टा करके एक दूसरा हैशटेबल में डालें। यहाँ है एक वाक्य को स्वचालित रूप से दोनो ओर विस्तृत करने का कोड:
(defparameter *words* (make-hash-table :size 10000))
(defconstant maxword 100)
(defparameter nwords 0)
(defconstant debug nil)
(let ((prev '|.|))
(defun see (sym)
(incf nwords)
(let ((pair (assoc sym (gethash prev *words*))))
(if pair
(incf (cdr pair))
(push (cons sym 1) (gethash prev *words*))))
(setf prev sym)))
(defun check-punc (c) ; char to symbol
(case c
(#\. '|.|) (#\, '|,|)
(#\; '|;|) (#\? '|?|)
(#\: '|:|) (#\! '|!|)))
(defun read-text (pathname)
(with-open-file (str pathname :direction :input)
(let ((buf (make-string maxword))
(pos 0))
(do ((c (read-char str nil 'eof)
(read-char str nil 'eof)))
((eql c 'eof))
(if (or (alpha-char-p c)
(eql c #\'))
(progn
(setf (char buf pos) c)
(incf pos))
(progn
(unless (zerop pos)
(see (intern (subseq buf 0 pos)))
(setf pos 0))
(let ((punc (check-punc c)))
(if punc
(see punc)))))))))
(defun print-ht (ht)
(maphash #'(lambda (k v)
(format t "~A ~A~%" k v))
ht))
(defparameter *r-words* (make-hash-table :size 10000))
(defun push-words (w1 w2 n)
(push (cons w2 n) (gethash w1 *r-words*)))
(defun get-reversed-words () ; a cat -> cat a
(maphash #'(lambda (k lst)
(dolist (pair lst)
(push-words (car pair) k (cdr pair))))
*words*))
(defun print-a-word (word ht)
(maphash #'(lambda (k lst)
(if (eql k word)
(format t "~A ~A~%" k lst)))
ht))
(if debug
(print-a-word '|leave| *r-words*))
(defun punc-p (sym) ; symbol to char, nil when fails.
(check-punc (char (symbol-name sym) 0)))
(defun random-word (word ht)
(let* ((choices (gethash word ht))
(x (random (reduce #'+ choices :key #'cdr))))
(dolist (pair choices)
(decf x (cdr pair))
(if (minusp x)
(return (car pair))))))
(defun gen-former (word str)
(let ((last (random-word word *r-words*)))
(if (not (punc-p last))
(progn
(gen-former last str)
(format str "~A " last)))))
(defun gen-latter (word str)
(let ((next (random-word word *words*)))
(format str "~A " next)
(if (not (punc-p next))
(gen-latter next str))))
;(gen-latter '|leave| t)
(defun get-a-word (ht) ; get a random word
(let ((x (random nwords)))
(maphash #'(lambda (k v)
(dolist (pair v)
(decf x (cdr pair))
(if (minusp x)
(return-from get-a-word (car pair)))))
ht)))
;(get-a-word *words*)
(defun gen-sentence (word str)
(gen-former word str)
(format str "~A " word)
(gen-latter word str))
(defun test ()
(setf nwords 0)
(read-text "essay.txt")
(get-reversed-words)
(let ((word (get-a-word *words*)))
(print word)
(gen-sentence word t)))
(test)