Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-01-09

Shibuya.lisp に向けて Scheme コードバトンするのはどうか?

| 19:33 | Shibuya.lisp に向けて Scheme コードバトンするのはどうか? - わだばLisperになる を含むブックマーク はてなブックマーク - Shibuya.lisp に向けて Scheme コードバトンするのはどうか? - わだばLisperになる

higeponさんが、Shibuya.lisp に向けて Scheme コードバトンするのはどうか?とのことだったので、R6RS SchemeをCLに適当翻訳。

もとのコードに少し機能拡張を加えていながら、gotoや&auxを使っていたりして下品な風味に仕上げました。

やる気のある方は、是非、綺麗に書き直してみて下さい!

(defun read-dict (file)
  (with-open-file (in file)
    (read in)))

(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 (mapcar (lambda (x)
                  (destructuring-bind
                        (word meaning &optional (ok-count 0) (ng-count 0)) x
                    (list word meaning ok-count ng-count)))
                word-spec*)
        (lambda (a b)
          (destructuring-bind (word meaning ok-count1 ng-count1) a
            (declare (ignore word meaning))
            (destructuring-bind (word meaning ok-count2 ng-count2) b
              (declare (ignore word meaning))
              (> (- ng-count1 ok-count1)
                 (- ng-count2 ok-count2)))))))

(defun main (file &aux (ans (read-dict file)))
  (loop :named loop
        :for (word-spec . more) :on (sort-word-spec* ans)
        :for (word meaning ok-count ng-count) := word-spec
        :do (progn (format *query-io* "~A: " word)
                   (read-char *query-io*)     ;wait
                   (format *query-io* "~A y/n? " meaning))
        :collect (block ask
                   (tagbody 
                    :again
                      (return-from ask
                        (case (progn 
                                (clear-input *query-io*)
                                (prog1 (read-char *query-io*)
                                       (clear-input *query-io*)))
                          ((#\y #\Y) (list word meaning (1+ ok-count) ng-count))
                          ((#\n #\N) (list word meaning ok-count (1+ ng-count)))
                          ((#\q #\Q) (progn
                                       (setq ans (append result-spec*
                                                         (list word-spec)
                                                         more))
                                       (return-from loop)))
                          (T (progn
                               (format *query-io*
                                       "~&Please type Y for yes or N for no or Q for quit.~%")
                               (go :again)))))))
        :into result-spec*
        :finally (setq ans result-spec*))
  (when ans
    (write-dict file ans)))

実行例

CL-USER> (main "dict.lisp")
BAR: ↓:改行
ばー y/n? foo ↓

Please type Y for yes or N for no or Q for quit.
aaaaaa ↓
Please type Y for yes or N for no or Q for quit.
y<改行>
BAZ: ↓
ばず y/n? y ↓
FOO: <改行>
ふー y/n? y ↓

;=> ((BAR "ばー" 1 0) (BAZ "ばず" 1 0) (FOO "ふー" 2 0))

dict.lispの中身

((FOO "ふー" 0 0) (BAR "ばー" 0 0) (BAZ "ばず" 0 0))

ちなみに、ご覧の通り、シェルから実行というよりREPLであれこれというタイプです。

KMRCLを眺める (62) READ-FILE-TO-STRINGS

| 12:40 | KMRCLを眺める (62) READ-FILE-TO-STRINGS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (62) READ-FILE-TO-STRINGS - わだばLisperになる

今回はKMRCLのio.lisp中からREAD-FILE-TO-STRINGSです。

前回のREAD-STREAM-TO-STRINGSをWITH-OPEN-FILEで包んだものです。

定義は、

(defun read-file-to-strings (file)
  "Opens a reads a file. Returns the contents as a list of strings"
  (with-open-file (in file :direction :input)
    (read-stream-to-strings in)))

となっています。

使用例は、

(DEFVAR *WORDS*
  (READ-FILE-TO-STRINGS "/usr/share/dict/words"))

(LENGTH *WORDS*)
;⇒ 98569

(FILTER (LAMBDA (LINE)
          (UNLESS (EQUAL "" LINE)
            (CHAR= #\Z (CHAR LINE 0))))
        *WORDS*)
⇒ ("Z" "Z's" "Zachariah" "Zachariah's" "Zachary" "Zachary's" "Zachery"
 "Zachery's" "Zagreb" "Zagreb's" "Zaire" "Zaire's" "Zairian" "Zairians"
 "Zambezi" "Zambezi's" "Zambia" "Zambia's" "Zambian" "Zambians" "Zamboni"
 "Zamenhof" "Zamenhof's" "Zamora" "Zamora's" "Zane" "Zane's" "Zanuck"
 "Zanuck's" "Zanzibar" "Zanzibar's" "Zapata" "Zapata's" "Zaporozhye"
 "Zaporozhye's" "Zapotec" "Zapotec's" "Zappa" "Zappa's" "Zebedee" "Zebedee's"
 "Zechariah" "Zechariah's" "Zedekiah" "Zedekiah's" "Zedong" "Zedong's"
 "Zeffirelli" "Zeffirelli's" "Zeke" "Zeke's" "Zelig" "Zelig's" "Zelma"
 "Zelma's" "Zen" "Zen's" "Zenger" "Zenger's" "Zeno" "Zeno's" "Zens" "Zephaniah"
 "Zephaniah's" "Zephyrus" "Zephyrus's" "Zeppelin" "Zeppelin's" "Zest" "Zest's"
 "Zeus" "Zeus's" "Zhengzhou" "Zhivago" "Zhivago's" "Zhukov" "Zhukov's" "Zibo"
 "Zibo's" "Ziegfeld" "Ziegfeld's" "Ziegler" "Ziegler's" "Ziggy" "Ziggy's"
 "Zimbabwe" "Zimbabwe's" "Zimbabwean" "Zimbabweans" "Zimmerman" "Zimmerman's"
 "Zinfandel" "Zinfandel's" "Zion" "Zion's" "Zionism" "Zionism's" "Zionisms"
 "Zionist" "Zionist's" "Zionists" "Zions" "Ziploc" "Zn" "Zn's" "Zoe" "Zoe's"
 "Zola" "Zola's" "Zollverein" "Zollverein's" "Zoloft" "Zomba" "Zomba's" "Zorn"
 "Zorn's" "Zoroaster" "Zoroaster's" "Zoroastrian" "Zoroastrianism"
 "Zoroastrianism's" "Zoroastrianisms" "Zorro" "Zorro's" "Zosma" "Zosma's" "Zr"
 "Zr's" "Zsigmondy" "Zsigmondy's" "Zubenelgenubi" "Zubenelgenubi's"
 "Zubeneschamali" "Zubeneschamali's" "Zukor" "Zukor's" "Zulu" "Zulu's" "Zulus"
 "Zuni" "Zwingli" "Zwingli's" "Zworykin" "Zworykin's" "Zyrtec" "Zyrtec's"
 "Zyuganov" "Zyuganov's" "Zürich" "Zürich's")

位のところでしょうか

ファイルをオープンして行ごとに処理していくのも良いとは思いますが、LIST処理言語LISPとしては、一旦リストにしてしまうと色々素材の料理が楽ですね。