├── tests ├── extras.cfg ├── testrunner.lpr ├── testrunner.lpi └── testgrad.pas ├── .gitattributes ├── assets ├── noe-txt.png └── raster │ ├── icon-dark.png │ ├── logo-dark.png │ ├── icon-light.png │ └── logo-light.png ├── .gitignore ├── examples ├── datasets │ ├── iris.csv │ ├── housing.csv │ ├── optdigits-test.csv │ ├── optdigits-train.csv │ └── README.md └── console │ ├── iris.lpr │ ├── xor.lpr │ ├── mnist_mlp.lpi │ ├── xor.lpi │ ├── iris.lpi │ ├── optdigits_hl_api.lpi │ ├── mnist_mlp.lpr │ ├── optdigits.lpi │ ├── optdigits_hl_api.lpr │ └── optdigits.lpr ├── CONTRIBUTING.md ├── src ├── legacy │ ├── config.pas │ ├── noe.types.pas │ ├── noe.mathwrapper.pas │ ├── noe.backend.native.pas │ ├── noe.backend.blas.pas │ ├── noe.utils.pas │ ├── noe.optimizer.pas │ ├── noe.plot.gnuplot.pas │ ├── noe.ndarr.pas │ ├── noe.neuralnet.pas │ └── noe.pas ├── noe.optimizer.pas ├── noe.neuralnet.pas └── noe.pas ├── pkg ├── noe.source.pas └── noe.source.lpk ├── LICENSE └── README.md /tests/extras.cfg: -------------------------------------------------------------------------------- 1 | -Fu../src;../../ndarray/src 2 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.csv filter=lfs diff=lfs merge=lfs -text 2 | -------------------------------------------------------------------------------- /assets/noe-txt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ariaghora/noe/HEAD/assets/noe-txt.png -------------------------------------------------------------------------------- /assets/raster/icon-dark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ariaghora/noe/HEAD/assets/raster/icon-dark.png -------------------------------------------------------------------------------- /assets/raster/logo-dark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ariaghora/noe/HEAD/assets/raster/logo-dark.png -------------------------------------------------------------------------------- /assets/raster/icon-light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ariaghora/noe/HEAD/assets/raster/icon-light.png -------------------------------------------------------------------------------- /assets/raster/logo-light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ariaghora/noe/HEAD/assets/raster/logo-light.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.ppu 3 | *.swp 4 | *.svg 5 | *.dll 6 | *.exe 7 | *.lps 8 | *.tmp 9 | *.model 10 | backup/ 11 | lib/ 12 | -------------------------------------------------------------------------------- /examples/datasets/iris.csv: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:39f03d68cb1774ba478c11b2b26b881e069926d92a320f3e87be64f1567aa139 3 | size 2699 4 | -------------------------------------------------------------------------------- /examples/datasets/housing.csv: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:5287ab86c16fd961b712f953bc8c5de89161eb5ecbd4653ddcc1b9614dd4a061 3 | size 41748 4 | -------------------------------------------------------------------------------- /examples/datasets/optdigits-test.csv: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:6ebb3d2fee246a4e99363262ddf8a00a3c41bee6014c373ed9d9216ba7f651b8 3 | size 264712 4 | -------------------------------------------------------------------------------- /examples/datasets/optdigits-train.csv: -------------------------------------------------------------------------------- 1 | version https://git-lfs.github.com/spec/v1 2 | oid sha256:e1b683cc211604fe8fd8c4417e6a69f31380e0c61d4af22e93cc21e9257ffedd 3 | size 563639 4 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | ## Contributing 2 | - Fork this repository 3 | - Create your feature branch (git checkout -b my-new-feature) 4 | - Commit your changes (git commit -am 'add some cool features') 5 | - Push to the branch (git push origin my-new-feature) 6 | - Create new Pull Request 7 | -------------------------------------------------------------------------------- /src/legacy/config.pas: -------------------------------------------------------------------------------- 1 | {$IFDEF MSWINDOWS} 2 | BLAS_FILENAME = 'libopenblas.dll'; 3 | {$ENDIF} 4 | {$IFDEF UNIX} 5 | {$IFDEF LINUX} 6 | BLAS_FILENAME = 'libblas.so.3'; 7 | {$ENDIF} 8 | {$IFDEF DARWIN} 9 | BLAS_FILENAME = 'libopenblas.dylib'; 10 | {$ENDIF} 11 | {$ENDIF} 12 | -------------------------------------------------------------------------------- /src/legacy/noe.types.pas: -------------------------------------------------------------------------------- 1 | unit noe.types; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils; 9 | 10 | type 11 | NFloat = double; 12 | 13 | TIntVector = array of longint; 14 | TFloatVector = array of NFloat; 15 | 16 | implementation 17 | 18 | end. 19 | 20 | -------------------------------------------------------------------------------- /src/legacy/noe.mathwrapper.pas: -------------------------------------------------------------------------------- 1 | unit noe.mathwrapper; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, noe.types; 9 | 10 | function Add_F(v1, v2: NFloat): NFloat; 11 | 12 | implementation 13 | 14 | function Add_F(v1, v2: NFloat): NFloat; 15 | begin 16 | Result := v1 + v2; 17 | end; 18 | 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /pkg/noe.source.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit noe.source; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | noe.neuralnet, noe.optimizer, noe, LazarusPackageIntf; 12 | 13 | implementation 14 | 15 | procedure Register; 16 | begin 17 | end; 18 | 19 | initialization 20 | RegisterPackage('noe.source', @Register); 21 | end. 22 | -------------------------------------------------------------------------------- /examples/datasets/README.md: -------------------------------------------------------------------------------- 1 | - Fisher Iris (`iris.csv`): [https://archive.ics.uci.edu/ml/datasets/Iris](https://archive.ics.uci.edu/ml/datasets/Iris) 2 | - Optical Recognition of Handwritten Digits (`optdigits-train.csv` and `optdigits-test.csv`): [https://archive.ics.uci.edu/ml/datasets/optical+recognition+of+handwritten+digits](https://archive.ics.uci.edu/ml/datasets/optical+recognition+of+handwritten+digits) 3 | - Boston housing (`housing.csv`): [https://archive.ics.uci.edu/ml/datasets/Housing](https://www.cs.toronto.edu/~delve/data/boston/bostonDetail.html) -------------------------------------------------------------------------------- /tests/testrunner.lpr: -------------------------------------------------------------------------------- 1 | program testrunner; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Classes, consoletestrunner, testgrad; 7 | 8 | type 9 | 10 | { TMyTestRunner } 11 | 12 | TMyTestRunner = class(TTestRunner) 13 | protected 14 | // override the protected methods of TTestRunner to customize its behavior 15 | end; 16 | 17 | var 18 | Application: TMyTestRunner; 19 | 20 | begin 21 | Application := TMyTestRunner.Create(nil); 22 | Application.Initialize; 23 | Application.Title := 'FPCUnit Console test runner'; 24 | Application.Run; 25 | Application.Free; 26 | end. 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Aria Ghora Prabono 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /pkg/noe.source.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /examples/console/iris.lpr: -------------------------------------------------------------------------------- 1 | program iris; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | SysUtils, DateUtils, multiarray, numerik, 7 | noe, noe.optimizer, noe.neuralnet; 8 | 9 | var 10 | Dataset, X, Y, YBin, YPred, Loss: TTensor; 11 | model: TNNModel; 12 | opt: TOptAdam; 13 | i: integer; 14 | t: TDateTime; 15 | 16 | begin 17 | Dataset := ReadCSV('../datasets/iris.csv'); 18 | 19 | X := Dataset[[ _ALL_, Range(0, 4) ]]; // Get all rows and first four columns 20 | Y := Dataset[[ _ALL_, 4 ]]; // Get all rows and a column with index 4 21 | YBin := BinarizeLabel(Y); // Transform labels into one-hot vectors 22 | 23 | model := TNNModel.Create; 24 | model.AddLayer(TLayerDense.Create(4, 30)); 25 | model.AddLayer(TLayerReLU.Create()); 26 | model.AddLayer(TLayerDense.Create(30, 3)); 27 | model.AddLayer(TLayerSoftmax.Create(1)); 28 | 29 | opt := TOptAdam.Create(model.Params); // Adam optimizer 30 | opt.LearningRate := 0.01; 31 | 32 | t := Now; 33 | for i := 0 to 100 do 34 | begin 35 | YPred := model.Eval(X); 36 | Loss := CrossEntropy(YPred, YBin); 37 | Loss.Backward(); 38 | opt.Step; 39 | 40 | if i mod 10 = 0 then 41 | WriteLn('Loss at iteration ', i, ': ', Loss.Data.Get(0) : 5 : 2); 42 | end; 43 | 44 | WriteLn('Training completed in ', MilliSecondsBetween(Now, t), ' ms'); 45 | WriteLn('Training accuracy: ', Mean(ArgMax(YPred.Data, 1, True)).Item : 5 : 2); 46 | WriteLn('Press enter to exit'); ReadLn; 47 | 48 | model.Free; 49 | opt.Free; 50 | end. 51 | 52 | -------------------------------------------------------------------------------- /examples/console/xor.lpr: -------------------------------------------------------------------------------- 1 | program xor_example; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | multiarray, numerik, noe; 7 | 8 | var 9 | X, y, yPred, W1, W2, b1, b2, Loss: TTensor; 10 | LearningRate: Single; 11 | i: integer; 12 | 13 | begin 14 | Randomize; 15 | 16 | X := CreateMultiArray([0, 0, 17 | 0, 1, 18 | 1, 0, 19 | 1, 1]).Reshape([4, 2]); 20 | y := CreateMultiArray([0, 1, 1, 0]).Reshape([4, 1]); 21 | 22 | W1 := Random([2, 5]); // Input to hidden 23 | W2 := Random([5, 1]); // Hidden to output 24 | W1.RequiresGrad := True; 25 | W2.RequiresGrad := True; 26 | 27 | b1 := Zeros([5]); 28 | b2 := Zeros([1]); 29 | b1.RequiresGrad := True; 30 | b2.RequiresGrad := True; 31 | 32 | LearningRate := 0.01; 33 | for i := 0 to 2000 do 34 | begin 35 | yPred := (ReLu(X.Matmul(W1) + b1)).Matmul(W2) + b2; 36 | Loss := Mean(Sqr(yPred - y)); // MSE error 37 | 38 | W1.ZeroGrad; 39 | W2.ZeroGrad; 40 | b1.ZeroGrad; 41 | b2.ZeroGrad; 42 | 43 | Loss.Backward(); 44 | 45 | W1.Data := W1.Data - LearningRate * W1.Grad; 46 | W2.Data := W2.Data - LearningRate * W2.Grad; 47 | b1.Data := b1.Data - LearningRate * b1.Grad; 48 | b2.Data := b2.Data - LearningRate * b2.Grad; 49 | 50 | if i mod 50 = 0 then 51 | WriteLn('Loss at iteration ', i, ': ', Loss.Data.Get(0) : 5 : 2); 52 | end; 53 | 54 | WriteLn('Prediction:'); 55 | PrintTensor(YPred); 56 | 57 | Write('Press enter to exit'); ReadLn; 58 | end. 59 | 60 | -------------------------------------------------------------------------------- /examples/console/mnist_mlp.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <Units Count="1"> 30 | <Unit0> 31 | <Filename Value="mnist_mlp.lpr"/> 32 | <IsPartOfProject Value="True"/> 33 | </Unit0> 34 | </Units> 35 | </ProjectOptions> 36 | <CompilerOptions> 37 | <Version Value="11"/> 38 | <PathDelim Value="\"/> 39 | <Target> 40 | <Filename Value="mnist_mlp"/> 41 | </Target> 42 | <SearchPaths> 43 | <IncludeFiles Value="$(ProjOutDir)"/> 44 | <OtherUnitFiles Value="..\..\src"/> 45 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 46 | </SearchPaths> 47 | </CompilerOptions> 48 | <Debugging> 49 | <Exceptions Count="3"> 50 | <Item1> 51 | <Name Value="EAbort"/> 52 | </Item1> 53 | <Item2> 54 | <Name Value="ECodetoolError"/> 55 | </Item2> 56 | <Item3> 57 | <Name Value="EFOpenError"/> 58 | </Item3> 59 | </Exceptions> 60 | </Debugging> 61 | </CONFIG> 62 | -------------------------------------------------------------------------------- /examples/console/xor.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="11"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <MainUnit Value="0"/> 14 | <Title Value="xor"/> 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="2"> 30 | <Item1> 31 | <PackageName Value="numerik.source"/> 32 | </Item1> 33 | <Item2> 34 | <PackageName Value="noe.source"/> 35 | </Item2> 36 | </RequiredPackages> 37 | <Units Count="1"> 38 | <Unit0> 39 | <Filename Value="xor.lpr"/> 40 | <IsPartOfProject Value="True"/> 41 | <UnitName Value="xor_example"/> 42 | </Unit0> 43 | </Units> 44 | </ProjectOptions> 45 | <CompilerOptions> 46 | <Version Value="11"/> 47 | <PathDelim Value="\"/> 48 | <Target> 49 | <Filename Value="xor"/> 50 | </Target> 51 | <SearchPaths> 52 | <IncludeFiles Value="$(ProjOutDir)"/> 53 | <OtherUnitFiles Value="..\..\src;..\..\..\ndarray\src"/> 54 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 55 | </SearchPaths> 56 | <Linking> 57 | <Debugging> 58 | <GenerateDebugInfo Value="False"/> 59 | </Debugging> 60 | </Linking> 61 | </CompilerOptions> 62 | </CONFIG> 63 | -------------------------------------------------------------------------------- /tests/testrunner.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <Title Value="testrunner"/> 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes> 18 | <Item Name="Default" Default="True"/> 19 | </BuildModes> 20 | <PublishOptions> 21 | <Version Value="2"/> 22 | <UseFileFilters Value="True"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <FormatVersion Value="2"/> 26 | </RunParams> 27 | <RequiredPackages> 28 | <Item> 29 | <PackageName Value="FCL"/> 30 | </Item> 31 | </RequiredPackages> 32 | <Units> 33 | <Unit> 34 | <Filename Value="testrunner.lpr"/> 35 | <IsPartOfProject Value="True"/> 36 | </Unit> 37 | <Unit> 38 | <Filename Value="testgrad.pas"/> 39 | <IsPartOfProject Value="True"/> 40 | </Unit> 41 | </Units> 42 | </ProjectOptions> 43 | <CompilerOptions> 44 | <Version Value="11"/> 45 | <PathDelim Value="\"/> 46 | <Target> 47 | <Filename Value="testrunner"/> 48 | </Target> 49 | <SearchPaths> 50 | <IncludeFiles Value="$(ProjOutDir)"/> 51 | <OtherUnitFiles Value="..\src;..\..\numerik\src"/> 52 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 53 | </SearchPaths> 54 | <Linking> 55 | <Debugging> 56 | <UseHeaptrc Value="True"/> 57 | </Debugging> 58 | </Linking> 59 | </CompilerOptions> 60 | <Debugging> 61 | <Exceptions> 62 | <Item> 63 | <Name Value="EAbort"/> 64 | </Item> 65 | <Item> 66 | <Name Value="ECodetoolError"/> 67 | </Item> 68 | <Item> 69 | <Name Value="EFOpenError"/> 70 | </Item> 71 | </Exceptions> 72 | </Debugging> 73 | </CONFIG> 74 | -------------------------------------------------------------------------------- /src/legacy/noe.backend.native.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit provides a native implementation in case of the absence of BLAS or 7 | any other accelerators. 8 | } 9 | 10 | unit noe.backend.native; 11 | 12 | {$mode objfpc}{$H+} 13 | 14 | interface 15 | 16 | uses 17 | Classes, SysUtils, noe; 18 | 19 | { Naive O(n^3) matmul implementation } 20 | function MatMul_Native(A, B: TTensor): TTensor; 21 | 22 | function MeanCol_Native(A: TTensor): TTensor; 23 | function MeanRow_Native(A: TTensor): TTensor; 24 | function SumCol_Native(A: TTensor): TTensor; 25 | function SumRow_Native(A: TTensor): TTensor; 26 | 27 | implementation 28 | 29 | function MatMul_Native(A, B: TTensor): TTensor; 30 | var 31 | i, j, k: longint; 32 | sum: double; 33 | begin 34 | SetLength(Result.Val, A.Shape[0] * B.Shape[1]); 35 | for i := 0 to A.shape[0] - 1 do 36 | for j := 0 to B.Shape[1] - 1 do 37 | begin 38 | sum := 0; 39 | for k := 0 to A.Shape[1] - 1 do 40 | sum := sum + A.Val[i * A.Shape[1] + k] * B.Val[k * B.Shape[1] + j]; 41 | Result.Val[i * B.Shape[1] + j] := sum; 42 | end; 43 | 44 | Result.ReshapeInplace([A.Shape[0], B.Shape[1]]); 45 | end; 46 | 47 | function MeanCol_Native(A: TTensor): TTensor; 48 | begin 49 | Result := SumCol_Native(A) / A.Shape[0]; 50 | end; 51 | 52 | function MeanRow_Native(A: TTensor): TTensor; 53 | begin 54 | Result := SumRow_Native(A) / A.Shape[1]; 55 | end; 56 | 57 | function SumCol_Native(A: TTensor): TTensor; 58 | var 59 | i, j: longint; 60 | begin 61 | //Result := TTensor.Create; 62 | SetLength(Result.Val, A.Shape[1]); 63 | Result.ReshapeInplace([1, A.Shape[1]]); 64 | for i := 0 to A.Shape[1] - 1 do 65 | begin 66 | Result.val[i] := 0; 67 | for j := 0 to A.Shape[0] - 1 do 68 | Result.val[i] := Result.val[i] + A.val[i + A.Shape[1] * j]; 69 | end; 70 | end; 71 | 72 | function SumRow_Native(A: TTensor): TTensor; 73 | var 74 | i, j: longint; 75 | begin 76 | Result := SumCol_Native(A); 77 | SetLength(Result.Val, A.Shape[0]); 78 | Result.ReshapeInplace([A.Shape[0], 1]); 79 | for i := 0 to A.Shape[0] - 1 do 80 | begin 81 | Result.val[i] := 0; 82 | for j := 0 to A.Shape[1] - 1 do 83 | Result.val[i] := Result.val[i] + A.val[i * A.Shape[1] + j]; 84 | end; 85 | end; 86 | 87 | 88 | end. 89 | 90 | -------------------------------------------------------------------------------- /examples/console/iris.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="11"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <MainUnit Value="0"/> 14 | <Title Value="iris"/> 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="2"> 30 | <Item1> 31 | <PackageName Value="noe.source"/> 32 | </Item1> 33 | <Item2> 34 | <PackageName Value="numerik.source"/> 35 | </Item2> 36 | </RequiredPackages> 37 | <Units Count="1"> 38 | <Unit0> 39 | <Filename Value="iris.lpr"/> 40 | <IsPartOfProject Value="True"/> 41 | </Unit0> 42 | </Units> 43 | </ProjectOptions> 44 | <CompilerOptions> 45 | <Version Value="11"/> 46 | <PathDelim Value="\"/> 47 | <Target> 48 | <Filename Value="iris"/> 49 | </Target> 50 | <SearchPaths> 51 | <IncludeFiles Value="$(ProjOutDir)"/> 52 | <OtherUnitFiles Value="..\..\src"/> 53 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 54 | </SearchPaths> 55 | <CodeGeneration> 56 | <Optimizations> 57 | <OptimizationLevel Value="2"/> 58 | </Optimizations> 59 | </CodeGeneration> 60 | <Linking> 61 | <Debugging> 62 | <GenerateDebugInfo Value="False"/> 63 | <StripSymbols Value="True"/> 64 | </Debugging> 65 | </Linking> 66 | </CompilerOptions> 67 | <Debugging> 68 | <Exceptions Count="3"> 69 | <Item1> 70 | <Name Value="EAbort"/> 71 | </Item1> 72 | <Item2> 73 | <Name Value="ECodetoolError"/> 74 | </Item2> 75 | <Item3> 76 | <Name Value="EFOpenError"/> 77 | </Item3> 78 | </Exceptions> 79 | </Debugging> 80 | </CONFIG> 81 | -------------------------------------------------------------------------------- /examples/console/optdigits_hl_api.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="11"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <MainUnit Value="0"/> 14 | <Title Value="optdigits_hl_api"/> 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="noe.source"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="1"> 35 | <Unit0> 36 | <Filename Value="optdigits_hl_api.lpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | </Units> 40 | </ProjectOptions> 41 | <CompilerOptions> 42 | <Version Value="11"/> 43 | <PathDelim Value="\"/> 44 | <Target> 45 | <Filename Value="optdigits_hl_api"/> 46 | </Target> 47 | <SearchPaths> 48 | <IncludeFiles Value="$(ProjOutDir)"/> 49 | <OtherUnitFiles Value="..\..\src"/> 50 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 51 | </SearchPaths> 52 | <Parsing> 53 | <SyntaxOptions> 54 | <IncludeAssertionCode Value="True"/> 55 | </SyntaxOptions> 56 | </Parsing> 57 | <CodeGeneration> 58 | <Checks> 59 | <IOChecks Value="True"/> 60 | <RangeChecks Value="True"/> 61 | <OverflowChecks Value="True"/> 62 | <StackChecks Value="True"/> 63 | </Checks> 64 | <VerifyObjMethodCallValidity Value="True"/> 65 | </CodeGeneration> 66 | </CompilerOptions> 67 | <Debugging> 68 | <Exceptions Count="3"> 69 | <Item1> 70 | <Name Value="EAbort"/> 71 | </Item1> 72 | <Item2> 73 | <Name Value="ECodetoolError"/> 74 | </Item2> 75 | <Item3> 76 | <Name Value="EFOpenError"/> 77 | </Item3> 78 | </Exceptions> 79 | </Debugging> 80 | </CONFIG> 81 | -------------------------------------------------------------------------------- /examples/console/mnist_mlp.lpr: -------------------------------------------------------------------------------- 1 | program mnist_mlp; 2 | 3 | {$H+} 4 | 5 | uses 6 | SysUtils, 7 | noe, 8 | noe.Math, 9 | noe.neuralnet, 10 | noe.optimizer, 11 | noe.utils; 12 | 13 | var 14 | DatasetTrain, DatasetTest: TTensor; 15 | Xtrain, ytrain, Xtest, ytest: TTensor; 16 | Loss, yPred, yPredTest, Xbatch, ybatch, v: TVariable; 17 | encoder: TOneHotEncoder; 18 | br: TBatchingResult; 19 | NNModel: TModel; 20 | optim: TAdamOptimizer; 21 | BatchLoss, ValidationAcc: double; 22 | i, j: integer; 23 | 24 | begin 25 | randomize; 26 | WriteLn('Loading datasets...'); 27 | 28 | { Joseph Redmond's CSV version, https://pjreddie.com/projects/mnist-in-csv/. 29 | They are not included in noe repository due to the size. } 30 | DatasetTrain := ReadCSV('mnist_train.csv'); 31 | DatasetTest := ReadCSV('mnist_test.csv'); 32 | 33 | Xtrain := GetColumnRange(DatasetTrain, 1, 28 * 28) / 255; 34 | ytrain := GetColumn(DatasetTrain, 0); 35 | Xtest := GetColumnRange(DatasetTest, 1, 28 * 28) / 255; 36 | ytest := GetColumn(DatasetTest, 0); 37 | 38 | encoder := TOneHotEncoder.Create; 39 | ytrain := encoder.Encode(ytrain); 40 | 41 | NNModel := TModel.Create([ 42 | TDenseLayer.Create(28 * 28, 512), 43 | TReLULayer.Create, 44 | TDropoutLayer.Create(0.2), 45 | TDenseLayer.Create(512, 512), 46 | TReLULayer.Create, 47 | TDropoutLayer.Create(0.2), 48 | TDenseLayer.Create(512, 10), 49 | TSoftMaxLayer.Create(1) 50 | ]); 51 | 52 | br := CreateBatch(Xtrain, ytrain, 1000); 53 | Xtrain.Free; 54 | 55 | optim := TAdamOptimizer.Create; 56 | optim.LearningRate := 0.0001; 57 | optim.Verbose := False; 58 | 59 | WriteLn('Start training.'); 60 | for i := 1 to 50 do 61 | begin 62 | BatchLoss := 0; 63 | for j := 0 to br.BatchCount - 1 do 64 | begin 65 | Xbatch := br.Xbatches[j]; 66 | ybatch := br.ybatches[j]; 67 | 68 | yPred := NNModel.Eval(Xbatch); 69 | Loss := CrossEntropyLoss(yPred, ybatch) + L2Regularization(NNModel); 70 | 71 | optim.UpdateParams(Loss, NNModel.Params); 72 | 73 | BatchLoss := BatchLoss + Loss.Data.Val[0]; 74 | end; 75 | 76 | GLOBAL_SKIP_GRAD := True; 77 | yPredTest := NNModel.Eval(Xtest); 78 | ValidationAcc := AccuracyScore(encoder.Decode(yPredTest.Data), ytest); 79 | GLOBAL_SKIP_GRAD := False; 80 | WriteLn(Format('Epoch %d: batch_mean_loss=%f; validation_acc=%f', 81 | [i, BatchLoss / br.BatchCount, ValidationAcc])); 82 | end; 83 | 84 | SaveModel(NNModel, 'mnist_mlp.model'); 85 | WriteLn('Model was saved.'); 86 | 87 | ReadLn; 88 | end. 89 | -------------------------------------------------------------------------------- /examples/console/optdigits.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="11"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <MainUnit Value="0"/> 14 | <Title Value="optdigits"/> 15 | <UseAppBundle Value="False"/> 16 | <ResourceType Value="res"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="noe.source"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="1"> 35 | <Unit0> 36 | <Filename Value="optdigits.lpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | </Units> 40 | </ProjectOptions> 41 | <CompilerOptions> 42 | <Version Value="11"/> 43 | <PathDelim Value="\"/> 44 | <Target> 45 | <Filename Value="optdigits"/> 46 | </Target> 47 | <SearchPaths> 48 | <IncludeFiles Value="$(ProjOutDir)"/> 49 | <OtherUnitFiles Value="..\..\src"/> 50 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 51 | </SearchPaths> 52 | <Parsing> 53 | <SyntaxOptions> 54 | <IncludeAssertionCode Value="True"/> 55 | </SyntaxOptions> 56 | </Parsing> 57 | <CodeGeneration> 58 | <Checks> 59 | <IOChecks Value="True"/> 60 | <RangeChecks Value="True"/> 61 | <OverflowChecks Value="True"/> 62 | <StackChecks Value="True"/> 63 | </Checks> 64 | <VerifyObjMethodCallValidity Value="True"/> 65 | </CodeGeneration> 66 | <Linking> 67 | <Debugging> 68 | <UseHeaptrc Value="True"/> 69 | </Debugging> 70 | </Linking> 71 | </CompilerOptions> 72 | <Debugging> 73 | <Exceptions Count="4"> 74 | <Item1> 75 | <Name Value="EAbort"/> 76 | </Item1> 77 | <Item2> 78 | <Name Value="ECodetoolError"/> 79 | </Item2> 80 | <Item3> 81 | <Name Value="EFOpenError"/> 82 | </Item3> 83 | <Item4> 84 | <Name Value="ERangeError"/> 85 | </Item4> 86 | </Exceptions> 87 | </Debugging> 88 | </CONFIG> 89 | -------------------------------------------------------------------------------- /tests/testgrad.pas: -------------------------------------------------------------------------------- 1 | unit testgrad; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, fpcunit, testregistry, noe, multiarray, numerik; 9 | 10 | type 11 | 12 | TTestGrad = class(TTestCase) 13 | published 14 | procedure TestGradMax1; 15 | procedure TestGradMax2; 16 | procedure TestGradMean; 17 | procedure TestGradMeanAxis; 18 | procedure TestGradSigmoid; 19 | { Regular sum over elements } 20 | procedure TestGradSum; 21 | { Sum with axis=0 } 22 | procedure TestGradSumAxis1; 23 | { Sum with axis=1 } 24 | procedure TestGradSumAxis2; 25 | { Sum with axis=1 and KeepDims=True } 26 | procedure TestGradSumAxis3; 27 | 28 | end; 29 | 30 | var 31 | A: TMultiArray; 32 | T, U: TTensor; 33 | 34 | implementation 35 | 36 | procedure TTestGrad.TestGradMax1; 37 | begin 38 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 39 | T.RequiresGrad := True; 40 | U := Max(T); 41 | U.Backward(Ones(U.Shape)); 42 | AssertTrue(ArrayEqual(T.Grad, 43 | TMultiArray([0, 0, 0, 44 | 0, 0, 1]).Reshape([2, 3]) 45 | )); 46 | end; 47 | 48 | procedure TTestGrad.TestGradMax2; 49 | begin 50 | T := TMultiArray([6, 6, 6, 6, 6, 6]).Reshape([2, 3]); 51 | T.RequiresGrad := True; 52 | U := Max(T); 53 | U.Backward(Ones(U.Shape)); 54 | AssertTrue(ArrayEqual(T.Grad, 55 | Ones([2, 3]) 56 | )); 57 | end; 58 | 59 | procedure TTestGrad.TestGradMean; 60 | begin 61 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 62 | T.RequiresGrad := True; 63 | U := Mean(T); 64 | U.Backward(Ones(U.Shape)); 65 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]) / 6)); 66 | end; 67 | 68 | procedure TTestGrad.TestGradMeanAxis; 69 | begin 70 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 71 | T.RequiresGrad := True; 72 | U := Mean(T, 0); 73 | U.Backward(Ones(U.Shape)); 74 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]) / 2)); 75 | end; 76 | 77 | procedure TTestGrad.TestGradSigmoid; 78 | begin 79 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 80 | T.RequiresGrad := True; 81 | U := Sigmoid(T); 82 | U.Backward(Ones(U.Shape)); 83 | AssertTrue(ArrayEqual(T.Grad, 84 | TMultiArray([0.1966, 0.1050, 0.0452, 85 | 0.0177, 0.0066, 0.0025]).Reshape([2, 3]), 86 | 1e-4)); 87 | end; 88 | 89 | procedure TTestGrad.TestGradSum; 90 | begin 91 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 92 | T.RequiresGrad := True; 93 | U := Sum(T); 94 | U.Backward(Ones(U.Shape)); 95 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]))); 96 | end; 97 | 98 | procedure TTestGrad.TestGradSumAxis1; 99 | begin 100 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 101 | T.RequiresGrad := True; 102 | U := Sum(T, 0); 103 | U.Backward(Ones(U.Shape)); 104 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]))); 105 | end; 106 | 107 | procedure TTestGrad.TestGradSumAxis2; 108 | begin 109 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 110 | T.RequiresGrad := True; 111 | U := Sum(T, 1); 112 | U.Backward(Ones(U.Shape)); 113 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]))); 114 | end; 115 | 116 | procedure TTestGrad.TestGradSumAxis3; 117 | begin 118 | T := TMultiArray([1, 2, 3, 4, 5, 6]).Reshape([2, 3]); 119 | T.RequiresGrad := True; 120 | U := Sum(T, 1, True); 121 | U.Backward(Ones(U.Shape)); 122 | AssertTrue(ArrayEqual(T.Grad, Ones([2, 3]))); 123 | end; 124 | 125 | 126 | initialization 127 | 128 | RegisterTest(TTestGrad); 129 | end. 130 | 131 | -------------------------------------------------------------------------------- /src/legacy/noe.backend.blas.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit provides an interface to OpenBLAS library. 7 | Dependency: 8 | o Linux: 9 | - Debian/Ubuntu/Kali: apt install libopenblas-base 10 | o Windows: 11 | - Provide the libopenblas.dll 12 | o OSX: 13 | - Provide the libopenblas.dylib 14 | } 15 | 16 | unit noe.backend.blas; 17 | 18 | {$mode objfpc}{$H+} 19 | 20 | interface 21 | 22 | uses 23 | Classes, dynlibs, noe, SysUtils; 24 | 25 | type 26 | CBLAS_ORDER = (CblasRowMajor = 101, CblasColMajor = 102); 27 | CBLAS_TRANSPOSE = (CblasNoTrans = 111, CblasTrans = 112, CblasConjTrans = 113); 28 | CBLAS_UPLO = (CblasUpper = 121, CblasLower = 122); 29 | CBLAS_DIAG = (CblasNonUnit = 131, CblasUnit = 132); 30 | LAPACK_ORDER = (LAPACKRowMajor = 101, LAPACKColMajor = 102); 31 | 32 | TFuncDaxpy = procedure(N: longint; Alpha: NFloat; X: TFloatVector; 33 | INCX: longint; Y: TFloatVector; INCY: longint); cdecl; 34 | TFuncDgemm = procedure(Order: CBLAS_ORDER; TransA: CBLAS_TRANSPOSE; 35 | TransB: CBLAS_TRANSPOSE; M: longint; N: longint; K: longint; 36 | alpha: NFloat; A: TFloatVector; lda: longint; B: TFloatVector; 37 | ldb: longint; beta: NFloat; C: TFloatVector; ldc: longint); 38 | 39 | {$IFDEF FPC} 40 | {$PACKRECORDS C} 41 | {$ENDIF} 42 | 43 | var 44 | blas_dgemm: TFuncDgemm; 45 | blas_daxpy: TFuncDaxpy; 46 | 47 | libHandle: THandle = dynlibs.NilHandle; 48 | 49 | function Add_BLAS(A, B: TTensor): TTensor; 50 | function MatMul_BLAS(A, B: TTensor): TTensor; 51 | function MeanCol_BLAS(A: TTensor): TTensor; 52 | function MeanRow_BLAS(A: TTensor): TTensor; 53 | function SumCol_BLAS(A: TTensor): TTensor; 54 | function SumRow_BLAS(A: TTensor): TTensor; 55 | 56 | implementation 57 | 58 | uses 59 | noe.Math; 60 | 61 | function Add_BLAS(A, B: TTensor): TTensor; 62 | begin 63 | Assert(A.Size = B.Size, MSG_ASSERTION_DIFFERENT_LENGTH); 64 | Result := CreateEmptyTensor(A.Shape); 65 | Result.Val := copy(B.Val); 66 | blas_daxpy(A.Size, 1, A.Val, 1, Result.Val, 1); 67 | end; 68 | 69 | function MatMul_BLAS(A, B: TTensor): TTensor; 70 | begin 71 | Result := CreateEmptyTensor([A.Shape[0], B.Shape[1]]); 72 | blas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, 73 | A.Shape[0], B.Shape[1], B.Shape[0], // m, n, k 74 | 1, // alpha 75 | A.val, B.Shape[0], 76 | B.val, B.Shape[1], 77 | 1, // beta 78 | Result.val, B.Shape[1] 79 | ); 80 | Result.ReshapeInplace([A.Shape[0], B.Shape[1]]); 81 | end; 82 | 83 | function MeanCol_BLAS(A: TTensor): TTensor; 84 | begin 85 | Result := MatMul_BLAS(CreateTensor([1, A.Shape[0]], 1 / A.Shape[0]), A); 86 | end; 87 | 88 | function MeanRow_BLAS(A: TTensor): TTensor; 89 | begin 90 | Result := MatMul_BLAS(A, CreateTensor([A.Shape[1], 1], 1 / A.Shape[1])); 91 | end; 92 | 93 | function SumCol_BLAS(A: TTensor): TTensor; 94 | begin 95 | Result := MatMul_BLAS(Ones([1, A.Shape[0]]), A); 96 | end; 97 | 98 | function SumRow_BLAS(A: TTensor): TTensor; 99 | begin 100 | Result := MatMul_BLAS(A, Ones([A.Shape[1], 1])); 101 | end; 102 | 103 | initialization 104 | libHandle := LoadLibrary(BLAS_FILENAME); 105 | 106 | Pointer(blas_dgemm) := (GetProcedureAddress(libHandle, 'cblas_dgemm')); 107 | Pointer(blas_daxpy) := (GetProcedureAddress(libHandle, 'cblas_daxpy')); 108 | 109 | if IsConsole then 110 | begin 111 | if blas_dgemm = nil then 112 | WriteLn('blas_dgemm is not supported'); 113 | if blas_daxpy = nil then 114 | WriteLn('blas_daxpy is not supported'); 115 | end; 116 | 117 | finalization 118 | blas_dgemm := nil; 119 | blas_daxpy := nil; 120 | 121 | end. 122 | -------------------------------------------------------------------------------- /src/noe.optimizer.pas: -------------------------------------------------------------------------------- 1 | unit noe.optimizer; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | fgl, multiarray, numerik, noe; 9 | 10 | type 11 | TOptimizer = class 12 | private 13 | FModelParams: TTensorList; 14 | public 15 | LearningRate: single; 16 | constructor Create(ModelParams: TTensorList); virtual; 17 | procedure Step; virtual; abstract; 18 | end; 19 | 20 | TOptSGD = class(TOptimizer) 21 | public 22 | constructor Create(ModelParams: TTensorList; ALearningRate: single); overload; 23 | procedure Step; override; 24 | end; 25 | 26 | TOptRMSPROP = class(TOptimizer) 27 | private 28 | V: array of TMultiArray; 29 | public 30 | Epsilon: single; 31 | Gamma: single; 32 | constructor Create(ModelParams: TTensorList); override; 33 | procedure Step; override; 34 | end; 35 | 36 | TOptAdam = class(TOptimizer) 37 | private 38 | M: array of TMultiArray; 39 | V: array of TMultiArray; 40 | public 41 | Epsilon: single; 42 | Beta1: single; 43 | Beta2: single; 44 | Iteration: longint; 45 | constructor Create(ModelParams: TTensorList); override; 46 | procedure Step; override; 47 | end; 48 | 49 | implementation 50 | 51 | constructor TOptimizer.Create(ModelParams: TTensorList); 52 | begin 53 | self.FModelParams := ModelParams; 54 | end; 55 | 56 | constructor TOptSGD.Create(ModelParams: TTensorList; ALearningRate: single); 57 | begin 58 | inherited Create(ModelParams); 59 | 60 | LearningRate := ALearningRate; 61 | end; 62 | 63 | procedure TOptSGD.Step; 64 | var 65 | T: TTensor; 66 | begin 67 | for T in FModelParams do 68 | begin 69 | T.Data := T.Data - T.Grad * LearningRate; 70 | T.ZeroGrad; 71 | end; 72 | end; 73 | 74 | constructor TOptRMSPROP.Create(ModelParams: TTensorList); 75 | var 76 | i: integer; 77 | begin 78 | inherited Create(ModelParams); 79 | LearningRate := 0.001; 80 | Epsilon := 10E-8; 81 | Gamma := 0.99; 82 | SetLength(V, ModelParams.Count); 83 | for i := 0 to ModelParams.Count - 1 do 84 | V[i] := Zeros(ModelParams[i].Shape); 85 | end; 86 | 87 | procedure TOptRMSPROP.Step; 88 | var 89 | i: integer; 90 | begin 91 | for i := 0 to FModelParams.Count - 1 do 92 | begin 93 | V[i] := Gamma * V[i] + LearningRate * FModelParams[i].Grad; 94 | FModelParams[i].Data := FModelParams[i].Data - self.V[i]; 95 | FModelParams[i].ZeroGrad; 96 | end; 97 | end; 98 | 99 | constructor TOptAdam.Create(ModelParams: TTensorList); 100 | var 101 | i: integer; 102 | begin 103 | inherited Create(ModelParams); 104 | LearningRate := 0.001; 105 | Epsilon := 10E-8; 106 | Beta1 := 0.9; 107 | Beta2 := 0.999; 108 | Iteration := 1; 109 | SetLength(M, ModelParams.Count); 110 | SetLength(V, ModelParams.Count); 111 | for i := 0 to ModelParams.Count - 1 do 112 | begin 113 | M[i] := Zeros(ModelParams[i].Shape); 114 | V[i] := Zeros(ModelParams[i].Shape); 115 | end; 116 | end; 117 | 118 | procedure TOptAdam.Step; 119 | var 120 | i: integer; 121 | mHat, vHat: TMultiArray; 122 | begin 123 | for i := 0 to FModelParams.Count - 1 do 124 | begin 125 | { First and second moment estimate } 126 | M[i] := Beta1 * M[i] + (1 - Beta1) * FModelParams[i].Grad; 127 | V[i] := Beta2 * V[i] + (1 - Beta2) * (FModelParams[i].Grad ** 2); 128 | 129 | { Bias correction } 130 | mHat := self.M[i] / (1 - (Beta1 ** Iteration)); 131 | vHat := self.V[i] / (1 - (Beta2 ** Iteration)); 132 | 133 | { Model parameter update } 134 | FModelParams[i].Data := FModelParams[i].Data - LearningRate * 135 | mHat / ((vHat ** 0.5) + Epsilon); 136 | 137 | FModelParams[i].ZeroGrad; 138 | Inc(Iteration); 139 | end; 140 | end; 141 | 142 | end. 143 | 144 | -------------------------------------------------------------------------------- /src/noe.neuralnet.pas: -------------------------------------------------------------------------------- 1 | unit noe.neuralnet; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | fgl, multiarray, numerik, noe; 9 | 10 | type 11 | TLayer = class 12 | Params: TTensorList; 13 | public 14 | constructor Create; virtual; 15 | destructor Destroy; override; 16 | function Eval(X: TTensor): TTensor; virtual; abstract; 17 | end; 18 | 19 | TLayerList = specialize TFPGObjectList<TLayer>; 20 | 21 | TLayerDense = class(TLayer) 22 | public 23 | constructor Create(InSize, OutSize: longint); overload; 24 | function Eval(X: TTensor): TTensor; override; 25 | end; 26 | 27 | TLayerLeakyReLU = class(TLayer) 28 | private 29 | FLeakiness: single; 30 | public 31 | constructor Create(Leakiness: single); overload; 32 | function Eval(X: TTensor): TTensor; override; 33 | end; 34 | 35 | TLayerReLU = class(TLayer) 36 | public 37 | function Eval(X: TTensor): TTensor; override; 38 | end; 39 | 40 | TLayerSoftmax = class(TLayer) 41 | private 42 | FAxis: integer; 43 | public 44 | constructor Create(Axis: integer); overload; 45 | function Eval(X: TTensor): TTensor; override; 46 | end; 47 | 48 | TNNModel = class 49 | private 50 | FLayerList: TLayerList; 51 | function GetParams: TTensorList; 52 | public 53 | FParams: TTensorList; 54 | constructor Create; 55 | destructor Destroy; override; 56 | procedure AddLayer(ALayer: TLayer); 57 | function Eval(X: TTensor): TTensor; 58 | property Params: TTensorList read GetParams; 59 | end; 60 | 61 | implementation 62 | 63 | constructor TLayerLeakyReLU.Create(leakiness: Single); 64 | begin 65 | inherited Create; 66 | end; 67 | 68 | function TLayerLeakyReLU.Eval(X: TTensor): TTensor; 69 | begin 70 | Exit(LeakyReLU(X, FLeakiness)); 71 | end; 72 | 73 | { TLayerReLU } 74 | 75 | function TLayerReLU.Eval(X: TTensor): TTensor; 76 | begin 77 | Exit(ReLU(X)); 78 | end; 79 | 80 | constructor TLayerSoftmax.Create(Axis: integer); 81 | begin 82 | inherited Create; 83 | Faxis := Axis; 84 | end; 85 | 86 | { TLayerSoftmax } 87 | 88 | function TLayerSoftmax.Eval(X: TTensor): TTensor; 89 | begin 90 | Exit(Softmax(X, FAxis)); 91 | end; 92 | 93 | { TLayerDense } 94 | 95 | constructor TLayerDense.Create(InSize, OutSize: longint); 96 | var 97 | W, b: TTensor; 98 | begin 99 | inherited Create; 100 | W := RandG(0, 1, [InSize, OutSize]) * ((2 / (InSize + OutSize)) ** 0.5); 101 | W.RequiresGrad := True; 102 | b := FullMultiArray([OutSize], 0); 103 | b.RequiresGrad := True; 104 | Params.Add(W); 105 | Params.Add(b); 106 | end; 107 | 108 | function TLayerDense.Eval(X: TTensor): TTensor; 109 | begin 110 | Exit(X.Matmul(Params[0]) + Params[1]); 111 | end; 112 | 113 | { TLayer } 114 | 115 | constructor TLayer.Create; 116 | begin 117 | Params := TTensorList.Create(False); 118 | end; 119 | 120 | destructor TLayer.Destroy; 121 | begin 122 | inherited; 123 | Params.Free; 124 | end; 125 | 126 | { TNNModel } 127 | 128 | function TNNModel.GetParams: TTensorList; 129 | var 130 | L: TLayer; 131 | begin 132 | FParams.Clear; 133 | for L in FLayerList do 134 | FParams.AddList(L.Params); 135 | Exit(FParams); 136 | end; 137 | 138 | constructor TNNModel.Create; 139 | begin 140 | FParams := TTensorList.Create(False); 141 | FLayerList := TLayerList.Create(); 142 | end; 143 | 144 | destructor TNNModel.Destroy; 145 | begin 146 | inherited; 147 | FLayerList.Free; 148 | FParams.Free; 149 | end; 150 | 151 | procedure TNNModel.AddLayer(ALayer: TLayer); 152 | begin 153 | FLayerList.Add(ALayer); 154 | end; 155 | 156 | function TNNModel.Eval(X: TTensor): TTensor; 157 | var 158 | L: TLayer; 159 | begin 160 | Result := X; 161 | for L in FLayerList do 162 | begin 163 | Result := L.Eval(Result); 164 | end; 165 | end; 166 | 167 | end. 168 | -------------------------------------------------------------------------------- /examples/console/optdigits_hl_api.lpr: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | - OBJECTIVE 7 | ========= 8 | This program demonstrates the use of neural network TModel class, TLayer 9 | class and its derivatives. Instead of defining model weights manually, the 10 | TLayer provides a wrapper to avoid doing so. The problem is optical digit 11 | classification. 12 | 13 | - DATASET DESCRIPTION 14 | =================== 15 | From "archive.ics.uci.edu/ml/datasets/Optical+Recognition+of+Handwritten+Digits": 16 | "We used preprocessing programs made available by NIST to extract normalized 17 | bitmaps of handwritten digits from a preprinted form. From a total of 43 18 | people, 30 contributed to the training set and different 13 to the test set. 19 | 32x32 bitmaps are divided into nonoverlapping blocks of 4x4 and the number of 20 | on pixels are counted in each block. This generates an input matrix of 8x8 21 | where each element is an integer in the range 0..16. This reduces dimensionality 22 | and gives invariance to small distortions." 23 | } 24 | 25 | program optdigits_hl_api; 26 | 27 | {$mode objfpc}{$H+} 28 | 29 | uses 30 | math, 31 | noe, 32 | noe.Math, 33 | noe.optimizer, 34 | noe.utils, 35 | noe.neuralnet; 36 | 37 | const 38 | MAX_EPOCH = 100; 39 | 40 | var 41 | i, M, NInputNeuron, NOutputNeuron, PredictedLabel, ActualLabel, SampleIdx: longint; 42 | DatasetTrain, DatasetTest, LabelsTest, FeatsTest, ImageSample: TTensor; 43 | Xtrain, ytrain, ypred, Loss, ypredTest: TVariable; 44 | LabelEncoder: TOneHotEncoder; 45 | NNModel: TModel; 46 | optimizer: TAdamOptimizer; 47 | TrainingAcc, TestingAcc: double; 48 | 49 | begin 50 | RandSeed := 1; 51 | 52 | { Data preparation ----------------------------------------------------------} 53 | WriteLn('Loading and preparing the data...'); 54 | DatasetTrain := ReadCSV('../datasets/optdigits-train.csv'); 55 | M := DatasetTrain.Shape[0]; 56 | 57 | Xtrain := GetRange(DatasetTrain, 0, 0, M, 64); 58 | ytrain := Squeeze(GetColumn(DatasetTrain, 64)); 59 | LabelEncoder := TOneHotEncoder.Create; 60 | ytrain := LabelEncoder.Encode(ytrain.Data); 61 | 62 | { Model preparation ---------------------------------------------------------} 63 | NInputNeuron := Xtrain.Shape[1]; 64 | NOutputNeuron := ytrain.Shape[1]; 65 | 66 | NNModel := TModel.Create([ 67 | TDenseLayer.Create(NInputNeuron, 128), 68 | TLeakyReLULayer.Create(0.3), 69 | TDenseLayer.Create(128, 64), 70 | TLeakyReLULayer.Create(0.3), 71 | TDenseLayer.Create(64, NOutputNeuron), 72 | TSoftMaxLayer.Create(1) 73 | ]); 74 | 75 | { Training phase ------------------------------------------------------------} 76 | WriteLn('Press enter to start training in ', MAX_EPOCH, ' iterations.'); 77 | ReadLn; 78 | optimizer := TAdamOptimizer.Create; 79 | for i := 0 to MAX_EPOCH - 1 do 80 | begin 81 | ypred := NNModel.Eval(Xtrain); 82 | Loss := CrossEntropyLoss(ypred, ytrain) + L2Regularization(NNModel); 83 | 84 | optimizer.UpdateParams(Loss, NNModel.Params); 85 | end; 86 | 87 | TrainingAcc := AccuracyScore(LabelEncoder.Decode(ypred.Data), 88 | LabelEncoder.Decode(ytrain.Data)); 89 | WriteLn('Training accuracy: ', TrainingAcc: 2: 4); 90 | WriteLn; 91 | 92 | 93 | { Testing Phase -------------------------------------------------------------} 94 | WriteLn('Traning completed. Now evaluating the model on the testing set...'); 95 | DatasetTest := ReadCSV('../datasets/optdigits-test.csv'); 96 | FeatsTest := GetRange(DatasetTest, 0, 0, DatasetTest.Shape[0], 64) / 16; 97 | LabelsTest := Squeeze(GetColumn(DatasetTest, 64)); 98 | 99 | ypredTest := NNModel.Eval(FeatsTest.ToVariable()); 100 | TestingAcc := AccuracyScore(LabelEncoder.Decode(ypredTest.Data), 101 | LabelsTest); 102 | WriteLn('testing accuracy = ', TestingAcc: 2: 2); 103 | 104 | { Pick one sample from the test set. Let's try to visualize and predict the 105 | label } 106 | SampleIdx := 100; 107 | ImageSample := GetRow(FeatsTest, SampleIdx, True); 108 | ypredTest := NNModel.Eval(ImageSample.ToVariable(False)); 109 | 110 | { transform the probability into the discrete label } 111 | PredictedLabel := Round(LabelEncoder.Decode(ypredTest.Data).Val[0]); 112 | ActualLabel := Round(LabelsTest.GetAt(SampleIdx)); 113 | 114 | WriteLn('Predicting one of the test samples...'); 115 | VisualizeMatrix(ImageSample.Reshape([8, 8])); 116 | WriteLn('Predicted class: ', PredictedLabel, '; Probability: ', Max(ypredTest.Data, 117 | 1).Val[0]: 2: 2, '; The actual class: ', ActualLabel); 118 | 119 | ReadLn; 120 | end. 121 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | <div align="center"> 2 | <img src="assets/raster/logo-light.png" alt="logo" width="200px"></img> 3 | </div> 4 | 5 | 6 | <div align="center"> 7 | 8 | [![Generic badge](https://img.shields.io/badge/license-MIT-blue.svg)](https://shields.io/) 9 | [![made-for-pascal](https://img.shields.io/badge/Made%20for-object%20pascal-7642d2.svg)](https://code.visualstudio.com/) 10 | 11 | </div> 12 | 13 | Noe is a framework to build neural networks (and hence, the name — noe (뇌): brain: 🧠) in pure object pascal. Yes, pascal, so you will have readable codes and pretty fast compiled executable binary. Some of its key features: 14 | - Automatic gradient computation 15 | - Creation of arbitrary rank tensor (a.k.a. multidimensional array) based on [numerik](https://github.com/ariaghora/numerik) library, that supports numpy-style broadcasting and is accelerated with *OpenBLAS* for the underlying heavy-lifting 16 | - (Optional) interface with *GNU plot* for plotting 17 | 18 | Please note that although computation accelerator is applied, for the time being, noe is aimed for pedagogical purpose. If you want to create neural network in production with optimum speed, there are of course other choices. 19 | 20 | ## Installation 21 | - Noe requires [numerik](https://github.com/ariaghora/numerik), so you should install it first. Refer to numerik installation [guide](https://github.com/ariaghora/numerik#installation). 22 | - In lazarus, open "noe.source.lpk" package inside "pkg" directory. Open the package, compile, and add to project. Alternatively, you may also just include the "src" directory to the unit search path. 23 | 24 | ## High-level neural network API 25 | With automatic differentiation, it is possible to make of neural networks in various degree of abstraction. You can control the flow of of the network, even design a custom fancy loss function. For the high level API, there are several implementation of neural network layers, optimizers, along with `TNNModel` class helper, so you can prototype your network quickly. 26 | ```delphi 27 | program iris_classification; 28 | 29 | {$mode objfpc}{$H+} 30 | 31 | uses 32 | SysUtils, DateUtils, multiarray, numerik, 33 | noe2, noe2.optimizer, noe2.neuralnet; 34 | 35 | var 36 | Dataset, X, Y, YBin, YPred, Loss: TTensor; 37 | model: TNNModel; 38 | opt: TOptAdam; 39 | i: integer; 40 | t: TDateTime; 41 | 42 | begin 43 | Dataset := ReadCSV('iris.csv'); 44 | 45 | X := Dataset[[ _ALL_, Range(0, 4) ]]; // Get all rows and first four columns 46 | Y := Dataset[[ _ALL_, 4 ]]; // Get all rows and a column with index 4 47 | YBin := BinarizeLabel(Y); // Transform labels into one-hot vectors 48 | 49 | model := TNNModel.Create; 50 | model.AddLayer(TLayerDense.Create(4, 30)); 51 | model.AddLayer(TLayerReLU.Create()); 52 | model.AddLayer(TLayerDense.Create(30, 3)); 53 | model.AddLayer(TLayerSoftmax.Create(1)); 54 | 55 | opt := TOptAdam.Create(model.Params); // Adam optimizer 56 | opt.LearningRate := 0.01; 57 | 58 | t := Now; 59 | for i := 0 to 100 do 60 | begin 61 | YPred := model.Eval(X); 62 | Loss := CrossEntropy(YPred, YBin); 63 | Loss.Backward(); 64 | opt.Step; 65 | 66 | if i mod 10 = 0 then 67 | WriteLn('Loss at iteration ', i, ': ', Loss.Data.Get(0) : 5 : 2); 68 | end; 69 | 70 | WriteLn('Training completed in ', MilliSecondsBetween(Now, t), ' ms'); 71 | WriteLn('Training accuracy: ', Mean(ArgMax(YPred.Data, 1, True)).Item : 5 : 2); 72 | WriteLn('Press enter to exit'); ReadLn; 73 | 74 | model.Free; 75 | opt.Free; 76 | end. 77 | ``` 78 | <div align="center"> 79 | <img src="https://i.imgur.com/0NngCHB.png" alt="logo" width="640px"></img> 80 | </div> 81 | 82 | Aaaand... you are good to go. More layers are coming soon (including convolutional layers). 83 | 84 | ## Touching the bare metal: Write your own math 85 | Noe is hackable. If you want more control, you can skip `TNNModel` and `TLayer` creation and define your own model from scratch. It is easy and straightforward, like how normal people do math. No random cryptic symbols. Following is an example of noe usage to solve XOR problem. 86 | ```delphi 87 | program xor_example; 88 | 89 | uses 90 | multiarray, numerik, noe; 91 | 92 | var 93 | X, y, yPred, Loss: TTensor; 94 | W1, W2, b1, b2: TTensor; // Weights and biases 95 | LearningRate: Single; 96 | i: integer; 97 | 98 | begin 99 | Randomize; 100 | 101 | X := CreateMultiArray([0, 0, 102 | 0, 1, 103 | 1, 0, 104 | 1, 1]).Reshape([4, 2]); 105 | y := CreateMultiArray([0, 1, 1, 0]).Reshape([4, 1]); 106 | 107 | W1 := Random([2, 5]); // Input to hidden 108 | W2 := Random([5, 1]); // Hidden to output 109 | W1.RequiresGrad := True; 110 | W2.RequiresGrad := True; 111 | 112 | b1 := Zeros([5]); 113 | b2 := Zeros([1]); 114 | b1.RequiresGrad := True; 115 | b2.RequiresGrad := True; 116 | 117 | LearningRate := 0.01; 118 | for i := 0 to 2000 do 119 | begin 120 | yPred := (ReLu(X.Matmul(W1) + b1)).Matmul(W2) + b2; // Prediction 121 | Loss := Mean(Sqr(yPred - y)); // MSE error 122 | 123 | W1.ZeroGrad; 124 | W2.ZeroGrad; 125 | b1.ZeroGrad; 126 | b2.ZeroGrad; 127 | 128 | Loss.Backward(); // Backpropagate the error and compute gradients 129 | 130 | { Update the parameters } 131 | W1.Data := W1.Data - LearningRate * W1.Grad; 132 | W2.Data := W2.Data - LearningRate * W2.Grad; 133 | b1.Data := b1.Data - LearningRate * b1.Grad; 134 | b2.Data := b2.Data - LearningRate * b2.Grad; 135 | 136 | if i mod 50 = 0 then 137 | WriteLn('Loss at iteration ', i, ': ', Loss.Data.Get(0) : 5 : 2); 138 | end; 139 | 140 | WriteLn('Prediction:'); 141 | PrintTensor(YPred); 142 | 143 | Write('Press enter to exit'); ReadLn; 144 | end. 145 | ``` 146 | 147 | <div align="center"> 148 | <img src="https://i.imgur.com/J6x6rNJ.png" alt="logo" width="400px"></img> 149 | </div> 150 | 151 | 152 | That said, you could have even defined your own custom layers and optimizers :metal:. Really. Even noe's layer implementations are pretty verbose and straightfowrward. Check the source code yourself whenever you have free time. 153 | 154 | You can also compute the loss function derivative with respect to all parameters to obtain the gradients... by your hands... But just stop there. Stop hurting yourself. Use more autograd. 155 | 156 | See [the wiki](https://github.com/ariaghora/noe/wiki) for more documentation. Please note that this framework is developed and heavily tested using fpc 3.0.4, with object pascal syntax mode, on a windows machine. Portability is not really my first concern right now, but any helps are sincerely welcome. See [CONTRIBUTING.md](CONTRIBUTING.md). 157 | 158 | >:warning: *Noe is evolving. The development is still early and active. The use for production is not encouraged at this moment.* 159 | -------------------------------------------------------------------------------- /src/legacy/noe.utils.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit implement some helper functionalities, such as some operator 7 | overloadings, which I think will be helpful. 8 | } 9 | 10 | unit noe.utils; 11 | 12 | {$mode objfpc}{$H+} 13 | 14 | interface 15 | 16 | uses 17 | SysUtils, 18 | strutils, 19 | fgl, 20 | Classes, 21 | math, 22 | noe; 23 | 24 | type 25 | TIntVector = array of longint; 26 | TDoubleList = specialize TFPGList<double>; 27 | TDoubleIntMap = specialize TFPGMap<double, longint>; 28 | 29 | { One-hot encode categorical labels } 30 | 31 | { TOneHotEncoder } 32 | 33 | TOneHotEncoder = class 34 | unique: TDoubleList; 35 | function Encode(T: TTensor): TTensor; 36 | function Decode(T: TTensor): TTensor; 37 | procedure Cleanup; 38 | private 39 | LabelToIndexMap: TDoubleIntMap; 40 | end; 41 | 42 | function IntVectorEquals(v1, v2: TIntVector): boolean; 43 | function ReverseIntArr(A: array of longint): TIntVector; 44 | function ReverseFloatArr(A: array of Double): TFloatVector; 45 | 46 | { Sorting chars in a string using bubble sort. Not for big strings. } 47 | function SortStr(s: string; ascending: boolean = True): string; inline; 48 | function StandardScaler(X:TTensor): TTensor; 49 | 50 | procedure NoeLog(tag, msg: string); 51 | procedure VisualizeMatrix(T: TTensor); 52 | 53 | operator in (substr, mainstr: string) b: boolean; 54 | operator in (str: string; arr: array of string) b: boolean; 55 | operator in (x: double; arr: array of double) b: boolean; 56 | operator in (x: longint; arr: array of longint) b: boolean; 57 | operator = (a, b: array of longint) c: boolean; 58 | 59 | implementation 60 | 61 | uses 62 | noe.Math; 63 | 64 | 65 | function IntVectorEquals(v1, v2: TIntVector): boolean; 66 | var 67 | i: longint; 68 | begin 69 | Result := True; 70 | if not (length(v1) = length(v2)) then Exit(False); 71 | for i := 0 to length(v1) - 1 do 72 | if v1[i] <> v2[i] then 73 | begin 74 | Exit(False); 75 | end; 76 | end; 77 | 78 | function ReverseIntArr(A: array of longint): TIntVector; 79 | var 80 | i: longint; 81 | begin 82 | SetLength(Result, Length(A)); 83 | for i := Length(A) - 1 downto 0 do 84 | Result[Length(A) - i - 1] := A[i]; 85 | end; 86 | 87 | function ReverseFloatArr(A: array of Double): TFloatVector; 88 | var 89 | i: longint; 90 | begin 91 | SetLength(Result, Length(A)); 92 | for i := Length(A) - 1 downto 0 do 93 | Result[Length(A) - i - 1] := A[i]; 94 | end; 95 | 96 | function SortStr(s: string; ascending: boolean = True): string; 97 | var 98 | i, j: integer; 99 | tmp: char; 100 | tmpstr: string; 101 | compSatisfied: boolean; 102 | begin 103 | tmpstr := s; 104 | for i := 1 to Length(s) do 105 | begin 106 | for j := 1 to Length(s) do 107 | begin 108 | if ascending then 109 | compSatisfied := tmpstr[i] < tmpstr[j] 110 | else 111 | compSatisfied := tmpstr[i] > tmpstr[j]; 112 | 113 | if compSatisfied then 114 | begin 115 | tmp := tmpstr[i]; 116 | tmpstr[i] := tmpstr[j]; 117 | tmpstr[j] := tmp; 118 | end; 119 | end; 120 | end; 121 | Result := tmpstr; 122 | end; 123 | 124 | function CompareDouble(const x, y: double): integer; 125 | begin 126 | if x = y then 127 | Result := 0 128 | else if x < y then 129 | Result := -1 130 | else 131 | Result := 1; 132 | end; 133 | 134 | function StandardScaler(X: TTensor): TTensor; 135 | var 136 | mu, std: TTensor; 137 | begin 138 | mu := Mean(X, 0); 139 | std := (Mean((X - mu) ** 2, 0)) ** 0.5; 140 | 141 | Result := ((X - mu)/std); 142 | end; 143 | 144 | procedure NoeLog(tag, msg: string); 145 | begin 146 | if noe.NoeConfig.debug and IsConsole then 147 | begin 148 | WriteLn(tag + ': ' + msg); 149 | end; 150 | end; 151 | 152 | procedure VisualizeMatrix(T: TTensor); 153 | var 154 | i, j: integer; 155 | maxval: double; 156 | begin 157 | Assert(T.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 158 | maxval := maxvalue(T.Val); 159 | for i := 0 to T.Shape[0] - 1 do 160 | begin 161 | for j := 0 to T.Shape[1] - 1 do 162 | begin 163 | if (T.GetAt(i, j) / maxval) > (4/5) then write(#178) 164 | else if (T.GetAt(i, j) / maxval) > (3/5) then write(#177) 165 | else if (T.GetAt(i, j) / maxval) > (2/5) then write(#176) 166 | else if (T.GetAt(i, j) / maxval) > (1/5) then write(#247) 167 | else write(' '); 168 | end; 169 | writeln; 170 | //s := s + sLineBreak; 171 | end; 172 | //WriteLn(s); 173 | end; 174 | 175 | operator in (substr, mainstr: string)b: boolean; 176 | begin 177 | b := AnsiContainsStr(mainstr, substr); 178 | end; 179 | 180 | operator in(str: string; arr: array of string)b: boolean; 181 | var 182 | i: longint; 183 | begin 184 | result := false; 185 | for i:=0 to length(arr)-1 do 186 | if str = arr[i] then 187 | begin 188 | result := true; 189 | exit; 190 | end; 191 | end; 192 | 193 | operator in(x: double; arr: array of double)b: boolean; 194 | var 195 | i: longint; 196 | begin 197 | result := false; 198 | for i:=0 to length(arr)-1 do 199 | if x = arr[i] then 200 | begin 201 | result := true; 202 | exit; 203 | end; 204 | end; 205 | 206 | operator in(x: longint; arr: array of longint)b: boolean; 207 | var 208 | i: longint; 209 | begin 210 | result := false; 211 | for i:=0 to length(arr)-1 do 212 | if x = arr[i] then 213 | begin 214 | result := true; 215 | exit; 216 | end; 217 | end; 218 | 219 | operator = (a, b: array of longint) c: boolean; 220 | var 221 | i: longint; 222 | begin 223 | Assert(length(a) = length(b), MSG_ASSERTION_DIFFERENT_LENGTH); 224 | c := True; 225 | for i := 0 to length(a) - 1 do 226 | if a[i] <> b[i] then 227 | begin 228 | c := False; 229 | exit; 230 | end; 231 | end; 232 | 233 | { TOneHotEncoder } 234 | 235 | function TOneHotEncoder.Encode(T: TTensor): TTensor; 236 | var 237 | i: double; 238 | j, row: longint; 239 | begin 240 | Assert(T.NDims = 1, MSG_ASSERTION_RANK_1_TENSORS_ONLY); 241 | 242 | { get unique labels } 243 | unique := TDoubleList.Create; 244 | for i in T.Val do 245 | if (unique.IndexOf(i) < 0) then 246 | unique.Add(i); 247 | unique.Sort(@CompareDouble); 248 | 249 | { Create zeros as the placeholder } 250 | Result := Zeros([T.Size, unique.Count]); 251 | 252 | LabelToIndexMap := TDoubleIntMap.Create; 253 | for j := 0 to unique.Count - 1 do 254 | LabelToIndexMap.Add(unique.Items[j], j); 255 | 256 | { Actual data handling } 257 | for row := 0 to Result.Shape[0] - 1 do 258 | Result.SetAt(row, LabelToIndexMap.KeyData[T.Val[row]], 1.0); 259 | 260 | FreeAndNil(LabelToIndexMap); 261 | end; 262 | 263 | function TOneHotEncoder.Decode(T: TTensor): TTensor; 264 | var 265 | Indices: TTensor; 266 | i: longint; 267 | begin 268 | Assert(T.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 269 | Indices := Squeeze(ArgMax(T, 1)); 270 | 271 | Result.ReshapeInplace([Indices.Size]); 272 | SetLength(Result.Val, Indices.Size); 273 | for i := 0 to Indices.Size - 1 do 274 | Result.SetAt(i, unique[Round(Indices.GetAt(i))]); 275 | end; 276 | 277 | procedure TOneHotEncoder.Cleanup; 278 | begin 279 | FreeAndNil(unique); 280 | FreeAndNil(LabelToIndexMap); 281 | FreeAndNil(self); 282 | end; 283 | 284 | 285 | end. 286 | -------------------------------------------------------------------------------- /src/legacy/noe.optimizer.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit provides implementation for neural network optimization algorithms. 7 | } 8 | 9 | unit noe.optimizer; 10 | 11 | {$mode objfpc}{$H+} 12 | 13 | interface 14 | 15 | uses 16 | Classes, noe, noe.math, noe.utils, SysUtils; 17 | 18 | procedure DefaultOptimizerCallback(Loss: TVariable; iteration: longint; 19 | Params: array of TVariable); 20 | 21 | type 22 | TOptimizerCallbackProc = procedure(Loss: TVariable; iteration: longint; 23 | Params: array of TVariable); 24 | 25 | { The base class for optimizer. All optimizers should extend this class. } 26 | 27 | { TBaseOptimizer } 28 | 29 | TBaseOptimizer = class 30 | private 31 | FCallback: TOptimizerCallbackProc; 32 | FLearningRate: double; 33 | FIteration: longint; 34 | FVerbose: boolean; 35 | public 36 | constructor Create; 37 | procedure UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 38 | procedure Cleanup; 39 | property LearningRate: double read FLearningRate write FLearningRate; 40 | property Iteration: longint read FIteration write FIteration; 41 | property Verbose: boolean read FVerbose write FVerbose; 42 | end; 43 | 44 | { The implementation of stochastic gradient descent. It is the most basic 45 | optimizer among available ones. } 46 | 47 | TSGDOptimizer = class(TBaseOptimizer) 48 | constructor Create; 49 | procedure UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 50 | 51 | end; 52 | 53 | { The implementation of stochastic gradient descent with momentum } 54 | 55 | TSGDMomentumOptimizer = class(TBaseOptimizer) 56 | private 57 | FGamma: double; 58 | V: array of TTensor; 59 | VPopulated: boolean; 60 | public 61 | constructor Create; 62 | procedure UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 63 | property Gamma: double read FGamma write FGamma; 64 | end; 65 | 66 | { The implementation of adam optimizer. It was proposed by Kingma & Ba (2014). 67 | Please check the paper, "Adam: A Method for Stochastic Optimization", here: 68 | https://arxiv.org/abs/1412.6980. } 69 | 70 | TAdamOptimizer = class(TBaseOptimizer) 71 | private 72 | M: array of TTensor; 73 | V: array of TTensor; 74 | MVPopulated: boolean; 75 | public 76 | Epsilon: double; 77 | Beta1: double; 78 | Beta2: double; 79 | constructor Create; 80 | procedure UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 81 | end; 82 | 83 | { TRMSPropOptimizer } 84 | 85 | TRMSPropOptimizer = class(TBaseOptimizer) 86 | private 87 | V: array of TTensor; 88 | VPopulated: boolean; 89 | public 90 | Epsilon: double; 91 | Gamma: double; 92 | constructor Create; 93 | procedure UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 94 | end; 95 | 96 | implementation 97 | 98 | procedure DefaultOptimizerCallback(Loss: TVariable; iteration: longint; 99 | Params: array of TVariable); 100 | begin 101 | NoeLog('Debug', 'Epoch ' + IntToStr(iteration) + ': loss = ' + 102 | FloatToStrF(Loss.Data.GetAt(0), ffFixed, 2, 5)); 103 | end; 104 | 105 | { TRMSPropOptimizer } 106 | 107 | constructor TRMSPropOptimizer.Create; 108 | begin 109 | inherited; 110 | self.LearningRate := 0.001; 111 | self.Epsilon := 10E-8; 112 | self.Gamma := 0.99; 113 | self.VPopulated := False; 114 | end; 115 | 116 | procedure TRMSPropOptimizer.UpdateParams(Loss: TVariable; 117 | ModelParams: array of TVariable); 118 | var 119 | i: longint; 120 | begin 121 | inherited; 122 | if not self.VPopulated then 123 | begin 124 | SetLength(self.V, Length(ModelParams)); 125 | for i := 0 to Length(ModelParams) - 1 do 126 | begin 127 | self.V[i] := Zeros(ModelParams[i].Data.Shape); 128 | end; 129 | self.VPopulated := True; 130 | end; 131 | 132 | for i := 0 to Length(ModelParams) - 1 do 133 | begin 134 | self.V[i] := self.Gamma * self.V[i] + (1 - self.Gamma) * (ModelParams[i].Grad ** 2); 135 | 136 | { Model parameter update } 137 | ModelParams[i].Data := ModelParams[i].Data - self.LearningRate * 138 | ModelParams[i].Grad / ((self.V[i]) ** 0.5 + self.Epsilon); 139 | end; 140 | end; 141 | 142 | { TBaseOptimizer } 143 | 144 | constructor TBaseOptimizer.Create; 145 | begin 146 | Self.Verbose := True; 147 | Self.FCallback := @DefaultOptimizerCallback; 148 | end; 149 | 150 | procedure TBaseOptimizer.UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 151 | begin 152 | ZeroGradGraph(Loss); 153 | Loss.Backpropagate; 154 | 155 | if self.Verbose then 156 | self.FCallback(Loss, self.FIteration, ModelParams); 157 | 158 | Inc(FIteration); 159 | end; 160 | 161 | procedure TBaseOptimizer.Cleanup; 162 | begin 163 | FreeAndNil(self); 164 | end; 165 | 166 | { TSGDMomentumOptimizer } 167 | 168 | constructor TSGDMomentumOptimizer.Create; 169 | begin 170 | inherited; 171 | self.LearningRate := 0.01; 172 | self.VPopulated := False; 173 | end; 174 | 175 | procedure TSGDMomentumOptimizer.UpdateParams(Loss: TVariable; 176 | ModelParams: array of TVariable); 177 | var 178 | i: integer; 179 | begin 180 | inherited; 181 | 182 | if not self.VPopulated then 183 | begin 184 | SetLength(self.V, Length(ModelParams)); 185 | for i := 0 to Length(ModelParams) - 1 do 186 | self.V[i] := Zeros(ModelParams[i].Data.Shape); 187 | self.VPopulated := True; 188 | end; 189 | 190 | for i := 0 to Length(ModelParams) - 1 do 191 | begin 192 | self.V[i] := self.Gamma * self.V[i] + self.LearningRate * ModelParams[i].Grad; 193 | ModelParams[i].Data := ModelParams[i].Data - self.V[i]; 194 | end; 195 | 196 | end; 197 | 198 | { TAdamOptimizer } 199 | 200 | constructor TAdamOptimizer.Create; 201 | begin 202 | inherited; 203 | 204 | self.FIteration := 1; 205 | self.LearningRate := 0.001; 206 | self.Epsilon := 10E-8; 207 | self.Beta1 := 0.9; 208 | self.Beta2 := 0.999; 209 | self.MVPopulated := False; 210 | end; 211 | 212 | procedure TAdamOptimizer.UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 213 | var 214 | mHat, vHat: TTensor; 215 | i: longint; 216 | begin 217 | inherited; 218 | 219 | { initialize elements in M and V once with zeros } 220 | if not self.MVPopulated then 221 | begin 222 | SetLength(self.M, Length(ModelParams)); 223 | SetLength(self.V, Length(ModelParams)); 224 | for i := 0 to Length(ModelParams) - 1 do 225 | begin 226 | self.M[i] := Zeros(ModelParams[i].Data.Shape); 227 | self.V[i] := Zeros(ModelParams[i].Data.Shape); 228 | end; 229 | self.MVPopulated := True; 230 | end; 231 | 232 | for i := 0 to Length(ModelParams) - 1 do 233 | begin 234 | { First and second moment estimate } 235 | self.M[i] := self.Beta1 * self.M[i] + (1 - Self.Beta1) * ModelParams[i].Grad; 236 | self.V[i] := self.Beta2 * self.V[i] + (1 - Self.Beta2) * (ModelParams[i].Grad ** 2); 237 | 238 | { Bias correction } 239 | mHat := self.M[i] / (1 - (self.Beta1 ** (self.Iteration))); 240 | vHat := self.V[i] / (1 - (self.Beta2 ** (self.Iteration))); 241 | 242 | { Model parameter update } 243 | ModelParams[i].Data := ModelParams[i].Data - self.LearningRate * 244 | mHat / ((vHat ** 0.5) + self.Epsilon); 245 | end; 246 | end; 247 | 248 | { TSGDOptimizer } 249 | 250 | constructor TSGDOptimizer.Create; 251 | begin 252 | inherited; 253 | 254 | self.LearningRate := 0.01; 255 | end; 256 | 257 | procedure TSGDOptimizer.UpdateParams(Loss: TVariable; ModelParams: array of TVariable); 258 | var 259 | param: TVariable; 260 | begin 261 | inherited; 262 | 263 | for param in ModelParams do 264 | begin 265 | param.Data := param.Data - self.LearningRate * param.Grad; 266 | end; 267 | 268 | end; 269 | 270 | end. 271 | -------------------------------------------------------------------------------- /src/legacy/noe.plot.gnuplot.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit provides an interface to GNU Plot. 7 | } 8 | unit noe.plot.gnuplot; 9 | 10 | {$mode objfpc}{$H+} 11 | 12 | interface 13 | 14 | uses 15 | Classes, noe, SysUtils; 16 | 17 | var 18 | { Hold global count of created plots } 19 | GlobalPlotCount: integer; 20 | 21 | type 22 | TPlotType = (ptBoxes, ptLines, ptPoints, ptHistogram, ptImage); 23 | 24 | { @abstract(A record containing plot style) } 25 | TPlotStyle = record 26 | LineType: longint; 27 | LineColor: string; 28 | LineWidth: longint; 29 | PointType: longint; 30 | PointSize: longint; 31 | end; 32 | 33 | { @abstract(A class that holds information of data points to plot, including its style) } 34 | 35 | { TPlot } 36 | 37 | TPlot = class 38 | PlotStyle: TPlotStyle; 39 | Title: string; 40 | PlotType: TPlotType; 41 | OverrideDefaultStyle: boolean; 42 | public 43 | Values: TTensor; 44 | constructor Create; 45 | procedure Cleanup; 46 | { Set the data points to plot 47 | @param(x only accepts TDTMatrix with size of 1 by m or m by 1) } 48 | procedure SetDataPoints(x: TTensor); overload; 49 | { Set the data points to plot (x axis against y axis) } 50 | procedure SetDataPoints(x, y: TTensor); overload; 51 | function GenerateScript: string; 52 | private 53 | FileName: string; 54 | procedure WriteDataStringTableToFile; 55 | procedure RemoveDataStringTableFile; 56 | end; 57 | 58 | { @abstract(A class that holds information of a single figure) } 59 | 60 | { TFigure } 61 | 62 | TFigure = class(TObject) 63 | Title: string; 64 | XLabel: string; 65 | YLabel: string; 66 | Palette: string; 67 | public 68 | constructor Create; 69 | procedure Cleanup; 70 | procedure AddPlot(Plot: TPlot); 71 | procedure Show; 72 | private 73 | PlotList: TList; 74 | function GenerateScript: string; 75 | end; 76 | 77 | { Initialize plotting functionality by passing gnuplot executable path } 78 | procedure GNUPlotInit(GNUplotPath: string); 79 | procedure ImageShow(img: TTensor; title: string = ''); 80 | 81 | 82 | implementation 83 | 84 | var 85 | _GNUPlotInitialized: boolean = False; 86 | _GNUPlotPath: string; 87 | _GNUPlotTerminal: string; 88 | 89 | procedure MatrixStringTableToFile(X: TTensor; fn: string); 90 | var 91 | F: TextFile; 92 | begin 93 | AssignFile(F, fn); 94 | try 95 | ReWrite(F); 96 | Write(F, X.DumpCSV(' ')); 97 | finally 98 | CloseFile(F); 99 | end; 100 | end; 101 | 102 | function IsDTPlotReady: boolean; 103 | begin 104 | Result := True; 105 | if not _GNUPlotInitialized then 106 | begin 107 | WriteLn('GNU Plot has not been configured properly.'); 108 | Result := False; 109 | end; 110 | end; 111 | 112 | procedure GNUPlotInit(GNUplotPath: string); 113 | begin 114 | _GNUPlotPath := GNUplotPath; 115 | _GNUPlotTerminal := 'qt'; 116 | //if FileExists(GNUplotPath) then 117 | _GNUPlotInitialized := True; 118 | //else 119 | // WriteLn('GNU Plot executable is not found.'); 120 | end; 121 | 122 | procedure ImageShow(img: TTensor; title: string); 123 | var 124 | fig: TFigure; 125 | plot: TPlot; 126 | begin 127 | Assert(img.NDims = 2, 'Currently only greyscale images are supported (NDims=2).'); 128 | fig := TFigure.Create; 129 | fig.Title := title; 130 | fig.Palette := 'grey'; 131 | 132 | plot := TPlot.Create; 133 | plot.PlotType := ptImage; 134 | plot.SetDataPoints(VFlip(img)); 135 | 136 | fig.AddPlot(plot); 137 | fig.Show; 138 | end; 139 | 140 | constructor TPlot.Create; 141 | begin 142 | OverrideDefaultStyle := False; 143 | PlotType := ptPoints; // 'histogram', 'lines', 'dots' 144 | Inc(GlobalPlotCount); 145 | FileName := Format('_DTPLOT_TMP_%d.tmp', [GlobalPlotCount]); 146 | 147 | { default style (for overriding) } 148 | PlotStyle.LineType := 1; 149 | PlotStyle.LineColor := '#000000'; 150 | PlotStyle.LineWidth := 2; 151 | PlotStyle.PointType := 7; 152 | PlotStyle.PointSize := 1; 153 | end; 154 | 155 | procedure TPlot.Cleanup; 156 | begin 157 | FreeAndNil(self); 158 | end; 159 | 160 | procedure TPlot.RemoveDataStringTableFile; 161 | begin 162 | if FileExists(self.FileName) then 163 | DeleteFile(self.FileName); 164 | end; 165 | 166 | procedure TPlot.WriteDataStringTableToFile; 167 | begin 168 | MatrixStringTableToFile(self.Values, self.FileName); 169 | end; 170 | 171 | function TPlot.GenerateScript: string; 172 | var 173 | s, style, PlotTypeStr, Modifier: string; 174 | begin 175 | case PlotType of 176 | ptLines: PlotTypeStr := 'lines'; 177 | ptPoints: PlotTypeStr := 'points'; 178 | ptHistogram: PlotTypeStr := 'histogram'; 179 | ptBoxes: PlotTypeStr := 'boxes'; 180 | ptImage: PlotTypeStr := 'image'; 181 | end; 182 | 183 | if PlotType = ptImage then 184 | Modifier := 'matrix'; 185 | 186 | if not OverrideDefaultStyle then 187 | style := '' 188 | else 189 | style := Format(' linetype %d linecolor ''%s'' linewidth %d pointtype %d pointsize %d', 190 | [PlotStyle.LineType, PlotStyle.LineColor, PlotStyle.LineWidth, 191 | PlotStyle.PointType, PlotStyle.PointSize]); 192 | s := Format('''%s'' %s title ''%s'' with %s%s', 193 | [FileName, Modifier, Title, PlotTypeStr, style]); 194 | Result := s; 195 | end; 196 | 197 | procedure TPlot.SetDataPoints(x: TTensor); 198 | var 199 | x_: TTensor; 200 | begin 201 | x_ := x; 202 | 203 | if self.PlotType <> ptImage then 204 | x_.ReshapeInplace([x_.Size, 1]); 205 | 206 | self.Values := x_; 207 | end; 208 | 209 | procedure TPlot.SetDataPoints(x, y: TTensor); 210 | var 211 | x_, y_: TTensor; 212 | begin 213 | //if ((x_.Shape[1] = 1) or (x_.Shape[0] = 1)) and ((y_.Shape[1] = 1) or (y_.Shape[0] = 1)) then 214 | //begin 215 | // x_ := CopyTensor(x); 216 | // y_ := CopyTensor(y); 217 | // if x.Shape[1] > 1 then 218 | // x_ := x_.T; 219 | // if y.Shape[1] > 1 then 220 | // y_ := y_.T; 221 | // column 222 | //self.Values := AppendColumns(x, y); 223 | //end; 224 | end; 225 | 226 | constructor TFigure.Create; 227 | begin 228 | self.PlotList := TList.Create; 229 | self.Palette := 'rgbformulae 7,5,15'; 230 | end; 231 | 232 | procedure TFigure.Cleanup; 233 | var 234 | i: integer; 235 | begin 236 | for i:=0 to PlotList.Count - 1 do 237 | TPlot(PlotList.Items[i]).Cleanup; 238 | FreeAndNil(PlotList); 239 | 240 | FreeAndNil(self); 241 | end; 242 | 243 | function TFigure.GenerateScript: string; 244 | var 245 | s, script: string; 246 | i: integer; 247 | begin 248 | s := '' + sLineBreak; 249 | s := s + 'set terminal %s title ''%s'';' + sLineBreak; 250 | s := s + 'set key right top;' + sLineBreak; 251 | s := s + 'set xlabel ''' + self.XLabel + ''';' + sLineBreak; 252 | s := s + 'set ylabel ''' + self.YLabel + ''';' + sLineBreak; 253 | s := s + 'set palette ' + self.Palette + ';' + sLineBreak; 254 | 255 | s := s + 'do for [i=1:64] {set style line i linewidth 2};' + sLineBreak; 256 | 257 | s := s + 'plot '; 258 | for i := 0 to PlotList.Count - 1 do 259 | begin 260 | s := s + TPlot(PlotList.items[i]).GenerateScript; 261 | if i < PlotList.Count - 1 then 262 | s := s + ','; 263 | end; 264 | s := s + ';'; 265 | script := Format(s, [_GNUPlotTerminal, Title]); 266 | Result := script; 267 | end; 268 | 269 | procedure TFigure.AddPlot(Plot: TPlot); 270 | begin 271 | PlotList.Add(Plot); 272 | end; 273 | 274 | procedure TFigure.Show; 275 | var 276 | i: integer; 277 | begin 278 | { Generate temp files for each plot } 279 | for i := 0 to PlotList.Count - 1 do 280 | TPlot(PlotList.Items[i]).WriteDataStringTableToFile; 281 | 282 | if IsDTPlotReady then 283 | ExecuteProcess(Utf8ToAnsi(Format('%s --persist -e "%s" ', 284 | [_GNUPlotPath, self.GenerateScript])), 285 | '', []); 286 | 287 | { do cleanup (temp files removal) } 288 | for i := 0 to PlotList.Count - 1 do 289 | TPlot(PlotList.Items[i]).RemoveDataStringTableFile; 290 | 291 | end; 292 | 293 | initialization 294 | GNUPlotInit('gnuplot'); 295 | GlobalPlotCount := 0; 296 | 297 | end. 298 | -------------------------------------------------------------------------------- /examples/console/optdigits.lpr: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | - OBJECTIVE 7 | ========= 8 | This program highlights several important high (abstraction) level features 9 | of noe through the case of optical digits classification problem. The input 10 | is handwritten digits datasaet as described below. 11 | 12 | - DATASET DESCRIPTION 13 | =================== 14 | From "archive.ics.uci.edu/ml/datasets/Optical+Recognition+of+Handwritten+Digits": 15 | "We used preprocessing programs made available by NIST to extract normalized 16 | bitmaps of handwritten digits from a preprinted form. From a total of 43 17 | people, 30 contributed to the training set and different 13 to the test set. 18 | 32x32 bitmaps are divided into nonoverlapping blocks of 4x4 and the number of 19 | on pixels are counted in each block. This generates an input matrix of 8x8 20 | where each element is an integer in the range 0..16. This reduces dimensionality 21 | and gives invariance to small distortions." 22 | } 23 | program optdigits; 24 | 25 | {$mode objfpc}{$H+} 26 | 27 | uses 28 | SysUtils, 29 | Math, 30 | noe, 31 | noe.Math, 32 | noe.utils, 33 | noe.optimizer, 34 | noe.plot.gnuplot; 35 | 36 | const 37 | MAX_EPOCH = 5; 38 | 39 | var 40 | DatasetTrain, DatasetTest, FeatsTrain, LabelsTrain, EncodedLabelsTrain, 41 | Losses, ImageSample: TTensor; 42 | Lambda, TrainingAcc, TestingAcc: double; 43 | FeatsTest, LabelsTest, ypredTest: TTensor; 44 | i, M, NHiddenNeuron, NInputNeuron, NOutputNeuron, SampleIdx, 45 | PredictedLabel, ActualLabel: longint; 46 | Xtrain, ytrain, ypred, W1, W2, b1, b2, L2Reg, CrossEntropyLoss, TotalLoss: TVariable; 47 | 48 | Optimizer: TAdamOptimizer; 49 | LabelEncoder: TOneHotEncoder; 50 | 51 | { A tiny function to obtain classification accuracy. It simply computes the 52 | number of correctly classified samples divided by the total number of 53 | samples. } 54 | function AccuracyScore(predicted, actual: TTensor): double; 55 | var 56 | i: integer; 57 | tot: double; 58 | begin 59 | tot := 0; 60 | for i := 0 to predicted.Size - 1 do 61 | { check if the sample is correctly classified (i.e., predicted = actual) } 62 | if predicted.GetAt(i) = actual.GetAt(i) then 63 | tot := tot + 1; 64 | Result := tot / predicted.Size; 65 | end; 66 | 67 | { A procedure to display figure using noe's interface to GNU plot. } 68 | procedure ShowFigure(Losses: TTensor; Title: string; PlotType: TPlotType); 69 | var 70 | Figure: TFigure; 71 | Plot: TPlot; 72 | begin 73 | GNUPlotInit('gnuplot'); 74 | Figure := TFigure.Create; 75 | Figure.Title := Title; 76 | 77 | if PlotType = ptImage then 78 | Figure.Palette := 'gray'; 79 | 80 | Plot := TPlot.Create; 81 | Plot.Title := Title; 82 | Plot.PlotType := PlotType; 83 | Plot.SetDataPoints(Losses); 84 | 85 | Figure.AddPlot(Plot); 86 | Figure.Show; 87 | 88 | Figure.Cleanup; 89 | end; 90 | 91 | begin 92 | RandSeed := 1; 93 | 94 | //globali 95 | 96 | { Load the DatasetTrain from CSV. Noe has a built-in function to do so. } 97 | DatasetTrain := ReadCSV('../datasets/optdigits-train.csv'); 98 | 99 | M := DatasetTrain.Shape[0]; // The number of samples 100 | 101 | { Get the columns that represent feature vectors. The opdigits DatasetTrain contains 102 | values within the range [0, 16]. Thus we can perform feature scaling by simply 103 | dividing the feature values by 16. } 104 | FeatsTrain := GetRange(DatasetTrain, 0, 0, M, 64) / 16; 105 | 106 | { The column containing LabelsTrain is located at index 64. } 107 | LabelsTrain := Squeeze(GetColumn(DatasetTrain, 64)); 108 | 109 | { Convert the categorical label into one-hot encoded matrix. } 110 | LabelEncoder := TOneHotEncoder.Create; 111 | EncodedLabelsTrain := LabelEncoder.Encode(LabelsTrain); 112 | 113 | { Then we use TVariable to wrap around the features and LabelsTrain. } 114 | Xtrain := TVariable.Create(FeatsTrain); 115 | ytrain := TVariable.Create(EncodedLabelsTrain); 116 | 117 | NInputNeuron := Xtrain.Shape[1]; // The number of features (columns) 118 | NHiddenNeuron := 32; // Feel free to experiment with the value. 119 | NOutputNeuron := ytrain.Shape[1]; // The number of unique class in the LabelsTrain 120 | 121 | { Initialize weights and biases. The weights are randomized, and the biases 122 | are set to a particular value. Typically the value is small in the beginning. 123 | Some implementations just use 1/sqrt(n_of_layer_neuron) for the initial bias 124 | value. } 125 | W1 := RandomTensorNormal([NInputNeuron, NHiddenNeuron]); 126 | W2 := RandomTensorNormal([NHiddenNeuron, NOutputNeuron]); 127 | b1 := CreateTensor([1, NHiddenNeuron], 1 / NHiddenNeuron ** 0.5); 128 | b2 := CreateTensor([1, NOutputNeuron], 1 / NOutputNeuron ** 0.5); 129 | 130 | { Since we need the gradient of weights and biases, it is mandatory to set 131 | RequiresGrad property to True. We can also set the parameter individually 132 | for each parameter, e.g., `W1.RequiresGrad := True;`. } 133 | SetRequiresGrad([W1, W2, b1, b2], True); 134 | 135 | { Noe provides the implementation of several optimization algorithms. For this 136 | example we will use adam optimizer. } 137 | Optimizer := TAdamOptimizer.Create; 138 | 139 | { The default is 0.001. Feel free to experiment with the value. } 140 | Optimizer.LearningRate := 0.01; 141 | 142 | Lambda := 0.001; // Weight decay. Feel free to experiment with the value. 143 | 144 | { Keep track the loss values over iteration } 145 | Losses := CreateEmptyTensor([MAX_EPOCH]); 146 | 147 | for i := 0 to MAX_EPOCH - 1 do 148 | begin 149 | { Our neural network -> ŷ = softmax(σ(XW₁ + b₁)W₂ + b₂). } 150 | ypred := SoftMax(ReLU(Xtrain.Dot(W1) + b1).Dot(W2) + b2, 1); 151 | 152 | { Compute the cross-entropy loss. } 153 | CrossEntropyLoss := -Sum(ytrain * Log(ypred)) / M; 154 | 155 | { Compute L2 regularization term. Later it is added to the total loss to 156 | prevent model overfitting. } 157 | L2Reg := Sum(W1 * W1) + Sum(W2 * W2); 158 | 159 | TotalLoss := CrossEntropyLoss + (Lambda / (2 * M)) * L2Reg; 160 | Losses.SetAt(i, TotalLoss.Data.GetAt(0)); 161 | 162 | { Update the network weight } 163 | Optimizer.UpdateParams(TotalLoss, [W1, W2, b1, b2]); 164 | 165 | TrainingAcc := AccuracyScore(LabelEncoder.Decode(ypred.Data), LabelsTrain); 166 | Writeln('Epoch ', i + 1, ' training accuracy: ', TrainingAcc: 2: 3); 167 | end; 168 | 169 | WriteLn('Traning completed. Now evaluating the model on the testing set...'); 170 | 171 | DatasetTest := ReadCSV('../datasets/optdigits-test.csv'); 172 | FeatsTest := GetRange(DatasetTest, 0, 0, DatasetTest.Shape[0], 64) / 16; 173 | LabelsTest := Squeeze(GetColumn(DatasetTest, 64, True)); 174 | 175 | { Note that we do not need to wrap the test data in a variable, since we only 176 | need to evaluate the trained model. Thus, there is no need to create another 177 | computational graph. We can directly use FeatsTest as a TTensor, therefore we 178 | need to use the TTensor inside the model parameters, e.g., instead of using 179 | W1 directly, we shold use W1.Data } 180 | ypredTest := SoftMax(ReLU(FeatsTest.Dot(W1.Data) + b1.Data).Dot(W2.Data) + 181 | b2.Data, 1); 182 | 183 | TestingAcc := AccuracyScore(LabelEncoder.Decode(ypredTest), LabelsTest); 184 | WriteLn('testing accuracy = ', TestingAcc: 2: 2); 185 | 186 | { Displaying plot of training loss } 187 | ShowFigure(Losses, 'Training Loss Plot', ptLines); 188 | 189 | { Pick one sample from the test set. Let's try to visualize and predict the 190 | label } 191 | SampleIdx := 850; 192 | ImageSample := GetRow(FeatsTest, SampleIdx, True); 193 | ypredTest := SoftMax(ReLU(ImageSample.Dot(W1.Data) + b1.Data).Dot(W2.Data) + 194 | b2.Data, 1); 195 | 196 | { Reshape it first for display. } 197 | ImageSample.ReshapeInplace([8, 8]); 198 | 199 | { transform the probability into the discrete label } 200 | PredictedLabel := Round(LabelEncoder.Decode(ypredTest).Val[0]); 201 | ActualLabel := Round(LabelsTest.GetAt(SampleIdx)); 202 | 203 | { I don't know why the image is vertically flipped. So We should flip it back. } 204 | ShowFigure(VFlip(ImageSample), 'Predicted: ' + IntToStr(PredictedLabel) + 205 | '; Actual: ' + IntToStr(ActualLabel), ptImage); 206 | 207 | ReadLn; 208 | 209 | noe.Cleanup; 210 | LabelEncoder.Cleanup; 211 | Optimizer.Cleanup; 212 | end. 213 | 214 | -------------------------------------------------------------------------------- /src/legacy/noe.ndarr.pas: -------------------------------------------------------------------------------- 1 | unit noe.ndarr; 2 | 3 | {$mode objfpc}{$H+}{$modeSwitch advancedRecords} 4 | 5 | interface 6 | 7 | uses 8 | Classes, Math, SysUtils, noe.types, noe.utils, strutils; 9 | 10 | type 11 | 12 | TUFunc = function(v: NFloat): NFloat; 13 | TBFunc = function(v1, v2: NFloat): NFloat; 14 | 15 | { TNdArr } 16 | 17 | TNdArr = record 18 | private 19 | fIsContiguous: boolean; 20 | fShape: array of longint; 21 | fStrides: array of longint; 22 | function GetNDims: longint; 23 | function GetSize: longint; 24 | public 25 | Val: TFloatVector; 26 | function Contiguous: TNdArr; 27 | function Dot(Other: TNdArr): TNdArr; 28 | function DumpCSV(Sep: string = ','): string; 29 | function GetAt(Index: array of longint): TNdArr; 30 | function GetShape: TIntVector; 31 | function Reshape(ShapeVals: array of longint): TNdArr; 32 | function T: TNdArr; 33 | function ToTensor(RequiresGrad: boolean = False): TNdArr; 34 | procedure Fill(v: double); 35 | procedure Cleanup; 36 | procedure SetAt(Index: array of longint; x: double); 37 | procedure WriteToCSV(FileName: string); 38 | procedure ReshapeInplace(NewShape: array of longint); 39 | property IsContiguous: boolean read fIsContiguous write fIsContiguous; 40 | property NDims: longint read GetNDims; 41 | property Shape: TIntVector read FShape write FShape; 42 | property Size: longint read GetSize; 43 | property Strides: TIntVector read FStrides write FStrides; 44 | end; 45 | 46 | TCallback = procedure(val: NFloat; offset:longint; idx: TIntVector; currDim: longint; var T, OutT: TNdArr); 47 | 48 | function CreateEmptyNdArr(Shape: array of longint): TNdArr; 49 | 50 | function ApplyBfunc(A, B: TNdArr; Func: TBFunc): TNdArr; 51 | function ApplyUfunc(A: TNdArr; Func: TUFunc): TNdArr; 52 | 53 | procedure Print2DArray(T: TNdArr); 54 | 55 | 56 | implementation 57 | 58 | procedure Print2DArray(T: TNdArr); 59 | var 60 | i, j: integer; 61 | s: string; 62 | begin 63 | Assert(T.NDims <= 2, 'Can only print a tensor with NDims = 2.'); 64 | s := ''; 65 | 66 | if T.NDims = 0 then 67 | s := s + FloatToStr(T.Val[0]) 68 | else if T.NDims = 1 then 69 | begin 70 | for i := 0 to T.Shape[0] - 1 do 71 | begin 72 | s := s + FloatToStr(T.Val[i]); // ENSURE CONTIGUOUS 73 | if i < T.Shape[0] - 1 then s := s + ' '; 74 | end; 75 | end 76 | else 77 | begin 78 | for i := 0 to T.Shape[0] - 1 do 79 | begin 80 | for j := 0 to T.Shape[1] - 1 do 81 | begin 82 | s := s + FloatToStr(T.Val[i * T.Shape[1] + j]); 83 | if j < T.Shape[1] - 1 then s := s + ' '; 84 | end; 85 | s := s + sLineBreak; 86 | end; 87 | end; 88 | WriteLn(s); 89 | end; 90 | 91 | function ApplyUfunc(A: TNdArr; Func: TUFunc): TNdArr; 92 | var 93 | i: longint; 94 | begin 95 | Result.ReshapeInplace(A.Shape); 96 | SetLength(Result.val, Length(A.val)); 97 | for i := 0 to length(A.val) - 1 do 98 | Result.val[i] := func(A.val[i]); 99 | end; 100 | 101 | function IndexToOffset(Index, Shape, Strides: array of longint): longint; 102 | var 103 | k: longint; 104 | begin 105 | Result := 0; 106 | for k := 0 to Length(Shape) - 1 do 107 | Result := Result + Strides[k] * Index[k]; 108 | end; 109 | 110 | procedure IterateTensor(T, OutT: TNdArr; Callback: TCallback); 111 | var 112 | n, offset, ithDimChanged, dtIter: longint; 113 | res, dimTracker: TIntVector; 114 | 115 | procedure iterate(d: longint; res: TIntVector); 116 | var 117 | i, j: longint; 118 | begin 119 | if d >= n then 120 | begin 121 | for j := Length(res) - 1 downto 0 do 122 | if dimTracker[j] <> res[j] then 123 | begin 124 | dimTracker[j] := res[j]; 125 | 126 | ithDimChanged := j; 127 | end; 128 | Callback(T.Val[IndexToOffset(res, T.Shape, T.Strides)], offset, res, ithDimChanged, T, OutT); 129 | Inc(offset); 130 | exit; 131 | end; 132 | 133 | for i := 0 to T.shape[d] - 1 do 134 | begin 135 | res[d] := i; 136 | iterate(d + 1, res); 137 | end; 138 | end; 139 | begin 140 | offset := 0; 141 | n := Length(T.Shape); 142 | SetLength(res, n); 143 | n := Length(T.shape); 144 | SetLength(dimTracker, n); 145 | for dtIter := 0 to n - 1 do 146 | dimTracker[dtIter] := 0; 147 | iterate(0, res); 148 | end; 149 | 150 | procedure cbAsStrided(val: NFloat; offset: longint; idx: TIntVector; 151 | currDim: longint; var T, OutT: TNdArr); 152 | begin 153 | OutT.Val[offset] := val; 154 | end; 155 | 156 | function ShapeToSize(Shape: array of longint): longint; 157 | var 158 | i, size: longint; 159 | begin 160 | size := 1; 161 | for i := 0 to Length(Shape) - 1 do 162 | size := size * shape[i]; 163 | Result := size; 164 | end; 165 | 166 | function ShapeToStride(Shape: array of longint): TIntVector; 167 | var 168 | k, j, prod: longint; 169 | begin 170 | SetLength(Result, Length(Shape)); 171 | 172 | for k := 0 to Length(Shape) - 1 do 173 | begin 174 | prod := 1; 175 | for j := k + 1 to Length(Shape) - 1 do 176 | prod := prod * Shape[j]; 177 | Result[k] := prod; 178 | end; 179 | end; 180 | 181 | function AsStrided(X: TNdArr; TargetShape, Strides: array of longint): TNdArr; 182 | var 183 | i: longint; 184 | OutStrides: TIntVector; 185 | begin 186 | SetLength(Result.Val, ShapeToSize(TargetShape)); 187 | 188 | X.ReshapeInplace(TargetShape); 189 | SetLength(OutStrides, Length(strides)); 190 | for i := 0 to length(Strides) - 1 do 191 | OutStrides[i] := Strides[i]; 192 | X.Strides := OutStrides; 193 | 194 | IterateTensor(X, Result, @cbAsStrided); 195 | Result.ReshapeInplace(TargetShape); 196 | end; 197 | 198 | function BroadcastTo(X: TNdArr; TargetShape: array of longint): TNdArr; 199 | var 200 | OutShape, OutStrides: TIntVector; 201 | i: longint; 202 | begin 203 | OutShape := ReverseIntArr(X.Shape); 204 | OutStrides := ReverseIntArr(X.Strides); 205 | while length(OutShape) < Length(TargetShape) do 206 | begin 207 | SetLength(OutShape, Length(OutShape) + 1); 208 | OutShape[Length(OutShape) - 1] := 1; 209 | 210 | SetLength(OutStrides, Length(OutStrides) + 1); 211 | OutStrides[Length(OutStrides) - 1] := 0; 212 | end; 213 | OutShape := ReverseIntArr(OutShape); 214 | OutStrides := ReverseIntArr(OutStrides); 215 | 216 | for i := 0 to Length(TargetShape) - 1 do 217 | if TargetShape[i] <> OutShape[i] then 218 | OutStrides[i] := 0; 219 | 220 | Result := AsStrided(X, TargetShape, OutStrides); 221 | end; 222 | 223 | function IsBroadcastable(A, B: TNdArr): boolean; 224 | var 225 | i, violated: longint; 226 | revA, revB: TIntVector; 227 | begin 228 | { counting the violation of broadcasting rule } 229 | violated := 0; 230 | Result := False; 231 | revA := ReverseIntArr(A.Shape); 232 | revB := ReverseIntArr(B.Shape); 233 | for i := 0 to Math.Min(Length(A.Shape), Length(B.Shape)) - 1 do 234 | if (revA[i] <> revB[i]) then 235 | if ((revA[i] <> 1) and (revB[i] <> 1)) then 236 | Inc(violated); 237 | Result := violated = 0; 238 | end; 239 | 240 | function GetBroadcastDims(A, B: TNdArr): TIntVector; 241 | var 242 | i, finalDimSize: longint; 243 | revA, revB: TIntVector; 244 | begin 245 | Assert(IsBroadcastable(A, B), 'A and B cannot be broadcasted'); 246 | finalDimSize := Max(Length(A.Shape), Length(B.Shape)); 247 | 248 | SetLength(Result, finalDimSize); 249 | SetLength(revA, finalDimSize); 250 | SetLength(revB, finalDimSize); 251 | for i := 0 to Length(Result) - 1 do 252 | begin 253 | revA[i] := 1; 254 | revB[i] := 1; 255 | end; 256 | 257 | for i := 0 to length(A.Shape) - 1 do 258 | revA[i] := ReverseIntArr(A.Shape)[i]; 259 | 260 | for i := 0 to Length(B.Shape) - 1 do 261 | revB[i] := ReverseIntArr(B.Shape)[i]; 262 | 263 | revA := ReverseIntArr(revA); 264 | revB := ReverseIntArr(revB); 265 | for i := 0 to Max(Length(A.Shape), Length(B.Shape)) - 1 do 266 | Result[i] := max(revA[i], revB[i]); 267 | end; 268 | 269 | function ApplyBfunc(A, B: TNdArr; Func: TBFunc): TNdArr; 270 | var 271 | i: Longint; 272 | outdim: TIntVector; 273 | begin 274 | { Case 1: A and B have the same shape. Perform usual element-wise operation. } 275 | if IntVectorEquals(A.Shape, B.Shape) then 276 | begin 277 | Result := CreateEmptyNdArr(A.Shape); 278 | for i := 0 to A.Size - 1 do 279 | Result.Val[i] := Func(A.Val[i], B.Val[i]); 280 | end 281 | else 282 | begin 283 | { General tensor broadcast bfunc } 284 | outdim := GetBroadcastDims(A, B); 285 | if not IntVectorEquals(A.Shape, outdim) then 286 | A := BroadcastTo(A, outdim); 287 | if not IntVectorEquals(B.Shape, outdim) then 288 | B := BroadcastTo(B, outdim); 289 | Result := ApplyBfunc(A, B, Func); 290 | end; 291 | end; 292 | 293 | function CreateEmptyNdArr(Shape: array of longint): TNdArr; 294 | var 295 | size: LongInt; 296 | begin 297 | size := ShapeToSize(Shape); 298 | SetLength(Result.Val, size); 299 | Result.ReshapeInplace(Shape); 300 | Result.Strides := ShapeToStride(Shape); 301 | Result.IsContiguous := True; 302 | end; 303 | 304 | function TNdArr.GetNDims: longint; 305 | begin 306 | Exit(Length(Self.Shape)); 307 | end; 308 | 309 | function TNdArr.GetSize: longint; 310 | begin 311 | Exit(Length(self.Val)); 312 | end; 313 | 314 | function TNdArr.Contiguous: TNdArr; 315 | begin 316 | if Self.IsContiguous then Exit(Self) 317 | else 318 | begin 319 | Exit(AsStrided(Self, Self.Shape, Self.Strides)); 320 | end; 321 | end; 322 | 323 | function TNdArr.Dot(Other: TNdArr): TNdArr; 324 | begin 325 | 326 | end; 327 | 328 | function TNdArr.DumpCSV(Sep: string): string; 329 | begin 330 | 331 | end; 332 | 333 | function TNdArr.GetAt(Index: array of longint): TNdArr; 334 | var 335 | i, offset, amount: longint; 336 | OutShape: TIntVector; 337 | begin 338 | offset := 0; 339 | for i := 0 to Length(Index) - 1 do 340 | offset := offset + Self.Strides[i] * Index[i]; 341 | 342 | SetLength(OutShape, Length(Self.Shape) - Length(Index)); 343 | amount := 1; 344 | for i := Length(Index) to Length(Self.Shape) - 1 do 345 | begin 346 | amount := amount * Self.Shape[i]; 347 | OutShape[i - Length(Index)] := Self.Shape[i]; 348 | end; 349 | 350 | SetLength(Result.Val, amount+10); 351 | for i := offset to offset + amount - 1 do 352 | begin 353 | Result.Val[i - offset] := Self.Val[i]; 354 | end; 355 | 356 | Result.ReshapeInplace(OutShape); 357 | end; 358 | 359 | function TNdArr.GetShape: TIntVector; 360 | begin 361 | Exit(Self.Shape); 362 | end; 363 | 364 | function TNdArr.Reshape(ShapeVals: array of longint): TNdArr; 365 | var 366 | i: longint; 367 | begin 368 | SetLength(Result.fShape, Length(ShapeVals)); 369 | for i := 0 to Length(ShapeVals) -1 do 370 | Result.Shape[i] := ShapeVals[i]; 371 | Result.Val := copy(Self.Val); 372 | Result.Strides := ShapeToStride(ShapeVals); 373 | end; 374 | 375 | function TNdArr.T: TNdArr; 376 | begin 377 | Result := AsStrided(Self, ReverseIntArr(Self.Shape), ReverseIntArr(Self.Strides)); 378 | end; 379 | 380 | function TNdArr.ToTensor(RequiresGrad: boolean): TNdArr; 381 | begin 382 | 383 | end; 384 | 385 | procedure TNdArr.Fill(v: double); 386 | var 387 | i: longint; 388 | begin 389 | for i := 0 to Self.Size - 1 do 390 | self.Val[i] := v; 391 | end; 392 | 393 | procedure TNdArr.Cleanup; 394 | begin 395 | self.val := nil; 396 | self.Shape := nil; 397 | self.Strides := nil; 398 | end; 399 | 400 | procedure TNdArr.SetAt(Index: array of longint; x: double); 401 | begin 402 | 403 | end; 404 | 405 | procedure TNdArr.WriteToCSV(FileName: string); 406 | begin 407 | 408 | end; 409 | 410 | procedure TNdArr.ReshapeInplace(NewShape: array of longint); 411 | var 412 | i: longint; 413 | begin 414 | SetLength(self.FShape, Length(NewShape)); 415 | for i := 0 to Length(NewShape) - 1 do 416 | self.FShape[i] := NewShape[i]; 417 | self.Strides := ShapeToStride(NewShape); 418 | end; 419 | 420 | end. 421 | 422 | -------------------------------------------------------------------------------- /src/legacy/noe.neuralnet.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit contains the interface for high-level neural network API. Specifically, 7 | it contains the implementation of layers, optimizers, and loss functions. 8 | } 9 | unit noe.neuralnet; 10 | 11 | {$mode objfpc}{$H+} 12 | 13 | interface 14 | 15 | uses 16 | Classes, fgl, fpjson, jsonparser, Math, noe, noe.Math, SysUtils; 17 | 18 | type 19 | TLayer = class; 20 | TModel = class; 21 | 22 | TVariableList = specialize TFPGList<TVariable>; 23 | TLayerList = specialize TFPGList<TLayer>; 24 | 25 | TBatchNormLayer = class; 26 | TConv2dLayer = class; 27 | TDenseLayer = class; 28 | TDropoutLayer = class; 29 | TFlattenLayer = class; 30 | TLeakyReLULayer = class; 31 | TReLULayer = class; 32 | TSigmoidLayer = class; 33 | TSoftMaxLayer = class; 34 | TTanhLayer = class; 35 | 36 | { TLayer Base class } 37 | 38 | TLayer = class 39 | private 40 | Params: TVariableArr; 41 | public 42 | function Eval(X: TVariable): TVariable; virtual; abstract; 43 | function GetParams: TVariableArr; 44 | procedure Cleanup; 45 | end; 46 | 47 | { TBatchNormLayer } 48 | 49 | TBatchNormLayer = class(TLayer) 50 | private 51 | FGamma, FBeta: TVariable; 52 | public 53 | constructor Create; 54 | function Eval(X: TVariable): TVariable; override; 55 | property Gamma: TVariable read FGamma write FGamma; 56 | property Beta: TVariable read FBeta write FBeta; 57 | end; 58 | 59 | { TConv2dLayer } 60 | 61 | TConv2dLayer = class(TLayer) 62 | constructor Create(InChannels, OutChannels, KernelSize: longint; 63 | Strides: longint = 1; Padding: longint = 0); 64 | function Eval(X: TVariable): TVariable; override; 65 | end; 66 | 67 | { TDenseLayer, or fully-connected layer } 68 | 69 | TDenseLayer = class(TLayer) 70 | public 71 | constructor Create(InSize, OutSize: longint); 72 | function Eval(X: TVariable): TVariable; override; 73 | end; 74 | 75 | { TDropoutLayer } 76 | 77 | TDropoutLayer = class(TLayer) 78 | private 79 | FDropoutRate: float; 80 | FUseDropout: boolean; 81 | function GetUseDropout: boolean; 82 | public 83 | constructor Create(ADropoutRate: float); 84 | function Eval(X: TVariable): TVariable; override; 85 | property DropoutRate: float read FDropoutRate write FDropoutRate; 86 | property UseDropout: boolean read GetUseDropout write FUseDropout; 87 | end; 88 | 89 | { TFlattenLayer } 90 | 91 | TFlattenLayer = class(TLayer) 92 | public 93 | function Eval(X: TVariable): TVariable; override; 94 | end; 95 | 96 | { TLeakyReLULayer } 97 | 98 | TLeakyReLULayer = class(TLayer) 99 | private 100 | FAlpha: float; 101 | public 102 | constructor Create(AAlpha: float); 103 | function Eval(X: TVariable): TVariable; override; 104 | property Alpha: float read FAlpha write FAlpha; 105 | end; 106 | 107 | { TReLULayer } 108 | 109 | TReLULayer = class(TLayer) 110 | public 111 | function Eval(X: TVariable): TVariable; override; 112 | end; 113 | 114 | { TSigmoidLayer } 115 | 116 | TSigmoidLayer = class(TLayer) 117 | public 118 | function Eval(X: TVariable): TVariable; override; 119 | end; 120 | 121 | { TSoftMaxLayer } 122 | 123 | TSoftMaxLayer = class(TLayer) 124 | private 125 | FAxis: longint; 126 | public 127 | constructor Create(AAxis: longint); 128 | function Eval(X: TVariable): TVariable; override; 129 | property Axis: longint read FAxis write FAxis; 130 | end; 131 | 132 | { TTanhLayer } 133 | 134 | TTanhLayer = class(TLayer) 135 | public 136 | function Eval(X: TVariable): TVariable; override; 137 | end; 138 | 139 | { TModel } 140 | 141 | TModel = class 142 | LayerList: TLayerList; 143 | Params: TVariableArr; 144 | public 145 | constructor Create; 146 | constructor Create(Layers: array of TLayer); overload; 147 | function Eval(X: TVariable): TVariable; 148 | procedure AddLayer(Layer: TLayer); 149 | procedure AddParam(param: TVariable); 150 | procedure Cleanup; 151 | end; 152 | 153 | TBatchingResult = record 154 | Xbatches, ybatches: TTensorArr; 155 | BatchCount: longint; 156 | end; 157 | 158 | { Loss functions } 159 | function AccuracyScore(predicted, actual: TTensor): float; 160 | function BinaryCrossEntropyLoss(ypred, ytrue: TVariable): TVariable; 161 | function CrossEntropyLoss(ypred, ytrue: TVariable): TVariable; 162 | function L2Regularization(Model: TModel; Lambda: float = 0.001): TVariable; 163 | 164 | { Utilities } 165 | function CreateBatch(X: TTensor; BatchSize: integer): TTensorArr; 166 | function CreateBatch(X, y: TTensor; BatchSize: integer): TBatchingResult; 167 | function LoadModel(filename: string): TModel; 168 | procedure SaveModel(Model: TModel; filename: string); 169 | 170 | 171 | implementation 172 | 173 | function BinaryCrossEntropyLoss(ypred, ytrue: TVariable): TVariable; 174 | var 175 | m: longint; 176 | begin 177 | Assert(ypred.Size = ytrue.Size, MSG_ASSERTION_DIFFERENT_LENGTH); 178 | 179 | m := ypred.Size; 180 | Result := -(1 / m) * Sum(ytrue * Log(ypred) + (1 - ytrue) * Log(1 - ypred)); 181 | end; 182 | 183 | function CrossEntropyLoss(ypred, ytrue: TVariable): TVariable; 184 | begin 185 | Assert(ypred.Size = ytrue.Size, MSG_ASSERTION_DIFFERENT_LENGTH); 186 | Result := -Mean(ytrue * Log(ypred)); 187 | end; 188 | 189 | function L2Regularization(Model: TModel; Lambda: float): TVariable; 190 | var 191 | param: TVariable; 192 | begin 193 | Result := 0; 194 | for param in Model.Params do 195 | if not param.Name.StartsWith('Bias') then 196 | Result := Result + Sum(param * param); 197 | Result := Lambda * Result; 198 | end; 199 | 200 | 201 | function CreateBatch(X: TTensor; BatchSize: integer): TTensorArr; 202 | var 203 | i, OutSize: longint; 204 | begin 205 | OutSize := ceil(X.Shape[0] / BatchSize); 206 | SetLength(Result, OutSize); 207 | for i := 0 to OutSize - 1 do 208 | Result[i] := GetRowRange(X, i * BatchSize, 209 | Math.min(BatchSize, X.Shape[0] - i * BatchSize)); 210 | 211 | end; 212 | 213 | function CreateBatch(X, y: TTensor; BatchSize: integer): TBatchingResult; 214 | var 215 | i, OutSize: longint; 216 | begin 217 | Assert(X.Shape[0] = y.Shape[0], 'X and y have different height'); 218 | OutSize := ceil(X.Shape[0] / BatchSize); 219 | 220 | SetLength(Result.Xbatches, OutSize); 221 | SetLength(Result.ybatches, OutSize); 222 | Result.BatchCount := OutSize; 223 | 224 | for i := 0 to OutSize - 1 do 225 | begin 226 | Result.Xbatches[i] := GetRowRange(X, i * BatchSize, 227 | Math.min(BatchSize, X.Shape[0] - i * BatchSize)); 228 | Result.ybatches[i] := GetRowRange(y, i * BatchSize, 229 | Math.min(BatchSize, y.Shape[0] - i * BatchSize)); 230 | end; 231 | 232 | end; 233 | 234 | function JSONArrayToFloatVector(arr: TJSONArray): TFloatVector; 235 | var 236 | i: longint; 237 | begin 238 | SetLength(Result, arr.Count); 239 | for i := 0 to arr.Count - 1 do 240 | Result[i] := arr[i].AsFloat; 241 | end; 242 | 243 | function FloatVectorToJSONArray(arr: array of NFloat): TJSONArray; 244 | var 245 | i: longint; 246 | begin 247 | Result := TJSONArray.Create; 248 | for i := 0 to high(arr) do 249 | Result.Add(arr[i]); 250 | end; 251 | 252 | function IntVectorToJSONArray(arr: array of longint): TJSONArray; 253 | var 254 | i: longint; 255 | begin 256 | Result := TJSONArray.Create; 257 | for i := 0 to high(arr) do 258 | Result.Add(arr[i]); 259 | end; 260 | 261 | function LoadModel(filename: string): TModel; 262 | var 263 | JData: TJSONData; 264 | o: TJSONEnum; 265 | LayerName: string; 266 | layer: TLayer; 267 | sl: TStringList; 268 | DenseIn, DenseOut: longint; 269 | begin 270 | Result := TModel.Create; 271 | 272 | sl := TStringList.Create; 273 | sl.LoadFromFile(filename); 274 | 275 | JData := GetJSON(sl.Text); 276 | for o in TJSONArray(JData) do 277 | begin 278 | LayerName := o.Value.FindPath('layer_name').AsString; 279 | 280 | case LayerName of 281 | 'Dense': 282 | begin 283 | DenseIn := TJSONArray(o.Value.FindPath('layer_data.weight_shape')).Items[0].AsInteger; 284 | DenseOut := TJSONArray(o.Value.FindPath('layer_data.weight_shape')).Items[1].AsInteger; 285 | layer := TDenseLayer.Create(DenseIn, DenseOut); 286 | 287 | layer.Params[0] := 288 | CreateTensor([DenseIn, DenseOut], JSONArrayToFloatVector( 289 | TJSONArray(o.Value.FindPath('layer_data.weight_val')))).ToVariable(True); 290 | layer.Params[1] := 291 | CreateTensor(layer.Params[1].Shape, JSONArrayToFloatVector( 292 | TJSONArray(o.Value.FindPath('layer_data.bias_val')))).ToVariable(True); 293 | Result.AddLayer(layer); 294 | end; 295 | 'Dropout': 296 | begin 297 | layer := TDropoutLayer.Create( 298 | o.Value.FindPath('layer_data.DropoutRate').AsFloat); 299 | Result.AddLayer(layer); 300 | end; 301 | 'LeakyReLU': 302 | begin 303 | layer := TLeakyReLULayer.Create( 304 | o.Value.FindPath('layer_data.leakiness').AsFloat); 305 | Result.AddLayer(layer); 306 | end; 307 | 'ReLU': 308 | begin 309 | layer := TReLULayer.Create; 310 | Result.AddLayer(layer); 311 | end; 312 | 'SoftMax': 313 | begin 314 | layer := TSoftMaxLayer.Create( 315 | o.Value.FindPath('layer_data.axis').AsInteger); 316 | Result.AddLayer(layer); 317 | end; 318 | end; 319 | end; 320 | 321 | sl.Free; 322 | end; 323 | 324 | procedure SaveModel(Model: TModel; filename: string); 325 | var 326 | layer: TLayer; 327 | o, LayerData: TJSONObject; 328 | LayersJSONArr: TJSONArray; 329 | a: array[0..1] of integer; 330 | sl: TStringList; 331 | begin 332 | LayersJSONArr := TJSONArray.Create; 333 | 334 | for layer in Model.LayerList do 335 | begin 336 | if layer is TDenseLayer then 337 | begin 338 | LayerData := TJSONObject.Create( 339 | ['weight_val', FloatVectorToJSONArray(layer.Params[0].Data.val), 340 | 'weight_shape', IntVectorToJSONArray(layer.Params[0].Data.Shape), 341 | 'bias_val', FloatVectorToJSONArray(layer.Params[1].Data.Val), 342 | 'bias_shape', IntVectorToJSONArray(layer.Params[1].Data.Shape)]); 343 | LayersJSONArr.Add(TJSONObject.Create(['layer_name', 'Dense', 344 | 'layer_data', LayerData])); 345 | end; 346 | 347 | if layer is TDropoutLayer then 348 | begin 349 | LayerData := TJSONObject.Create(['DropoutRate', TDropoutLayer(layer).DropoutRate]); 350 | LayersJSONArr.Add(TJSONObject.Create(['layer_name', 'Dropout', 351 | 'layer_data', LayerData])); 352 | end; 353 | 354 | if layer is TLeakyReLULayer then 355 | begin 356 | LayerData := TJSONObject.Create(['leakiness', TLeakyReLULayer(layer).Alpha]); 357 | LayersJSONArr.Add(TJSONObject.Create(['layer_name', 'LeakyReLU', 358 | 'layer_data', LayerData])); 359 | end; 360 | 361 | if layer is TReLULayer then 362 | LayersJSONArr.Add(TJSONObject.Create(['layer_name', 'ReLU'])); 363 | 364 | if layer is TSoftMaxLayer then 365 | begin 366 | LayerData := TJSONObject.Create(['axis', 367 | TSoftMaxLayer(layer).Axis]); 368 | LayersJSONArr.Add(TJSONObject.Create(['layer_name', 'SoftMax', 369 | 'layer_data', LayerData])); 370 | end; 371 | end; 372 | 373 | sl := TStringList.Create; 374 | sl.Text := LayersJSONArr.AsJSON; 375 | sl.SaveToFile(filename); 376 | 377 | sl.Free; 378 | LayersJSONArr.Free; 379 | end; 380 | 381 | function AccuracyScore(predicted, actual: TTensor): float; 382 | var 383 | i: integer; 384 | tot: float; 385 | begin 386 | tot := 0; 387 | for i := 0 to predicted.Size - 1 do 388 | { check if the sample is correctly classified (i.e., predicted = actual) } 389 | if predicted.GetAt(i) = actual.GetAt(i) then 390 | tot := tot + 1; 391 | Result := tot / predicted.Size; 392 | end; 393 | 394 | { TFlattenLayer } 395 | 396 | function TFlattenLayer.Eval(X: TVariable): TVariable; 397 | var 398 | i, sz: longint; 399 | begin 400 | sz := 1; 401 | for i := 1 to X.NDims - 1 do 402 | sz := sz * X.Shape[i]; 403 | Result := Reshape(X, [X.Shape[0], sz]); 404 | end; 405 | 406 | { TConv2dLayer } 407 | 408 | constructor TConv2dLayer.Create(InChannels, OutChannels, KernelSize: longint; 409 | Strides: longint; Padding: longint); 410 | var 411 | W, b: TVariable; 412 | begin 413 | inherited Create; 414 | { Xavier weight initialization } 415 | W := RandomTensorNormal([OutChannels, InChannels, KernelSize, KernelSize]) * 416 | ((2 / (InChannels * KernelSize * KernelSize)) ** 0.5); 417 | b := CreateTensor([1, OutChannels, 1, 1], 0); 418 | 419 | b.Name := 'Bias' + IntToStr(b.ID); 420 | SetRequiresGrad([W, b], True); 421 | 422 | SetLength(self.Params, 2); 423 | self.Params[0] := W; 424 | self.Params[1] := b; 425 | end; 426 | 427 | function TConv2dLayer.Eval(X: TVariable): TVariable; 428 | begin 429 | //PrintTensor(Conv2D(self.Params[0], self.Params[1], 0, 0, 1, 1)); 430 | Result := Conv2D(X, self.Params[0], 0, 0, 1, 1) + self.Params[1]; 431 | end; 432 | 433 | { TBatchNormLayer } 434 | 435 | constructor TBatchNormLayer.Create; 436 | begin 437 | self.Beta := 0; 438 | self.Gamma := 1; 439 | 440 | self.Beta.Data.ReshapeInplace([1, 1]); 441 | self.Gamma.Data.ReshapeInplace([1, 1]); 442 | 443 | self.Beta.RequiresGrad := True; 444 | self.Gamma.RequiresGrad := True; 445 | end; 446 | 447 | function TBatchNormLayer.Eval(X: TVariable): TVariable; 448 | var 449 | muB, varB: TVariable; 450 | begin 451 | muB := Mean(X, 0); 452 | varB := Sum(Sqr(X - muB), 0) / X.Shape[0]; 453 | Result := self.Gamma * ((X - muB) / Sqrt(varB + 1e-8)) + self.Beta; 454 | end; 455 | 456 | { TTanhLayer } 457 | 458 | function TTanhLayer.Eval(X: TVariable): TVariable; 459 | begin 460 | Result := Tanh(X); 461 | end; 462 | 463 | { TSigmoidLayer } 464 | 465 | function TSigmoidLayer.Eval(X: TVariable): TVariable; 466 | begin 467 | Result := 0.5 * (Tanh(X / 2) + 1); 468 | end; 469 | 470 | { TLeakyReLULayer } 471 | 472 | constructor TLeakyReLULayer.Create(AAlpha: float); 473 | begin 474 | self.Alpha := AAlpha; 475 | end; 476 | 477 | function TLeakyReLULayer.Eval(X: TVariable): TVariable; 478 | begin 479 | Result := LeakyReLU(X, self.FAlpha); 480 | end; 481 | 482 | { TReLULayer } 483 | 484 | function TReLULayer.Eval(X: TVariable): TVariable; 485 | begin 486 | Result := ReLU(X); 487 | end; 488 | 489 | { TDropoutLayer } 490 | 491 | function TDropoutLayer.GetUseDropout: boolean; 492 | begin 493 | if GLOBAL_SKIP_GRAD then 494 | exit(False) 495 | else 496 | Result := self.FUseDropout; 497 | end; 498 | 499 | constructor TDropoutLayer.Create(ADropoutRate: float); 500 | begin 501 | self.DropoutRate := ADropoutRate; 502 | self.UseDropout := True; 503 | end; 504 | 505 | function TDropoutLayer.Eval(X: TVariable): TVariable; 506 | var 507 | T: TTensor; 508 | begin 509 | if Self.UseDropout then 510 | begin 511 | { FIXME: it works, but seems slow because of copy. Later the dropout can be 512 | applied directly on X data (i.e., pass by ref) } 513 | T := X.Data; 514 | Result := X; 515 | Result.Data := T * RandomTensorBinomial(X.Shape, 1 - self.DropoutRate) * 516 | (1 / (1 - self.DropoutRate)); 517 | end 518 | else 519 | Result := X; 520 | end; 521 | 522 | { TSoftMaxLayer } 523 | 524 | constructor TSoftMaxLayer.Create(AAxis: longint); 525 | begin 526 | self.FAxis := AAxis; 527 | end; 528 | 529 | function TSoftMaxLayer.Eval(X: TVariable): TVariable; 530 | begin 531 | Result := SoftMax(X, self.FAxis); 532 | end; 533 | 534 | { TDenseLayer } 535 | 536 | constructor TDenseLayer.Create(InSize, OutSize: longint); 537 | var 538 | W, b: TVariable; 539 | begin 540 | inherited Create; 541 | 542 | { Xavier weight initialization } 543 | W := TVariable.Create(RandomTensorNormal([InSize, OutSize]) * 544 | ((2 / (InSize + OutSize)) ** 0.5)); 545 | b := TVariable.Create(CreateTensor([1, OutSize], 0)); 546 | b.Name := 'Bias' + IntToStr(b.ID); 547 | SetRequiresGrad([W, b], True); 548 | 549 | SetLength(self.Params, 2); 550 | self.Params[0] := W; 551 | self.Params[1] := b; 552 | end; 553 | 554 | function TDenseLayer.Eval(X: TVariable): TVariable; 555 | begin 556 | Result := X.Dot(self.Params[0]) + self.Params[1]; 557 | end; 558 | 559 | { TModel } 560 | 561 | constructor TModel.Create; 562 | begin 563 | self.LayerList := TLayerList.Create; 564 | end; 565 | 566 | constructor TModel.Create(Layers: array of TLayer); 567 | var 568 | Layer: TLayer; 569 | begin 570 | self.Create; 571 | for Layer in Layers do 572 | self.AddLayer(Layer); 573 | end; 574 | 575 | function TModel.Eval(X: TVariable): TVariable; 576 | var 577 | Layer: TLayer; 578 | begin 579 | Result := X; 580 | for Layer in self.LayerList do 581 | Result := Layer.Eval(Result); 582 | end; 583 | 584 | procedure TModel.AddLayer(Layer: TLayer); 585 | var 586 | Param: TVariable; 587 | begin 588 | self.LayerList.Add(Layer); 589 | for Param in Layer.Params do 590 | self.AddParam(param); 591 | end; 592 | 593 | procedure TModel.AddParam(param: TVariable); 594 | begin 595 | SetLength(self.Params, Length(self.Params) + 1); 596 | self.Params[Length(self.Params) - 1] := param; 597 | end; 598 | 599 | procedure TModel.Cleanup; 600 | var 601 | l: TLayer; 602 | begin 603 | Params := nil; 604 | for l in LayerList do 605 | begin 606 | l.Cleanup; 607 | l.Free; 608 | end; 609 | FreeAndNil(LayerList); 610 | FreeAndNil(self); 611 | end; 612 | 613 | { TLayer } 614 | 615 | function TLayer.GetParams: TVariableArr; 616 | begin 617 | Result := self.Params; 618 | end; 619 | 620 | procedure TLayer.Cleanup; 621 | begin 622 | Params := nil; 623 | end; 624 | 625 | end. 626 | -------------------------------------------------------------------------------- /src/noe.pas: -------------------------------------------------------------------------------- 1 | unit noe; 2 | 3 | {$mode objfpc}{$H+} 4 | {$modeswitch advancedRecords} 5 | 6 | interface 7 | 8 | uses 9 | Math, SysUtils, multiarray, numerik, fgl; 10 | 11 | type 12 | 13 | TTensor = class 14 | Data: TMultiArray; 15 | BackwardFunc: Pointer; 16 | Deps: array of TTensor; 17 | IsLeaf: boolean; 18 | private 19 | FGrad: TMultiArray; 20 | FRequiresGrad: boolean; 21 | function GetGrad: TMultiArray; 22 | function GetItems(idx: array of TLongVector): TMultiArray; 23 | function GetShape: TLongVector; 24 | procedure AddDependencies(ADeps: array of TTensor); 25 | procedure SetRequiresGrad(val: boolean); 26 | public 27 | destructor Destroy; override; 28 | function Matmul(T: TTensor): TTensor; 29 | procedure Backward; 30 | procedure Backward(G: TMultiArray); 31 | procedure ZeroGrad; 32 | property Grad: TMultiArray read GetGrad write FGrad; 33 | property Items[idx: array of TLongVector]: TMultiArray read GetItems; default; 34 | property RequiresGrad: boolean read FRequiresGrad write SetRequiresGrad; 35 | property Shape: TLongVector read GetShape; 36 | end; 37 | 38 | TBackwardFunc = procedure(var arr: array of TTensor; G: TMultiArray); 39 | TTensorList = specialize TFPGObjectList<TTensor>; 40 | 41 | procedure PrintTensor(T: TTensor); 42 | 43 | function CreateTensor(Data: TMultiArray; RequiresGrad: boolean = False): TTensor; 44 | function BinarizeLabel(T: TTensor): TTensor; 45 | 46 | function Add(A, B: TTensor): TTensor; overload; 47 | function Conv2d(X, W: TTensor; Stride, Pad: longint): TTensor; 48 | function Divide(A, B: TTensor): TTensor; overload; 49 | function Exp(A: TTensor): TTensor; overload; 50 | function LeakyReLU(A: TTensor; Leakiness: single): TTensor; overload; 51 | function Ln(A: TTensor): TTensor; overload; 52 | function Matmul(A, B: TTensor): TTensor; overload; 53 | function Max(A: TTensor; axis: integer = -1; KeepDims: boolean = False): TTensor; overload; 54 | function Mean(A: TTensor; axis: integer = -1; KeepDims: boolean = False): TTensor; overload; 55 | function Multiply(A, B: TTensor): TTensor; overload; 56 | function Negate(A: TTensor): TTensor; overload; 57 | function ReLU(A: TTensor): TTensor; overload; 58 | function Sigmoid(A: TTensor): TTensor; overload; 59 | function Softmax(A: TTensor; axis: integer): TTensor; overload; 60 | function Subtract(A, B: TTensor): TTensor; overload; 61 | function Sqr(A: TTensor): TTensor; overload; 62 | function Sum(A: TTensor; axis: integer = -1; KeepDims: boolean = False): TTensor; overload; 63 | 64 | { Cross entropy loss, with ground truth represented as one-hot matrix } 65 | function CrossEntropy(YPred, Y: TTensor; Tol: single=1e-8): TTensor; 66 | 67 | { @exclude } operator +(A, B: TTensor) C: TTensor; 68 | { @exclude } operator -(A: TTensor) B: TTensor; 69 | { @exclude } operator -(A, B: TTensor) C: TTensor; 70 | { @exclude } operator * (A, B: TTensor) C: TTensor; 71 | { @exclude } operator / (A, B: TTensor) C: TTensor; 72 | { @exclude } operator := (A: TMultiArray) B: TTensor; 73 | { @exclude } operator := (A: single) B: TTensor; 74 | { @exclude } operator := (A: TTensor) B: TMultiArray; 75 | 76 | var 77 | NoeGlobalTensorList: TTensorList; 78 | 79 | implementation 80 | 81 | procedure TTensor.AddDependencies(ADeps: array of TTensor); 82 | var 83 | i: integer; 84 | begin 85 | SetLength(Deps, Length(ADeps)); 86 | for i := 0 to High(ADeps) do 87 | begin 88 | Self.RequiresGrad := Self.RequiresGrad or ADeps[i].RequiresGrad; 89 | Deps[i] := ADeps[i]; 90 | end; 91 | end; 92 | 93 | procedure TTensor.SetRequiresGrad(val: boolean); 94 | begin 95 | self.FRequiresGrad := val; 96 | if val then 97 | self.Grad := Zeros(Self.Data.Shape); 98 | 99 | end; 100 | 101 | function TopologicalSort(T: TTensor): TTensorList; 102 | var 103 | Seen, Sorted: TTensorList; 104 | prv: TTensor; 105 | 106 | procedure TopoHelper(v: TTensor); 107 | begin 108 | if (Seen.IndexOf(v) = -1) then 109 | begin 110 | Seen.Add(v); 111 | for prv in v.Deps do 112 | TopoHelper(prv); 113 | 114 | if v.RequiresGrad then 115 | Sorted.Add(v); 116 | end; 117 | end; 118 | 119 | begin 120 | Seen := TTensorList.Create(False); 121 | Sorted := TTensorList.Create(False); 122 | TopoHelper(T); 123 | 124 | Result := Sorted; 125 | Seen.Free; 126 | end; 127 | 128 | 129 | procedure TTensor.Backward(G: TMultiArray); 130 | var 131 | i: integer; 132 | Sorted: TTensorList; 133 | begin 134 | if not self.RequiresGrad then 135 | raise Exception.Create('Cannot call backward on tensor not requiring grad.'); 136 | if not VectorEqual(self.Shape, G.Shape) then 137 | raise Exception.Create('G must have the same dimension.'); 138 | 139 | Sorted := TopologicalSort(self); 140 | self.Grad := G; 141 | 142 | for i := Sorted.Count - 1 downto 0 do 143 | begin 144 | if Assigned(Sorted[i].BackwardFunc) then 145 | begin 146 | TBackwardFunc(Sorted[i].BackwardFunc)(Sorted[i].Deps, Sorted[i].Grad); 147 | end; 148 | end; 149 | 150 | { Remove the unused Tensors in the previous pass } 151 | for i := NoeGlobalTensorList.Count - 1 downto 0 do 152 | if (Sorted.IndexOf(NoeGlobalTensorList[i]) = -1) and not 153 | (NoeGlobalTensorList[i].IsLeaf) then 154 | NoeGlobalTensorList.Remove(NoeGlobalTensorList[i]); 155 | 156 | Sorted.Free; 157 | end; 158 | 159 | procedure TTensor.ZeroGrad; 160 | begin 161 | if not RequiresGrad then 162 | Exit; 163 | Grad := Zeros(self.Shape); 164 | end; 165 | 166 | destructor TTensor.Destroy; 167 | begin 168 | self.Deps := nil; 169 | end; 170 | 171 | function TTensor.Matmul(T: TTensor): TTensor; 172 | begin 173 | Exit(noe.Matmul(Self, T)); 174 | end; 175 | 176 | procedure TTensor.Backward; 177 | begin 178 | self.Backward(1); 179 | end; 180 | 181 | procedure PrintTensor(T: TTensor); 182 | begin 183 | PrintMultiArray(T.Data); 184 | end; 185 | 186 | function BinarizeLabel(T: TTensor): TTensor; 187 | var 188 | MaxVal: single; 189 | i: longint; 190 | begin 191 | if T.Data.Squeeze.NDims > 1 then 192 | raise Exception.Create('Can only accept a tensor with NDim=1 or a column tensor'); 193 | MaxVal := MaxValue(T.Data.Data); 194 | Result := Zeros([T.Data.Size, Round(MaxVal) + 1]); 195 | for i := 0 to Result.Data.Shape[0] - 1 do 196 | Result.Data.Put([i, Round(T.Data.Get(i))], 1); 197 | end; 198 | 199 | function CreateTensor(Data: TMultiArray; RequiresGrad: boolean = False): TTensor; 200 | begin 201 | Result := TTensor.Create; 202 | Result.RequiresGrad := RequiresGrad; 203 | Result.Data := Data; 204 | Result.BackwardFunc := nil; 205 | Result.IsLeaf := True; 206 | NoeGlobalTensorList.Add(Result); 207 | end; 208 | 209 | function CreateOpNode(Val: TTensor; Deps: array of TTensor; 210 | BackwardFunc: TBackwardFunc): TTensor; 211 | begin 212 | Result := Val; 213 | Result.AddDependencies(Deps); 214 | Result.BackwardFunc := BackwardFunc; 215 | Result.IsLeaf := False; 216 | end; 217 | 218 | function ReduceGradToShape(Grad: TMultiArray; Shape: TLongVector): TMultiArray; 219 | var 220 | i, NDimsAdded: integer; 221 | begin 222 | NDimsAdded := Grad.NDims - Length(Shape); 223 | for i := 0 to NDimsAdded - 1 do 224 | Grad := Sum(Grad, 0); 225 | 226 | for i := 0 to High(Shape) do 227 | if Shape[i] = 1 then 228 | Grad := Sum(Grad, i, True); 229 | Result := Grad; 230 | 231 | end; 232 | 233 | procedure AddBackward(var Deps: array of TTensor; G: TMultiArray); 234 | begin 235 | if Deps[0].RequiresGrad then 236 | Deps[0].Grad := Deps[0].Grad + ReduceGradToShape(G, Deps[0].Shape); 237 | if Deps[1].RequiresGrad then 238 | Deps[1].Grad := Deps[1].Grad + ReduceGradToShape(G, Deps[1].Shape); 239 | end; 240 | 241 | function Add(A, B: TTensor): TTensor; 242 | begin 243 | Exit(CreateOpNode(A.Data + B.Data, [A, B], @AddBackward)); 244 | end; 245 | 246 | procedure DivideBackward(var Deps: array of TTensor; G: TMultiArray); 247 | begin 248 | if Deps[0].RequiresGrad then 249 | Deps[0].Grad := Deps[0].Grad + ReduceGradToShape(G / Deps[1].Data, Deps[0].Shape); 250 | if Deps[1].RequiresGrad then 251 | Deps[1].Grad := Deps[1].Grad + ReduceGradToShape(-G * Deps[0].Data / 252 | Deps[1].Data ** 2, Deps[1].Shape); 253 | end; 254 | 255 | procedure Conv2dBackward(var Deps: array of TTensor; G: TMultiArray); 256 | var 257 | GFlat: TMultiArray; 258 | TrailingDim: longint; 259 | begin 260 | //if Deps[0].RequiresGrad then 261 | // Deps[0].Grad; 262 | if Deps[1].RequiresGrad then 263 | begin 264 | PrintMultiArray(TSingleVector(G.Shape)); 265 | TrailingDim := G.Shape[1] * G.Shape[2] * G.Shape[3]; 266 | GFlat := Transpose(G, [1, 2, 3, 0]).Reshape([G.Shape[0], TrailingDim]); 267 | Deps[1].Grad := Deps[1] + GFlat.Matmul(Deps[0].Data.T).Reshape(Deps[1].Shape); 268 | end; 269 | end; 270 | 271 | function Conv2d(X, W: TTensor; Stride, Pad: longint): TTensor; 272 | var 273 | deps: array of TTensor; 274 | OutH, OutW: longint; 275 | ConvRes, WCol, XCols: TMultiArray; 276 | begin 277 | OutH := (X.Shape[2] - W.Shape[2]) div Stride + 1; 278 | OutW := (X.Shape[3] - W.Shape[3]) div Stride + 1; 279 | WCol := W.Data.Reshape([W.Shape[0], W.Shape[1] * W.Shape[2] * W.Shape[3]]); 280 | 281 | XCols := Im2Col(X.Data, W.Shape[2], w.Shape[3], Stride, Pad); 282 | 283 | ConvRes := WCol.matmul(XCols); 284 | ConvRes := ConvRes.Reshape([X.Shape[0], W.Shape[0], OutH, OutW]).Contiguous; 285 | 286 | deps := [XCols, W, Stride, Pad]; 287 | Exit(CreateOpNode(ConvRes, deps, @Conv2dBackward)); 288 | end; 289 | 290 | function Divide(A, B: TTensor): TTensor; 291 | begin 292 | Exit(CreateOpNode(A.Data / B.Data, [A, B], @DivideBackward)); 293 | end; 294 | 295 | procedure ExpBackward(var Deps: array of TTensor; G: TMultiArray); 296 | begin 297 | if Deps[0].RequiresGrad then 298 | Deps[0].Grad := Deps[0].Grad + (G * Exp(Deps[0].Data)); 299 | end; 300 | 301 | function Exp(A: TTensor): TTensor; overload; 302 | begin 303 | Exit(CreateOpNode(Exp(A.Data), [A], @ExpBackward)); 304 | end; 305 | 306 | procedure LnBackward(var Deps: array of TTensor; G: TMultiArray); 307 | begin 308 | if Deps[0].RequiresGrad then 309 | Deps[0].Grad := Deps[0].Grad + (G / Deps[0].Data); 310 | end; 311 | 312 | procedure LeakyReLUBackward(var Deps: array of TTensor; G: TMultiArray); 313 | var 314 | i: longint; 315 | begin 316 | if Deps[0].RequiresGrad then 317 | for i := 0 to Deps[0].Data.Size - 1 do 318 | if Deps[0].Data.Get(i) > 0 then 319 | Deps[0].Grad.Data[i] := Deps[0].Grad.Data[i] + G.Data[i] 320 | else 321 | { Deps[1].Data.Get(0) refers to 'Leakiness' parameter in LeakyReLU } 322 | Deps[0].Grad.Data[i] := Deps[0].Grad.Data[i] + G.Data[i] * Deps[1].Data.Get(0); 323 | end; 324 | 325 | function LeakyReLU(A: TTensor; Leakiness: single): TTensor; 326 | var 327 | OutArr: TMultiArray; 328 | i: integer; 329 | v: single; 330 | begin 331 | OutArr := AllocateMultiArray(A.Data.Size).Reshape(A.Shape); 332 | for i := 0 to A.Data.Size - 1 do 333 | begin 334 | v := A.Data.Get(i); 335 | OutArr.Data[i] := IfThen(v < 0, v * Leakiness, v); 336 | end; 337 | Exit(CreateOpNode(OutArr, [A, TMultiArray(Leakiness)], @LeakyReluBackward)); 338 | end; 339 | 340 | function Ln(A: TTensor): TTensor; 341 | begin 342 | Exit(CreateOpNode(Ln(A.Data), [A], @LnBackward)); 343 | end; 344 | 345 | procedure MatmulBackward(var Deps: array of TTensor; G: TMultiArray); 346 | begin 347 | if Deps[0].RequiresGrad then 348 | Deps[0].Grad := Deps[0].Grad + G.Matmul(Deps[1].Data.T); 349 | if Deps[1].RequiresGrad then 350 | Deps[1].Grad := Deps[1].Grad + Deps[0].Data.T.Matmul(G); 351 | end; 352 | 353 | function Matmul(A, B: TTensor): TTensor; 354 | begin 355 | Exit(CreateOpNode(A.Data.Matmul(B.Data), [A, B], @MatmulBackward)); 356 | end; 357 | 358 | procedure MultiplyBackward(var Deps: array of TTensor; G: TMultiArray); 359 | begin 360 | if Deps[0].RequiresGrad then 361 | Deps[0].Grad := Deps[0].Grad + ReduceGradToShape(G * Deps[1].Data, Deps[0].Shape); 362 | if Deps[1].RequiresGrad then 363 | Deps[1].Grad := Deps[1].Grad + ReduceGradToShape(G * Deps[0].Data, Deps[1].Shape); 364 | end; 365 | 366 | procedure MeanBackward(var Deps: array of TTensor; G: TMultiArray); 367 | var 368 | Shape: TLongVector; 369 | Axis: integer; 370 | begin 371 | if Deps[0].RequiresGrad then 372 | begin 373 | { If axis is specified, then G should be reshaped accordingly to comply 374 | with broadcasting. } 375 | Axis := Round(Deps[1].Data.Data[0]); 376 | if Axis > -1 then 377 | begin 378 | Shape := CopyVector(Deps[0].Shape); 379 | Shape[Axis] := 1; 380 | G := G.Reshape(Shape) / Deps[0].Shape[Axis]; 381 | end 382 | else 383 | begin 384 | G := G.Item / Deps[0].Data.Size; 385 | end; 386 | 387 | Deps[0].Grad := Deps[0].Grad + G; 388 | end; 389 | end; 390 | 391 | function Mean(A: TTensor; axis: integer = -1; KeepDims: boolean = False): TTensor; 392 | begin 393 | Exit(CreateOpNode(Mean(A.Data, axis, KeepDims), [A, TMultiArray(axis), TMultiArray(integer(KeepDims))], 394 | @MeanBackward)); 395 | end; 396 | 397 | procedure MaxBackward(var Deps: array of TTensor; G: TMultiArray); 398 | begin 399 | if Deps[0].RequiresGrad then 400 | Deps[0].Grad := Deps[0].Grad + (Deps[0].Data = Deps[1].Data) * 401 | G.Reshape(Deps[1].Shape); 402 | end; 403 | 404 | function Max(A: TTensor; axis: integer; KeepDims: boolean = False): TTensor; 405 | var 406 | tmp1, tmp2: TMultiArray; 407 | begin 408 | tmp1 := Max(A.Data, axis, KeepDims); 409 | tmp2 := tmp1.Copy(); 410 | if not KeepDims then 411 | SqueezeMultiArrayAt(tmp2, axis); 412 | Exit(CreateOpNode(tmp2, [A, tmp1], @MaxBackward)); 413 | end; 414 | 415 | function Multiply(A, B: TTensor): TTensor; 416 | begin 417 | Exit(CreateOpNode(A.Data * B.Data, [A, B], @MultiplyBackward)); 418 | end; 419 | 420 | procedure NegateBackward(var Deps: array of TTensor; G: TMultiArray); 421 | begin 422 | if Deps[0].RequiresGrad then 423 | Deps[0].Grad := Deps[0].Grad - G; 424 | end; 425 | 426 | function Negate(A: TTensor): TTensor; 427 | begin 428 | Exit(CreateOpNode(-A.Data, [A], @NegateBackward)); 429 | end; 430 | 431 | procedure ReLUBackward(var Deps: array of TTensor; G: TMultiArray); 432 | var 433 | i: longint; 434 | begin 435 | if Deps[0].RequiresGrad then 436 | Deps[0].Grad := Deps[0].Grad + G * (Deps[0].Data > 0); 437 | end; 438 | 439 | function ReLU(A: TTensor): TTensor; overload; 440 | begin 441 | Exit(CreateOpNode(Maximum(A.Data, 0), [A], @ReLUBackward)); 442 | end; 443 | 444 | function _Sigmoid(A: TMultiArray): TMultiArray; 445 | begin 446 | Exit(1/(1 + Exp(-A))); 447 | end; 448 | 449 | procedure SigmoidBackward(var Deps: array of TTensor; G: TMultiArray); 450 | begin 451 | if Deps[0].RequiresGrad then 452 | Deps[0].Grad := Deps[0].Grad + _Sigmoid(Deps[0].Data) * (1 - _Sigmoid(Deps[0].Data)); 453 | end; 454 | 455 | function Sigmoid(A: TTensor): TTensor; overload; 456 | begin 457 | Exit(CreateOpNode(_Sigmoid(A.Data), [A], @SigmoidBackward)); 458 | end; 459 | 460 | procedure SubtractBackward(var Deps: array of TTensor; G: TMultiArray); 461 | begin 462 | if Deps[0].RequiresGrad then 463 | Deps[0].Grad := Deps[0].Grad + ReduceGradToShape(G, Deps[0].Shape); 464 | if Deps[1].RequiresGrad then 465 | Deps[1].Grad := Deps[1].Grad - ReduceGradToShape(G, Deps[1].Shape); 466 | end; 467 | 468 | function Softmax(A: TTensor; axis: integer): TTensor; overload; 469 | begin 470 | Result := Exp(A - Max(A, axis, True)); 471 | Result := Result / Sum(Result, axis, True); 472 | end; 473 | 474 | function Subtract(A, B: TTensor): TTensor; 475 | begin 476 | Exit(CreateOpNode(A.Data - B.Data, [A, B], @SubtractBackward)); 477 | end; 478 | 479 | procedure SqrBackward(var Deps: array of TTensor; G: TMultiArray); 480 | begin 481 | if Deps[0].RequiresGrad then 482 | Deps[0].Grad := Deps[0].Grad + (2 * G * Deps[0].Data); 483 | end; 484 | 485 | function Sqr(A: TTensor): TTensor; 486 | begin 487 | Exit(CreateOpNode((A.Data ** 2), [A], @SqrBackward)); 488 | end; 489 | 490 | procedure SumBackward(var Deps: array of TTensor; G: TMultiArray); 491 | var 492 | Shape: TLongVector; 493 | Axis: integer; 494 | begin 495 | if Deps[0].RequiresGrad then 496 | begin 497 | { If axis is specified, then G should be reshaped accordingly to comply 498 | with broadcasting. } 499 | Axis := Round(Deps[1].Data.Get(0)); 500 | if Axis > -1 then 501 | begin 502 | Shape := CopyVector(Deps[0].Shape); 503 | Shape[Axis] := 1; 504 | G := G.Reshape(Shape); 505 | end; 506 | 507 | Deps[0].Grad := Deps[0].Grad + G; 508 | end; 509 | end; 510 | 511 | 512 | function Sum(A: TTensor): TTensor; 513 | begin 514 | Exit(CreateOpNode(Sum(A.Data), [A], @SumBackward)); 515 | end; 516 | 517 | function Sum(A: TTensor; axis: integer; KeepDims: boolean): TTensor; 518 | begin 519 | Exit(CreateOpNode(Sum(A.Data, axis, KeepDims), 520 | [A, TMultiArray(axis), TMultiArray(integer(KeepDims))], @SumBackward)); 521 | end; 522 | 523 | function TTensor.GetGrad: TMultiArray; 524 | begin 525 | if RequiresGrad then 526 | Exit(FGrad); 527 | raise Exception.Create('Trying to access Grad of a tensor that has no Grad.'); 528 | end; 529 | 530 | function TTensor.GetItems(idx: array of TLongVector): TMultiArray; 531 | begin 532 | Exit(Data[Idx]); 533 | end; 534 | 535 | function TTensor.GetShape: TLongVector; 536 | begin 537 | Exit(Self.Data.Shape); 538 | end; 539 | 540 | function CrossEntropy(YPred, Y: TTensor; Tol: single=1e-8): TTensor; 541 | begin 542 | if YPred.Data.Size <> Y.Data.Size then 543 | raise Exception.Create('A and B have different size.'); 544 | Exit(-Mean(Sum(Y * Ln(YPred + Tol), 1))); 545 | end; 546 | 547 | operator +(A, B: TTensor)C: TTensor; 548 | begin 549 | C := Add(A, B); 550 | end; 551 | 552 | operator -(A: TTensor) B: TTensor; 553 | begin 554 | B := Negate(A); 555 | end; 556 | 557 | operator -(A, B: TTensor) C: TTensor; 558 | begin 559 | C := Subtract(A, B); 560 | end; 561 | 562 | operator * (A, B: TTensor) C: TTensor; 563 | begin 564 | C := Multiply(A, B); 565 | end; 566 | 567 | operator / (A, B: TTensor) C: TTensor; 568 | begin 569 | C := Divide(A, B); 570 | end; 571 | 572 | operator := (A: TMultiArray) B: TTensor; 573 | begin 574 | B := CreateTensor(A); 575 | end; 576 | 577 | operator := (A: single) B: TTensor; 578 | begin 579 | B := TMultiArray(A); 580 | end; 581 | 582 | operator := (A: TTensor) B: TMultiArray; 583 | begin 584 | B := A.Data; 585 | end; 586 | 587 | initialization 588 | NoeGlobalTensorList := TTensorList.Create; 589 | 590 | finalization 591 | NoeGlobalTensorList.Free; 592 | 593 | end. 594 | -------------------------------------------------------------------------------- /src/legacy/noe.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of "noe" library. 3 | 4 | Noe library. Copyright (C) 2020 Aria Ghora Prabono. 5 | 6 | This unit contains the interface for TTensor to perform multidimensional array 7 | operations. The dimension can be of any arbitrary nonnegative integer. 8 | } 9 | unit noe; 10 | 11 | {$mode objfpc}{$H+}{$modeSwitch advancedRecords} 12 | 13 | interface 14 | 15 | uses 16 | Classes, Math, strutils, SysUtils, fgl; 17 | 18 | type 19 | NFloat = double; 20 | 21 | TIntVector = array of longint; 22 | TFloatVector = array of NFloat; 23 | TVariable = class; 24 | 25 | { TTensor } 26 | TTensor = record 27 | private 28 | FShape: array of longint; 29 | FStrides: array of longint; 30 | function GetNDims: longint; 31 | function GetSize: longint; 32 | public 33 | Val: TFloatVector; 34 | function Dot(Other: TTensor): TTensor; 35 | function DumpCSV(Sep: string = ','): string; 36 | function GetAt(i: longint): double; 37 | function GetAt(i, j: longint): double; 38 | function GetAt(Index: array of longint): TTensor; 39 | function GetShape: TIntVector; 40 | function Reshape(ShapeVals: array of longint): TTensor; 41 | function T: TTensor; 42 | function ToVariable(RequiresGrad: boolean = False): TVariable; 43 | procedure Fill(v: double); 44 | procedure Free; 45 | procedure SetAt(i: longint; x: double); 46 | procedure SetAt(i, j: longint; x: double); 47 | procedure SetAt(Index: array of longint; x: double); 48 | procedure WriteToCSV(FileName: string); 49 | procedure ReshapeInplace(ShapeVals: array of longint); 50 | property NDims: longint read GetNDims; 51 | property Shape: TIntVector read FShape write FShape; 52 | property Size: longint read GetSize; 53 | property Strides: TIntVector read FStrides write FStrides; 54 | end; 55 | 56 | TTensorHelper = record helper for TTensor 57 | const Default: TTensor = (FShape:nil; FStrides: nil; val: nil); 58 | end; 59 | 60 | PTensor = ^TTensor; 61 | TTensorArr = array of TTensor; 62 | 63 | TConfig = record 64 | debug: boolean; 65 | useBLAS: boolean; 66 | backend: string; 67 | BLASFileName: string; 68 | end; 69 | 70 | TCallback = procedure(val: NFloat; offset:longint; idx: TIntVector; currDim: longint; var T, OutT: TTensor); 71 | 72 | { The wrapper of TTensor that also acts as a single node in a computaional graph } 73 | PVariable = ^TVariable; 74 | 75 | TVariableArr = array of TVariable; 76 | PVariableArr = array of ^TVariable; 77 | TBackwardFunc = procedure(arr: TVariableArr; ADy: TTensor); 78 | 79 | { TVariable } 80 | 81 | TVariable = class 82 | Prev: TVariableArr; 83 | private 84 | FTensor: TTensor; 85 | FGrad: TTensor; 86 | FID: longint; 87 | FIsLeaf: boolean; 88 | FRequiresGrad: boolean; 89 | FBackwardFunc: TBackwardFunc; 90 | FName: string; 91 | FTrackingID: string; 92 | function GetNDims: longint; 93 | function GetShape: TIntVector; 94 | function GetSize: longint; 95 | procedure SetData(AValue: TTensor); 96 | procedure SetRequiresGrad(AValue: boolean); 97 | public 98 | constructor Create; overload; 99 | constructor Create(AName: string); overload; 100 | constructor Create(ATensor: TTensor); overload; 101 | constructor Create(ATensor: TTensor; AName: string); overload; 102 | constructor Create(ATensor: TTensor; AName: string; 103 | ABackwardFunc: TBackwardFunc); overload; 104 | constructor Create(ATensor: TTensor; AName: string; 105 | ABackwardFunc: TBackwardFunc; AIsLeaf: boolean); overload; 106 | destructor Cleanup; 107 | procedure AddPrev(AVariable: TVariable); 108 | procedure AddPrev(arr: array of TVariable); 109 | procedure Backpropagate; 110 | procedure FreeData; 111 | procedure FreeGrad; 112 | procedure ZeroGrad; 113 | property BackwardFunc: TBackwardFunc read FBackwardFunc write FBackwardFunc; 114 | property Data: TTensor read FTensor write SetData; 115 | property Grad: TTensor read FGrad write FGrad; 116 | property ID: longint read FID write FID; 117 | property IsLeaf: boolean read FIsLeaf write FIsLeaf; 118 | property Name: string read FName write FName; 119 | property NDims: longint read GetNDims; 120 | property RequiresGrad: boolean read FRequiresGrad write SetRequiresGrad; 121 | property Shape: TIntVector read GetShape; 122 | property Size: longint read GetSize; 123 | property TrackingID: string read FTrackingID write FTrackingID; 124 | 125 | { Math helpers } 126 | function Dot(Other: TVariable): TVariable; 127 | end; 128 | 129 | { TNodeTracker } 130 | TVariableList = specialize TFPGList<TVariable>; 131 | 132 | TNodeTracker = record 133 | Items: TVariableArr; 134 | NodeSpace: TVariableList; 135 | procedure Add(V: TVariable); 136 | procedure ClearUnusedNodes(root: TVariable); 137 | function FindByTrackingID(TrackingID: string): longint; 138 | end; 139 | 140 | const 141 | {$I config} 142 | MSG_ASSERTION_DIM_MISMATCH = 'Dimension mismatch.'; 143 | MSG_ASSERTION_INVALID_AXIS = 'Invalid axis. The value should be either 0 or 1.'; 144 | MSG_ASSERTION_DIFFERENT_LENGTH = 'Two arrays have different length.'; 145 | MSG_ASSERTION_RANK_2_TENSORS_ONLY = 'This function can be used only on rank-2 tensors'; 146 | MSG_ASSERTION_RANK_1_TENSORS_ONLY = 'This function can be used only on rank-1 tensors'; 147 | 148 | EPS_TOL = 1e-5; 149 | 150 | var 151 | NoeConfig: TConfig; 152 | GLOBAL_NODE_COUNT: integer; 153 | GLOBAL_SKIP_GRAD: boolean; 154 | GlobalNodeTracker: TNodeTracker; 155 | 156 | { Operator overloading --------------------------------------------------------} 157 | operator := (Val: float) M: TTensor; 158 | operator := (Val: double) V: TVariable; 159 | operator := (Val: TTensor) V: TVariable; 160 | operator +(A, B: TTensor) C: TTensor; 161 | operator +(A, B: TVariable) C: TVariable; 162 | operator -(A: TTensor) B: TTensor; 163 | operator -(A: TVariable) B: TVariable; 164 | operator -(A, B: TTensor) C: TTensor; 165 | operator -(A, B: TVariable) C: TVariable; 166 | operator / (A, B: TTensor) C: TTensor; 167 | operator / (A, B: TVariable) C: TVariable; 168 | operator * (A, B: TTensor) C: TTensor; 169 | operator * (A, B: TVariable) C: TVariable; 170 | operator ** (A: TTensor; expo: double) B: TTensor; 171 | operator ** (A, B: TTensor) C: TTensor; 172 | operator in (T: TVariable; arr: array of TVariable) b: boolean; 173 | operator explicit (Val: TVariable) M: TTensor; 174 | operator explicit (Val: TTensor) M: TVariable; 175 | 176 | 177 | { Helpers ---------------------------------------------------------------------} 178 | 179 | function ArgMax(V: TFloatVector): longint; 180 | 181 | { Check if all corresponding elements in two tensor are equal } 182 | function Equals(A, B: TTensor): boolean; 183 | 184 | function DimsToLetter(dims: array of longint): string; 185 | 186 | { Determine the offset based on given multidimensional index } 187 | function IndexToOffset(Index, Shape: array of longint): longint; 188 | function IndexToOffset(Index, Shape, Strides: array of longint): longint; 189 | { Determine the multidimensional index based on given offset } 190 | function OffsetToIndex(offset: longint; Shape: array of longint): TIntVector; 191 | { Determine the required 1-d array size based on a tensor shape } 192 | function ShapeToSize(Shape: array of longint): longint; 193 | function ShapeToStride(Shape: array of longint): TIntVector; 194 | function Squeeze(T: TTensor): TTensor; 195 | 196 | { Helpers API for matrix (rank-2 tensor) --------------------------------------} 197 | function GetRange(T: TTensor; RowIndex, ColumnIndex, Height, Width: longint): TTensor; 198 | function GetRange(T: TVariable; RowIndex, ColumnIndex, Height, Width: longint): TTensor; 199 | function GetColumn(T: TTensor; ColumnIndex: longint; KeepDims: boolean = false): TTensor; 200 | function GetColumnRange(T: TTensor; ColumnIndex, Amount: longint): TTensor; 201 | function GetRow(T: TTensor; RowIndex: longint; KeepDims: boolean = false): TTensor; 202 | function GetRowRange(T: TTensor; RowIndex, Amount: longint): TTensor; 203 | function VFlip(T: TTensor): TTensor; 204 | 205 | { Broadcasting ----------------------------------------------------------------} 206 | 207 | function AsStrided(X: TTensor; TargetShape, Strides: array of longint): TTensor; 208 | function BroadcastTo(X: TTensor; TargetShape: array of longint): TTensor; 209 | 210 | { Check if two tensors are broadcasatable } 211 | function IsBroadcastable(A, B: TTensor): boolean; 212 | function GetBroadcastDims(A, B: TTensor): TIntVector; 213 | 214 | { Tile column tensor A n times to the right } 215 | { HACK: it works, but certainly can be improved } 216 | function TileColumn(A: TTensor; n: longint): TTensor; 217 | 218 | { Tile row tensor A n times to bottom } 219 | { HACK: it works, but certainly can be improved } 220 | function TileRow(A: TTensor; n: longint): TTensor; 221 | 222 | procedure PrintTensor(T: TTensor); 223 | procedure PrintTensor(V: TVariable); 224 | procedure IterateTensor(T, OutT: TTensor; Callback: TCallback); 225 | 226 | { Tensor creation ------------------------------------------------------------ } 227 | function CopyTensor(A: TTensor): TTensor; 228 | function CreateEmptyTensor(Shape: array of longint): TTensor; 229 | function CreateTensor(Shape: array of longint; Val: NFloat): TTensor; overload; 230 | function CreateTensor(Shape: array of longint; Vals: array of NFloat): TTensor; overload; 231 | function Ones(Shape: array of longint): TTensor; 232 | function RandomTensorNormal(Shape: array of longint): TTensor; 233 | function RandomTensorBinomial(Shape: array of longint; p: double): TTensor; 234 | function ReadCSV(fileName: string; NRowSkip: longint = 0): TTensor; 235 | function Zeros(Shape: array of longint): TTensor; 236 | 237 | 238 | { Generates an array of float within range of (0, n] } 239 | function Range(start, stop, step: double): TTensor; 240 | function Range(start, stop: double): TTensor; 241 | function Range(n: longint): TTensor; 242 | 243 | { Computational graph ---------------------------------------------------------} 244 | function TopologicalSort(T: TVariable): TVariableArr; 245 | procedure BackwardGraph(const T: TVariable); 246 | procedure ClearIntermediaryNodes; 247 | procedure SetRequiresGrad(arr: array of TVariable; val: boolean); 248 | procedure ZeroGradGraph(const T: TVariable); 249 | 250 | { Auxilaries ------------------------------------------------------------------} 251 | procedure Cleanup; 252 | 253 | implementation 254 | 255 | uses 256 | noe.Math, noe.utils; 257 | 258 | operator := (Val: float) M: TTensor; 259 | begin 260 | M := CreateTensor([1], Val); 261 | end; 262 | 263 | operator := (Val: TTensor)V: TVariable; 264 | begin 265 | V := TVariable.Create(Val); 266 | end; 267 | 268 | operator +(A, B: TTensor) C: TTensor; 269 | begin 270 | C := Add(A, B); 271 | end; 272 | 273 | operator -(A: TTensor)B: TTensor; 274 | var 275 | i: longint; 276 | begin 277 | B := CopyTensor(A); 278 | for i := 0 to Length(B.val) - 1 do 279 | B.val[i] := -A.val[i]; 280 | end; 281 | 282 | operator -(A, B: TTensor)C: TTensor; 283 | begin 284 | C := noe.Math.Subtract(A, B); 285 | end; 286 | 287 | operator / (A, B: TTensor)C: TTensor; 288 | begin 289 | C := noe.Math.Divide(A, B); 290 | end; 291 | 292 | operator / (A, B: TVariable)C: TVariable; 293 | begin 294 | C := Divide(A, B); 295 | end; 296 | 297 | operator * (A, B: TTensor)C: TTensor; 298 | begin 299 | C := Multiply(A, B); 300 | end; 301 | 302 | operator ** (A: TTensor; expo: double)B: TTensor; 303 | begin 304 | B := Power(A, expo); 305 | end; 306 | 307 | operator ** (A, B: TTensor)C: TTensor; 308 | begin 309 | C := Power(A, B); 310 | end; 311 | 312 | operator := (Val: double)V: TVariable; 313 | begin 314 | V := TVariable.Create(Val); 315 | V.RequiresGrad := False; 316 | 317 | { all constants are given id 1 } 318 | //V.ID := -1; 319 | end; 320 | 321 | operator +(A, B: TVariable)C: TVariable; 322 | begin 323 | C := Add(A, B); 324 | end; 325 | 326 | operator -(A, B: TVariable)C: TVariable; 327 | begin 328 | C := Subtract(A, B); 329 | end; 330 | 331 | operator -(A: TVariable)B: TVariable; 332 | begin 333 | B := Negate(A); 334 | end; 335 | 336 | operator * (A, B: TVariable)C: TVariable; 337 | begin 338 | C := Multiply(A, B); 339 | end; 340 | 341 | operator in(T: TVariable; arr: array of TVariable)b: boolean; 342 | var 343 | Tmp: TVariable; 344 | begin 345 | result := false; 346 | for Tmp in arr do 347 | if T.GetHashCode = Tmp.GetHashCode then 348 | begin 349 | result := true; 350 | exit; 351 | end; 352 | end; 353 | 354 | operator explicit(Val: TVariable)M: TTensor; 355 | begin 356 | M := Val.Data; 357 | end; 358 | 359 | operator explicit(Val: TTensor)M: TVariable; 360 | begin 361 | M := Val.ToVariable(False); 362 | end; 363 | 364 | function ArgMax(V: TFloatVector): longint; 365 | var 366 | i: longint; 367 | CurMax: double; 368 | begin 369 | CurMax := -Infinity; 370 | for i := 0 to Length(V) - 1 do 371 | if V[i] > CurMax then 372 | begin 373 | CurMax := V[i]; 374 | Result := i; 375 | end; 376 | end; 377 | 378 | function Equals(A, B: TTensor): boolean; 379 | begin 380 | Assert((A.Shape[0] = B.Shape[0]) and (A.Shape[1] = B.Shape[1]), 381 | MSG_ASSERTION_DIM_MISMATCH); 382 | 383 | Result := (A.val = B.val); 384 | end; 385 | 386 | function DimsToLetter(dims: array of longint): string; 387 | var 388 | alphabet: string = 'abcdefghijklmnopqrstuvwxyz'; 389 | begin 390 | Result := Copy(alphabet, 1, Length(dims)); 391 | end; 392 | 393 | function IndexToOffset(Index, Shape: array of longint): longint; 394 | var 395 | i, j, d, SumRes, ProdRes: longint; 396 | begin 397 | d := Length(Index); 398 | Assert(d <= Length(Shape), 'Cannot convert index to offset with such shape'); 399 | SumRes := 0; 400 | for i := 0 to d - 1 do 401 | begin 402 | ProdRes := 1; 403 | for j := i + 1 to d - 1 do 404 | ProdRes := ProdRes * (Shape[j]); 405 | SumRes := SumRes + ProdRes * Index[i]; 406 | end; 407 | Result := SumRes; 408 | end; 409 | 410 | function IndexToOffset(Index, Shape, Strides: array of longint): longint; 411 | var 412 | k: longint; 413 | begin 414 | Result := 0; 415 | for k := 0 to Length(Shape) - 1 do 416 | Result := Result + Strides[k] * Index[k]; 417 | end; 418 | 419 | function OffsetToIndex(offset: longint; Shape: array of longint): TIntVector; 420 | var 421 | dim, cnt: longint; 422 | begin 423 | SetLength(Result, Length(Shape)); 424 | cnt := 0; 425 | for dim in ReverseIntArr(Shape) do 426 | begin 427 | Result[cnt] := offset mod dim; 428 | offset := offset div dim; 429 | cnt := cnt + 1; 430 | end; 431 | 432 | Result := ReverseIntArr(Result); 433 | end; 434 | 435 | function ShapeToSize(Shape: array of longint): longint; 436 | var 437 | i, size: longint; 438 | begin 439 | size := 1; 440 | for i := 0 to Length(Shape) - 1 do 441 | size := size * shape[i]; 442 | Result := size; 443 | end; 444 | 445 | { TNodeTracker } 446 | 447 | procedure TNodeTracker.Add(V: TVariable); 448 | begin 449 | SetLength(Self.Items, Length(self.Items) + 1); 450 | Self.Items[Length(self.Items) - 1] := V; 451 | end; 452 | 453 | procedure TNodeTracker.ClearUnusedNodes(root: TVariable); 454 | var 455 | CurrentGraphNodes: TVariableArr; 456 | TobeRemoved: TVariableList; 457 | v, w, x, y: TVariable; 458 | i: longint; 459 | begin 460 | CurrentGraphNodes := TopologicalSort(root); 461 | 462 | TobeRemoved := TVariableList.Create; 463 | for v in NodeSpace do 464 | if not(v in CurrentGraphNodes) and not(v.IsLeaf) then 465 | TobeRemoved.Add(v); 466 | 467 | for w in TobeRemoved do 468 | begin 469 | w.FreeData; 470 | w.FreeGrad; 471 | Finalize(w.FName); 472 | NodeSpace.Remove(w); 473 | // for now idk why cannot destroy :( 474 | //w.Destroy; 475 | end; 476 | 477 | FreeAndNil(TobeRemoved); 478 | end; 479 | 480 | function TNodeTracker.FindByTrackingID(TrackingID: string): longint; 481 | var 482 | i: longint; 483 | begin 484 | Result := -1; 485 | for i:=0 to Length(self.Items) - 1 do 486 | begin 487 | if self.Items[i].TrackingID = TrackingID then 488 | exit(i); 489 | end; 490 | end; 491 | 492 | function TTensor.GetAt(Index: array of longint): TTensor; 493 | var 494 | i, offset, amount: longint; 495 | OutShape: TIntVector; 496 | begin 497 | offset := 0; 498 | for i := 0 to Length(Index) - 1 do 499 | offset := offset + Self.Strides[i] * Index[i]; 500 | 501 | SetLength(OutShape, Length(Self.Shape) - Length(Index)); 502 | amount := 1; 503 | for i := Length(Index) to Length(Self.Shape) - 1 do 504 | begin 505 | amount := amount * Self.Shape[i]; 506 | OutShape[i - Length(Index)] := Self.Shape[i]; 507 | end; 508 | 509 | SetLength(Result.Val, amount+10); 510 | for i := offset to offset + amount - 1 do 511 | begin 512 | Result.Val[i - offset] := Self.Val[i]; 513 | end; 514 | 515 | Result.ReshapeInplace(OutShape); 516 | end; 517 | 518 | procedure TTensor.SetAt(i: longint; x: double); 519 | begin 520 | assert(self.NDims = 1, MSG_ASSERTION_RANK_1_TENSORS_ONLY); 521 | self.Val[IndexToOffset([i], self.Shape)] := x; 522 | end; 523 | 524 | procedure TTensor.SetAt(i, j: longint; x: double); 525 | begin 526 | assert(self.NDims = 2, MSG_ASSERTION_RANK_1_TENSORS_ONLY); 527 | self.Val[IndexToOffset([i, j], Self.Shape)] := x; 528 | end; 529 | 530 | procedure TTensor.SetAt(Index: array of longint; x: double); 531 | begin 532 | self.Val[IndexToOffset(Index, Self.Shape)] := x; 533 | end; 534 | 535 | procedure TTensor.WriteToCSV(FileName: string); 536 | var 537 | F: TextFile; 538 | begin 539 | AssignFile(F, FileName); 540 | try 541 | ReWrite(F); 542 | Write(F, self.DumpCSV()); 543 | finally 544 | CloseFile(F); 545 | end; 546 | end; 547 | 548 | function TTensor.T: TTensor; 549 | begin 550 | Result := noe.Math.Transpose(Self); 551 | end; 552 | 553 | function TTensor.ToVariable(RequiresGrad: boolean): TVariable; 554 | begin 555 | Result := TVariable.Create(self); 556 | Result.RequiresGrad := RequiresGrad; 557 | end; 558 | 559 | procedure TTensor.Fill(v: double); 560 | var 561 | i: longint; 562 | begin 563 | for i := 0 to Length(self.Val) - 1 do 564 | self.Val[i] := v; 565 | end; 566 | 567 | procedure TTensor.Free; 568 | begin 569 | SetLength(self.Val, 0); 570 | SetLength(self.FShape, 0); 571 | SetLength(self.FStrides, 0); 572 | end; 573 | 574 | function TTensor.GetAt(i: longint): double; 575 | begin 576 | assert(self.NDims = 1, MSG_ASSERTION_RANK_1_TENSORS_ONLY); 577 | Result := self.GetAt([i]).Val[0]; 578 | end; 579 | 580 | function TTensor.GetAt(i, j: longint): double; 581 | begin 582 | assert(self.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 583 | Result := self.GetAt([i, j]).Val[0]; 584 | end; 585 | 586 | function TTensor.GetNDims: longint; 587 | begin 588 | Result := length(self.Shape); 589 | end; 590 | 591 | function TTensor.GetSize: longint; 592 | begin 593 | Result := Length(self.Val); 594 | end; 595 | 596 | function TTensor.DumpCSV(Sep: string = ','): string; 597 | var 598 | i, j: integer; 599 | begin 600 | Assert(Length(self.Shape) <= 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 601 | Result := ''; 602 | for i := 0 to self.Shape[0] - 1 do 603 | begin 604 | for j := 0 to self.Shape[1] - 1 do 605 | begin 606 | Result := Result + FloatToStr(self.val[i * self.Shape[1] + j]); 607 | if j < self.Shape[1] - 1 then 608 | Result := Result + sep; 609 | end; 610 | if i < self.Shape[0] - 1 then 611 | Result := Result + LineEnding; 612 | end; 613 | end; 614 | 615 | function TTensor.GetShape: TIntVector; 616 | begin 617 | Result := self.Shape; 618 | end; 619 | 620 | function TTensor.Reshape(ShapeVals: array of longint): TTensor; 621 | var 622 | i: longint; 623 | begin 624 | Result := CopyTensor(self); 625 | SetLength(Result.FShape, Length(ShapeVals)); 626 | for i :=0 to Length(ShapeVals) - 1 do 627 | Result.FShape[i] := ShapeVals[i]; 628 | Result.Strides := ShapeToStride(ShapeVals); 629 | end; 630 | 631 | procedure TTensor.ReshapeInplace(ShapeVals: array of longint); 632 | var 633 | i: longint; 634 | begin 635 | SetLength(self.FShape, Length(ShapeVals)); 636 | for i := 0 to Length(ShapeVals) - 1 do 637 | self.FShape[i] := ShapeVals[i]; 638 | self.Strides := ShapeToStride(ShapeVals); 639 | end; 640 | 641 | function TTensor.Dot(Other: TTensor): TTensor; 642 | begin 643 | Assert((Self.NDims <= 2) and (Other.NDims <= 2), MSG_ASSERTION_RANK_2_TENSORS_ONLY); 644 | Result := MatMul(self, Other); 645 | end; 646 | 647 | { TVariable } 648 | procedure TVariable.SetData(AValue: TTensor); 649 | begin 650 | FTensor := AValue; 651 | end; 652 | 653 | procedure TVariable.SetRequiresGrad(AValue: boolean); 654 | begin 655 | if FRequiresGrad=AValue then Exit; 656 | FRequiresGrad:=AValue; 657 | self.Grad := Zeros(self.Shape); 658 | end; 659 | 660 | function TVariable.GetShape: TIntVector; 661 | begin 662 | Result := self.Data.Shape; 663 | end; 664 | 665 | function TVariable.GetSize: longint; 666 | begin 667 | Result := Self.Data.Size; 668 | end; 669 | 670 | function TVariable.GetNDims: longint; 671 | begin 672 | Result := Length(self.Shape); 673 | end; 674 | 675 | constructor TVariable.Create; 676 | var 677 | T: TTensor; 678 | begin 679 | self.Create(T, '', nil, True); 680 | //self.FID := -2; 681 | end; 682 | 683 | constructor TVariable.Create(AName: string); 684 | var 685 | T: TTensor; 686 | begin 687 | self.Create(T, AName, nil, True); 688 | end; 689 | 690 | constructor TVariable.Create(ATensor: TTensor); 691 | begin 692 | self.Create(ATensor, '', nil, True); 693 | end; 694 | 695 | constructor TVariable.Create(ATensor: TTensor; AName: string); 696 | begin 697 | self.Create(ATensor, AName, nil, True); 698 | end; 699 | 700 | constructor TVariable.Create(ATensor: TTensor; AName: string; 701 | ABackwardFunc: TBackwardFunc); 702 | begin 703 | { it has a Backpropagate function, so it must be non-leaf } 704 | self.Create(ATensor, AName, ABackwardFunc, False); 705 | end; 706 | 707 | constructor TVariable.Create(ATensor: TTensor; AName: string; 708 | ABackwardFunc: TBackwardFunc; AIsLeaf: boolean); 709 | begin 710 | self.Data := ATensor; 711 | self.Name := AName; 712 | self.BackwardFunc := ABackwardFunc; 713 | self.IsLeaf := AIsLeaf; 714 | 715 | { always true on creation unless specified otherwise } 716 | self.RequiresGrad := False; 717 | 718 | self.ZeroGrad; 719 | 720 | { we need to keep track every single node created, e.g., for later removal } 721 | GlobalNodeTracker.NodeSpace.Add(self); 722 | 723 | self.FID := GLOBAL_NODE_COUNT; 724 | Inc(GLOBAL_NODE_COUNT); 725 | end; 726 | 727 | destructor TVariable.Cleanup; 728 | var 729 | v: TVariable; 730 | begin 731 | self.Data.Free; 732 | self.Grad.Free; 733 | self.TrackingID:=''; 734 | end; 735 | 736 | procedure TVariable.AddPrev(AVariable: TVariable); 737 | begin 738 | if not GLOBAL_SKIP_GRAD then 739 | begin 740 | SetLength(self.Prev, Length(self.Prev) + 1); 741 | self.Prev[Length(self.Prev) - 1] := AVariable; 742 | 743 | if AVariable.RequiresGrad then 744 | self.RequiresGrad:=True; 745 | end; 746 | end; 747 | 748 | procedure TVariable.AddPrev(arr: array of TVariable); 749 | var 750 | T: TVariable; 751 | begin 752 | for T in arr do 753 | self.AddPrev(T); 754 | end; 755 | 756 | procedure TVariable.Backpropagate; 757 | begin 758 | BackwardGraph(self); 759 | end; 760 | 761 | procedure TVariable.FreeData; 762 | begin 763 | self.Data.Free; 764 | end; 765 | 766 | procedure TVariable.FreeGrad; 767 | begin 768 | self.Grad.Free; 769 | end; 770 | 771 | procedure TVariable.ZeroGrad; 772 | var 773 | i: longint; 774 | begin 775 | for i := 0 to self.Grad.Size - 1 do 776 | self.Grad.Val[i] := 0; 777 | end; 778 | 779 | function TVariable.Dot(Other: TVariable): TVariable; 780 | begin 781 | Assert((Self.NDims <= 2) and (Other.NDims <= 2), MSG_ASSERTION_RANK_2_TENSORS_ONLY); 782 | Result := noe.Math.MatMul(self, Other); 783 | end; 784 | 785 | procedure ClearIntermediaryNodes; 786 | var 787 | i: integer; 788 | begin 789 | for i := 0 to length(GlobalNodeTracker.Items) - 1 do 790 | if not GlobalNodeTracker.Items[i].IsLeaf then 791 | begin 792 | GlobalNodeTracker.Items[i].FreeGrad; 793 | GlobalNodeTracker.Items[i].FreeData; 794 | GlobalNodeTracker.Items[i] := nil; 795 | end; 796 | SetLength(GlobalNodeTracker.Items, 0); 797 | end; 798 | 799 | procedure SetRequiresGrad(arr: array of TVariable; val: boolean); 800 | var 801 | V: TVariable; 802 | begin 803 | for V in arr do 804 | V.RequiresGrad := val; 805 | end; 806 | 807 | procedure ZeroGradGraph(const T: TVariable); 808 | var 809 | arr: TVariableArr; 810 | i: integer; 811 | begin 812 | arr := TopologicalSort(T); 813 | for i := 0 to length(arr) - 1 do 814 | arr[i].ZeroGrad; 815 | end; 816 | 817 | procedure Cleanup; 818 | var 819 | N: TVariable; 820 | begin 821 | for N in GlobalNodeTracker.NodeSpace do 822 | N.Cleanup; 823 | end; 824 | 825 | function CopyTensor(A: TTensor): TTensor; 826 | begin 827 | Result.val := copy(A.val); 828 | Result.ReshapeInplace(A.Shape); 829 | end; 830 | 831 | function RandomTensorNormal(Shape: array of longint): TTensor; 832 | var 833 | i: longint; 834 | begin 835 | Result := CreateEmptyTensor(Shape); 836 | for i := 0 to Result.Size - 1 do 837 | Result.Val[i] := Math.randg(0, 1); 838 | end; 839 | 840 | function RandomTensorBinomial(Shape: array of longint; p: double): TTensor; 841 | var 842 | i: longint; 843 | begin 844 | Result := CreateEmptyTensor(Shape); 845 | for i := 0 to Result.Size - 1 do 846 | Result.Val[i] := ifthen(random > p, 0, 1); 847 | end; 848 | 849 | function ReadCSV(fileName: string; NRowSkip: longint): TTensor; 850 | var 851 | s, number: string; 852 | sl: TStringList; 853 | InFile: Text; 854 | i, RowCount, ColCount, offset: longint; 855 | begin 856 | Assert(FileExists(filename), 'File does not exist.'); 857 | Assign(InFile, fileName); 858 | Reset(InFile); 859 | 860 | sl := TStringList.Create; 861 | sl.StrictDelimiter := True; 862 | 863 | { first run: estimate the RowCount & ColCount } 864 | ReadLn(InFile, s); 865 | sl.CommaText := s; 866 | ColCount := sl.Count; 867 | 868 | RowCount := 1; 869 | while not EOF(InFile) do 870 | begin 871 | Inc(RowCount); 872 | ReadLn(InFile); 873 | end; 874 | 875 | Dec(RowCount, NRowSkip); 876 | 877 | { actual data handle } 878 | Result.ReshapeInplace([RowCount, ColCount]); 879 | SetLength(Result.Val, RowCount * ColCount); 880 | 881 | offset := 0; 882 | Reset(InFile); 883 | 884 | for i := 0 to NRowSkip - 1 do 885 | ReadLn(InFile); 886 | 887 | while not EOF(InFile) do 888 | begin 889 | ReadLn(InFile, s); 890 | sl.CommaText := s; 891 | 892 | for number in sl do 893 | begin 894 | Result.Val[offset] := StrToFloat(number); 895 | Inc(offset); 896 | end; 897 | end; 898 | 899 | Close(InFile); 900 | sl.Free; 901 | end; 902 | 903 | function CreateEmptyTensor(Shape: array of longint): TTensor; 904 | begin 905 | Result := TTensor.Default; 906 | SetLength(Result.Val, ShapeToSize(Shape)); 907 | Result.ReshapeInplace(shape); 908 | Result.Strides := ShapeToStride(Shape); 909 | end; 910 | 911 | function CreateTensor(Shape: array of longint; Val: NFloat): TTensor; 912 | var 913 | i: longint; 914 | begin 915 | Result := CreateEmptyTensor(Shape); 916 | for i := 0 to Result.Size - 1 do 917 | Result.Val[i] := Val; 918 | end; 919 | 920 | function CreateTensor(Shape: array of longint; Vals: array of NFloat): TTensor; 921 | var 922 | i, size: longint; 923 | begin 924 | size := ShapeToSize(Shape); 925 | Assert(ShapeToSize(Shape) = size, 926 | 'The values cannot be reshaped into the target shape'); 927 | Result := CreateEmptyTensor(shape); 928 | for i := 0 to size - 1 do 929 | Result.Val[i] := Vals[i]; 930 | Result.ReshapeInplace(Shape); 931 | end; 932 | 933 | function Zeros(Shape: array of longint): TTensor; 934 | begin 935 | Result := CreateTensor(Shape, 0); 936 | end; 937 | 938 | function Ones(Shape: array of longint): TTensor; 939 | begin 940 | Result := CreateTensor(Shape, 1.0); 941 | end; 942 | 943 | function Range(start, stop, step: double): TTensor; 944 | var 945 | i: double; 946 | offset: longint; 947 | begin 948 | Result.ReshapeInplace([Ceil((stop - start) / step)]); 949 | Result.Strides := ShapeToStride([Ceil((stop - start) / step)]); 950 | SetLength(Result.Val, Ceil((stop - start) / step)); 951 | 952 | i := start; 953 | offset := 0; 954 | while offset < Ceil((stop - start) / step) do 955 | begin 956 | Result.Val[offset] := i; 957 | i := i + step; 958 | Inc(offset); 959 | end; 960 | end; 961 | 962 | function Range(start, stop: double): TTensor; 963 | begin 964 | Result := Range(start, stop, 1); 965 | end; 966 | 967 | function Range(n: longint): TTensor; 968 | begin 969 | Result := Range(0, n, 1); 970 | end; 971 | 972 | function TopologicalSort(T: TVariable): TVariableArr; 973 | var 974 | Seen, Sorted: TVariableArr; 975 | prv: TVariable; 976 | 977 | procedure TopoHelper(v: TVariable); 978 | begin 979 | if (not (v in Seen)) then 980 | begin 981 | SetLength(Seen, Length(seen) + 1); 982 | Seen[Length(Seen) - 1] := v; 983 | for prv in v.Prev do 984 | TopoHelper(prv); 985 | 986 | if v.RequiresGrad then 987 | begin 988 | SetLength(Sorted, Length(Sorted) + 1); 989 | Sorted[Length(Sorted) - 1] := v; 990 | end; 991 | end; 992 | end; 993 | 994 | begin 995 | TopoHelper(T); 996 | Result := Sorted; 997 | end; 998 | 999 | procedure BackwardGraph(const T: TVariable); 1000 | var 1001 | Sorted: TVariableArr; 1002 | v: TVariable; 1003 | i: longint; 1004 | begin 1005 | if GLOBAL_SKIP_GRAD then 1006 | exit; 1007 | 1008 | Sorted := TopologicalSort(T); 1009 | 1010 | T.Grad.ReshapeInplace(T.Data.Shape); 1011 | T.Grad.Fill(1); 1012 | 1013 | for i := length(Sorted) - 1 downto 0 do 1014 | if Assigned(Sorted[i].BackwardFunc) then 1015 | begin 1016 | Sorted[i].BackwardFunc(Sorted[i].Prev, Sorted[i].FGrad); 1017 | end; 1018 | 1019 | GlobalNodeTracker.ClearUnusedNodes(T); 1020 | end; 1021 | 1022 | function ShapeToStride(Shape: array of longint): TIntVector; 1023 | var 1024 | k, j, sz, prod: longint; 1025 | begin 1026 | SetLength(Result, Length(Shape)); 1027 | 1028 | for k := 0 to Length(Shape) - 1 do 1029 | begin 1030 | prod := 1; 1031 | for j := k + 1 to Length(Shape) - 1 do 1032 | prod := prod * Shape[j]; 1033 | Result[k] := prod; 1034 | end; 1035 | end; 1036 | 1037 | function Squeeze(T: TTensor): TTensor; 1038 | var 1039 | i, offset: longint; 1040 | tmpShape: TIntVector; 1041 | begin 1042 | Result := CopyTensor(T); 1043 | SetLength(tmpShape, Length(T.Shape)); 1044 | 1045 | offset := 0; 1046 | for i in T.Shape do 1047 | if i > 1 then 1048 | begin 1049 | tmpShape[offset] := i; 1050 | Inc(offset); 1051 | end; 1052 | SetLength(tmpShape, offset); 1053 | 1054 | if Length(tmpShape) = 0 then 1055 | Result.ReshapeInplace([1]) 1056 | else 1057 | Result.ReshapeInplace(tmpShape); 1058 | end; 1059 | 1060 | function GetRowRange(T: TTensor; RowIndex, Amount: longint): TTensor; 1061 | begin 1062 | Assert(T.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 1063 | Result := GetRange(T, RowIndex, 0, Amount, T.Shape[1]); 1064 | end; 1065 | 1066 | function VFlip(T: TTensor): TTensor; 1067 | var 1068 | i, j: longint; 1069 | begin 1070 | Assert(T.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 1071 | Result := CreateEmptyTensor(T.Shape); 1072 | for i := 0 to T.Shape[0] - 1 do 1073 | for j := 0 to T.Shape[1] - 1 do 1074 | Result.SetAt(i, j, T.GetAt(T.Shape[0] - i - 1, j)); 1075 | end; 1076 | 1077 | function GetRange(T: TTensor; RowIndex, ColumnIndex, Height, Width: longint): TTensor; 1078 | var 1079 | i, j, offset: longint; 1080 | begin 1081 | Assert(Length(T.Shape) = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 1082 | Result.ReshapeInplace([Height, Width]); 1083 | 1084 | SetLength(Result.Val, Height * Width); 1085 | offset := 0; 1086 | for i := RowIndex to RowIndex + Height - 1 do 1087 | for j := ColumnIndex to ColumnIndex + Width - 1 do 1088 | begin 1089 | Result.Val[offset] := T.Val[i * T.Shape[1] + j]; 1090 | Inc(offset); 1091 | end; 1092 | end; 1093 | 1094 | function GetRange(T: TVariable; 1095 | RowIndex, ColumnIndex, Height, Width: longint): TTensor; 1096 | begin 1097 | Result := GetRange(T.Data, RowIndex, ColumnIndex, Height, Width); 1098 | end; 1099 | 1100 | function GetColumn(T: TTensor; ColumnIndex: longint; KeepDims: boolean 1101 | ): TTensor; 1102 | begin 1103 | if not KeepDims then 1104 | Exit(Squeeze(GetRange(T, 0, ColumnIndex, T.Shape[0], 1))) 1105 | else 1106 | Exit(GetRange(T, 0, ColumnIndex, T.Shape[0], 1)); 1107 | end; 1108 | 1109 | function GetColumnRange(T: TTensor; ColumnIndex, Amount: longint): TTensor; 1110 | begin 1111 | Assert(T.NDims = 2, MSG_ASSERTION_RANK_2_TENSORS_ONLY); 1112 | Result := GetRange(T, 0, ColumnIndex, T.Shape[0], Amount); 1113 | end; 1114 | 1115 | function GetRow(T: TTensor; RowIndex: longint; KeepDims: boolean): TTensor; 1116 | begin 1117 | if not KeepDims then 1118 | Exit(Squeeze(GetRange(T, RowIndex, 0, 1, T.Shape[1]))) 1119 | else 1120 | Exit(GetRange(T, RowIndex, 0, 1, T.Shape[1])); 1121 | end; 1122 | 1123 | procedure PrintTensor(V: TVariable); 1124 | begin 1125 | PrintTensor(V.Data); 1126 | end; 1127 | 1128 | procedure IterateTensor(T, OutT: TTensor; Callback: TCallback); 1129 | var 1130 | n, offset, ithDimChanged, dtIter: longint; 1131 | res, dimTracker: TIntVector; 1132 | 1133 | procedure iterate(d: longint; res: TIntVector); 1134 | var 1135 | i, j: longint; 1136 | begin 1137 | if d >= n then 1138 | begin 1139 | for j := Length(res) - 1 downto 0 do 1140 | if dimTracker[j] <> res[j] then 1141 | begin 1142 | dimTracker[j] := res[j]; 1143 | 1144 | ithDimChanged := j; // in which dimension there is a change? 1145 | end; 1146 | 1147 | //writeln(offset); 1148 | Callback(T.Val[IndexToOffset(res, T.Shape, T.Strides)], offset, res, ithDimChanged, T, OutT); 1149 | Inc(offset); 1150 | exit; 1151 | end; 1152 | 1153 | for i := 0 to T.shape[d] - 1 do 1154 | begin 1155 | res[d] := i; 1156 | iterate(d + 1, res); 1157 | end; 1158 | end; 1159 | 1160 | begin 1161 | offset := 0; 1162 | n := Length(T.Shape); 1163 | SetLength(res, n); 1164 | n := Length(T.shape); 1165 | SetLength(dimTracker, n); 1166 | for dtIter := 0 to n - 1 do 1167 | dimTracker[dtIter] := 0; 1168 | iterate(0, res); 1169 | end; 1170 | 1171 | procedure cbAsStrided(val: NFloat; offset: longint; idx: TIntVector; 1172 | currDim: longint; var T, OutT: TTensor); 1173 | begin 1174 | OutT.Val[offset] := val; 1175 | end; 1176 | 1177 | function AsStrided(X: TTensor; TargetShape, Strides: array of longint): TTensor; 1178 | var 1179 | i: longint; 1180 | OutStrides: TIntVector; 1181 | begin 1182 | SetLength(Result.Val, ShapeToSize(TargetShape)); 1183 | 1184 | X.ReshapeInplace(TargetShape); 1185 | SetLength(OutStrides, Length(strides)); 1186 | for i := 0 to length(Strides) - 1 do 1187 | OutStrides[i] := Strides[i]; 1188 | X.Strides := OutStrides; 1189 | 1190 | IterateTensor(X, Result, @cbAsStrided); 1191 | Result.ReshapeInplace(TargetShape); 1192 | end; 1193 | 1194 | function BroadcastTo(X: TTensor; TargetShape: array of longint): TTensor; 1195 | var 1196 | OutShape, OutStrides: TIntVector; 1197 | i: longint; 1198 | begin 1199 | OutShape := ReverseIntArr(X.Shape); 1200 | OutStrides := ReverseIntArr(X.Strides); 1201 | while length(OutShape) < Length(TargetShape) do 1202 | begin 1203 | SetLength(OutShape, Length(OutShape) + 1); 1204 | OutShape[Length(OutShape) - 1] := 1; 1205 | 1206 | SetLength(OutStrides, Length(OutStrides) + 1); 1207 | OutStrides[Length(OutStrides) - 1] := 0; 1208 | end; 1209 | OutShape := ReverseIntArr(OutShape); 1210 | OutStrides := ReverseIntArr(OutStrides); 1211 | 1212 | for i := 0 to Length(TargetShape) - 1 do 1213 | if TargetShape[i] <> OutShape[i] then 1214 | OutStrides[i] := 0; 1215 | 1216 | Result := AsStrided(X, TargetShape, OutStrides); 1217 | end; 1218 | 1219 | function IsBroadcastable(A, B: TTensor): boolean; 1220 | var 1221 | i, violated: longint; 1222 | revA, revB: TIntVector; 1223 | begin 1224 | { counting the violation of broadcasting rule } 1225 | violated := 0; 1226 | Result := False; 1227 | revA := ReverseIntArr(A.Shape); 1228 | revB := ReverseIntArr(B.Shape); 1229 | for i := 0 to Math.Min(Length(A.Shape), Length(B.Shape)) - 1 do 1230 | if (revA[i] <> revB[i]) then 1231 | if ((revA[i] <> 1) and (revB[i] <> 1)) then 1232 | Inc(violated); 1233 | Result := violated = 0; 1234 | end; 1235 | 1236 | function GetBroadcastDims(A, B: TTensor): TIntVector; 1237 | var 1238 | i, finalDimSize: longint; 1239 | revA, revB: TIntVector; 1240 | begin 1241 | Assert(IsBroadcastable(A, B), 'A and B cannot be broadcasted'); 1242 | finalDimSize := Max(Length(A.Shape), Length(B.Shape)); 1243 | 1244 | SetLength(Result, finalDimSize); 1245 | SetLength(revA, finalDimSize); 1246 | SetLength(revB, finalDimSize); 1247 | for i := 0 to Length(Result) - 1 do 1248 | begin 1249 | revA[i] := 1; 1250 | revB[i] := 1; 1251 | end; 1252 | 1253 | for i := 0 to length(A.Shape) - 1 do 1254 | revA[i] := ReverseIntArr(A.Shape)[i]; 1255 | 1256 | for i := 0 to Length(B.Shape) - 1 do 1257 | revB[i] := ReverseIntArr(B.Shape)[i]; 1258 | 1259 | revA := ReverseIntArr(revA); 1260 | revB := ReverseIntArr(revB); 1261 | for i := 0 to Max(Length(A.Shape), Length(B.Shape)) - 1 do 1262 | Result[i] := max(revA[i], revB[i]); 1263 | end; 1264 | 1265 | function TileColumn(A: TTensor; n: longint): TTensor; 1266 | var 1267 | i, j: longint; 1268 | begin 1269 | Result := CreateEmptyTensor([A.Shape[0], n]); 1270 | for i := 0 to A.Shape[0] - 1 do 1271 | for j := 0 to n-1 do 1272 | result.Val[i * n + j] := A.val[i]; 1273 | end; 1274 | 1275 | function TileRow(A: TTensor; n: longint): TTensor; 1276 | var 1277 | i, j, OutSize: longint; 1278 | begin 1279 | OutSize := A.Size * n; 1280 | Result := CreateEmptyTensor([n, A.Shape[1]]); 1281 | i := 0; 1282 | while i < OutSize do 1283 | begin 1284 | for j := 0 to A.Shape[1] - 1 do 1285 | result.Val[i + j] := A.Val[j]; 1286 | i := i + A.Shape[1]; 1287 | end; 1288 | end; 1289 | 1290 | procedure PrintTensor(T: TTensor); 1291 | var 1292 | n, offset, digitMax, decimalPlace, dtIter: longint; 1293 | res, dimTracker: array of longint; 1294 | outstr: string = ''; 1295 | 1296 | procedure PPrint(res: array of longint); 1297 | var 1298 | i, NewlineNum, ithDimChanged: longint; 1299 | begin 1300 | NewlineNum := 0; 1301 | 1302 | ithDimChanged := n; 1303 | for i := Length(res) - 1 downto 0 do 1304 | if dimTracker[i] <> res[i] then 1305 | begin 1306 | dimTracker[i] := res[i]; 1307 | 1308 | NewlineNum := n - i - 1; 1309 | ithDimChanged := i; // in which dimension there is a change? 1310 | end; 1311 | 1312 | 1313 | if (ithDimChanged < n - 1) then 1314 | outstr := outstr + (DupeString(']', NewlineNum)); 1315 | 1316 | outstr := outstr + (DupeString(sLineBreak, NewlineNum)); 1317 | 1318 | if (ithDimChanged = n - 1) then 1319 | outstr := outstr + (', '); 1320 | 1321 | if ithDimChanged < n - 1 then 1322 | begin 1323 | outstr := outstr + (DupeString(' ', n - NewlineNum)); 1324 | outstr := outstr + (DupeString('[', NewlineNum)); 1325 | end; 1326 | 1327 | outstr := outstr + Format('%'+IntToStr(digitMax+decimalPlace+2)+'.'+IntToStr(decimalPlace)+'f', [T.Val[IndexToOffset(res, T.Shape, T.Strides)]]); 1328 | end; 1329 | 1330 | // d is dimension iterator, d=0..n-1 1331 | procedure iterate(d: longint; shape, res: array of longint); 1332 | var 1333 | i: longint; 1334 | begin 1335 | if d >= n then 1336 | begin 1337 | //if (res[d-1] < 3) or (res[d-1] > T.Shape[n-1] - 3 - 1) then 1338 | PPrint(res); 1339 | 1340 | //if res[d-1] = 3 then 1341 | // outstr := outstr + ', ... '; 1342 | Inc(offset); 1343 | exit; 1344 | end; 1345 | 1346 | for i := 0 to shape[d] - 1 do 1347 | begin 1348 | res[d] := i; 1349 | iterate(d + 1, shape, res); 1350 | end; 1351 | end; 1352 | 1353 | function MaxAbs(arr: array of NFloat): double; 1354 | var 1355 | i: double; 1356 | begin 1357 | Result := abs(arr[0]); 1358 | for i in arr do 1359 | if abs(i) > abs(Result) then 1360 | Result := i; 1361 | end; 1362 | 1363 | begin 1364 | digitMax := Math.ceil(Math.log10(abs(MaxAbs(T.Val)) + 0.01)); 1365 | decimalPlace := 2; 1366 | 1367 | if Length(T.Val) = 1 then { it is a scalar } 1368 | writeln(T.Val[0]: digitMax + decimalPlace + 1: decimalPlace) 1369 | else { it is a higher rank tensor } 1370 | begin 1371 | offset := 0; 1372 | n := Length(T.Shape); 1373 | 1374 | SetLength(dimTracker, n); 1375 | for dtIter := 0 to n - 1 do 1376 | dimTracker[dtIter] := 0; 1377 | 1378 | SetLength(res, n); 1379 | outstr := outstr + (DupeString('[', n)); 1380 | iterate(0, T.GetShape, res); 1381 | outstr := outstr + (DupeString(']', n)); 1382 | outstr := outstr + sLineBreak; 1383 | 1384 | Write(outstr); 1385 | end; 1386 | end; 1387 | 1388 | initialization 1389 | NoeConfig.debug := True; 1390 | NoeConfig.BLASFileName := BLAS_FILENAME; 1391 | NoeConfig.useBLAS := True; 1392 | 1393 | GlobalNodeTracker.NodeSpace := TVariableList.Create; 1394 | 1395 | GLOBAL_NODE_COUNT := 0; 1396 | 1397 | finalization 1398 | GlobalNodeTracker.NodeSpace.Free; 1399 | end. 1400 | --------------------------------------------------------------------------------