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-10

第1回 Scheme コードバトンのお知らせ

| 20:47 | 第1回 Scheme コードバトンのお知らせ - わだばLisperになる を含むブックマーク はてなブックマーク - 第1回 Scheme コードバトンのお知らせ - わだばLisperになる

higeponさん曰く、

Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びを始めました。
盛り上がるようであれば次回 Shibuya.lisp で成果を発表したいと思っています。

とのことだったので、CLの流れでフォークしました。

現在 higepon -> g000001(CL) とバトンが渡っています。

(Scheme->Schemeは、higepon -> yadokarielectric とバトンが渡っています。 )

ここから、Arcに流すか、Clojureに流すか、CLに流れるか、Emacs Lispになるか、は謎です。

もしご興味のある方がいらっしゃいましたら、コメントで表明していただくとバトンが回ってくる対象となります。

とても短いコードをいじっていくので 初心者の方でも参加歓迎です。(分からない事があればフォローします。)

詳細はこちらをどうぞ。

CL版:

http://gist.github.com/273441

R6RS Scheme製オリジナル:

http://gist.github.com/273431

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

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

前回のエントリーも依然としてカオスかなあと思ったので、lequeさんのエントリーも参照しつつ、さらに単純にしてみました。

よくよく考えてみると、単語のエントリーを破壊的に変更していくのが楽ですね。

(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)))

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

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

前回のエントリーのコードだとカオス過ぎるかなと思ったので、心の赴くままに関数を分解してみました。

対話周りは、折角のCLなのでコンディションシステムを使って処理した方が良いような気もしています。

(defpackage :hige
  (:use :cl)
  (:import-from :kmrcl :aand :it)
  (:import-from :shibuya.lisp :fn))

(in-package :hige)

(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 (loop :for (word meaning ok-count ng-count) :in word-spec*
              :collect (list word meaning (or ok-count 0) (or ng-count)))
        #'>
        :key (fn ((ign ore ok-count ng-count))
               (- ng-count ok-count))))

(defun ask (catch-tag 
            result-spec* word-spec
            word more meaning ok-count ng-count)
  (flet ((*query ()
           (clear-input *query-io*)
           (prog1 (read-char *query-io*)
                  (clear-input *query-io*)))
         (*pr (&rest args)
           (apply #'format *query-io* args))
         (*ready? () (read-char *query-io*)))
    (tagbody 
       (*pr "~A: " word)
       (*ready?)    
       (*pr "~A y/n? " meaning)
     :again
       (return-from ask
         (case (*query)
           ((#\y #\Y) (list word meaning (1+ ok-count) ng-count))
           ((#\n #\N) (list word meaning ok-count (1+ ng-count)))
           ((#\q #\Q) (throw catch-tag 
                        `(,@result-spec* ,word-spec ,@more)))
           (otherwise
              (*pr "~&Please type Y for yes or N for no or Q for quit.~%")
              (go :again)))))))

;; main
(defun main (file)
  (aand (read-dict file)
        (catch 'break
          (loop :for (word-spec . more) :on (sort-word-spec* it)
                :for (word meaning ok-count ng-count) := word-spec
                  :collect (ask 'break
                                result-spec* word-spec
                                word more meaning ok-count ng-count)
                     :into result-spec*
                :finally (return result-spec*)))
        (write-dict file it)))

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20100110