人工ニューラルネットワークをフルスクラッチで作成 ~Delphiソースコード集

人工ニューラルネットワークをフルスクラッチで作成 ~Delphiソースコード集

人工ニューラルネットワーク(Artificial Neural Network)を使用する為のファイルの準備

本ページ最下部にある「UMamAnn.pas」ソースコードを、プロジェクトフォルダ内に「UMamAnn.pas」ファイルとして保存します。 ほかに必要なファイルやライブラリはありません。
TMamAnnクラスのインスタンスを作り、Trainプロシージャで学習し、Runプロシージャで学習結果をもとに結果を返します。
活性化関数はシグモイド関数だけです。

参考URL
https://atmarkit.itmedia.co.jp/ait/articles/2202/09/news027.html

Delphiを起動して新規作成を行い、必要なコンポーネントをドラッグ&ドロップする

Delphi起動⇒ファイル⇒新規作成⇒WindowsVCLアプリケーション を選択します。
TButton 2個、TMemo 1個、をフォームへドラッグ&ドロップします。

Delphiで人工ニューラルネットワーク(Artificial Neural Network)を使用する

「ファイル」⇒「全て保存」でフォルダを作成して、プロジェクトとユニットを保存します。
プロジェクトフォルダ内にUMamAnn.pasファイルを配置します。

ソースコードを記述する

Button1のOnClickイベント、Button2のOnClickイベントに以下ソースコードを記述します。
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses UMamAnn;

procedure TForm1.Button1Click(Sender: TObject);
var Neurons:TArray<Integer>;
    Ann:TMamAnn;
    Inputs,OutPuts:TArray<Single>;
    epoch:Integer;//繰り返し学習
begin
  //排他論理和(XOR)を「回帰問題」として学習させる

  Memo1.Clear;

  SetLength(Neurons,3);//3層
  Neurons[0]:=2;//入力層のニューロン数
  Neurons[1]:=2;//中間層のニューロン数
  Neurons[2]:=1;//出力層のニューロン数
  SetLength(Inputs,2); //入力層データ
  SetLength(Outputs,1);//出力層データ
  Ann:=TMamAnn.Create(Neurons);
  try
    //10000回繰り返し学習させる
    for epoch := 1 to 10000 do
    begin
      //0 XOR 0 = 0を学習させる
      Inputs[0]:=0;
      Inputs[1]:=0;
      OutPuts[0]:= Trunc(Inputs[0]) XOR Trunc(Inputs[1]);
      Ann.Train(Inputs,Outputs);//学習
      //0 XOR 1 = 1を学習させる
      Inputs[0]:=0;
      Inputs[1]:=1;
      OutPuts[0]:= Trunc(Inputs[0]) XOR Trunc(Inputs[1]);
      Ann.Train(Inputs,Outputs);//学習
      //1 XOR 0 = 1を学習させる
      Inputs[0]:=1;
      Inputs[1]:=0;
      OutPuts[0]:= Trunc(Inputs[0]) XOR Trunc(Inputs[1]);
      Ann.Train(Inputs,Outputs);//学習
      //1 XOR 1 = 0を学習させる
      Inputs[0]:=1;
      Inputs[1]:=1;
      OutPuts[0]:= Trunc(Inputs[0]) XOR Trunc(Inputs[1]);
      Ann.Train(Inputs,Outputs);//学習
    end;

    //学習結果をファイルに保存する
    //Ann.SaveToFile('xor.net');

    Memo1.Lines.Add('排他論理和(XOR)を「回帰問題」として学習');
    //0 XOR 0 がいくつかAIに聞く
    Inputs[0]:=0;
    Inputs[1]:=0;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0f = %1.0f',[Inputs[0],Inputs[1],Outputs[0]])
    );
    //0 XOR 1 がいくつかAIに聞く
    Inputs[0]:=0;
    Inputs[1]:=1;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0f = %1.0f',[Inputs[0],Inputs[1],Outputs[0]])
    );
    //1 XOR 0 がいくつかAIに聞く
    Inputs[0]:=1;
    Inputs[1]:=0;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0f = %1.0f',[Inputs[0],Inputs[1],Outputs[0]])
    );
    //1 XOR 1 がいくつかAIに聞く
    Inputs[0]:=1;
    Inputs[1]:=1;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0f = %1.0f',[Inputs[0],Inputs[1],Outputs[0]])
    );
  finally
    Ann.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var Neurons:TArray<Integer>;
    Ann:TMamAnn;
    Inputs,OutPuts:TArray<Single>;
    epoch:Integer;//繰り返し学習
begin
  //排他論理和(XOR)を「分類問題」として学習させる

  Memo1.Clear;

  SetLength(Neurons,3);//3層
  Neurons[0]:=2;//入力層のニューロン数
  Neurons[1]:=2;//中間層のニューロン数
  Neurons[2]:=2;//出力層のニューロン数
  SetLength(Inputs,2); //入力層データ
  SetLength(Outputs,2);//出力層データ
  Ann:=TMamAnn.Create(Neurons);
  try
    //10000回繰り返し学習させる
    for epoch := 1 to 10000 do
    begin
      //0 XOR 0 = 0を学習させる
      Inputs[0]:=0;
      Inputs[1]:=0;
      OutPuts[0]:=1;//答えは「0」か
      OutPuts[1]:=0;//答えは「1」か
      Ann.Train(Inputs,Outputs);//学習
      //0 XOR 1 = 1を学習させる
      Inputs[0]:=0;
      Inputs[1]:=1;
      OutPuts[0]:=0;//答えは「0」か
      OutPuts[1]:=1;//答えは「1」か
      Ann.Train(Inputs,Outputs);//学習
      //1 XOR 0 = 1を学習させる
      Inputs[0]:=1;
      Inputs[1]:=0;
      OutPuts[0]:=0;//答えは「0」か
      OutPuts[1]:=1;//答えは「1」か
      Ann.Train(Inputs,Outputs);//学習
      //1 XOR 1 = 0を学習させる
      Inputs[0]:=1;
      Inputs[1]:=1;
      OutPuts[0]:=1;//答えは「0」か
      OutPuts[1]:=0;//答えは「1」か
      Ann.Train(Inputs,Outputs);//学習
    end;

    //学習結果をファイルに保存する
    //Ann.SaveToFile('xor.net');

    Memo1.Lines.Add('排他論理和(XOR)を「分類問題」として0か1かを学習');

    //0 XOR 0 が「0」か「1」のどちらかをAIに聞く
    Inputs[0]:=0;
    Inputs[1]:=0;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0fが 0の確率%3.0f%%、1の確率%3.0f%%',
        [Inputs[0],Inputs[1],Outputs[0]*100,Outputs[1]*100])
    );
    //0 XOR 1 がいくつかAIに聞く
    Inputs[0]:=0;
    Inputs[1]:=1;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0fが 0の確率%3.0f%%、1の確率%3.0f%%',
        [Inputs[0],Inputs[1],Outputs[0]*100,Outputs[1]*100])
    );
    //1 XOR 0 がいくつかAIに聞く
    Inputs[0]:=1;
    Inputs[1]:=0;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0fが 0の確率%3.0f%%、1の確率%3.0f%%',
        [Inputs[0],Inputs[1],Outputs[0]*100,Outputs[1]*100])
    );
    //1 XOR 1 がいくつかAIに聞く
    Inputs[0]:=1;
    Inputs[1]:=1;
    Ann.Run(Inputs,Outputs);
    Memo1.Lines.Add(
      Format('%1.0f XOR %1.0fが 0の確率%3.0f%%、1の確率%3.0f%%',
        [Inputs[0],Inputs[1],Outputs[0]*100,Outputs[1]*100])
    );
  finally
    Ann.Free;
  end;
end;

end.

実行する

実行ボタンを押して実行します。(デバッグ実行でもOK)
Button1をクリックすると、排他論理和(XOR)を「回帰問題」として学習し、AIが排他論理和の答えを返します。

Delphiで人工ニューラルネットワーク(Artificial Neural Network)を使用し排他論理和(XOR)を「回帰問題」として学習して答えを返す

Button2をクリックすると、排他論理和(XOR)を「分類問題」として学習し、AIが排他論理和の答えを返します。

Delphiで人工ニューラルネットワーク(Artificial Neural Network)を使用し排他論理和(XOR)を「分類問題」として学習して答えを返す

UMamAnn.pasソースコード

unit UMamAnn;
interface
uses System.Math,System.Classes,System.SysUtils;
{
  人工ニューラルネットワーク(Artificial Neural Network)クラスのライブラリ
  活性化関数はシグモイド関数と恒等関数を使用

  ◎=入力層のニューロン
  ●=中間層のニューロン
  ○=出力層のニューロン
  ■=重み
  ▼=バイアス
      値      重み           バイアス
      fSum    fWeight        fBias
      fOut    fGradsW        fGradsB
  i0 ◎◎
     j0j1     j0   j1   j2     j0j1j2
            i0■■ ■■ ■■ i0▼▼▼
              k0k1 k0k1 k0k1
  i1 ●●●
     j0j1j2   j0     j1        j0j1
            i1■■■ ■■■  i1▼▼
              k0k1k2 k0k1k2
  i2 ●●
     j0j1     j0   j1          j0j1
            i2■■ ■■      i2▼▼
              k0k1 k0k1
  i3 ○○
     j0j1
}

  type TMamAnn=class(TObject)
    private
      fSum:TArray<TArray<single>>;//各層の値(重み付線形和)
      fOut:TArray<TArray<single>>;//各層の値(重み付線形和の活性化関数適用後)
      fLayerCount:Integer;//層の数
      fNeuronCountInLayers:TArray<Integer>;//各層のニューロン数
      fLearningRate:single;//学習率
      fLoss:Single;//損失値(累計2乗誤差)
      fTrainCount:Integer;//学習回数
      fBias:TArray<TArray<single>>;//バイアス
      fWeight:TArray<TArray<TArray<single>>>;//重みづけ(-1~1)
      procedure ForwardProp(Inputs:TArray<Single>);//順伝播
      procedure BackProp(Outputs:TArray<Single>);  //逆伝播とパラメータ更新
      function Sigmoid(x:Single):Single;           //シグモイド
      function SigmoidDerivative(x:single):single; //シグモイドの導関数
      function GetLearningRate():Single;
      procedure SetLearningRate(LearningRage:Single);
    public
      constructor Create(
        NeuronCountInLayers:TArray<Integer>;LerningRate:Single=0.2
      );overload;
      constructor Create(Filename:String);overload;
      //学習
      procedure Train(Inputs,Outputs: TArray<Single>);
      //予測の実行
      procedure Run(Inputs:TArray<Single>;out Outputs:TArray<Single>);
      //MSE(平均二乗誤差)出力
      function GetMSE():Single;
      destructor Destroy; override;
      procedure SaveToFile(FileName:String);
      procedure LoadFromFile(FileName:String);
      property LearningRate:Single read GetLearningRate write SetLearningRate;
  end;

implementation

{ TMamAnn }

procedure TMamAnn.BackProp(Outputs:TArray<Single>);
var i,j,k:Integer;
    loss_der:single;
    back_error:TArray<Single>;
    active_der:single;
    delta:single;
    sum_der_w,sum_der_x:TArray<Single>;
    sum_der_b:Single;
    layer_grads_x:TArray<Single>;
begin
//逆伝播とパラメータ更新
  SetLength(layer_grads_x,0);
  for i := (fLayerCount-1) downto 1 do
  begin
    if i=(fLayerCount-1) then
    begin
      //出力層の場合
      SetLength(back_error,Length(Outputs));
      for j := Low(Outputs) to High(Outputs) do
      begin
        loss_der:=fOut[i][j]-Outputs[j];
        back_error[j]:=loss_der;
      end;
    end
    else
    begin
      //隠れ層(次の層への入力の偏微分係数)
      //最後に追加された入力の勾配(layer_grads_x)をback_errorに入れる
      SetLength(back_error,Length(layer_grads_x));
      Move(
        layer_grads_x[0],
        back_error[0],
        SizeOf(layer_grads_x[0])*Length(layer_grads_x)
      );
    end;
    for j := Low(fSum[i]) to High(fSum[i]) do
    begin
      if i=(fLayerCount-1) then
      begin
        //出力層の場合
        active_der:=1.0;
      end
      else
      begin
        //出力層以外の場合
        active_der:=SigmoidDerivative(fSum[i][j]);
      end;

      //fOut[i-1]配列をsum_der_wにコピー
      SetLength(sum_der_w,Length(fOut[i-1]));
      Move(
        fOut[i-1][0],
        sum_der_w[0],
        Sizeof(fOut[i-1][0])*Length(fOut[i-1])
      );
      sum_der_b:=1.0;
      //fWeight[i-1][j]配列をsum_der_xにコピー
      SetLength(sum_der_x,Length(fWeight[i-1][j]));
      Move(
        fWeight[i-1][j][0], sum_der_x[0],
        Sizeof(fWeight[i-1][j][0])*Length(fWeight[i-1][j])
      );

      //勾配を計算
      delta:=back_error[j]*active_der;
      //勾配からバイアス計算してバイアスを更新する
      fBias[i-1][j]:=fBias[i-1][j]-delta*sum_der_b*fLearningRate;

      if j=0 then SetLength(layer_grads_x,Length(sum_der_w));

      //重みと入力
      for k := Low(sum_der_w) to High(sum_der_w) do
      begin
        //勾配から重みの計算を行い重みを更新する
        fWeight[i-1][j][k]:=
          fWeight[i-1][j][k]-delta*sum_der_w[k]*fLearningRate;
        //入力は各ノードから前のノードに接続する全ての入力を合計する
        if j=0 then
        begin
          layer_grads_x[k]:=delta *sum_der_x[k];
        end
        else
        begin
          layer_grads_x[k]:=layer_grads_x[k]+delta *sum_der_x[k];
        end;
      end;
    end;
  end;
end;

constructor TMamAnn.Create(
  NeuronCountInLayers:TArray<Integer>;LerningRate: Single=0.2);
var i,j,k,num:Integer;
    scale:Single;
begin
  fLearningRate:=LerningRate;
  if fLearningRate>0.999 then fLearningRate:=0.999;
  if fLearningRate<0.001 then fLearningRate:=0.001;

  fLoss:=0;
  fTrainCount:=0;

  fLayerCount:=Length(NeuronCountInLayers);
  SetLength(fNeuronCountInLayers,fLayerCount);
  Move(
    NeuronCountInLayers[0],
    fNeuronCountInLayers[0],
    SizeOf(NeuronCountInLayers[0])*Length(NeuronCountInLayers)
  );

  Randomize;

  //値初期化
  SetLength(fOut,fLayerCount);
  SetLength(fSum,fLayerCount);
  for i := Low(fOut) to High(fOut) do
  begin
    num:=fNeuronCountInLayers[i];
    SetLength(fOut[i],num);
    SetLength(fSum[i],num);
  end;

  //バイアス初期化(0にする)
  SetLength(fBias,fLayerCount-1);
  for i := Low(fBias) to High(fBias) do
  begin
    SetLength(fBias[i],fNeuronCountInLayers[i+1]);
    for j := Low(fBias[i]) to High(fBias[i]) do
      fBias[i][j]:=0;
  end;

  //重みづけ初期化
  SetLength(fWeight,fLayerCount-1);
  for i := Low(fWeight) to High(fWeight) do
  begin
    SetLength(fWeight[i],fNeuronCountInLayers[i+1]);
    for j := Low(fWeight[i]) to High(fWeight[i]) do
    begin
      SetLength(fWeight[i][j],Length(fOut[i]));
      //scale:=sqrt(2/(Length(fWeight[i])*Length(fWeight[i][j])));
      scale:=1/sqrt(Length(fWeight[i][j]));
      for k := Low(fWeight[i][j]) to High(fWeight[i][j]) do
      begin
        //平均0、1/√nのガウス分布乱数や、
        //平均0、√(2/(n1+n2))のガウス分布乱数が良いようです
        //乱数だけだと永遠にMSEが収束しない場合がある(1/20回くらい)
        if k=Low(fWeight[i][j]) then
          fWeight[i][j][k]:=scale
        else if k=High(fWeight[i][j]) then
          fWeight[i][j][k]:=-scale
        else
          fWeight[i][j][k]:=RandG(0,scale);
      end;
    end;
  end;
end;


constructor TMamAnn.Create(Filename: String);
begin
  Randomize;
  Self.LoadFromFile(Filename);
end;

destructor TMamAnn.Destroy;
begin
  inherited;
end;

procedure TMamAnn.ForwardProp(Inputs: TArray<Single>);
var i,j,k:Integer;
    ww:Single;
begin
//順伝播
  //入力層に入力値を入れる
  Move(Inputs[0],fSum[0][0],SizeOf(Inputs[0])*Length(Inputs));
  Move(Inputs[0],fOut[0][0],SizeOf(Inputs[0])*Length(Inputs));

  //入力層から中間層から出力層まで計算する
  for i := Low(fWeight) to High(fWeight) do
  begin
    for j := Low(fWeight[i]) to High(fWeight[i]) do
    begin
      //fSum[i+1][j]:=
      //        fOut[i][  0]*fWeight[i][j][  0]+
      //        fOut[i][  1]*fWeight[i][j][  1]+
      //        fOut[i][...]*fWeight[i][j][...]+fBias[i][j];
      //fOut[i*1][j]:=活性化関数(fSum[i+1][j]);
      ww:=fBias[i][j];
      for k := Low(fWeight[i][j]) to High(fWeight[i][j]) do
      begin
        ww:=ww+fOut[i][k]*fWeight[i][j][k];
      end;
      fSum[i+1][j]:=ww;
      if i=(fLayerCount-2) then
      begin
        //出力層の場合 何もしない
      end
      else
      begin
        //出力層以外の場合
        ww:=Sigmoid(ww);//活性化関数(シグモイド)
      end;
      fOut[i+1][j]:=ww;
    end;
  end;
end;

function TMamAnn.GetLearningRate: Single;
begin
  result:=fLearningRate;
end;

function TMamAnn.GetMSE: Single;
begin
  //MSE(平均二乗誤差)出力
  if fTrainCount>0 then
    result:=fLoss/fTrainCount
  else
    result:=0;
end;

procedure TMamAnn.LoadFromFile(FileName: String);
var strm:TFileStream;
    i,j,k:Integer;
begin
  strm:=TFileStream.Create(FileName,fmOpenRead OR fmShareDenyWrite);
  try
    strm.Position:=0;
    //層数読み込み
    strm.ReadData(fLayerCount);
    //層ごとのニューロン数読み込み
    setLength(fNeuronCountInLayers,fLayerCount);
    for i := 0 to fLayerCount-1 do
      strm.ReadData(fNeuronCountInLayers[i]);
    //学習率の読み込み
    strm.ReadData(fLearningRate);
    //損失値(累計2乗誤差)読み込み
    strm.ReadData(fLoss);
    //学習回数読み込み
    strm.ReadData(fTrainCount);
    //fSum,fOutの準備
    SetLength(fSum,fLayerCount);
    SetLength(fOut,fLayerCount);
    for i := 0 to fLayerCount-1 do
    begin
      SetLength(fSum[i],fNeuronCountInLayers[i]);
      SetLength(fOut[i],fNeuronCountInLayers[i]);
    end;
    //バイアス読み込み
    SetLength(fBias,fLayerCount-1);
    for i := Low(fBias) to High(fBias) do
    begin
      SetLength(fBias[i],fNeuronCountInLayers[i+1]);
      for j := Low(fBias[i]) to High(fBias[i]) do
      begin
        strm.ReadData(fBias[i][j]);
      end;
    end;
    //重み読み込み
    SetLength(fWeight,fLayerCount-1);
    for i := Low(fWeight) to High(fWeight) do
    begin
      SetLength(fWeight[i],fNeuronCountInLayers[i+1]);
      for j := Low(fWeight[i]) to High(fWeight[i]) do
      begin
        SetLength(fWeight[i][j],fNeuronCountInLayers[i]);
        for k := Low(fWeight[i][j]) to High(fWeight[i][j]) do
        begin
          strm.ReadData(fWeight[i][j][k]);
        end;
      end;
    end;
  finally
    strm.Free;
  end;
end;

procedure TMamAnn.Run(Inputs: TArray<Single>; out Outputs: TArray<Single>);
begin
//予測の実行
  ForwardProp(Inputs);
  //出力層の値のコピー
  SetLength(Outputs,Length(fOut[High(fOut)]));
  Move(
    fOut[High(fOut)][0],
    Outputs[0],
    SizeOf(fOut[High(fOut)][0])*Length(fOut[High(fOut)])
  );
end;

procedure TMamAnn.SaveToFile(FileName: String);
var strm:TFileStream;
    i,j,k:Integer;
begin
  //バイナリで保存する
  strm:=TFileStream.Create(FileName,fmCreate OR fmShareExclusive);
  try
    //層数保存
    strm.WriteData(fLayerCount);
    //層ごとのニューロン数保存
    for i := Low(fNeuronCountInLayers) to High(fNeuronCountInLayers) do
      strm.WriteData(fNeuronCountInLayers[i]);
    //学習率保存
    strm.WriteData(fLearningRate);
    //損失値(累計2乗誤差)保存
    strm.WriteData(fLoss);
    //学習回数保存
    strm.WriteData(fTrainCount);
    //バイアス保存
    for i := Low(fBias) to High(fBias) do
      for j := Low(fBias[i]) to High(fBias[i]) do
        strm.WriteData(fBias[i][j]);
    //重み保存
    for i := Low(fWeight) to High(fWeight) do
      for j := Low(fWeight[i]) to High(fWeight[i]) do
        for k := Low(fWeight[i][j]) to High(fWeight[i][j]) do
          strm.WriteData(fWeight[i][j][k]);
  finally
    strm.Free;
  end;
end;

procedure TMamAnn.SetLearningRate(LearningRage:Single);
begin
  if LearningRate>0.999 then LearningRate:=0.999;
  if LearningRate<0.001 then LearningRate:=0.001;
  fLearningRate:=LearningRate;
end;

function TMamAnn.Sigmoid(x: Single): Single;
begin
//シグモイド関数
  result:=1.0/(1.0+system.exp(-x))
end;

function TMamAnn.SigmoidDerivative(x:single): single;
begin
//シグモイド関数の微分関数
  result:=Sigmoid(x);
  result:=result*(1.0-result);
end;

procedure TMamAnn.Train(Inputs, Outputs: Tarray<Single>);
var j:Integer;
    sub:Single;
begin
//学習
  //順伝播
  ForwardProp(Inputs);
  //逆伝播
  BackProp(Outputs);
  //MSE(平均二乗誤差)の為に累計2乗誤差計算
  for j := Low(Outputs) to High(Outputs) do
  begin
    inc(fTrainCount);
    sub:=fOut[High(fOut)][j]-Outputs[j];
    fLoss:=fLoss+sub*sub;
  end;
end;

end.