HOME | 13. 連想リスト、ハッシュ表 | もうひとつの Scheme 入門 | 15. 構文の定義 | download | 書き込む |
一般にベクトルは同じ長さのリストよりも空間効率が高く、ランダムに選択した要素に対する 平均アクセス時間もリストより早くなります。 一方、ベクトルの操作は副作用が伴うため、不用意に使うとバグの元になります。
また、構造体も C 言語の構造体と同様のものです。ただ、Lisp 語族にはマクロがあるので、 値にアクセスしたり、値をセットする関数を自動で書いてくれます。
例:
'#(1 2 3) ; 整数のベクトル '#(a 0 #\a) ; シンボル、整数、文字を要素に持つベクトル
(vector 'a 'b 'c) ⇒ #(a b c)
(define (add-vector v1 v2) (vector-map + v1 v2))問題1:
構造体は define-record-type で定義します。 例を示しながら説明したほうがわかりやすいので本を例にとって説明します。 本の属性としては、
(define-record-type book (fields title authors publisher year isbn))"The Cathedral and Bazaar" を登録するときは以下のようにします。make-book という関数が
(define bazaar (make-book "The Cathedral and the Bazaar" "Eric S. Raymond" "O'Reilly" 1999 0596001088))構造体を生成する関数はカスタマイズすることもできます。 例えば、前の定義だと、属性と値の対応がわかりづらいので、 スロット名と値の対を与えて構造体を生成するようにします。
下の例では、protocol オプションを使って、構造体を生成する関数をカスタマイズします。 引数を読み込んで、初期値をいったんベクトルに保存し、そのベクトルを使って構造体を初期化します。
(define-record-type book2 (fields title authors publisher year isbn) (protocol (lambda (p) (lambda ls (let ((len (length ls))) (if (and (even? len) (<= len 10)) (let ((arg (make-vector 5 ""))) (let loop ((ls ls)) (if (null? ls) (p (vector-ref arg 0) (vector-ref arg 1) (vector-ref arg 2) (vector-ref arg 3) (vector-ref arg 4)) (begin (vector-set! arg (case (car ls) ((title) 0) ((authors) 1) ((publisher) 2) ((year) 3) ((isbn) 4)) (cadr ls)) (loop (cddr ls)))))) 'wrong-argument--cannot-make-book2)))))) (define bazaar (make-book2 'title "The Cathedral and the Bazaar" 'authors "Eric S. Raymond" 'publisher "O'Reilly" 'year 1999 'isbn 0596001088))
(book? bazaar)
;Value: #t
(book-title bazaar)
;Value 18: "The Cathedral and the Bazaar"
の様にします。
(define-record-type (auto make-auto auto?) (fields (immutable name) (immutable date) (mutable miles)))
> (define my-auto (make-auto "Benz" "2008/01/01" 0)) > my-auto #(struct:auto "Benz" "2008/01/01" 0) ; 新車 > (auto-miles-set! my-auto 10) ; 10 マイル走る > my-auto #(struct:auto "Benz" "2008/01/01" 10) ; 10 マイル走った後の状態構造体についてさらに詳しい使い方は R6RS Libraries, Records を見てください。
コンピュータと人間が数を当てあい、先に当てたほうが勝ちになります。 両者が同じ推測回数で当てた場合は引き分けです。
要素が 10 個のベクトルを作り、インデックス (k) の数が現れる桁を そのインデックスの値にします。桁は 1 の位から 1,2,3,4 と数えます。 現れない数字のインデックスの値は 0 にします。 先の2つの数字 5601 と 1685 はプログラム内部では次のように表現されます。
5601 → #(2 1 0 0 0 4 3 0 0 0) 1685 → #(0 4 0 0 0 1 3 0 2 0)5601 の場合は、数字 0, 1, 5, 6 がそれぞれ 2, 1, 4, 3 番目の桁に現れるので、 ベクトル表現にした場合、インデックス 0, 1, 5, 6 の値がそれぞれ 2, 1, 4, 3 になり、 それ以外は 0 になります。
数をこのように表現すると2つの数の比較を高速に行うことができます。 すなわち、2つのベクトルで同じインデックスの値が両方とも正で、その値が 1) 等しければ bull、2) 等しくなければ cow だと数えることができます。 この場合インデックス 6 の値が両方とも 3 で等しいので bull は 1、 インデックス 1, 5, の値が両方とも正で、値が等しくないので cow は 2 になります。 このプログラムでは、 一致度 (score) を (bull*5 + cow) で表わします。
001: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 002: ;;; 003: ;;; mastermind.scm 004: ;;; by T.Shido 005: ;;; 006: ;;; User and computer try to locate the four-digit integer set by the opponents each other. 007: ;;; One who locates the integer with fewer question is the winner. 008: ;;; The four-digit integer contains four of numerals 0--9, like 0123, 3749 etc. 009: ;;; The opponents should tell the guesser 010: ;;; (1) number of numerals that are shared by the guessed and set numbers 011: ;;; at wrong position (cows) 012: ;;; and (2) number of numerals at collect position (bulls). 013: ;;; 014: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 015: ;;; 016: ;;; The four-digit integers are represented by 10-cell vectors in the program 017: ;;; The value of n-th cell is the number of column that n appears in the integer. 018: ;;; in n is not appears the value is 0. 019: ;;; for example, 1234 is represented as #(0 4 3 2 1 0 0 0 0 0) and 020: ;;; 3916 as #(0 2 0 4 0 0 1 0 0 3). 021: ;;; With this inner representation, the score of the guess can be calculated faster. 022: ;;; 023: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 024: 025: 026: (require rnrs/control-6) 027: (require rnrs/io/ports-6) 028: (require srfi/27) 029: ;;; 030: (define (char2int c) 031: (- (char->integer c) (char->integer #\0))) 032: 033: ;;; converting a list of 4 numbers to the vector notation 034: (define (ls2nvec ls) 035: (let ((vec (make-vector 10 0))) 036: (let loop ((i (length ls)) (ls ls)) 037: (when (> i 0) 038: (vector-set! vec (car ls) i) 039: (loop (- i 1) (cdr ls))) 040: vec))) 041: 042: ;;; converting the vector notation to string 043: (define (nvec2int vec) 044: (let loop ((i 0) (n 0)) 045: (if (= i 10) 046: n 047: (let ((j (vector-ref vec i))) 048: (loop (+ 1 i) (+ n (if (> j 0) 049: (* i (expt 10 (- j 1))) 050: 0))))))) 051: 052: ;;; 053: (define (int2str i) 054: (string-append 055: (if (< i 1000) "0" "") 056: (number->string i))) 057: 058: ;;; reading integer from stdin 059: (define (read-integer str) 060: (read-from-stdin str)) 061: 062: ;;; 063: (define (read-from-stdin str) 064: (display str) 065: (newline) 066: (read)) 067: 068: ;;; 069: (define (write-to-stdout . ls) 070: (for-each (lambda (obj) (display obj)) ls) 071: (newline)) 072: 073: ;;; convert numeral string to the vector representation. 074: (define (str2nvec str) 075: (let ((vec (make-vector 10 0))) 076: (let loop ((i (string-length str)) (ls (string->list str))) 077: (if (pair? ls) 078: (begin 079: (vector-set! vec (char2int (car ls)) i) 080: (loop (- i 1) (cdr ls))) 081: vec)))) 082: 083: ;;; calculating the score of guess 084: (define (scoring vec0 vec1) 085: (let ((n (vector-length vec0))) 086: (let loop ((i 0) (score 0)) 087: (if (< i n) 088: (let ((d0 (vector-ref vec0 i)) 089: (d1 (vector-ref vec1 i))) 090: (loop (+ 1 i) 091: (+ score (if (and (< 0 d0) (< 0 d1)) 092: (if (= d0 d1) 5 1) 093: 0)))) 094: score)))) 095: 096: ;;; show bulls and cows calculated from the score of user's guess 097: (define (show-user-score score) 098: (write-to-stdout "Number of bulls and cows in your guess:" ) 099: (write-to-stdout "bulls: " (quotient score 5)) 100: (write-to-stdout "cows: " (modulo score 5)) 101: (newline)) 102: 103: ;;; calculating the score of computer's guess from bulls and cows 104: (define (read-my-score gu0) 105: (write-to-stdout "My guess is: " (int2str (nvec2int gu0))) 106: (write-to-stdout "Give number of bulls and cows in my guess." ) 107: (let ((na5 (* 5 (read-integer "bulls: ")))) 108: (+ na5 (read-integer "cows: ")))) ; the score is calculated by (5 * bull + cow) 109: 110: 111: ;;; convert integer to nvec 112: (define (int2nvec i) 113: (let loop((i i) (j 1) (ls '())) 114: (if (= j 5) 115: (ls2nvec (reverse ls)) 116: (loop (floor (/ i 10)) (+ 1 j) (cons (modulo i 10) ls))))) 117: 118: 119: ;;; reading the user guess 120: (define (read-user-guess) 121: (newline) 122: (int2nvec (read-from-stdin "Give your guess."))) 123: 124: ;;; shuffling the list of four-digit numbers 125: (define (shuffle-numbers ls0) 126: (let ((vec (list->vector ls0))) 127: (let loop ((n (vector-length vec)) (ls1 '())) 128: (if (= n 0) 129: ls1 130: (let* ((r (random-integer n)) 131: (v (vector-ref vec r))) 132: (vector-set! vec r (vector-ref vec (- n 1))) 133: (loop (- n 1) (cons v ls1))))))) 134: 135: ;;; making a list of four-digit numbers in which numeral 0--9 appear once 136: (define (make-numbers) 137: (let ((ls1 '())) 138: (letrec ((rec (lambda (i num ls) 139: (if (= i 4) 140: (set! ls1 (cons (ls2nvec ls) ls1)) 141: (for-each 142: (lambda (n) 143: (rec (+ 1 i) (remove n num) (cons n ls))) 144: num))))) 145: (rec 0 '(0 1 2 3 4 5 6 7 8 9) '())) 146: ls1)) 147: 148: ;;; 149: (define (game-over sc0 sc1) 150: (write-to-stdout 151: (cond 152: ((= sc0 sc1) "Draw") 153: ((> sc0 sc1) "I won.") 154: (else "You won."))) 155: 'game-over) 156: 157: (define (scoring-user-guess an0 gu1) 158: (let ((sc1 (scoring an0 gu1))) 159: (show-user-score sc1) 160: sc1)) 161: 162: ;;; Practical main function. tail recursive. 163: (define (mastermind-rec an0 candidates) 164: (if (null? candidates) 165: (error "Error. You gave wrong score for my guess, probably.") 166: (let ((gu0 (car candidates))) 167: (let ((sc1 (scoring-user-guess an0 (read-user-guess))) 168: (sc0 (read-my-score gu0))) 169: (if (or (= sc0 20) (= sc1 20)) 170: (game-over sc0 sc1) 171: (mastermind-rec an0 172: (filter 173: (lambda (x) (= (scoring gu0 x) sc0)) 174: (cdr candidates)))))))) 175: 176: 177: ;;; The main function called from the top-level 178: (define (mastermind) 179: (let ((ls0 (make-numbers))) 180: (mastermind-rec (list-ref ls0 (random-integer (length ls0))) (shuffle-numbers ls0))))
関数 | 説明 | 行 |
---|---|---|
(char2int c) | 文字 c (#\0 --#\9) を整数 (0--9) に変換します。 | 30 |
(ls2nvec ls) | 4 つの数字からなるリスト (ls)をベクトル表現の 4 桁の数に変換します。 '(5 3 6 0) → #(1 0 0 3 0 4 2 0 0 0) | 34 |
(nvec2int vec) | ベクトル表現の整数 vec を通常の整数に変換します。 | 44 |
(int2str i) | 4 桁の整数 i を文字列に変換します。i が 1000 未満のときは先頭に 0 が付きます。 | 54 |
(read-from-stdin str) | str をコンソールに表示して、標準入力からユーザーが入力した行を返します。 | 64 |
(write-to-stdout . ls) | ls の各要素を標準出力に表示して最後に改行します。 | 70 |
(str2nvec str) | ユーザーが入力した 4 桁の数字(入力した時点では文字列 str) をベクトル表現の 4 桁の整数に変換します。 | 75 |
(scoring vec0 vec1) | ベクトル表現の二つの整数 vec0, vec1 の類似性 (score) を (5*bull + cow) で計算します。 | 85 |
(show-user-score score) | score から bull と cow を計算し、それらを標準出力に表示します。 | 98 |
(read-my-score gu0) | コンピュータの推定値 (gu0)を表示し、 それに対する bull と cow の値をユーザーに入力してもらい、 それから計算した score を返します。 | 105 |
(read-user-guess) | ユーザーの推定値を入力してもらい、それのベクトル表現を返します。 | 112 |
(shuffle-numbers ls0) | ls0 をシャッフルします。ランダムにアクセスする必要があるので、ls0 をベクトルに変換して、 そこから要素をランダムにピックアップして ls1 を作ります。 | 116 |
(make-numbers) | 異なる 4 つの数字からなるすぺての4 桁の数のリストを返します。 | 128 |
(game-over sc0 sc1) | コンピュータとユーザーのスコア(それぞれ sc0, sc1)を比較して、 どちらが勝利したか判定します。 | 141 |
(scoring-user-guess an0 gu1) | コンピュータの設定値 (an0) と ユーザーの推定値を比較して、スコアを計算します。 また、show-user-score を使って、bull と cow の値を標準出力に出力します。 | 149 |
(mastermind-rec an0 candidates) | 実質的なメイン関数です。コンピュータの設定値 (an0) と推定値のリスト (candidates) を引数にとります。コンピュータのスコア (sc0) とユーザーのスコア (sc1) を計算して、もしどちらかが 20 になったら (game-over sc0 sc1) を 呼び出します。そうでない場合は、sc0 の値に基づいて候補を絞って (164--166 行)ゲームを続けます。 | 155 |
(mastermind) | コンソールからこの関数を呼び出すとゲームが始まります。 | 169 |
(load/cd "mastermind.scm") (mastermind)
(define (inner-product v1 v2) (let ((vec (vector-map * v1 v2))) (let loop ((i 0) (product 0)) (if (= i (vector-length vec)) product (loop (+ i 1) (+ product (vector-ref vec i)))))))
次回は自前の構文を定義する方法について述べます。自前の構文を定義できるのは Lisp 語族の大きな特徴になっています。
HOME | 13. 連想リスト、ハッシュ表 | もうひとつの Scheme 入門 | 15. 構文の定義 | download | 書き込む |