schemeで全dataを+するのを知りたいです、か？

http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1347295398

とりあえず仕様を満たすものをガガッと力任せに書いてみた。

(define (mysum lst)
  (define (iter lst)
    (if (null? lst) 0
        (let ((head (car lst))
              (tail (cdr lst)))
          (+ (iter tail)
             (if (number? head) head
                 (iter head))))))
  (if (list? lst) (iter lst)
      (error)))

(define (mytrans lst)
  (define (iter lst)
    (if (null? lst) '()
        (let ((head (car lst))
              (tail (cdr lst)))
          (if (number? head)
              (cons (alpha head) (iter tail))
              (cons (iter head) (iter tail))))))
  (define (alpha n)
    (cond ((= n 1) 'one)
          ((= n 2) 'two)
          ((= n 3) 'three)
          ((= n 4) 'four)
          ((= n 5) 'five)
          ((= n 6) 'six)
          ((= n 7) 'seven)
          ((= n 8) 'eight)
          ((= n 9) 'nine)))
  (cond ((number? lst)(error))
        ((null? lst) 0)
        (else (iter lst))))

(define (myfind lst n)
  (let ((result (assoc n lst)))
    (if result (cadr result)
        #f)))

【追記】
もっとかっちょいいのを書いてくれてる
→ http://d.hatena.ne.jp/trotr/20100921/1285082372

valvallowさんの抽象化バージョン
→ http://valvallow.blogspot.com/2010/09/re-schemedata.html

第208回 ç´ äººãã•ã„SICP読書会（at 三田某所）

• 会場提供ありがとうございました
• 参加は3人
• 超久しぶりにSICPをやりました。反省

• 問題5.23
• 以前やったはずなので復習

ev-cond
  (assign exp (op cond->if) (reg exp)
  (goto (label eval-dispatch))

ev-let
  (assign exp (op let->combination) (reg exp)
  (goto (label eval-dispatch))

• 問題5.24
• 問題5.23の機能をコード組み込みできちんと書き下す問題

第2回 やさしいPAIP読書会（at 三田某所）

• 会場提供ありがとうございました
• 当初、机はない予定だったけど、机も用意してくれてた。ありがとうございます

• 参加表明20人中、実際の参加は18名。ドタキャン率低いなあ。来月もこの調子でお願いします

• 白状します。当日の午前まで全く準備してませんでした。ごめんなさい
• 午後の空き時間に急いでスライド作ってsbclをインストールした。準竹迫メソッド

• 反省点。あの説明じゃ再帰に慣れてない人は絶対に理解できないよね。1.2で例に挙げるnの数をもっと減らして実際に生成される展開式を示せばよかった
• ゆるい発表をして突っ込まれるのはいつもの芸風なので、その点はまあよしと
• テキストエディットからEmacsへのコピペは自分でもさすがにひどいと思う。「Emacs使いに殺されるぞ」と言われました。せめてEmacs内でウィンドウを分けてコピペ、とか
• 【TODO】次回までにSLIME入れてまともな環境に近づける

• 1.10音読 → 第1章全体の簡単なまとめ → 演習問題の解説という流れ

PAIP 第1章 Lisp入門

View more presentations from yadokari electric.

• ドキュメンテーション文字列はただの注釈じゃなくてプログラムで操作できる、とか
• 「fourth」を間違って「forth」と書いてた…

• 演習1.1
• 基本的には15ページのfirst-nameを書き換えてlast-nameを作るだけ
• 注意点はlastが返すのはリストだという点くらい
• 最後の要素を削るのは、(reverse (cdr (reverse …と書きたいのをぐっとこらえてbutlastを使用
• Downey,の「,」をどう削るか。名前のところで「Downey |,| Jr.」とかにしておけば、削除候補に「|,|」を入れておくことで削れるとのこと。問題の趣旨としてはそんなことまで考えなくてよさそうだけど

• 演習1.2
• 階乗のプログラムを書くときに組み込みの階乗関数であるexptを使うのはあんまりなので、解答の(expt x 2)のところは、(* x x)として定義したsquareを使用
• dotimesを使ったナイーブなループ版も用意。「ループ版」「再帰＋最適化版」「組み込みのexpt」の性能を5の20万乗にかかる時間で比較してみた
  • ループ版　7.041秒
  • 再帰＋最適化版　0.278秒
  • 組み込みのexpt　0.315秒
• 再帰＋最適化版の圧勝
• 組み込みのexptのほうが遅いのは、整数乗だけじゃなくて実数乗とかもサポートしているためだと思われ

• 演習1.3
• 「何の処理か書いてない」って言ったら「ドキュメンテーション文字列にちゃんと書いてある」と言われた orz
• 下の「nilも数える版」のオプショナル引数の使い方がおもしろい。再帰の際のフラグに使ってる
• ただし、あまりよくない書き方。誤動作を引き起こす可能性のあるオプショナル引数を外部にさらすのは危険と佐野さんから指摘
  • 問題になるのは、expがnilの場合。オプショナル引数で数を渡すとその数がそのまま返り値になってしまう
  • さらに問題なのは、expがnilで、オプショナル引数でもnilを渡した場合。sbclで試したらエラーになった

• 演習1.4
• 基本的には問題1.3とほとんど変わらない

• 演習1.5
• 再帰版、ループ版、高階関数版の三つのバージョンが解答に示されてる
• リストaとリストbの長さが違う場合、ループ版はエラーになる可能性があると参加者からの指摘。たしかにループ版ではリストaの長さしか見ていないので、リストbがリストaより短い場合はやばい

【次回発表者】

• 第2章本文　yshigeruさん
• 演習2.1　iori0121さん
• 演習2.2　kurohukuさん
• 演習2.3　snmstsさん
• 演習2.4　私

第1回 やさしいPAIP読書会（at 月島某所）

• 会場提供ありがとうございました
• 第1回 やさしいPAIP読書会 : ATNDに登録した23人のうち、20人＋1人＝21人が参加。ドタキャンは予想していたよりかなり少なかった
• 順番に1章を音読していった
• 誤植が2個所見つかった。13ページの一番上で最後のカッコが1個多いのと、15ページのfirst-name関数の定義の中で最後の「first-name」は「first name」
• 読み終わったのは1.8まで

• first、second…とnthの話
• 関数と変数の名前空間が分かれてるのはどうよという話
• 無名関数内で自分自身を呼び出す話。On Lispのalambdaマクロとか（nitro_idiotさんがここにまとめてくれてる）

• 終わった後は10人でもんじゃ
• 1人につき1個もんじゃを頼んだのは多すぎだった。満腹すぎ＆時間かかりすぎ。今度から3人で2個を上限に頼むのがよさげ
• todo：k.hibinoさんとnitro_idiotさんに510円ずつ返金

【課題】

• 2時間という限られた時間で音読するのはかなり効率が悪い感じ
• 予想されていたことだけど、やっぱり参加者のレベル差がかなりある印象。たぶん、Lispがわかる人にとっては易しすぎで、わからない人はコードが追えなかったと思う
• ペースを上げるか開催頻度を上げるか
  • 開催を月2回にするのは参加者にとっても会場確保の面でも難しそうな感触
  • ということで、音読廃止の方向で

【次回以降】

• 発表者が内容をまとめる形式にとりあえず変えてみる
• 実は、今回のために「問題1.2でナイーブなループと再帰で最適化入れるのとでこんなに性能が変わる」という簡単なデモを用意してたんだけど、時間的に全然見せられなかった。次回は1章のまとめと問題の解説を自分がやる感じかな
• 会場は、8月は弾さんのご都合が悪いので探す必要あり。9月は今のところは弾さん宅の予定

Keccon2010（庄司嘉織・永田祐子 結婚カンファレンス）

• 髪の赤い人とドラの人がどれくらいまわりから愛されてるかがわかるとてもよい会でした
• 演出もすごくよかった。スタッフの人たちGJ
• 130人くらい来てたらしい。すごいな
• 日記を更新してないと指摘されました＞＜
• 思いがけないカップルにびっくりするなど。ご婚約おめでとうございます！
• 某氏の転職を知ってびっくりするなど

• ということで、id:Yoshioriさん、id:ngtykさん、ご結婚おめでとうございます！

PRML復習レーン（第3回）

• 幹事のnaoya_tさん、会場を貸してくださったECナビさん、どうもありがとうございました
• 復習レーン皆勤を目指すぜ、とか思ってたのにいきなり2回目で出張とかぶって涙目。第3回はなんとか参加
• 独りで読んでると数式だらけで泣きたくなるけど、わかってる人に説明してもらうとちょっとだけわかったような気になれる。読書会向きの本だよなー
• ベイズ推論の考え方に少しだけ慣れた
• やむを得ない用事↓で途中退場

第192回 ç´ äººãã•ã„SICP読書会（at 三田某所）

• 会場提供ありがとうございました
• 参加は最小構成人数の2人

• 6月の第1週は海外にいる可能性があるので、その場合は読書会は休みにしようという話
• ○○ったーが流行っているという話から血液型の性格分類はひどいねという話に

• 問題5.22
• 非破壊的な方はfactとほとんど同じ。factをちょこちょこっと書き換えたら動いた

(define append-machine
  (make-machine
   '(x y val continue)
   (list (list 'null? null?) (list 'cons cons) (list 'car car) (list 'cdr cdr))
    '((assign continue (label append-done))
    append-loop
      (test (op null?) (reg x))
      (branch (label base-case))
      (save continue)
      (save x)
      (assign x (op cdr) (reg x))
      (assign continue (label after-append))
      (goto (label append-loop))
    after-append
      (restore x)
      (restore continue)
      (assign x (op car) (reg x))
      (assign val (op cons) (reg x) (reg val))
      (goto (reg continue))
    base-case
      (assign val (reg y))
      (goto (reg continue))
    append-done)))

• 破壊的なほうは、最初、5.11と同じように単純なループにしてはまった
• それだとcdrで削ったところが復元できない。ということで、valを介する形に書き直し
• 書けたんだけど、最後の要素とyã‚’appendしたものからxを復元するにはどうしたらいいかがわからなくてタイムアップ

• で帰り道に考えてたら、ほとんど正解してたことに気付いた
• set-cdr! val yした時点で、答えはxに入ってる
• 何のためにxを復元したんだか。アホだオレ

(define append!-machine
  (make-machine
   '(x y temp val continue)
   (list (list 'null? null?) (list 'cdr cdr) (list 'set-cdr! set-cdr!))
    '((assign continue (label last-pair-done))
    last-pair-loop
      (assign temp (op cdr) (reg x))
      (test (op null?) (reg temp))
      (branch (label base-case))
      (save continue)
      (save x)
      (assign x (op cdr) (reg x))
      (assign continue (label after-last-pair))
      (goto (label last-pair-loop))
   after-last-pair
      (restore x)
      (restore continue)
      (goto (reg continue))
   base-case
      (assign val (reg x))
      (goto (reg continue))
   last-pair-done
      (perform (op set-cdr!) (reg val) (reg y)))))

(define (test-append!-machine)
  (set-register-contents! append!-machine 'x '(a b c))
  (set-register-contents! append!-machine 'y '(x y))
  (start append!-machine)
  (get-register-contents append!-machine 'x))

;;(test-append!-machine) => (a b c x y)

• 何が起きてたのか把握したので、単純ループに書き換えた
• たぶんこっちが正解

(define append!-machine
  (make-machine
   '(x y temp x-last)
   (list (list 'null? null?) (list 'cdr cdr) (list 'set-cdr! set-cdr!))
    '((assign x-last (reg x))
    last-pair-loop
      (assign temp (op cdr) (reg x-last))
      (test (op null?) (reg temp))
      (branch (label last-pair-done))
      (assign x-last (op cdr) (reg x-last))
      (goto (label last-pair-loop))
   last-pair-done
      (perform (op set-cdr!) (reg x-last) (reg y)))))

• ということで問題5.22 done