１ システム理論演習２
     最終課題（１１） ソフトウェア開発
                                               
                                         ７１２０８D
                                         鈴木雄治郎
                                         基礎科学科第二

２ ソフトウェアの概略

   最終課題はパターン認識のアルゴリズムをつくってみました。
   パターン認識といってもたいしたものではなくニューラルネットワークの
   古典的なパーセプトロンのモデルで、複数入力単出力のネットワークモデルです。
   今回は9個の入力があるもので、x(0 1 0 1 0 1 0 1 0 1) といった0と1だけの入
   力です。この行列でできるパターンは大量にありますが、今回は2グループに分け
   やすい20個のパターンを使いました。20個のパターンのうちそれぞれが2グループ
   のうちのどちらに組するものなのかを判定する。
     重みベクトルである行ベクトルwにはじめてきとうな初期値をあたえる。
     そのwに1個ずつパターン行列の列ベクトルxを掛ける。
     その値が正であれば集合１、負であれば集合２に属するようにしたいのだが
     wは適当にいれただけなのでうまく20パターンを2つにわけることができない。
     そこで学習によってwの値を変化させていき、最終的には思い通りの出力がでる
     ようにwの値を求める。

３ 使い方

   以下の関数をすべて読み込み
     > (c-perceptron joken w xlist)
   と打ち込むだけす。
   これは最終的な重みベクトルwがでてくるだけですが、
     > (n-perceptron joken w xlist n)
   の最後の引数のnに実行回数（wの修正回数）をいれると決まった回数後の結果が
   見られ、wの修正の様子が見られます。
   c-perceptronは結構実行時間がかかります。
   wの初期値は自分でてきとうに
     > (define w (list 1 1 1 1 1 1 1 1 1 1))
   などと定義して実行できます。
   xの20パターンも自分で変えることができますが、このパーセプトロンには線形分
   離可能不可能というもんだいがあり、ここに載せてあるものを使うのが無難です。
   また、3入力のものなどで実行したいときは関数 hantei をグループ１を示す 
   joken の要素の数だけ matrix-eq の足し算が行なわれるように数を減らし、
   c-perceptron においては全パターン数（xlist の要素数）だけ matrix-eq のかけ
   算が行なわれるように変更すればよい。もちろん w xlist も書き換える。
   アルゴリズムの関係上3入力の場合 w x は4つの要素をもつ、xについてはそれぞれ
   の先頭に必ず1をつけるようにしなければならない。

(define (matrix-product list1 list2)
  (cond ((null? list1) 0)
        (else
         (+
          (* (car list1) (car list2))
          (matrix-product (cdr list1) (cdr list2))))))
(define (matrix-sub list1 list2)
  (cond ((null? list1) list1)
        (else (cons (- (car list1) (car list2))
                    (matrix-sub (cdr list1) (cdr list2))))))
(define (matrix-add list1 list2)
  (cond ((null? list1) list1)
        (else (cons (+ (car list1) (car list2))
                    (matrix-add (cdr list1) (cdr list2))))))
(define (matrix-eq list1 list2)
  (cond ((null? list1) 1)
        (else (cond ((= (car list1) (car list2))
                     (matrix-eq (cdr list1) (cdr list2)))
              (else 0)))))
(define (list-ref list n)
  (if (= n 1)
      (car list)
      (list-ref (cdr list) (- n 1))))
(define (append list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (append (cdr list1) list2))))
(define (change list)
  (append (cdr list) (cons (car list) '())))
(define (hantei joken x)
  (+ (matrix-eq  x (list-ref joken 1))
     (matrix-eq  x (list-ref joken 2))
     (matrix-eq  x (list-ref joken 3))
     (matrix-eq  x (list-ref joken 4))
     (matrix-eq  x (list-ref joken 5))
     (matrix-eq  x (list-ref joken 6))
     (matrix-eq  x (list-ref joken 7))
     (matrix-eq  x (list-ref joken 8))
     (matrix-eq  x (list-ref joken 9))
     (matrix-eq  x (list-ref joken 10))))
(define (perceptron joken w x)
  (cond ((and (> 0 (matrix-product w x))
              (= 1 (hantei joken x)))
         (begin (set! w w)
                w))
        ((and (< 0 (matrix-product w x))
              (= 0 (hantei joken x)))
         (begin (set! w w)
                w))
        ((and (<= 0 (matrix-product w x))
              (= 1 (hantei joken x)))
         (begin (set! w (matrix-sub w x))
                w))
        ((and (>= 0 (matrix-product w x))
              (= 0 (hantei joken x)))
         (begin (set! w (matrix-add w x))
                w))))
(define (n-perceptron joken w xlist n)
  (cond ((= n 1) (perceptron joken w (car xlist)))
        (else (n-perceptron joken (perceptron joken w (car xlist))
			    (change xlist) (- n 1)))))
(define (c-perceptron joken w xlist)
  (cond ((= 1 (* (matrix-eq w (n-perceptron joken w xlist 1))
                 (matrix-eq w (n-perceptron joken w xlist 2))
	         (matrix-eq w (n-perceptron joken w xlist 3))
                 (matrix-eq w (n-perceptron joken w xlist 4))
		 (matrix-eq w (n-perceptron joken w xlist 5))
                 (matrix-eq w (n-perceptron joken w xlist 6))
	         (matrix-eq w (n-perceptron joken w xlist 7))
                 (matrix-eq w (n-perceptron joken w xlist 8))
                 (matrix-eq w (n-perceptron joken w xlist 9))
		 (matrix-eq w (n-perceptron joken w xlist 10))
                 (matrix-eq w (n-perceptron joken w xlist 11))
                 (matrix-eq w (n-perceptron joken w xlist 12))
	         (matrix-eq w (n-perceptron joken w xlist 13))
                 (matrix-eq w (n-perceptron joken w xlist 14))
		 (matrix-eq w (n-perceptron joken w xlist 15))
                 (matrix-eq w (n-perceptron joken w xlist 16))
	         (matrix-eq w (n-perceptron joken w xlist 17))
                 (matrix-eq w (n-perceptron joken w xlist 18))
                 (matrix-eq w (n-perceptron joken w xlist 19))
		 (matrix-eq w (n-perceptron joken w xlist 20))))
         w)
        (else (c-perceptron joken (perceptron joken w (car xlist))
			    (change xlist)))))

(define w (list 1 2 3 4 5 6 7 8 9 10))

(define xlist (list (list 1 0 1 1 0 1 0 1 0 1)
		    (list 1 1 0 1 0 1 0 1 1 1)
		    (list 1 0 1 1 1 1 0 1 1 1)
		    (list 1 0 1 1 1 1 0 0 1 1)
		    (list 1 0 0 0 1 1 1 0 1 1)
		    (list 1 0 0 1 0 1 0 0 0 0)
		    (list 1 1 1 1 0 1 1 1 1 1)
		    (list 1 0 1 1 0 1 0 0 0 0)
		    (list 1 0 0 1 0 1 0 1 1 0)
		    (list 1 0 1 1 0 0 1 0 1 1)
		    (list 1 1 0 0 1 1 1 1 1 1)
		    (list 1 1 0 0 1 0 1 1 1 1)
		    (list 1 0 0 1 0 0 0 0 0 0)
		    (list 1 1 1 1 1 1 1 0 0 0)
		    (list 1 0 0 0 1 1 1 1 0 1)
		    (list 1 1 0 1 1 0 1 0 0 0)
		    (list 1 1 0 0 0 1 1 0 1 0)
		    (list 1 1 1 1 1 1 0 1 1 0)
		    (list 1 0 0 1 0 0 1 1 0 1)
		    (list 1 0 0 1 1 0 0 1 1 0)))

(define joken (list (list 1 0 1 1 0 1 0 1 0 1)
		    (list 1 1 0 1 0 1 0 1 1 1)
		    (list 1 0 1 1 1 1 0 1 1 1)
		    (list 1 0 1 1 1 1 0 0 1 1)
		    (list 1 0 0 0 1 1 1 0 1 1)
		    (list 1 0 0 1 0 1 0 0 0 0)
		    (list 1 1 1 1 0 1 1 1 1 1)
		    (list 1 0 1 1 0 1 0 0 0 0)
		    (list 1 0 0 1 0 1 0 1 1 0)
		    (list 1 0 1 1 0 0 1 0 1 1)))

(define w (list 0 0 0 0))

(define xlist (list (list 1 1 1 1) (list 1 1 1 0) (list 1 1 0 1)
		    (list 1 0 1 1) (list 1 0 1 0) (list 1 0 0 0)))

(define joken (list (list 1 1 0 1) (list 1 0 1 1) (list 1 0 0 0)))



４ 使用例

> (define w (list 1 1 1 1 1 1 1 1 1 1)) 
;Evaluation took 0 mSec (0 in gc) 38 cells work, 51 bytes other
#<unspecified>
> (c-perceptron joken w xlist)   ／＊ wの最終値をもとめる
;Evaluation took 102716 mSec (16616 in gc) 19979813 cells work, 31 bytes 
                                                                    other
(2 3 -1 0 3 -4 3 1 -2 -4)
> (n-perceptron joken w xlist 10)   ／＊ wの10回修正した後の値をもとめる
;Evaluation took 50 mSec (16 in gc) 6560 cells work, 33 bytes other
(-1 0 0 -1 1 -1 1 -1 0 -1)
> (n-perceptron joken w xlist 20) 
;Evaluation took 83 mSec (0 in gc) 13020 cells work, 33 bytes other
(1 1 0 0 2 0 2 0 1 0)
> (n-perceptron joken w xlist 50)
;Evaluation took 166 mSec (0 in gc) 32398 cells work, 33 bytes other
(-1 1 -1 -1 1 -3 1 -1 -1 -3)
> (n-perceptron joken w xlist 100)
;Evaluation took 333 mSec (66 in gc) 63470 cells work, 33 bytes other
(2 3 -1 0 3 -2 3 1 0 -2)
> (n-perceptron joken w xlist 200)
;Evaluation took 633 mSec (116 in gc) 122440 cells work, 33 bytes other
(2 3 -1 0 3 -4 3 1 -2 -4)

   回数を増やすごとに最終値に近付く様子がわかる。


５
   このプログラムによって解析解をもとめるのが困難なネットワークのモデルを
   定量的に作ることができる。


６ プログラムの内容

  matrix-product    内積をもとめる
  matrix-sub        ベクトルの引き算
  matrix-add        ベクトルの足し算
  matrix-eq         2つのベクトルが等しいか判定
  list-ref          リストのn番目の要素をとりだす
  append            2つのリストをつなぐ
  change            リストの最前要素を後ろにうつす
  hantei            パターンxがグループ１に属するか判定
  perceptron        パーセプトロンの最も基本となるプログラム
                    4つの条件でwの修正の仕方をわけている
  n-perceptron      パーセプトロンをn回実行する
  c-perceptron      classic-perceptronということですべてのパターンについて
                     正しい出力がなされるまでperceptronを実行する

  w                 重みの初期値の設定
  xlist             全パターンのリスト
  joken             xlistのうちグループ１に属するもののリスト
                    xlistのうちこれにないものはグループ２とする


７ c71208/last.scm