情報処理演習第三回レポート（木曜三限,横尾真）

1TE11174G成林晃

情報処理演習II（木曜２限　横尾）

第三回レポート課題：(生成的再帰，知識の蓄積，グラフィック)

http://www.s.kyushu-u.ac.jp/~1TE11174G/index.html

(define (natint n)

  (cond

    [(= n 0) empty]

    [else (append (natint (- n 1)) (list n))]))

リストの順番が１からになるようappendの順序を逆にしてNから１へと減らすようにしている。

(define (sieve m l)

  (cond

    [(empty? l) empty]

    [(= (remainder (first l) m) 0) (sieve m (rest l))]

    [else (append (list (first l)) (sieve m (rest l)))]))

リストの最初の要素がｍで割れればリストに加えず再帰的に求めていくようにした。また割り切れるかどうかにはremainderを利用した。

(define (prime l)

  (cond

    [(empty? l) (append empty)]

    [(= 1 (first l)) (prime (rest l))]

    [else (append (list (first l)) (prime (sieve (first l) (rest l))))]))

Sieve関数を使いリストの最初の要素で割り切れるリストの要素を消していくようにした。また、１が含まれる場合はsieve関数を使わずリストの残りから再帰的に求めるようにした。

2-1

(define-struct valnode (value left right))

;;BinSearchTree?:any->boolean

(define (BinSearchTree? a-tree)

  (cond

    [(empty? a-tree) true]

    [(not (valnode? a-tree)) false]

    [(and

      (not (empty? (valnode-left a-tree)))

      (> (valnode-value (valnode-left a-tree))

         (valnode-value a-tree))) false]

    [(and

      (not (empty? (valnode-right a-tree)))

      (< (valnode-value (valnode-right a-tree))

         (valnode-value a-tree))) false]

    [else

     (and

      (BinSearchTree? (valnode-left a-tree))

      (BinSearchTree? (valnode-right a-tree)))]))

2-2

(define-struct valnode (value left right))

(define (BinSearchTreeMin a-tree)

  (cond

    [(empty? (valnode-left a-tree)) (valnode-value a-tree)]

    [else (BinSearchTreeMin (valnode-left a-tree))]))

このプログラムはいちばん左にあるノードのvalueを出力するような関数である。

3-2

(define-struct node (sn pn left right))

(define list-of-valnode

(list (list 'A 61)

(list 'B 28)

(list 'C 89)

(list 'D 16)

(list 'E 77)

(list 'F 96)

(list 'G 12)

(list 'H 25)

(list 'I 98)

(list 'J 37)

(list 'K 21)

(list 'L 22)

(list 'M 88)

(list 'N 90)

(list 'O 100)

(list 'P 76)

(list 'Q 35)

(list 'R 1)))

;;to set the canvas' size

(define width 700)

(define height 730)

;;to set the disk's radius and color

(define disk-radious 5)

(define disk-color 'blue)

(define line-color 'black)

;;to set root position

(define TopMargine 30)

(define root-pos

  (make-posn (/ width 2)

  (+ disk-radious TopMargine)))

;; draw-node : node posn -> boolean

;;to draw a disk and a string at a-posn position

(define (draw-node a-node a-posn)

  (and

   (draw-solid-disk a-posn disk-radious disk-color)

   (draw-solid-string a-posn (number->string (node-sn a-node)))

))

;;to draw-line: node posn posn -> true

(define (draw-line a-node a-posn1 a-posn2)

  (cond

    ;;if a-node = empty -> the branch will not be drawn.

    [(empty? a-node) true]

    [else

     (draw-solid-line a-posn1 a-posn2 line-color)]))

(define N (length list-of-valnode));;num of "fusi"

(define DP (/ (- height TopMargine) (- N (log N))));;length between fusi

;;get-next-left-posn : posn number -> posn

(define (get-next-left-posn a-posn width)

  (make-posn (-(posn-x a-posn) width)

             (+ (posn-y a-posn) DP)))

;;get-next-right-posn : posn number number -> posn

(define (get-next-right-posn a-posn width)

  (make-posn (+ (posn-x a-posn) width)

   (+ (posn-y a-posn) DP)))

(define Interval-Time 0.5);;to wait time between make brance etc...

;; draw-node-and-branches : node posn number -> true

(define (draw-node-and-branches node a-posn width)

  (and ;;to draw node

   (draw-node node a-posn)

   (sleep-for-a-while Interval-Time)

   ;;to draw left and right branches

   (draw-line (node-left node) a-posn

              (get-next-left-posn a-posn (/ width 2)))

   (sleep-for-a-while Interval-Time)

   (draw-line (node-right node) a-posn

              (get-next-right-posn a-posn (/ width 2)))

))

;;to make the tree

(define (draw-tree node a-posn width)

  (cond

    [(empty? node) true]

    [else

     (and

      ;;to draw node and edges

      (draw-node-and-branches node a-posn width)

      ;;to traverse left and right nodes

      (draw-tree (node-left node)

                 (get-next-left-posn a-posn (/ width 2)) (/ width 2))

      (draw-tree (node-right node)

                 (get-next-right-posn a-posn (/ width 2)) (/ width 2))

)]))

;; add-node : node (listof number symbol) -> node

(define (add-node bt alosp)

  (cond

    [(empty? bt)

     (make-node (first (rest alosp))(first (rest alosp)) empty empty)]

    [else

     (cond

       [(= (node-sn bt) (first (rest alosp))) bt]

       [(> (node-sn bt) (first (rest alosp)))

        (make-node (node-sn bt) (node-pn bt)

                   (add-node (node-left bt) alosp)

                   (node-right bt))]

       [else

        (make-node (node-sn bt) (node-pn bt)

                   (node-left bt)

                   (add-node (node-right bt)alosp))])]))

;;create-btree : node (lof (lof symbol number))->node

(define (create-btree bt lof-alosp)

  (cond

    [(empty? lof-alosp) bt]

    [else

     (create-btree

      (add-node bt (first lof-alosp))

      (rest lof-alosp))]))

(define Root-Pos

  (make-posn (/ width 2) (+ disk-radious TopMargine)))

(start width height)

(draw-tree (create-btree empty list-of-valnode) Root-Pos (/ width 3))

;; height-2 : tree -> number

;;to measure the height of a tree

(define (height-2 abt)

  (cond

    [(empty? abt) 0]

    [else (+ 1

             (max (height-2 (node-left abt))

                  (height-2 (node-right abt))))]))

(define Root-Pos-2

  (make-posn (+ (/ width 2) (* 4 disk-radious)) (+ (* 2 disk-radious) TopMargine)))

(draw-solid-string Root-Pos-2 (number->string (height-2 (create-btree empty list-of-valnode))))

感想：今回のプログラムは難しすぎて、前回のようにschemeの文法に慣れていないために完成させることができないのではなくアルゴリズムを考えることそのものもかなり難しかったです。