Revisions
-
making revised this gist
Jan 23, 2010 . 3 changed files with 35 additions and 18 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -4,7 +4,8 @@ (in-package :cl-user) (defpackage :hige (:use :cl :drakma) #+ABCL (:shadow :y-or-n-p) (:export #:pin #:pon This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,4 +1,5 @@ (defsystem :scheme_baton :serial t :depends-on (:drakma) :components ((:file "package") (:file "scheme_baton")) ) This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -55,7 +55,8 @@ ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 ;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。 ;; 12. 佐野匡俊 (http://twitter.com/snmsts): 備前さんの変更がSBCL+OS Xなのでread-time conditionalizationをらしく修正。これがschemeに無いらしいのが残念。 ;; 13. making (http://blog.ik.am): 辞書ファイルをhttp経由で取得できるようにした。要drakma。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 ;; ================================================================================================================================================= @@ -67,6 +68,7 @@ ;; ■動作方法 ;; ANSI Common Lisp で動作します。 ;; (hige:pin) ; 辞書に英単語を登録 ;; (hige:pin :uri "http://gist.github.com/raw/273424/b06bb9626381e9510115290c8e87caabad2d6156/words.txt") ; http経由で辞書に登録 ;; (hige:pon) ; 英単語ゲームの開始 ;; (hige:pun) ; 辞書の一覧表示 ;; (hige:pun :score-threshold 10) ; 辞書の一覧表示(スコアが10以下の単語のみを表示する） @@ -155,10 +157,11 @@ "Return a score of this entry." (- (entry-ok-count entry) (* (entry-ng-count entry) 3))) (defmacro with-dict ((&key (read-only nil) (uri nil)) &rest body) `(progn (format *debug-io* ";; setup dict") (if ,uri (format *debug-io* "~%;; download dictionary from ~a " ,uri)) (if ,uri (setup-dict :file ,uri :http? t) (setup-dict)) (format *debug-io* "...done~%") ,@body (unless ,read-only @@ -171,15 +174,27 @@ `(dolist (,entry (entries-of *dict*)) ,@body)) (defmacro with-http-request ((stream uri &rest drakma-args) &body body) `(let ((,stream (drakma:http-request ,uri :want-stream t ,@drakma-args))) (unwind-protect (progn ,@body) (when ,stream (close ,stream)) ))) (defmacro with-open-dict ((dict in &key (http? nil)) &body body) `(if ,http? (with-http-request (,dict ,in) ,@body) (with-open-file (,dict ,in) ,@body) )) ;;; Top-Level Functions (defun pin (&key (uri nil)) "Register new entries to the dictionary." (with-dict (:uri uri) (unless uri (loop (add-entry (prompt-for-entry)) (unless (y-or-n-p "Another words to register? [yn]: ") (return)))))) (defun pon () "Start self-study english vocabulary quiz." (with-dict () @@ -240,11 +255,11 @@ (itr (read *query-io* nil nil))))))))) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*) (http? nil)) "Setup a dictionary for quiz; maybe read data from a file and apply fn to the dictionary." (unless (and (not http?) *dict*) (setf *dict* (make-dict (read-dict file :http? http?)))) (setf (entries-of *dict*) (funcall fn (entries-of *dict*))) *dict*) @@ -265,11 +280,11 @@ (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 ,@body))) (defun read-dict (file &key (http? nil)) "Read dictionary data from a file or http." (unless (or http? (probe-file file)) (return-from read-dict NIL)) (with-open-dict (in file :http? http?) (with-dictionary-io-syntax (normalize-dict (loop :for word := (read in nil in) :until (eq word in) -
snmsts revised this gist
Jan 20, 2010 . 1 changed file with 2 additions and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -54,6 +54,7 @@ ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 ;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。 ;; 12. 佐野匡俊 (http://twitter.com/snmsts): 備前さんの変更がSBCL+OS Xなのでread-time conditionalizationをらしく修正。これがschemeに無いらしいのが残念。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -351,7 +352,7 @@ (defun read-aloud (word) "Read aloud the given word and return it." #+(and SBCL DARWIN) (sb-ext:run-program "/usr/bin/say" `(,(symbol-name word)) :wait t) word) (defun nthcar (n list) -
southly revised this gist
Jan 20, 2010 . 1 changed file with 1 addition and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -53,7 +53,7 @@ ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 ;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 -
Jan 20, 2010 . 3 changed files with 17 additions and 12 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,13 @@ ;; -*- Mode: Lisp; Syntax: Common-Lisp -*- ;;; Package Management (in-package :cl-user) (defpackage :hige (:use :cl) #+ABCL (:shadow :y-or-n-p) (:export #:pin #:pon #:pun #:pan #:pen)) This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,4 @@ (defsystem :scheme_baton :serial t :components ((:file "package") (:file "scheme_baton")) ) This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -80,18 +80,6 @@ ;; ■辞書ファイルの例 ;; http://gist.github.com/273424 (in-package :hige) ;;quek-san's http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre -
Jan 18, 2010 . 1 changed file with 43 additions and 31 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -53,6 +53,7 @@ ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 ;; 11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -177,23 +178,25 @@ (format *debug-io* "done~%")) *dict*)) (defmacro do-entries ((entry) &rest body) `(dolist (,entry (entries-of *dict*)) ,@body)) ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." (with-dict () (loop (add-entry (prompt-for-entry)) (unless (y-or-n-p "Another words to register? [yn]: ") (return))))) (defun pon () "Start self-study english vocabulary quiz." (with-dict () (do-entries (e) (p "~&~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e)) #-ABCL (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) @@ -207,12 +210,12 @@ (defun pan () "Search the word user has input from the dictionary" (with-dict (:read-only t) (let ((word (intern (prompt-read "Word to search") #.*package*))) (format t "~A" (or (search-dict word) "Not found."))))) (defun pun (&key score-threshold) (when (and score-threshold (not (numberp score-threshold))) (error "pun: score-threshold must be number.")) (setup-dict) (dump-dict :score-threshold score-threshold)) @@ -224,7 +227,7 @@ (with-dict () (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (do-entries (e) (p "~&~A (score: ~D): " (if meaning? (entry-meaning e) (read-aloud (entry-word e))) (entry-score e)) @@ -237,13 +240,15 @@ :do (p "~A.~A " i (if meaning? (entry-word item) (entry-meaning item)))) (p " [1-~Aq]: " n-choice) (nlet itr ((query (read *query-io* nil nil))) (cond ((and (numberp query) (< 0 query (1+ n-choice))) (if (= query correct-answer) (incf (entry-ok-count e)) (incf (entry-ng-count e)))) ((and (symbolp query) (string= (symbol-name query) "Q")) (return)) (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ") (itr (read *query-io* nil nil))))))))) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*)) @@ -259,21 +264,27 @@ (mapcar #'(lambda (e) (make-entry :word (entry-word e) :meaning (entry-meaning e) :ok-count (or (ignore-errors (entry-ok-count e)) 0) :ng-count (or (ignore-errors (entry-ng-count e)) 0))) entries)) (defmacro with-dictionary-io-syntax (&body body) `(with-standard-io-syntax (let ((*readtable* (copy-readtable nil)) (*package* #.*package*) ; 単語Symbolのホームは:higeパッケージです。 (*read-eval* nil)) (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 ,@body))) (defun read-dict (file) "Read dictionary data from a file." (unless (probe-file file) (return-from read-dict NIL)) (with-open-file (in file) (with-dictionary-io-syntax (normalize-dict (loop :for word := (read in nil in) :until (eq word in) :collect word))))) (defun save-dict (&key (file *dict-file*)) "Save the dictionary data into a file." @@ -283,19 +294,21 @@ :direction :output :if-exists :supersede :if-does-not-exist :create) (with-dictionary-io-syntax (let ((*package* #.*package*)) (dolist (word (entries-of *dict*)) (print word out)))))) (defun dump-dict (&key score-threshold) "Print the dictionary in CSV format." (let ((output (format nil "~{~{~A~^,~}~%~}" (if (null score-threshold) (entries-of *dict*) ; score-thresholdが指定されない場合は全件 (delete NIL ; score-thresholdが指定された場合は絞り込む (mapcar (lambda (e) (if (<= (entry-score e) score-threshold) e NIL)) (entries-of *dict*))))))) #-ABCL (format t "~A" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) @@ -329,7 +342,6 @@ (1 #\N) (2 #\Q))) (defun prompt-read (prompt) #-ABCL (progn (p "~A: " prompt) -
Jan 18, 2010 . 1 changed file with 8 additions and 3 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -184,8 +184,6 @@ ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." (with-dict () (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "Another words to register? [yn]: ")) (return))))) @@ -267,6 +265,8 @@ (defun read-dict (file) "Read dictionary data from a file." (unless (probe-file file) (return-from read-dict NIL)) (let ((*readtable* (copy-readtable nil)) (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。 (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 @@ -277,7 +277,12 @@ (defun save-dict (&key (file *dict-file*)) "Save the dictionary data into a file." (unless (probe-file file) (ensure-directories-exist file)) (with-open-file (out file :direction :output :if-exists :supersede :if-does-not-exist :create) (with-standard-io-syntax (dolist (word (entries-of *dict*)) (print word out))))) -
Jan 18, 2010 . 1 changed file with 13 additions and 13 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -139,10 +139,6 @@ "An entry for dictionary." word meaning ok-count ng-count) (defclass dict () ((entries :accessor entries-of @@ -156,16 +152,19 @@ (defmethod print-object ((dict dict) stream) (print-unreadable-object (dict stream) (format stream "dict: entries: ~A " (length (entries-of dict))) (loop :for e :in (entries-of dict) :sum (+ (entry-ok-count e) (entry-ng-count e)) :into total :sum (+ (entry-ok-count e)) :into total-ok :sum (+ (entry-ng-count e)) :into total-ng :finally (format stream "total/ok/NG: ~A/~A/~A" total total-ok total-ng)))) (defun entry-score (entry) "Return a score of this entry." (- (entry-ok-count entry) (* (entry-ng-count entry) 3))) (defmacro with-dict ((&key (read-only nil)) &rest body) `(progn (format *debug-io* ";; setup dict") @@ -182,6 +181,7 @@ `(dolist (,entry (entries-of *dict*)) ,@body)) ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." (unless *dict-file* @@ -194,7 +194,7 @@ "Start self-study english vocabulary quiz." (with-dict () (with-entries (e) (p "~&~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e)) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again @@ -210,7 +210,7 @@ "Search the word user has input from the dictionary" (with-dict (:read-only t) (let ((word (intern (prompt-read "Word to search") :hige))) (format t "~A" (or (search-dict word) "Not found."))))) (defun pun (&key score-threshold) (if (and score-threshold @@ -227,7 +227,7 @@ (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (with-entries (e) (p "~&~A (score: ~D): " (if meaning? (entry-meaning e) (read-aloud (entry-word e))) (entry-score e)) (ready?) @@ -283,15 +283,15 @@ (defun dump-dict (&key score-threshold) "Print the dictionary in CSV format." (let ((output (format nil "~{~{~A~^,~}~%~}" (if (null score-threshold) (entries-of *dict*) ;score-thresholdが指定されない場合は全件 (remove nil ;score-thresholdが指定された場合は絞り込む (mapcar (lambda (e) (if (<= (entry-score e) score-threshold) e)) (entries-of *dict*))))))) #-ABCL (format t "~A" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) (defun sort-dict-standard (dict) @@ -327,7 +327,7 @@ (defun prompt-read (prompt) #-ABCL (progn (p "~A: " prompt) (force-output *query-io*) (read-line *query-io*)) #+ABCL (or (|showInputDialog| |javax.swing.JOptionPane| nil prompt "prompt-read" 3) "") -
Jan 18, 2010 . 1 changed file with 17 additions and 17 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -95,26 +95,26 @@ ;;quek-san's http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre #+ABCL (defmacro jimport (fqcn &optional (package *package*)) (let ((fqcn (string fqcn)) (package package)) (let ((class (java:jclass fqcn))) `(progn (defparameter ,(intern fqcn package) ,class) ,@(map 'list (lambda (method) (let ((symbol (intern (java:jmethod-name method) package)) (fn (if (java:jmember-static-p method) #'java:jstatic #'java:jcall))) `(progn (defun ,symbol (&rest args) (apply ,fn ,(symbol-name symbol) args)) (defparameter ,symbol #',symbol)))) (java:jclass-methods class)))))) #+ABCL (jimport |javax.swing.JOptionPane|) #+ABCL (defun y-or-n-p (fmt &rest args) (zerop (|showConfirmDialog| |javax.swing.JOptionPane| nil (apply #'format nil fmt args) "y-or-n-p" 0))) ;; aif macro (from "On Lisp") (defmacro aif (test-form then-form &optional else-form) -
smeghead revised this gist
Jan 18, 2010 . 1 changed file with 1 addition and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -52,7 +52,7 @@ ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 -
Jan 18, 2010 . 1 changed file with 1 addition and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -140,7 +140,7 @@ word meaning ok-count ng-count) (defun entry-score (entry) "Return a score of this entry." (- (entry-ok-count entry) (* (entry-ng-count entry) 3))) (defclass dict () -
Jan 18, 2010 . 1 changed file with 21 additions and 15 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -52,7 +52,7 @@ ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): エントリのスコアを導入した。問題の表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にscore-thresholdを追加。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -67,6 +67,7 @@ ;; (hige:pin) ; 辞書に英単語を登録 ;; (hige:pon) ; 英単語ゲームの開始 ;; (hige:pun) ; 辞書の一覧表示 ;; (hige:pun :score-threshold 10) ; 辞書の一覧表示(スコアが10以下の単語のみを表示する） ;; (hige:pan) ; 辞書から単語を検索 ;; (hige:pen) ; 英単語ゲームの開始 (三択問題) ;; (hige:pen :n-choice 5 :meaning? t) ; (五択問題で意味に対応する英単語を選ぶ) @@ -133,17 +134,14 @@ (defvar *dict* nil "The dictionary object contains the entry structures.") ;;; Data Types (defstruct (entry (:type list)) "An entry for dictionary." word meaning ok-count ng-count) (defun entry-score (entry) "エントリのスコアを返す" (- (entry-ok-count entry) (* (entry-ng-count entry) 3))) (defclass dict () ((entries @@ -196,7 +194,7 @@ "Start self-study english vocabulary quiz." (with-dict () (with-entries (e) (p "~&~A (score: ~d): " (read-aloud (entry-word e)) (entry-score e)) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again @@ -214,7 +212,12 @@ (let ((word (intern (prompt-read "Word to search") :hige))) (format t "~a" (or (search-dict word) "Not found."))))) (defun pun (&key score-threshold) (if (and score-threshold (not (numberp score-threshold))) (error "pun: score-threshold must be number.")) (setup-dict) (dump-dict :score-threshold score-threshold)) (defun pen (&key (n-choice 3) (meaning? nil)) "Start self-study english vocabulary quiz with selection. @@ -224,7 +227,7 @@ (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (with-entries (e) (p "~&~A (score: ~d): " (if meaning? (entry-meaning e) (read-aloud (entry-word e))) (entry-score e)) (ready?) @@ -278,21 +281,24 @@ (with-standard-io-syntax (dolist (word (entries-of *dict*)) (print word out))))) (defun dump-dict (&key score-threshold) "Print the dictionary in CSV format." (let ((output (format nil "~{~{~a~^,~}~%~}" (if (null score-threshold) (entries-of *dict*) ;score-thresholdが指定されない場合は全件 (remove nil ;score-thresholdが指定された場合は絞り込む (mapcar (lambda (e) (if (<= (entry-score e) score-threshold) e)) (entries-of *dict*))))))) #-ABCL (format t "~a" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) (defun sort-dict-standard (dict) "Standard sort function for ordering the quiz." (sort dict #'< :key #'(lambda (e) (entry-score e)))) (defun search-dict (word) "Search the dictionary for a word." -
Jan 17, 2010 . 1 changed file with 14 additions and 4 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -52,6 +52,7 @@ ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; 10. smeghead (http://d.hatena.ne.jp/smeghead/): エントリのスコアを導入した。問題の表示時にスコアを表示するようにした。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -132,11 +133,18 @@ (defvar *dict* nil "The dictionary object contains the entry structures.") (defparameter *score-damage* 3 "スコア計算のパラメータ。この値が大きいと、NGだった場合にスコアの下げ幅が大きくなる。") ;;; Data Types (defstruct (entry (:type list)) "An entry for dictionary." word meaning ok-count ng-count) (defun entry-score (entry) "エントリのスコアを返す" (- (entry-ok-count entry) (* (entry-ng-count entry) *score-damage*))) (defclass dict () ((entries :accessor entries-of @@ -188,7 +196,7 @@ "Start self-study english vocabulary quiz." (with-dict () (with-entries (e) (p "~&~A [score: ~d]: " (read-aloud (entry-word e)) (entry-score e)) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again @@ -216,7 +224,9 @@ (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (with-entries (e) (p "~&~A [score: ~d]: " (if meaning? (entry-meaning e) (read-aloud (entry-word e))) (entry-score e)) (ready?) (let* ((choices-list (choices e (entries-of *dict*) :n-choice n-choice)) (correct-answer (1+ (position e choices-list)))) @@ -280,9 +290,9 @@ (defun sort-dict-standard (dict) "Standard sort function for ordering the quiz." (sort dict #'< :key #'(lambda (e) (entry-score e)))) (defun search-dict (word) "Search the dictionary for a word." -
cranebird revised this gist
Jan 17, 2010 . 1 changed file with 134 additions and 97 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -51,6 +51,7 @@ ;; 6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。 ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; 9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。 ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -86,7 +87,7 @@ #:pon #:pun #:pan #:pen)) (in-package :hige) @@ -127,113 +128,149 @@ ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) "Path object for the dictionary file.") (defvar *dict* nil "The dictionary object contains the entry structures.") ;;; Data Types (defstruct (entry (:type list)) "An entry for dictionary." word meaning ok-count ng-count) (defclass dict () ((entries :accessor entries-of :initform nil :initarg :entries :documentation "Entries")) (:documentation "Container class")) (defun make-dict (entries) (make-instance 'dict :entries entries)) (defmethod print-object ((dict dict) stream) (print-unreadable-object (dict stream) (format stream "dict: entries: ~a " (length (entries-of dict))) (loop :for e :in (entries-of dict) :sum (+ (entry-ok-count e) (entry-ng-count e)) :into total :sum (+ (entry-ok-count e)) :into total-ok :sum (+ (entry-ng-count e)) :into total-ng :finally (format stream "total/ok/ng: ~a/~a/~a" total total-ok total-ng)))) ;;; Top-Level Functions (defmacro with-dict ((&key (read-only nil)) &rest body) `(progn (format *debug-io* ";; setup dict") (setup-dict) (format *debug-io* "...done~%") ,@body (unless ,read-only (format *debug-io* ";; saving dict...") (save-dict) (format *debug-io* "done~%")) *dict*)) (defmacro with-entries ((entry) &rest body) `(dolist (,entry (entries-of *dict*)) ,@body)) (defun pin () "Register new entries to the dictionary." (unless *dict-file* (ensure-directories-exist *dict-file*)) (with-dict () (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "Another words to register? [yn]: ")) (return))))) (defun pon () "Start self-study english vocabulary quiz." (with-dict () (with-entries (e) (p "~&~A : " (read-aloud (entry-word e))) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) (otherwise (p "~&Please type Y for yes or N for no or Q for quit.~%[Ynq]: ") (go :again)))))) (defun pan () "Search the word user has input from the dictionary" (with-dict (:read-only t) (let ((word (intern (prompt-read "Word to search") :hige))) (format t "~a" (or (search-dict word) "Not found."))))) ;; pun defined as an alias for dump-dict function (see Auxiliary Functions) (defun pen (&key (n-choice 3) (meaning? nil)) "Start self-study english vocabulary quiz with selection. n-choice is number of choices. If meaning? is not nil, you sellect a word corresponding posed meanings." (with-dict () (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (with-entries (e) (p "~&~A : " (if meaning? (entry-meaning e) (read-aloud (entry-word e)))) (ready?) (let* ((choices-list (choices e (entries-of *dict*) :n-choice n-choice)) (correct-answer (1+ (position e choices-list)))) (loop ; プロンプト :for item :in choices-list :for i :from 1 :to n-choice :do (p "~A.~A " i (if meaning? (entry-word item) (entry-meaning item)))) (p " [1-~Aq]: " n-choice) (nlet itr ((query (read *query-io* nil nil))) (cond ((and (numberp query) (> query 0) (> (1+ n-choice) query)) (if (= query correct-answer) (incf (entry-ok-count e)) (incf (entry-ng-count e)))) ((and (symbolp query) (string= (symbol-name query) "Q")) (return)) (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ") (itr (read *query-io* nil nil))))))))) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*)) "Setup a dictionary for quiz; maybe read data from a file and apply fn to the dictionary." (unless *dict* (setf *dict* (make-dict (read-dict file)))) (setf (entries-of *dict*) (funcall fn (entries-of *dict*))) *dict*) (defun normalize-dict (entries) "Complement entries of a dictionary if one has missing slots." (mapcar #'(lambda (e) (make-entry :word (entry-word e) :meaning (entry-meaning e) :ok-count (or (entry-ok-count e) 0) :ng-count (or (entry-ng-count e) 0))) entries)) (defun read-dict (file) "Read dictionary data from a file." (let ((*readtable* (copy-readtable nil)) (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。 (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 (with-open-file (in file) (normalize-dict (loop :for word := (read in nil in) :until (eq word in) :collect word))))) (defun save-dict (&key (file *dict-file*)) "Save the dictionary data into a file." (with-open-file (out file :direction :output :if-exists :supersede) (with-standard-io-syntax (dolist (word (entries-of *dict*)) (print word out))))) (defun dump-dict () "Print the dictionary in CSV format." (let ((output (format nil "~{~{~a~^,~}~%~}" (entries-of *dict*)))) #-ABCL (format t "~a" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) @@ -244,14 +281,14 @@ "Standard sort function for ordering the quiz." (sort dict #'> :key #'(lambda (e) (- (entry-ng-count e) (entry-ok-count e))))) (defun search-dict (word) "Search the dictionary for a word." (aif (assoc word (entries-of *dict*)) (entry-meaning it) NIL)) ;;; Auxiliary Functions for the User Interface (defun p (&rest args) @@ -262,26 +299,26 @@ (read-line *query-io*)) (defun query #+ABCL (&optional message) #-ABCL () #-ABCL (let ((input (read-line *query-io*))) (if (= 0 (length input)) #\Y (elt input 0))) #+ABCL (case (|showConfirmDialog| |javax.swing.JOptionPane| nil message "query" 1) (0 #\Y) (1 #\N) (2 #\Q))) (defun prompt-read (prompt) #-ABCL (progn (p "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) #+ABCL (or (|showInputDialog| |javax.swing.JOptionPane| nil prompt "prompt-read" 3) "") ) (defun add-entry (entry) (push entry (entries-of *dict*))) (defun prompt-for-entry () (make-entry @@ -296,36 +333,36 @@ #+SBCL (sb-ext:run-program "/usr/bin/say" `(,(symbol-name word)) :wait t) word) (defun nthcar (n list) "Performs the car function n times on a list." (nlet itr ((n n) (list list) (product '())) (if (or (zerop n) (null list)) (nreverse product) (itr (1- n) (cdr list) (cons (car list) product))))) (defun insert (element n list) "Insert element to position n of list" (append (nthcar n list) (list element) (nthcdr n list))) (defun random-pickup (n m) "Pickup m elements from list randomly without overlapping." (if (> m n) (error "m is needed to be n and fewer.") (nlet itr ((m m) (product '())) (if (= m 0) product (let ((rand (random n))) (if (member rand product) (itr m product) (itr (1- m) (cons rand product)))))))) (defun random-pickup-list (m list) "Pickup m elements from list randomly without overlapping." (let ((positions (random-pickup (length list) m))) (mapcar (lambda (p) (nth p list)) positions))) (defun choices (entry dict &key (n-choice 3)) "Make choices list which contains entry and it's length is n-choice" (let ((dict-leaved-out (remove entry dict))) (insert entry (random n-choice) (random-pickup-list (1- n-choice) dict-leaved-out)))) -
masatoi revised this gist
Jan 16, 2010 . 1 changed file with 78 additions and 7 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -50,7 +50,8 @@ ;; 5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。 ;; 6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。 ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; 8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり． ;; ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 ;; ================================================================================================================================================= @@ -61,10 +62,13 @@ ;; ;; ■動作方法 ;; ANSI Common Lisp で動作します。 ;; (hige:pin) ; 辞書に英単語を登録 ;; (hige:pon) ; 英単語ゲームの開始 ;; (hige:pun) ; 辞書の一覧表示 ;; (hige:pan) ; 辞書から単語を検索 ;; (hige:pen) ; 英単語ゲームの開始 (三択問題) ;; (hige:pen :n-choice 5 :meaning? t) ; (五択問題で意味に対応する英単語を選ぶ) ;; ;; オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。 ;; ※R6RS Schemeで書かれたオリジナル版 ;; http://gist.github.com/273431 @@ -81,7 +85,8 @@ (:export #:pin #:pon #:pun #:pan #:pen)) (in-package :hige) @@ -113,6 +118,12 @@ `(let ((it ,test-form)) (if it ,then-form ,else-form))) ;; named-let macro (from "Let Over Lambda") (defmacro nlet (tag var-vals &body body) `(labels ((,tag ,(mapcar #'car var-vals) ,@body)) (declare (optimize (speed 3))) ; for tail recursion optimization (,tag ,@(mapcar #'cadr var-vals)))) ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) "Path object for the dictionary file.") @@ -143,7 +154,7 @@ (p "~&~A : " (read-aloud (entry-word e))) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) @@ -156,11 +167,37 @@ (defun pan () "Search the word user has input from the dictionary" (setup-dict) (let ((word (intern (prompt-read "Word to search") :hige))) (format t "~a" (or (search-dict word) "Not found.")))) ;; pun defined as an alias for dump-dict function (see Auxiliary Functions) (defun pen (&key (n-choice 3) (meaning? nil)) "Start self-study english vocabulary quiz with selection. n-choice is number of choices. If meaning? is not nil, you sellect a word corresponding posed meanings." (setup-dict) (if (> n-choice (length *dict*)) ; 辞書の長さチェック (error "Dictionary size is too small .~%")) (dolist (e *dict*) (p "~&~A : " (if meaning? (entry-meaning e) (read-aloud (entry-word e)))) (ready?) (let* ((choices-list (choices e *dict* :n-choice n-choice)) (correct-answer (1+ (position e choices-list)))) (loop ; プロンプト for item in choices-list for i from 1 to n-choice do (p "~A.~A " i (if meaning? (entry-word item) (entry-meaning item)))) (p " [1-~Aq]: " n-choice) (nlet itr ((query (read *query-io* nil nil))) (cond ((and (numberp query) (> query 0) (> (1+ n-choice) query)) (if (= query correct-answer) (incf (entry-ok-count e)) (incf (entry-ng-count e)))) ((and (symbolp query) (string= (symbol-name query) "Q")) (return)) (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ") (itr (read *query-io* nil nil))))) (save-dict)))) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*)) @@ -175,7 +212,7 @@ (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。 (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 (with-open-file (in file) (normalize-dict (loop :for word := (read in nil in) :until (eq word in) :collect word))))) @@ -185,7 +222,7 @@ (with-standard-io-syntax (dolist (word *dict*) (print word out))))) (defun normalize-dict (dict) "Complement entries of a dictionary if one has missing slots." (mapcar #'(lambda (e) (make-entry :word (entry-word e) @@ -258,3 +295,37 @@ "Read aloud the given word and return it." #+SBCL (sb-ext:run-program "/usr/bin/say" `(,(symbol-name word)) :wait t) word) (defun choices (entry dict &key (n-choice 3)) "Make choices list which contains entry and it's length is n-choice" (let ((dict-leaved-out (remove entry dict))) (insert entry (random n-choice) (random-pickup-list (1- n-choice) dict-leaved-out)))) (defun nthcar (n list) "Performs the car function n times on a list." (nlet itr ((n n) (list list) (product '())) (if (or (zerop n) (null list)) (nreverse product) (itr (1- n) (cdr list) (cons (car list) product))))) (defun insert (element n list) "Insert element to position n of list" (append (nthcar n list) (list element) (nthcdr n list))) (defun random-pickup (n m) "Pickup m elements from list randomly without overlapping." (if (> m n) (error "m is needed to be n and fewer.") (nlet itr ((m m) (product '())) (if (= m 0) product (let ((rand (random n))) (if (member rand product) (itr m product) (itr (1- m) (cons rand product)))))))) (defun random-pickup-list (m list) "Pickup m elements from list randomly without overlapping." (let ((positions (random-pick (length list) m))) (mapcar (lambda (p) (nth p list)) positions))) -
naoyat revised this gist
Jan 14, 2010 . 1 changed file with 15 additions and 15 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -111,7 +111,7 @@ ;; aif macro (from "On Lisp") (defmacro aif (test-form then-form &optional else-form) `(let ((it ,test-form)) (if it ,then-form ,else-form))) ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) @@ -140,24 +140,24 @@ "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) (p "~&~A : " (read-aloud (entry-word e))) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) (otherwise (p "~&Please type Y for yes or N for no or Q for quit.~%[Ynq]: ") (go :again)))) (save-dict)) (defun pan () "Search the word user has input from the dictionary" (setup-dict) (let ((word (intern (prompt-read "Word to search")))) (format t "~a" (or (search-dict word) "Not found.")))) ;; pun defined as an alias for dump-dict function (see Auxiliary Functions) @@ -196,8 +196,8 @@ (defun dump-dict () "Print the dictionary in CSV format." (let ((output (format nil "~{~{~a~^,~}~%~}" *dict*))) #-ABCL (format t "~a" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) (setf (symbol-function 'pun) @@ -227,17 +227,17 @@ (defun query #+ABCL (&optional message) #-ABCL () #-ABCL (let ((input (read-line *query-io*))) (if (= 0 (length input)) #\Y (elt input 0))) #+ABCL (case (|showConfirmDialog| |javax.swing.JOptionPane| nil message "query" 1) (0 #\Y) (1 #\N) (2 #\Q))) (defun prompt-read (prompt) #-ABCL (progn (p "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) #+ABCL (or (|showInputDialog| |javax.swing.JOptionPane| nil prompt "prompt-read" 3) "") -
Jan 14, 2010 . 1 changed file with 1 addition and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -49,7 +49,7 @@ ;; 4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。 ;; 5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。 ;; 6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。 ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 -
Jan 14, 2010 . 1 changed file with 34 additions and 16 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -49,6 +49,7 @@ ;; 4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。 ;; 5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。 ;; 6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。 ;; 7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書ファイルからの単語検索 (hige:pan) を実装。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -63,6 +64,7 @@ ;; (hige:pin) ; 英単語入力の開始 ;; (hige:pon) ; 英単語ゲームの開始 ;; (hige:pun) ; 辞書の一覧表示 ;; (hige:pan) ; 辞書から単語を検索 ;; オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。 ;; ※R6RS Schemeで書かれたオリジナル版 ;; http://gist.github.com/273431 @@ -78,7 +80,8 @@ #+ABCL (:shadow :y-or-n-p) (:export #:pin #:pon #:pun #:pan)) (in-package :hige) @@ -105,6 +108,11 @@ #+ABCL (defun y-or-n-p (fmt &rest args) (zerop (|showConfirmDialog| |javax.swing.JOptionPane| nil (apply #'format nil fmt args) "y-or-n-p" 0))) ;; aif macro (from "On Lisp") (defmacro aif (test-form then-form &optional else-form) `(let ((it ,test-form)) (if it ,then-form ,else-form))) ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) "Path object for the dictionary file.") @@ -132,19 +140,25 @@ "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) (p "‾&‾A : " (read-aloud (entry-word e))) (ready?) #-ABCL (p "‾&‾A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) ((#¥Y #¥y) (incf (entry-ok-count e))) ((#¥N #¥n) (incf (entry-ng-count e))) ((#¥Q #¥q) (return)) (otherwise (p "‾&Please type Y for yes or N for no or Q for quit.‾%[Ynq]: ") (go :again)))) (save-dict)) (defun pan () "Search the word user has input from the dictionary" (setup-dict) (let ((word (intern (prompt-read "Word to search")))) (format t "‾a" (or (search-dict word) "Not found.")))) ;; pun defined as an alias for dump-dict function (see Auxiliary Functions) @@ -169,8 +183,7 @@ "Save the dictionary data into a file." (with-open-file (out file :direction :output :if-exists :supersede) (with-standard-io-syntax (dolist (word *dict*) (print word out))))) (defun nomalize-dict (dict) "Complement entries of a dictionary if one has missing slots." @@ -183,8 +196,8 @@ (defun dump-dict () "Print the dictionary in CSV format." (let ((output (format nil "‾{‾{‾a‾^,‾}‾%‾}" *dict*))) #-ABCL (format t "‾a" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) (setf (symbol-function 'pun) @@ -197,6 +210,11 @@ :key #'(lambda (e) (- (entry-ng-count e) (entry-ok-count e))))) (defun search-dict (word) "Search the dictionary for a word." (aif (assoc word *dict*) (entry-meaning it) NIL)) ;;; Auxiliary Functions for the User Interface (defun p (&rest args) @@ -209,17 +227,17 @@ (defun query #+ABCL (&optional message) #-ABCL () #-ABCL (let ((input (read-line *query-io*))) (if (= 0 (length input)) #¥Y (elt input 0))) #+ABCL (case (|showConfirmDialog| |javax.swing.JOptionPane| nil message "query" 1) (0 #¥Y) (1 #¥N) (2 #¥Q))) (defun prompt-read (prompt) #-ABCL (progn (p "‾a: " prompt) (force-output *query-io*) (read-line *query-io*)) #+ABCL (or (|showInputDialog| |javax.swing.JOptionPane| nil prompt "prompt-read" 3) "") -
Tatsuya BIZENN revised this gist
Jan 14, 2010 . 1 changed file with 7 additions and 1 deletion.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -48,6 +48,7 @@ ;; 3. aka (http://aka-cs-blog.blogspot.com/): さらにCL臭く。足回りの整備を実施。REPL上での使い勝手を強化。副作用って何？という感じの仕立て。 ;; 4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。 ;; 5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。 ;; 6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -131,7 +132,7 @@ "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) (p "~&~A : " (read-aloud (entry-word e))) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again @@ -234,3 +235,8 @@ :meaning (prompt-read "Meaning") :ok-count 0 :ng-count 0)) (defun read-aloud (word) "Read aloud the given word and return it." #+SBCL (sb-ext:run-program "/usr/bin/say" `(,(symbol-name word)) :wait t) word) -
Jan 12, 2010 . 1 changed file with 7 additions and 8 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -131,13 +131,11 @@ "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) (p "~&~A : " (entry-word e)) (ready?) #-ABCL (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query #+ABCL (entry-meaning e)) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) @@ -184,8 +182,9 @@ (defun dump-dict () "Print the dictionary in CSV format." (let ((output (format nil "~{~{~a~^,~}~%~}" *dict*))) #-ABCL (format t "~a" output) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output))) (setf (symbol-function 'pun) (symbol-function 'dump-dict)) -
Jan 11, 2010 . 1 changed file with 53 additions and 17 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -47,6 +47,7 @@ ;; 2. g000001 (http://cadr.g.hatena.ne.jp/g000001/): CLに翻訳してみましたが、higeponさんのコードとは考え方が結構違うものになってしまいました! ;; 3. aka (http://aka-cs-blog.blogspot.com/): さらにCL臭く。足回りの整備を実施。REPL上での使い勝手を強化。副作用って何？という感じの仕立て。 ;; 4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。 ;; 5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -73,12 +74,35 @@ (defpackage :hige (:use :cl) #+ABCL (:shadow :y-or-n-p) (:export #:pin #:pon #:pun)) (in-package :hige) ;;quek-san's http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre #+ABCL (defmacro jimport (fqcn &optional (package *package*)) (let ((fqcn (string fqcn)) (package package)) (let ((class (java:jclass fqcn))) `(progn (defparameter ,(intern fqcn package) ,class) ,@(map 'list (lambda (method) (let ((symbol (intern (java:jmethod-name method) package)) (fn (if (java:jmember-static-p method) #'java:jstatic #'java:jcall))) `(progn (defun ,symbol (&rest args) (apply ,fn ,(symbol-name symbol) args)) (defparameter ,symbol #',symbol)))) (java:jclass-methods class)))))) #+ABCL (jimport |javax.swing.JOptionPane|) #+ABCL (defun y-or-n-p (fmt &rest args) (zerop (|showConfirmDialog| |javax.swing.JOptionPane| nil (apply #'format nil fmt args) "y-or-n-p" 0))) ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) @@ -100,18 +124,20 @@ (setup-dict) (ensure-directories-exist *dict-file*)) (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "Another words to register? [yn]: ")) (return))) (save-dict)) (defun pon () "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) #-ABCL (progn (p "~&~A : " (entry-word e)) (ready?) (p "~&~A [Ynq]: " (entry-meaning e))) #+ABCL (p "~A" (entry-word e)) :again (case (query #+ABCL (format nil "~A" (entry-meaning e))) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) @@ -158,7 +184,8 @@ (defun dump-dict () "Print the dictionary in CSV format." #-ABCL (format t "~{~{~a~^,~}~%~}" *dict*) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil (format nil "~{~{~a~^,~}~%~}" *dict*))) (setf (symbol-function 'pun) (symbol-function 'dump-dict)) @@ -173,29 +200,38 @@ ;;; Auxiliary Functions for the User Interface (defun p (&rest args) #-ABCL (apply #'format *query-io* args) #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil (apply #'format nil args))) (defun ready? () (read-line *query-io*)) (defun query #+ABCL (&optional message) #-ABCL () #-ABCL (let ((input (read-line *query-io*))) (if (= 0 (length input)) #\Y (elt input 0))) #+ABCL (case (|showConfirmDialog| |javax.swing.JOptionPane| nil message "query" 1) (0 #\Y) (1 #\N) (2 #\Q))) (defun prompt-read (prompt) #-ABCL (progn (p "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) #+ABCL (or (|showInputDialog| |javax.swing.JOptionPane| nil prompt "prompt-read" 3) "") ) (defun add-entry (entry) (push entry *dict*)) (defun prompt-for-entry () (make-entry :word (intern (prompt-read "Word") #.*package*) ; 単語Symbolの登録先は:higeパッケージです。 :meaning (prompt-read "Meaning") :ok-count 0 :ng-count 0)) -
quek revised this gist
Jan 11, 2010 . 1 changed file with 5 additions and 2 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -46,6 +46,7 @@ ;; 1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？ ;; 2. g000001 (http://cadr.g.hatena.ne.jp/g000001/): CLに翻訳してみましたが、higeponさんのコードとは考え方が結構違うものになってしまいました! ;; 3. aka (http://aka-cs-blog.blogspot.com/): さらにCL臭く。足回りの整備を実施。REPL上での使い勝手を強化。副作用って何？という感じの仕立て。 ;; 4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -80,7 +81,7 @@ ;;; Special Variables (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname)) "Path object for the dictionary file.") (defvar *dict* nil "The dictionary. a list of the entry structures.") @@ -95,7 +96,9 @@ ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." (if (probe-file *dict-file*) (setup-dict) (ensure-directories-exist *dict-file*)) (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "もうひとつ？ [yn]: ")) (return))) (save-dict)) -
akacs revised this gist
Jan 11, 2010 . 1 changed file with 3 additions and 2 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -83,7 +83,7 @@ (defvar *dict-file* #P"~/.hige/words.txt" "Path object for the dictionary file.") (defvar *dict* nil "The dictionary. a list of the entry structures.") ;;; Data Types @@ -94,6 +94,7 @@ ;;; Top-Level Functions (defun pin () "Register new entries to the dictionary." (setup-dict) (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "もうひとつ？ [yn]: ")) (return))) @@ -112,7 +113,7 @@ ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) (otherwise (p "~&Please type Y for yes or N for no or Q for quit.~%[Ynq]: ") (go :again)))) (save-dict)) -
Jan 11, 2010 . 1 changed file with 116 additions and 45 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,4 +1,6 @@ ;; -*- Mode: Lisp; Syntax: Common-Lisp -*- ;; ;; 第1回 Scheme コードバトン (CL fork) ;; ;; ■ これは何か？ ;; 「Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。」のCL版です。 @@ -43,6 +45,7 @@ ;; 名前(URL)：一言 ;; 1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？ ;; 2. g000001 (http://cadr.g.hatena.ne.jp/g000001/): CLに翻訳してみましたが、higeponさんのコードとは考え方が結構違うものになってしまいました! ;; 3. aka (http://aka-cs-blog.blogspot.com/): さらにCL臭く。足回りの整備を実施。REPL上での使い勝手を強化。副作用って何？という感じの仕立て。 ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 @@ -54,73 +57,141 @@ ;; ;; ■動作方法 ;; ANSI Common Lisp で動作します。 ;; (hige:pin) ; 英単語入力の開始 ;; (hige:pon) ; 英単語ゲームの開始 ;; (hige:pun) ; 辞書の一覧表示 ;; オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。 ;; ※R6RS Schemeで書かれたオリジナル版 ;; http://gist.github.com/273431 ;; ;; ■辞書ファイルの例 ;; http://gist.github.com/273424 ;;; Package Management (in-package :cl-user) (defpackage :hige (:use :cl) (:export #:pin #:pon #:pun)) (in-package :hige) ;;; Special Variables (defvar *dict-file* #P"~/.hige/words.txt" "Path object for the dictionary file.") (defvar *dict* nil "The dictionary. a list of entry structures.") ;;; Data Types (defstruct (entry (:type list)) "An entry for dictionary." word meaning ok-count ng-count) ;;; Top-Level Functions (defun pin () (setup-dict) (loop (add-entry (prompt-for-entry)) (if (not (y-or-n-p "もうひとつ？ [yn]: ")) (return))) (save-dict)) (defun pon () "Start self-study english vocabulary quiz." (setup-dict) (dolist (e *dict*) (p "~&~A : " (entry-word e)) (ready?) (p "~&~A [Ynq]: " (entry-meaning e)) :again (case (query) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) (otherwise (pr "~&Please type Y for yes or N for no or Q for quit.~%[Ynq]: ") (go :again)))) (save-dict)) ;; pun defined as an alias for dump-dict function (see Auxiliary Functions) ;;; Auxiliary Functions (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*)) "Setup a dictionary for quiz; maybe read data from a file and apply fn to the dictionary." (setf *dict* (funcall fn (if *dict* *dict* (read-dict file))))) ; introduce aif if you prefer. ;) (defun read-dict (file) "Read dictionary data from a file." (let ((*readtable* (copy-readtable nil)) (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。 (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。 (with-open-file (in file) (nomalize-dict (loop :for word := (read in nil in) :until (eq word in) :collect word))))) (defun save-dict (&key (file *dict-file*)) "Save the dictionary data into a file." (with-open-file (out file :direction :output :if-exists :supersede) (with-standard-io-syntax (loop :for word :in *dict* :do (print word out))))) (defun nomalize-dict (dict) "Complement entries of a dictionary if one has missing slots." (mapcar #'(lambda (e) (make-entry :word (entry-word e) :meaning (entry-meaning e) :ok-count (or (entry-ok-count e) 0) :ng-count (or (entry-ng-count e) 0))) dict)) (defun dump-dict () "Print the dictionary in CSV format." (format t "~{~{~a~^,~}~%~}" *dict*)) (setf (symbol-function 'pun) (symbol-function 'dump-dict)) (defun sort-dict-standard (dict) "Standard sort function for ordering the quiz." (sort dict #'> :key #'(lambda (e) (- (entry-ng-count e) (entry-ok-count e))))) ;;; Auxiliary Functions for the User Interface (defun p (&rest args) (apply #'format *query-io* args)) (defun ready? () (read-line *query-io*)) (defun query () (let ((input (read-line *query-io*))) (if (= 0 (length input)) #\Y (elt input 0)))) (defun prompt-read (prompt) (p "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) (defun add-entry (entry) (push entry *dict*)) (defun prompt-for-entry () (make-entry :word (intern (prompt-read "英単語") #.*package*) ; 単語Symbolの登録先は:higeパッケージです。 :meaning (prompt-read "意味") :ok-count 0 :ng-count 0)) -
g000001 revised this gist
Jan 10, 2010 . 1 changed file with 1 addition and 0 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -42,6 +42,7 @@ ;; ■ バトンの行方を記録 ;; 名前(URL)：一言 ;; 1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？ ;; 2. g000001 (http://cadr.g.hatena.ne.jp/g000001/): CLに翻訳してみましたが、higeponさんのコードとは考え方が結構違うものになってしまいました! ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 -
Jan 10, 2010 . 1 changed file with 5 additions and 2 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -71,7 +71,9 @@ (defun read-dict (file) (with-open-file (in file) (nomalize-dict (loop :for word := (read in nil in) :until (eq word in) :collect word)))) (defun nomalize-dict (dict) (mapcar (lambda (e) @@ -84,7 +86,8 @@ (defun write-dict (file data) (with-open-file (out file :direction :output :if-exists :supersede) (with-standard-io-syntax (loop :for word :in data :do (print word out))))) (defun sort-word-spec* (word-spec*) (sort word-spec* -
Jan 10, 2010 . 1 changed file with 62 additions and 68 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,7 +1,7 @@ ;; 第1回 Scheme コードバトン ;; ;; ■ これは何か？ ;; 「Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。」のCL版です。 ;; 次回 Shibuya.lisp で成果を発表します。 ;; Scheme 初心者のコードを書くきっかけに、中級者には他人のコードを読む機会になればと思います。 ;; @@ -48,81 +48,75 @@ ;; ================================================================================================================================================= ;; ■英単語暗記補助ツールです ;; 起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。改行を入力すると答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。 ;; 間違った単語は辞書ファイルに記録され次回出題されます。 ;; ;; ■動作方法 ;; ANSI Common Lisp で動作します。 ;; (main "辞書ファイル") ;; オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。 ;; ※R6RS Schemeで書かれたオリジナル版 ;; http://gist.github.com/273431 ;; ;; ■辞書ファイルの例 ;; http://gist.github.com/273424 (defpackage :hige (:use :cl)) (in-package :hige) (defstruct (entry (:type list)) word meaning ok-count ng-count) (defun read-dict (file) (with-open-file (in file) (nomalize-dict (read in)))) (defun nomalize-dict (dict) (mapcar (lambda (e) (make-entry :word (entry-word e) :meaning (entry-meaning e) :ok-count (or (entry-ok-count e) 0) :ng-count (or (entry-ng-count e) 0))) dict)) (defun write-dict (file data) (with-open-file (out file :direction :output :if-exists :supersede) (with-standard-io-syntax (print data out)))) (defun sort-word-spec* (word-spec*) (sort word-spec* #'> :key (lambda (e) (- (entry-ng-count e) (entry-ok-count e))))) (defun query () (prog2 ;1年に1度も遭遇するかしないかのprog2が使いたい状況 (clear-input *query-io*) (read-char *query-io*) (clear-input *query-io*))) (defun pr (&rest args) (apply #'format *query-io* args)) (defun ready? () (read-char *query-io*)) ;; main (defun main (file) (let ((dict (sort-word-spec* (read-dict file)))) (dolist (e dict) (pr "~&~A: " (entry-word e)) (ready?) (pr "~&~A y/n? " (entry-meaning e)) :again (case (query) ((#\Y #\y) (incf (entry-ok-count e))) ((#\N #\n) (incf (entry-ng-count e))) ((#\Q #\q) (return)) (otherwise (pr "~&Please type Y for yes or N for no or Q for quit.~%") (go :again)))) (write-dict file dict))) -
higepon revised this gist
Jan 10, 2010 . 1 changed file with 4 additions and 0 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -35,6 +35,10 @@ ;; (c) 次の人がコードを止めてしまいました ;; 残念ですが別の人にバトンを渡してください。 ;; ;; (d) Mosh で動かないとダメですか？ ;; いいえ。Scheme なら何でも良いです。Gauche, Ypsilon 用に書き換えるのも面白いですね。 ;; そのときは起動方法の説明も変えてください。 ;; ;; ■ バトンの行方を記録 ;; 名前(URL)：一言 ;; 1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？ -
Jan 10, 2010 . 1 changed file with 13 additions and 8 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -1,33 +1,38 @@ ;; 第1回 Scheme コードバトン ;; ;; ■ これは何か？ ;; Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。 ;; 次回 Shibuya.lisp で成果を発表します。 ;; Scheme 初心者のコードを書くきっかけに、中級者には他人のコードを読む機会になればと思います。 ;; ;; ■ 2 つのルール ;; ;; (1)自分がこれだと思える変更をコードに加えて2日以内に次の人にまわしてください。 ;; 「人に優しい」変更なら何でも良い。1文字の変更でも可。 ;; 「人に優しい」とは例えば、次の人が読みやすいコードを書くなど。 ;; コードを削るのもあり。 ;; ;; (2)次の人にまわしコードが変更されるのを"見守る"。 ;; この説明書きを含めてバトンが伝わった事を必ず確認してください。 ;; 止まっていたら助けてあげてください。 ;; ;; ■ バトンの回し方 ;; ;; (1) 回ってきたバトンは http://gist.github.com/xxxx という URL のはずです。 ;; (2) fork をクリックしてください（アカウントを持っていない人はこのとき作成します） ;; (3) edit で変更したファイルを貼り付けます。 ;; (4) 自分が fork した新しい URL を回してください ;; ;; ;; ■ 良くある質問 ;; ;; (a) 初心者です。参加したいけどちょっと不安です。 ;; higepon がフォローしますので大丈夫です。分からない事があれば遠慮無く聞いてください。 ;; ;; (b) 次にまわす人がいません ;; higepon に知らせてください。twitter, 日記のコメントなどで。 ;; ;; (c) 次の人がコードを止めてしまいました ;; 残念ですが別の人にバトンを渡してください。 ;; ;; ■ バトンの行方を記録 -
Jan 10, 2010 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,119 @@ ;; 第1回 Scheme コードバトン ;; ;; ■ これは何か？ ;; Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。次回 Shibuya.lisp で成果を発表します。 ;; Scheme 初心者のコードを書くきっかけに、中級者には他人のコードを読む機会になればと思います。 ;; ;; ■ 2 つのルール ;; ;; (1)自分がこれだと思える変更をコードに加えて2日以内に次の人にまわしてください。「人に優しい」変更なら何でも良い。1文字の変更でも可。 ;; 「人に優しい」とは例えば、次の人が読みやすいコードを書くなど。 ;; コードを削るのもあり。 ;; ;; (2)次の人にまわしコードが変更されるのを"見守る"。 ;; この説明書きを含めてバトンが伝わった事を必ず確認してください。 ;; 止まっていたら助けてあげてください。 ;; ;; ;; ■ 良くある質問 ;; ;; (a) 初心者です。参加したいけどちょっと不安です。 ;; higepon がフォローしますので大丈夫です。分からない事があれば遠慮無く聞いてください。 ;; ;; (b) 次の人にどうやってコードをまわせばよいですか？ ;; Web 上で見られる物ならば何でも構いません。 ;; ブログなどを持っていない人は http://gist.github.com/ など。 ;; ;; (c) 次にまわす人がいません ;; higepon に知らせてください。twitter, 日記のコメントなどで。 ;; ;; (d)次の人がコードを止めてしまいました ;; 残念ですが別の人にバトンを渡してください。 ;; ;; ■ バトンの行方を記録 ;; 名前(URL)：一言 ;; 1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？ ;; ================================================================================================================================================= ;; これより下がコードとその説明 - 変更・削除歓迎 ;; ================================================================================================================================================= ;; ■英単語暗記補助ツールです ;; 起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。Ctrl-D を押すと答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。 ;; 間違った単語は辞書ファイルに記録され次回出題されます。 ;; ;; ■動作方法 ;; Mosh (0.2.0) で動作します。(http://code.google.com/p/mosh-scheme/downloads/list) ;; % mosh scheme_button.scm 辞書ファイル ;; ;; ■辞書ファイルの例 ;; http://gist.github.com/273424 (import (rnrs) (mosh control) (mosh) (match) (srfi :8) (only (srfi :1) first second)) ;; ファイルを読んで S 式のリストにする (define (file->sexp-list file) (with-input-from-file file (lambda () (let loop ([line (read)] [ret '()]) (cond [(eof-object? line) (reverse ret)] [else (loop (read) (cons line ret))]))))) ;; 辞書ファイルをパース (define (sort-word-spec* word-spec*) (list-sort ;; 間違いが多い順にソート (lambda x (match x [((_a _b ok-count1 ng-count1) (_c _d ok-count2 ng-count2)) (> (- ng-count1 ok-count1) (- ng-count2 ok-count2))])) ;; 辞書形式は (word meaning) または (word meaning ok-count ng-count) (map (lambda (word-spec*) (match word-spec* [(word meaning) (list word meaning 0 0)] [(word meaning ok-count ng-count) (list word meaning ok-count ng-count)])) word-spec*))) (define (main args) (let1 result* (call/cc (lambda (break) (let loop ([word-spec* (sort-word-spec* (file->sexp-list (second args)))] [result-spec* '()]) (match word-spec* [() result-spec*] [((word meaning ok-count ng-count) . more) ;; 問題出題 (format #t "~s: " word) ;; Ctrl-D 待ち (read (current-input-port)) ;; 答え表示 (format #t "~s y/n? " meaning) (case (read-char (current-input-port)) ;; Y だったら [(#\y #\Y) (loop more (cons (list word meaning (+ ok-count 1) ng-count) result-spec* ))] ;; N だったら [(#\N #\n) (loop more (cons (list word meaning ok-count (+ ng-count 1)) result-spec*))] ;; Q だったら途中でやめるので成績を記録 [(#\q #\Q) (break (append (reverse result-spec*) word-spec*))])])])) ;; 正答と誤答を記録 (call-with-port (open-file-output-port (second args) (make-file-options '(no-fail)) 'block (native-transcoder)) (lambda (p) (for-each (lambda (x) (write x p) (newline p)) result*))))) (main (command-line))
Tatsuya BIZENN
revised
this gist