喫茶XRAYトップページ

[スレッド全体]
[12680] Re2:単純パーセプトロンを作ってみました。返信　削除
2019/4/6 (土) 16:39:44 taki
> 識別関数のテストが主な目的です。

識別関数のテストではなく、機械学習のテストが目的です。

それで、メールのSPAM、非SPAMのデータを作成してテストしました。
unitも別にしました。
関数、手続きの名前もGoogleで調べてそれらしい物に変えました。

懲りずにソースを挙げます。

実は理解不明な現象が起きています。
どこが間違っているのでしょうか。困っています。

ソースを一度に投稿したら投稿許可サイズを超えてしまいました。
分割して投稿します。

最初にパーセプトロンの分です。
-------------------------------------------------------------------
unit UnitSimplePerceptron;

interface

uses
  Winapi.Windows, Winapi.Messages, System.Types, Unit1, System.SysUtils;

var
  InputNodeCount:integer;        // 入力ノード数
  InputVector:TDoubleDynArray;   // 入力ベクトル サイズはInputNodeCount + 1
  WeightVector:TDoubleDynArray;  // 重みベクトル サイズはInputNodeCount + 1

  TeachingDataCount:integer;     // 教師データの数
  TeachingData :array of TDoubleDynArray;   // サイズはInputNodeCount + 1
  TeachingLabel:array of Integer;           // 対象 1, 非対象 -1

procedure SetRandomWeightVector(var AWeightVector:TDoubleDynArray);
function DiscriminantFunction(var AInputVector:TDoubleDynArray;
                              var AWeightVector:TDoubleDynArray):Double;
function MachineLearning(AInputNodeCount,ATeachingDataCount,Amaxloop:integer):integer;
procedure CrtTeachingData(AInputNodeCount,ATeachingDataCount:integer);

implementation

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,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;

// SPAMメール教師データ作成
procedure CrtTeachingData(AInputNodeCount,ATeachingDataCount:integer);
var
  i,j:integer;
begin
  Randomize;
  SetLength(TeachingData,ATeachingDataCount);
  for i := 0 to ATeachingDataCount - 1 do begin
    SetLength(TeachingData[i],AInputNodeCount + 1);
    TeachingData[i][0] := 1.0;              // X0
    for j := 1 to AInputNodeCount do begin  // X1,X2
      TeachingData[i][j] := Random * 5.0;   // 単語の出現回数
    end;
  end;

  // 教師用データのラベルを設定
  SetLength(TeachingLabel,ATeachingDataCount);
  for i := 0 to ATeachingDataCount - 1 do begin
    // SPAM指定
    if (TeachingData[i][1] + TeachingData[i][2]) > 3.8 then begin
      TeachingLabel[i] := 1;   // SPAM
      end else begin
      TeachingLabel[i] := -1;  // 非SPAM
    end;
  end;
end;

// 機械学習
function MachineLearning(AInputNodeCount,ATeachingDataCount,Amaxloop:integer):integer;
var
  i,j,k,maxloop,t:integer;
  rho,wx:Double;
begin
  rho := 0.1;   // 更新の刻み値ρ
  maxloop := 0;
  // 重みをランダムで設定
  SetRandomWeightVector(WeightVector);

  repeat
    k := 0;  // 更新のカウンタ
  // 全教師データで処理
    for i := 0 to ATeachingDataCount - 1 do begin
    // 教師データのXを入力し、
      for j := 0 to 2 do begin
        InputVector[j] := TeachingData[i][j];  // 1  x1 x2
      end;
    // 出力が正解と合っているかチェック
      wx := DiscriminantFunction(InputVector,WeightVector);
{
      if (wx >= 0) then begin               // i番目のデータはSPAMと識別した
        if TeachingLabel[i] = -1 then begin // しかし、実際は非SPAMだったので修正
          inc(k);                           // 更新の回数を記憶
          for j := 0 to AInputNodeCount do begin
            WeightVector[j] := WeightVector[j] - rho*InputVector[j];  // 重みを更新
          end;
        end;
      end else begin                       // i番目のデータは非SPAMと識別した
        if TeachingLabel[i] = 1 then begin // しかし、実際はSPAMだったので修正
          inc(k);                          // 更新の回数を記憶
          for j := 0 to AInputNodeCount do begin
            WeightVector[j] := WeightVector[j] + rho*InputVector[j];  // 重みを更新
          end;
        end;
      end;
}
{ 以下のコードは上のコメントアウトのコードと同等}
      t := TeachingLabel[i];              // t は -1 or +1 の値をとる
      if (wx * t) < 0 then begin          // wx * t がマイナスの時は更新が必要な時
        inc(k);                           // 更新の回数を記憶
        for j := 0 to AInputNodeCount do begin
          WeightVector[j] := WeightVector[j] + t * rho * InputVector[j];  // 式にtが入っている
        end;
      end;
{  }
    end;  // of for 全教師データ

    inc(maxloop);   // 無限ループ脱出用
    if maxloop > Amaxloop then break;
  until k = 0;   // 重みの更新がなくなるまで繰り返す
  // 無い場合、終了
  if k = 0 then result := maxloop else result := -1;
end;

end.
[12681] Re3:単純パーセプトロンを作ってみました。返信　削除
2019/4/6 (土) 16:41:57 taki
次に呼び出し側の分です。
-------------------------------------------------------------------
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

procedure ShowKekka;

implementation

uses UnitSimplePerceptron;

{$R *.dfm}

procedure ShowKekka;
var
  i,j,xx,yy,lp:integer;
  aa,cc:double;
begin
  with Form1 do begin
    Application.ProcessMessages;
    Image1.Picture := nil;
    for i := 0 to 99 do begin
      xx := round(TeachingData[i][1] * 80);    // '特売'の出現回数
      yy := round(TeachingData[i][2] * 80);    // '今すぐクリック'の出現回数
      yy := Image1.Height - yy;
      if TeachingLabel[i] = 1 then begin      // SPAMっぽい
        Image1.Canvas.Pixels[xx,yy] := clRed;
        Image1.Canvas.Pixels[xx+1,yy] := clRed;
        Image1.Canvas.Pixels[xx+1,yy+1] := clRed;
        Image1.Canvas.Pixels[xx,yy+1] := clRed;
      end else begin
        Image1.Canvas.Pixels[xx,yy] := clBlack;
        Image1.Canvas.Pixels[xx+1,yy] := clBlack;
        Image1.Canvas.Pixels[xx+1,yy+1] := clBlack;
        Image1.Canvas.Pixels[xx,yy+1] := clBlack;
      end;
    end;
    aa := -WeightVector[1]/WeightVector[2];
    cc := -WeightVector[0]/WeightVector[2];
    label1.Caption := floattostr(aa);
    label2.Caption := floattostr(cc);
    label3.Caption := inttostr(lp);      // ループの回数
    xx := 0;
    yy := round(aa*xx+cc);
    Image1.Canvas.MoveTo(xx*80,Image1.Height - yy*80);
    //
    yy := 0;
    xx := round((yy - cc) / aa);
    Image1.Canvas.LineTo(xx*80,Image1.Height - yy*80);
//    Application.ProcessMessages;
//    sleep(100);
//    Application.ProcessMessages;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j,xx,yy,lp:integer;
  aa,cc:double;
begin
  CrtTeachingData(2,100);     // (1,x1,x2)…100個
  //
  SetLength(InputVector,2 + 1);
  SetLength(WeightVector,2 + 1);
  lp := MachineLearning(2,100,1000);
  if lp > 0 then begin
    ShowKekka;
  end;

end;

// 入力結果の判定
procedure TForm1.Button2Click(Sender: TObject);
begin
// テストしたいデータをInputVectorにセットする
  InputVector[0] := 1;
  InputVector[1] := strtofloat(Edit1.Text);
  InputVector[2] := strtofloat(Edit2.Text);
  if DiscriminantFunction(InputVector,WeightVector) >= 0 then begin
    label4.Caption := 'SPAM';
  end else begin
    label4.Caption := '非SPAM';
  end;
end;

end.
-------------------------------------------------------------------

"特売"や"今すぐクリック"などの語句の出現数でSPAM度を計算しました。
"特売"はx1回、"今すぐクリック"はx2回含まれていたとして教師データを作成
しました。
また、２つの語句の合計が3.8回以上使われていたらSPAMメールとしました。

今回は黒点は非SPAMデータ、赤点はSPAMデータ、識別の線も表示しました。

困っている現象は、識別線のマイナス側（非SPAM側）に赤点（SPAM）データが
何個かある事です。
何度やってみても混ざり込みます。

機械学習のループでは全ての教師データが正確に識別された時にのみループから
抜け出す筈です。

しかしながら、最大ループ回数以下でループを抜け出しているのに混在する
理由がわかりません。

Button2はX1,X2に適当な数を入れてクリックすると、学習済みの識別関数を
使って結果が求まる事をテストしています。
識別関数は合計が約3.8回で学習しているので、3回は非SPAMという判定です。

長文すみません。

[12682] Re4:単純パーセプトロンを作ってみました。返信　削除
2019/4/6 (土) 16:54:10 taki
すみません。
原因がわかりました。

>     xx := 0;
>     yy := round(aa*xx+cc);
>     Image1.Canvas.MoveTo(xx*80,Image1.Height - yy*80);
>     //
>     yy := 0;
>     xx := round((yy - cc) / aa);
>     Image1.Canvas.LineTo(xx*80,Image1.Height - yy*80);

実数を丸めたものを80倍したら、誤差出るのは当たり前ですね。
80倍してから丸めたら混ざらなくなりました。

あ〜、はずかしい。

[12683] Re5:単純パーセプトロンを作ってみました。返信　削除
2019/4/8 (月) 10:21:34 Mr.XRAY
▼ takiさん

> あ〜、はずかしい。

私なんか，こんなこと毎度のことでございます．
しかし，面白いネタですね．

[12688] Re5:単純パーセプトロンを作ってみました。返信　削除
2019/4/10 (水) 23:23:00 Mr.XRAY
▼ takiさん

読み返してみて，つらづら思います．
かっては何にでも興味を持っていた時代がありましたねぇ (遠い目)

[▼次のスレッド]
INCM/CMT
Cyclamen v3.82