2019年12月2日

Scheme Tutorial 3

Input/Output

瞭解如何讀寫檔案

Input from Files 自檔案輸入

open-input-file,read-char和eof-object?

(open-input-file filename) 可打開一個文件,回傳 a port of file。

(read-char port)用於從port中讀取一個 char。當讀取到文件結尾(EOF)時,此函數返回eof-object,可以使用eof-object?來檢查。

(close-input-port port)用於關閉輸入 port。

ex: 實作以字符串形式回傳文件內容的函數

(define (read-file file-name)
  (let ((p (open-input-file file-name)))
    (let loop((ls1 '()) (c (read-char p)))
      (if (eof-object? c)
        (begin
          (close-input-port p)
          (list->string (reverse ls1)))
        (loop (cons c ls1) (read-char p)) ))))

(read-file "hello.txt")

begin 是一個集合多個 expression 的語法,當原本的語法中,只能放一個 form/expression 時,就用 begin 包裝多個 form/expression

ex: 每次使用 y 都會加上 1

(+ x 
   (begin (set! y (+ y 1)) y) 
   z)
call-with-input-file, with-input-from-file

(call-with-input-file filename procedure)

將 filename 文件打開後,提供輸入,procedure 接受 input port 為參數,因文件可能會再被使用,procedure 結束後,不會自動關閉 port,必須自己呼叫 (close-input-port p)

(define (read-file file-name)
  (call-with-input-file file-name
    (lambda (p)
      (let loop((ls1 '()) (c (read-char p)))
         (if (eof-object? c)
            (begin
              (close-input-port p)
              (list->string (reverse ls1)))
         (loop (cons c ls1) (read-char p))) ))))

如果是使用 with-input-from-file ,會自動關閉 port

(define (read-file file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop((ls1 '()) (c (read-char)))
        (if (eof-object? c)
          (list->string (reverse ls1))
        (loop (cons c ls1) (read-char)))) )))
read

(read port) 可從 port 讀取 S-expression

ex: paren.txt

'(Hello world!
Scheme is an elegant programming language.)

'(Lisp is a programming language ready to evolve.)
(define (s-read file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop ((ls1 '()) (s (read)))
        (if (eof-object? s)
          (reverse ls1)
        (loop (cons s ls1) (read)))) )))


(s-read "paren.txt")
;Value 2: ((quote (hello world! scheme is an elegant programming language.)) (quote (lisp is a programming language ready to evolve.)))

ex:

編寫函數(read-lines),該函數返回一個由字符串構成的表,分別代表每一行的內容。在Scheme中,換行符是由#\Linefeed表示。下面展示了將該函數用於 hello.txt 的結果。 (read-lines "hello.txt") ⇒ ("Hello world!" "Scheme is an elegant programming language.")

(define (group-list ls sep)
  (letrec ((iter (lambda (ls0 ls1)
       (cond
        ((null? ls0) (list ls1))
        ((eqv? (car ls0) sep)
         (cons ls1 (iter (cdr ls0) '())))
        (else (iter (cdr ls0) (cons (car ls0) ls1)))))))
    (map reverse (iter ls '())) ))


(define (read-lines file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop((ls1 '()) (c (read-char)))
        (if (eof-object? c)
          (map list->string (group-list (reverse ls1) #\Linefeed))  ; *
        (loop (cons c ls1) (read-char)))) )))


(group-list '(1 4 0 3 7 2 0 9 5 0 0 1 2 3) 0)
;Value 3: ((1 4) (3 7 2) (9 5) () (1 2 3))

(read-lines "hello.txt")
;Value 4: ("Hello world!" "Scheme is an elegant programming language.")

Output to files 輸出到檔案

打開用來輸出資料的 port

(open-output-file filename)
打開一個文件用作輸出,取得該輸出的 port

(close-output-port port)
關閉用於輸出的port

(call-with-output-file filename procedure)
打開文件filename用於輸出,並呼叫 procedure。該函數以輸出的 port 為參數。

(with-output-to-file filename procedure)
打開文件filename作為標準輸出,並呼叫 procedure。該 procedure 沒有參數。當控制權從過程procedure中返回時,文件會自動被關閉。

用來輸出的函數

(write obj port)
該函數將obj輸出至port。字串被雙引號括起而字符具有前綴 #\ 。

(display obj port)
該函數將obj輸出至port。字串不被雙引號括起而字符不具有前綴#\。

(newline port)
以新行起始。

(write-char char port)
該函數向port寫入一個 char。

ex: 編寫函數(my-copy-file)實現拷貝文件

(define (my-copy-file from to)
  (let ((pfr (open-input-file from))
        (pto (open-output-file to)))
    (let loop((c (read-char pfr)))
      (if (eof-object? c)
        (begin
          (close-input-port pfr)
          (close-output-port pto))
        (begin
          (write-char c pto)
          (loop (read-char pfr)) ))) ))

ex: 編寫函數(print-line),該函數具有任意多的字串作為參數,並將它們輸出至標準輸出。輸出的字串應該用新行分隔。

(define (print-lines . lines)
  (let loop((ls0 lines))
    (if (pair? ls0)
        (begin
         (display (car ls0))
         (newline)
         (loop (cdr ls0))) ) ))

Assignment 賦值

在 scheme 不常用 assignment,濫用 assignment 會讓程式碼很難懂,除非不得已,否則不要使用 assignment。

某些特別的演算法需要 assignment 語法,例如 internal states 及 continuations

雖然 assignment 語法很常見,容易理解,但卻有些缺陷,因為 assignment 改變了參數的值,具有破壞性。R5RS 中定義 assignment 為 set!set-car!set-cdr!string-set!vector-set!,在 scheme 所有具有破壞性的保留字都是以 ! 結尾。

set!

使用前,該參數要先被定義。跟 Common Lisp 不同,set! 無法給一個 S-expression 賦值。

(define var 1)
(set! var (* var 10))
var
;Value: 10

(let ((i 1))
    (set! i (+ i 3))
    i)
;Value: 4

internal states

scheme 的變數作用範圍,限制在原始程式碼中的括號裡面,稱為 lexical closure 或 static scope。另外有一種稱為 dynamic scope,會在執行時動態決定作用範圍,目前已經沒有使用。

特殊形式 let, lambda, leterc 會產生 closure,lambda expression 的參數只在函數定義內部有效。

另外可使用 lexical closure 實現帶有 internal state 的 process,例如,模擬銀行帳戶存款/提款。

(define bank-account
  (let ((balance 10))
    (lambda (n)
      (set! balance (+ balance n))
      balance) ))


(bank-account -5)
;Value: 5

(bank-account -1)
;Value: 4

只要稍微修改一下,就可以實現多個帳戶

(define (make-bank-account balance)
  (lambda (n)
    (set! balance (+ balance n))
    balance))

;Gates makes a bank account by donating  10 dollars
(define gates-bank-account (make-bank-account 10))
;Value: gates-bank-account

; donating 50 dollars
(gates-bank-account 50)
;Value: 60

; withdrawing 55 dollars
(gates-bank-account -55)
;Value: 5


; Torvalds makes a bank account by donating 100 dollars
(define torvalds-bank-account (make-bank-account 100))
;Value: torvalds-bank-account

; withdrawing 70 dollars
(torvalds-bank-account -70)
;Value: 30

; donating 300 dollars
(torvalds-bank-account 300)
;Value: 330

scheme procedure 會回傳一個 value,其他的用途就稱為 side effect,而 assignment 與 IO 就是一種 side effect。

ex: 修改 make-bank-account,提款超過 balance 時,會發生 error

(define (make-bank-account amount)
  (lambda (n)
    (let ((m (+ amount n)))
      (if (negative? m)
        'error
        (begin
          (set! amount m)
           amount)) )))

list 的破壞性操作 set-car! set-cdr

set-car!set-cdr 分別為一個 cons 單元的 car 與 cdr 部分設定新的值,跟 set!不同,這兩個函數可以為 S-expression 賦值。

(define tree '((1 2) (3 4 5) (6 7 8 9)))

; 把 1 改成 100
(set-car! (car tree) 100)

tree
; ((100 2) (3 4 5) (6 7 8 9))

;把 '(7 8 9) 改為 '(a b c)
(set-cdr! (third tree) '(a b c))

tree
; ((100 2) (3 4 5) (6 a b c))

queue

queue 是一種 FIFO 資料結構,list 則是 FILO。

以下是 queue 的資料結構

這是 enqueue 操作

  1. 將最後一個 cons 單元的 cdr 部分,指向新的元素
  2. 將 cons-cell-top 的 cdr 部分指向新的元素

這是 dequeue 操作

  1. 將queue head 元素存在 local 變數中
  2. 將 cons-cell-top 的 car 部分指向第二個元素

(define (make-queue)
  (cons '() '()))

(define (enqueue! queue obj)
  (let ((lobj (cons obj '())))
    (if (null? (car queue))
      (begin
        (set-car! queue lobj)
        (set-cdr! queue lobj))
      (begin
        (set-cdr! (cdr queue) lobj)
        (set-cdr! queue lobj)) )
    (car queue)))

(define (dequeue! queue)
  (let ((obj (car (car queue))))
    (set-car! queue (cdr (car queue)))
    obj))


(define q (make-queue))
;Value: q

(enqueue! q 'a)
;Value 12: (a)

(enqueue! q 'b)
;Value 12: (a b)

(enqueue! q 'c)
;Value 12: (a b c)

(dequeue! q)
;Value: a

q
;Value 13: ((b c) c)

char

在某個 char 前面加上 #\ 就表示它是 char,例如 #\a 表示 a

#\Space#\Tab#\Linefeed#\Return分別代表空格(Space)、製表符(Tab),Linefeed和返回(Return)

R5RS中定義了下面的與 char 相關的函數。

  • (char? obj)

    如果obj是一個 char 則返回#t

  • (char=? c1 c3)

    如果c1c2是同一個 char 的話則返回#t

  • (char->integer c)

    c轉化為對應的整數( char 代碼,character code)。

    ex:(char->integer #\a) => 97

  • (integer->char n)

    該函數將一個整數轉化為對應的字符。

  • (char<? c1 c2)(char<= c1 c2)(char> c1 c2)(char>= c1 c2)

    這些函數用於比較 char 。實際上,這些函數比較的是 char 代碼的大小。

    例如,(char<? c1 c2)等同於(< (char->integer c1) (char->integer c2))

  • (char-ci=? c1 c2)(char-ci<? c1 c2)(char-ci<=? c1 c2)(char-ci>? c1 c2)(char-ci>=? c1 c2)

    這些是 case-insensitive 比較函數

  • (char-alphabetic? c)(char-numeric? c)(char-whitespace? c)(char-upper-case? c)(char-lower-case? c)

    這些函數分別用於檢測 c是否為字母、數字、空白、大寫字母或小寫字母。

  • (char-upcase c)(char-downcase c)

    這些函數分別返回 c 對應的大寫或小寫。

string

用雙引號框住的就是字串

  • (string? s)

    如果s是一個字串則返回#t

  • (make-string n c)

    返回由n個 c 組成的字串。參數c 為 optional。

  • (string-length s)

    返回字串s的長度。

  • (string=? s1 s2)

    如果字串s1s2相同的話則返回#t

  • (string-ref s idx)

    返回字串s中索引為idx的 char(索引從0開始計數)。

  • (string-set! s idx c)

    將字符=串s中索引為idx的char設置為c

  • (substring s start end)

    返回字串sstart開始到end-1處的子字串。例如(substring "abcdefg" 1 4) => "b c d"

  • (string-append s1 s2 ...)

    連接兩個字串s1s2

  • (string->list s)

    將字串s轉換為由字符構成的表。

  • (list->string ls)

    將一個由 char 構成的表轉換為字串。

  • (string-copy s)

    複製字串s

ex: 編寫函數 title-style,讓每個單字的首字母大寫

先將 string 轉為 list,把空格後面的字元大寫,再轉回 string

(define (identity x) x)

(define (title-style str)
  (let loop ((ls (string->list str))
         (w #t)
         (acc '()))
    (if (null? ls)
    (list->string (reverse acc))
    (let ((c (car ls)))
      (loop (cdr ls)
        (char-whitespace? c)
        (cons ((if w char-upcase identity) c) acc))))))

;;; Another answer, You can assign caps to the string.
(define (title-style str)
  (let ((n (string-length str)))
    (let loop ((w #t) (i 0))
      (if (= i n)
      str
      (let ((c (string-ref str i)))
        (if w (string-set! str i (char-upcase c)))
        (loop (char-whitespace? c) (1+ i)))))))

(title-style "the cathedral and the bazaar")

symbol

透過 address 管理 string 的資料,symbol 可以被類似 eq? 這樣的函數快速處理,但 string 只能用 equal? 處理,因為 symbol 可被快速比較,常用來作 hash 的 key

以下是跟 symbol 有關的函數

  • (symbol? x)

    如果x是一個符號則返回#t。

  • (string->symbol str)

    str轉換為符號。str應該都是小寫的,否則地址系統可能無法正常運作。在MIT-Scheme中,(string->symbol "Hello")'Hello是不同的。

    (eq? (string->symbol "Hello") 'Hello)
    ;Value: ()
    
    (eq? (string->symbol "Hello") (string->symbol "Hello"))
    ;Value: #t
    
    (symbol->string  (string->symbol "Hello"))
    ;Value: "Hello"
  • (symbol->string sym)

    sym轉換為 string。

ex: 統計文章中的單字數量 wc.scm,裡面有用到 hash table 及 association list

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   wc.scm
;;;   a scheme word-count program
;;;
;;;    by T.Shido
;;;    on August 19, 2005
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; 將 list of chars (ls0) 轉為 symbol
(define (list->symbol ls0)
  (string->symbol (list->string (reverse! ls0))))

; 檢查 c 是否在 list (ls) 裡面,如果有,就回傳 #t
(define (char-in c . ls)
  (let loop((ls0 ls))
    (if (null? ls0)
        #f
      (or (char=? c (car ls0))
          (loop (cdr ls0))))))

; 讀入 fname 檔案,回傳 list of symbols,這個函數會將大寫轉為小寫,並轉會 list of chars(w) 為 symbol,同時添加在 list of symbols (wls) 裡面
(define (read-words fname)
  (with-input-from-file fname
    (lambda ()
      (let loop((w '()) (wls '()))
        (let ((c (read-char)))
          (cond
           ((eof-object? c)
            (reverse! (if (pair? w)
                          (cons (list->symbol w) wls)
                       wls)))
           ((char-in c #\Space #\Linefeed #\Tab #\, #\.  #\ #\( #\) #\= #\? #\! #\; #\:)
            (loop '() (if (pair? w)
                          (cons (list->symbol w) wls)
                        wls)))
       (else
        (loop (cons (char-downcase c) w) wls))))))))

; sorting al,依照出現的頻率
(define (sort-by-frequency al)
  (sort al (lambda (x y) (> (cdr x) (cdr y)))))

; 讀入檔案 fname,回傳 a sorted association list by frequency in descending order
(define (wc fname)
  (let ((wh (make-eq-hash-table)))
    (let loop((ls (read-words fname)))
      (if (null? ls)
          (sort-by-frequency (hash-table->alist wh))
        (begin
         (hash-table/put! wh (car ls) (1+ (hash-table/get wh (car ls) 0)))
         (loop (cdr ls)))))))

Association List and Hash table

資料關聯是用 key , value 組成的 data pair,value 可由唯一的 key 決定。

association list

symbol, string, 數字 常被用來當作 key

'((hi . 3) (everybody . 5) (nice . 3) (to . 10) (meet . 4) (you . 8))
'((1 2 3) (4 5 6) (7 8 9))

assq, assv, assc 可從 association list 中搜尋某一項,如果找到 pair 的 car 等於給定的 key,就回傳該 data pair,找不到就回傳 #f。這些函數分別是使用 eq?, eqv?, equal? ,這表示 assq 速度最快。string, vector, list 應該轉換為 symbol 再當做 key,會提高程式效能。

(define wc '((hi . 3) (everybody . 5) (nice . 3) (to . 10) (meet . 4) (you . 8)))
;Value: wc

(assq 'hi wc)
;Value 2: (hi . 3)

(assq 'you wc)
;Value 3: (you . 8)

(assq 'i wc)
;Value: #f

(define n '((1 2 3) (4 5 6) (7 8 9)))
;Value: n

(assv 1 n)
;Value 4: (1 2 3)

(assv 8 n)
;Value: #f

hash table

hash table 會將 key 轉成整數,將值存放在該整數指到的位置。search, insert, delete 都可在 O(1) 完成

  • (make-eq-hash-table size), (make-eqv-hash-table size), (make-equal-hash-table size), (make-string-hash-table size)

    產生 hash table 的函數,分別是使用eq?eqv?equal?,和string=?比較 key 的值。hash table 的初始 size 是 optional。由於只比較 key 的 address,所以 eq-hash-table是最快的。且由於鍵是序列,所以equal-hash-tablestring-hash-table比較慢。

  • (hash-table/put! hash-table key datum)

    hash-tablekey對應的值設為datum

  • (hash-table/get hash-table key default)

    返回hash-table中的key對應的值。如果key不存在於hash-table中,返回default

  • (hash-table->alist hash-table)

    hash-table轉換為 association list。

ex: 產生密碼

stat-spell.scm

; 可閱讀英文句子,將資料儲存在 hash table,轉換為 association list 並儲存在 stat-spell.data 文件裡面
;;; make an alist of probable spelling from a given english text

; 如果 c 不是圖像 char 或者c是 #\:, #\;, #\', or #\",就返回#t。讀取英文句子時,這些 char 會被跳過。
(define (skip-char? c)
  (or (not (char-graphic? c)) (memv c '(#\: #\; #\' #\" #\`))))

; 有兩個參數;字元的頻率的關聯表(alist)和字元(c)。如果c在alist中,在序對的cdr部分增加一。如果不在,返回 (cons (cons c 1) alist)
(define (ss-make-alist c alist)
  (let ((p (assv c alist)))
    (if p
        (begin
         (set-cdr! p (1+ (cdr p)))
         alist)
      (cons (cons c 1) alist))))

; 由 filename 檔案中讀取 char,使用下一個 char 的出現頻率的 association list,來記錄這些字元
; stat-speel.dat 儲存結果類似:
; (#\v (#\y . 1) (#\a . 3) (#\o . 7) (#\e . 51) (#\i . 15))
; 表示 #\y, #\a, #\o, #\e, 和 #\i 跟隨 #\v 之後出現的次數分別是1, 3, 7, 51, 和15次
(define (ss-make-dat filename)
  (let ((char-hash (make-eqv-hash-table)))
    (with-input-from-file filename
      (lambda ()
    (let loop ((c #\Space))
      (let ((c1 (read-char)))
                 (if (not (eof-object? c1))
                     (if (skip-char? c1)
                         (loop c)
                         (let ((c1 (char-downcase c1)))
               (hash-table/put! char-hash c
                        (ss-make-alist c1 (hash-table/get char-hash c '())))
               (loop c1))))))))
    (with-output-to-file "stat-spell.dat"
      (lambda ()
    (display "(define *stat-spell* \'(")
    (newline)
    (let loop ((alst (sort (hash-table->alist char-hash)
                   (lambda (x y) (char<? (car x) (car y))))))
      (if (pair? alst)
          (begin
        (write (car alst))
        (newline)
        (loop (cdr alst)))))
        (display "))")
        (newline)))))

make-pw.scm

;;; make password from the alist of probable spelling
; 基於 stat-spell.dat 頻率數據產生由9到13個隨機字符組成字串表。#\Space 被添加在表結尾。
; 添加一個00到99之間的隨機數在隨機選取的字符串表的結尾。
; 隨機地將 #\Space 轉換為 #-, #_, #\/, #\Space, #., 或者 #\,。
; 隨機地將30%的字母字符變為大寫。

(load "stat-spell.dat") ; *stat-spell* (alist for following characters) is in.

(define (alist->hash al mode)
  (let ((h (case mode
             ((eq) (make-eq-hash-table))
             ((eqv) (make-eqv-hash-table))
             ((equal) (make-equal-hash-table))
             ((string) (make-string-hash-table)))))
    (for-each (lambda (p)
                (hash-table/put! h (car p) (cdr p)))
              al)
    h))

(define *stat-spell-hash* (alist->hash *stat-spell* 'eqv))

(define (pw-random-select vec)
  (vector-ref vec (random (vector-length vec))))

(define (random00)
  (let loop ((i 0) (acc '()))
    (if (= i 2)
        (list->string acc)
      (loop (1+ i) (cons (pw-random-select '#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) acc)))))

(define (occasional-upcase c)
  (if (< (random 10) 3)
      (char-upcase c)
    c))

(define (pw-enhance ls)
  (list->string
   (map (lambda (c)
          (cond
           ((char=? c #\Space)
            (pw-random-select  '#(#\- #\_ #\/  #\Space  #\. #\, #\@ #\? #\( #\))))
           ((char-alphabetic? c)
            (occasional-upcase c))
           (else c)))
        (cdr (reverse! ls)))))


(define (random-following alist)
  (let ((n (random (apply + (map cdr alist)))))
    (let loop ((j 0) (alist alist))
      (if (pair? alist)
      (let* ((pair (car alist))
         (k (+ j (cdr pair))))
        (if (> k n)
        (car pair)
        (loop k (cdr alist))))))))

(define (make-pw h n)
  (let loop ((i 0) (c #\Space) (acc '()))
    (if (= i n)
        (string-append
         (pw-enhance (cons #\Space (cons c acc)))
         (random00))
      (loop (1+ i)
        (random-following (hash-table/get h c '((#\Space . 1))))
        (cons c acc)))))

(define (pw-candidates)
  (let loop ((i 0))
    (if (< i 10)
        (begin
         (display i)
         (display ": ")
         (write (make-pw *stat-spell-hash* (+ 9 (random 4))))
         (newline)
         (loop (1+ i)))
      'done)))

Vectors and Structures

vector 是使用整數索引的資料,可儲存不同資料型別的資料。跟 list 比較,vector資料更緊密且存取時間很短。但是 vector 是透過 side effect 來處理資料,會造成一些問題。

scheme 的 structures 跟 C 語言類似,但更容易使用,因為 scheme 為 structure 提供了讀取及寫入的函數(使用了 Lisp/Scheme 的 macro)。

vector

#( ) 表示,例如 #(1 2 3),作為 literals 時,必須要 quoted

ex:

'#(1 2 3) 整數向量

'#(a 0 #\a) symbol, 整數, char 的向量

R5RS規格中的向量函數

  • (vector? obj)

    如果obj是一個向量則返回#t。

  • (make-vector k) (make-vector k fill)

    返回有 k 個元素的向量。如果指定了第二個參數(fill),那麼所有的元素都會被初始化為fill。

  • (vector obj …)

    返回由參數列表構成的向量。

  • (vector-length vector)

    返回向量 vector 的長度。

  • (vector-ref vector k)

    返回向量 vector 的索引為 k 的元素。(向量的索引從0開始。)

  • (vector-set! vector k obj)

    將向量 vector 的索引為 k 的元素修改為 obj。

  • (vector->list vector)

    將 vector 轉換為 list。

  • (list->vector list)

    將 list 轉換為向量。

  • (vector-fill! vector fill)

    將向量 vector 的所有元素設定為 fill。

ex: 向量加法

(define (vector-add v1 v2)
  (let ((lenv1 (vector-length v1))
          (lenv2 (vector-length v2)))
    (if (= lenv1 lenv2)
          (let ((v (make-vector lenv1)))
            (let loop ((i 0))
              (if (= i lenv1)
                    v
                    (begin
                      (vector-set! v i (+ (vector-ref v1 i) (vector-ref v2 i)))
                      (loop (+ 1 i))))))
        (error "different dimensions."))))

(vector-add #(1 2 3) #(1 2 3))
;Value 2: #(2 4 6)

ex: 向量內積

(define (inner-product vec1 vec2)
  (let ((len1 (vector-length vec1))
          (len2 (vector-length vec2)))
    (if (= len1 len2)
        (let loop ((i 0) (pro 0))
          (if (= i len1)
              pro
              (loop (+ 1 i)
                  (+ pro (* (vector-ref vec1 i) (vector-ref vec2 i))))))
        (error "different dimensions."))))


(inner-product #(1 2 3) #(1 2 3))
;Value: 14

structure

R5RS 沒有定義 structure,但在 scheme 有實作類似於 Common Lisp 的 structure。

structure 本質上就是向量。每一個 slot 都透過 macro 來命名。

scheme 透過 define-structure 定義 structure,例如 定義書籍

(define-structure book title authors publisher year isbn)

(define bazaar 
  (make-book 
   "The Cathedral and the Bazaar"
   "Eric S. Raymond"
   "O'Reilly"
   1999
   0596001088))

但這樣定義,並沒有明確的屬性定義,改用 keyword-constructor 解決這個問題,其中參數 copier可用於為 structure 建立一個拷貝(copier)函數

(define-structure (book keyword-constructor copier) 
  title authors publisher year isbn)

(define bazaar 
  (make-book 
   'title "The Cathedral and the Bazaar"
   'authors "Eric S. Raymond"
   'publisher "O'Reilly"
   'year 1999    
   'isbn 0596001088))

支援 structure 的函數

  • [the name of structure]?的函數用於檢查某對象是否為特定structure。例如,可使用函數book?來檢查bazaar是否為book結構的一個實例。

    (book? bazaar)
    ;Value: #t
  • copy-[structure name] 函數用於拷貝結構。例如將 bazaar 複製到 cathedral

    (define cathedral (copy-book bazaar))
  • [structure name]-[attribute name] 函數用於讀取structure 某屬性的值。例如,讀取bazaartitle屬性。

    (book-title bazaar)
    ;Value 3: "The Cathedral and the Bazaar"
  • set-[結構體名稱]-[屬性名稱]!用於將某屬性設定為特定值

    (set-book-year! bazaar 2001)
    ;Unspecified return value
    
    (book-year bazaar)
    ;Value: 2001

Sample: Mastermind

一個猜對手密碼的遊戲。密碼是由0到9中四個不同的數組成的四位數。對手要通過使用bullscows的數量告知猜謎者猜測的準確程度。

  1. bull的數量(Nbull)是指值和位置都正確的數字的數量。
  2. cow的數量(Ncow)是指值正確但位置錯誤的數字的數量。

例如,密碼是5601,猜測是1685,那麼bullcow和數分別是1和2。

程式和用戶相互猜測對方的密碼。嘗試次數少的為勝利者。如果用戶和電腦在相同的嘗試次數中破解了密碼就是平局。

表示數字的方法:

產生長度為 10 的向量,索引值 k 表示 k 在密碼中的位置,四個位置為 1, 2, 3, 4,如果該數字沒乙出現,就是 0

5601  ->  #(2 1 0 0 0 4 3 0 0 0)   ; 數字0,1,5,和6分別出現在第2,第1,第4和第3位
1685  ->  #(0 4 0 0 0 1 3 0 2 0)

這樣的表示方式,可以快速地比較兩個數字,如果兩個向量,在相同索引位置的值都是正數,如果該值相等,就記為 bull,如果值不相等,就計為 cow。

以 5601 與 1685 為例,索引位置 6 的值都是 3,索引位置 1, 5 的值都是正數,bull, cow 的值是 1 與 2。

程式:
  1. 產生成一個 list,該表包含了所有不同四位數的向量表示。
  2. 從 list 中隨機選取一個數字。
  3. 重洗步驟(1)產生的表。
  4. 程式首次猜用戶的密碼,用戶給出bull和cow的數量。然後用戶猜程序的密碼,程序給出Nnull和Ncow。
  5. 重複步驟(3)直到程式的bull數量變為4為止。如果在同一次雙方的數量都變為4,就是平局。
測試:

先編譯程式再執行

(compile-file "mastermind.scm")
(load "mastermind")
(mastermind)

References

mit-scheme user doc

Yet Another Scheme Tutorial 中文版

Yet Another Scheme Tutorial

沒有留言:

張貼留言