喫茶XRAY [Mr.XRAY掲示板]

Delphiで単純パーセプトロンを作ってみました。
入力はx1,x2でANDゲートの動きをします。

参考にしたサイト
http://hokuts.com/2015/11/24/ml1_func/
https://qiita.com/yudsuzuk/items/a8e1eee92403f0921d92
http://enakai00.hatenablog.com/entry/20150112/1421036041

実行結果の見方は
0,0  -0.63… 負なので0
0,1  -0.15… 負なので0
1,0  -0.02… 負なので0
1,1  0.469… 正なので1
ボタンを押す度に違う値になりますが、負,負,負,正は同じです。

教師データをNANDやORに書き換えるとそのように学習します。

重みを更新の部分のWeightVector[]はforループを使用するべきでしょう。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, System.Types,
  Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

  InputNodeCount:integer;        // 入力ノード数
  InputVector:TDoubleDynArray;   // 入力ベクトルサイズはInputNodeCount + 1
  WeightVector:TDoubleDynArray;  // 重みベクトルサイズはInputNodeCount + 1
  TeachrData:TDoubleDynArray;    // 教師データ   サイズはInputNodeCount + 2

  aa,cc:Double;

implementation

{$R *.dfm}

procedure SetRandomWeightVector(var AWeightVector:TDoubleDynArray);
var
  i,lng:integer;
begin
  lng := Length(AWeightVector);
  Randomize;
  for i := 0 to lng - 1 do begin
    AWeightVector[i] := Random; // 0～1
  end;
end;

// 識別関数
function DiscriminantFunction(var AInputVector:TDoubleDynArray;
                              var AWeightVector:TDoubleDynArray):Double;
var
  i,j,lng:integer;
  val:Double;
begin
  lng := Length(AInputVector);
  val := 0.0;
  AInputVector[0] := 1.0;  // バイアスなので強制的に1.0へ
  for i := 0 to lng - 1 do begin
    val := val + AWeightVector[i] * AInputVector[i];
  end;
  result := val;
end;

// ANDの場合の教師データ 4種類のデータをセット
procedure SetTeachrData(var TData:TDoubleDynArray; DataNo:integer);
begin
  if DataNo = 0 then begin
    TData[0] := 1;    // バイアス1
    TData[1] := 0;    // 入力1
    TData[2] := 0;    // 入力2
    TData[3] := 0;    // 答え
  end;
  if DataNo = 1 then begin
    TData[0] := 1;
    TData[1] := 0;
    TData[2] := 1;
    TData[3] := 0;
  end;
  if DataNo = 2 then begin
    TData[0] := 1;
    TData[1] := 1;
    TData[2] := 0;
    TData[3] := 0;
  end;
  if DataNo = 3 then begin
    TData[0] := 1;
    TData[1] := 1;
    TData[2] := 1;
    TData[3] := 1;
  end;
end;

procedure StudyPerceptron;
var
  i,j,k,maxloop:integer;
  rho,wx:Double;
begin
  rho := 0.1;   // 更新の刻み値
  maxloop := 0;
  // 重みをランダムで設定
  SetRandomWeightVector(WeightVector);

  repeat
    k := 0;  // 更新のカウンタ
  // 全教師データで処理
    for i := 0 to 3 do begin
    // i= 0     1      2      3
    // x1,x2  x1,x2  x1,x2  x1,x2
    //  0,0    0,1    1,0    1,1
      SetTeachrData(TeachrData,i);
    // 教師データのXを入力し、
      for j := 0 to 2 do begin
        InputVector[j] := TeachrData[j];  // 1  x1 x2
      end;
    // 出力が正解と合っているかチェック
      wx := DiscriminantFunction(InputVector,WeightVector);
      if (wx >= 0) then begin  // プラス領域=1
        if (TeachrData[3] = 0) then begin  // しかし答えは0で、間違いなので重み更新
          inc(k);     // 更新の回数を記憶
          WeightVector[0] := WeightVector[0] - rho;                 // 重みを更新
          WeightVector[1] := WeightVector[1] - rho*InputVector[1];  // 重みを更新
          WeightVector[2] := WeightVector[2] - rho*InputVector[2];  // 重みを更新
        end else begin  // 答えも1なので
        // 何もしない
        end;
      end else begin  // マイナス領域 =0
        if (TeachrData[3] = 1) then begin  // しかし答えは1で、間違いなので重み更新
          inc(k);     // 更新の回数を記憶
          WeightVector[0] := WeightVector[0] + rho;                 // 重みを更新
          WeightVector[1] := WeightVector[1] + rho*InputVector[1];  // 重みを更新
          WeightVector[2] := WeightVector[2] + rho*InputVector[2];  // 重みを更新
        end else begin  // 答えも0なので
        // 何もしない
        end;
      end;
    end;

    inc(maxloop);   // 無限ループ脱出用
    if maxloop > 10000 then break;
  until k = 0;   // 重みの更新がなくなるまで繰り返す
  // 無い場合、終了
  aa := - WeightVector[1] / WeightVector[2];     // グラフの傾き
  cc := - WeightVector[0] / WeightVector[2];     // グラフの切片

  Form1.Label1.Caption := floattostr(aa);
  Form1.Label2.Caption := floattostr(cc);
  Form1.Label3.Caption := inttostr(k);
  Form1.Label4.Caption := inttostr(maxloop);

  Form1.Label5.Caption := floattostr(WeightVector[0]);
  Form1.Label6.Caption := floattostr(WeightVector[1]);
  Form1.Label7.Caption := floattostr(WeightVector[2]);

  Form1.Label12.Caption := floattostr(WeightVector[0]);
  Form1.Label13.Caption := floattostr(WeightVector[0] + WeightVector[2]);
  Form1.Label14.Caption := floattostr(WeightVector[0] + WeightVector[1]);
  Form1.Label15.Caption := floattostr(WeightVector[0] + WeightVector[1] + WeightVector[2]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InputNodeCount := 2;    // 入力2
  SetLength(InputVector,InputNodeCount + 1);
  SetLength(WeightVector,InputNodeCount + 1);
  SetLength(TeachrData,InputNodeCount + 2);
  StudyPerceptron;
end;

end.