nrtsb

Три функции активации: сигмоида, tanh, ReLU.

А чтобы было не скучно, добавил туда же инженерный калькулятор. Потому что нейросеть нейросетью, а синус 30 градусов посчитать иногда важнее. Тригонометрия, логарифмы, факториалы — чтобы оправдать название «инженерный».

Весь код — одна программа на PascalABC.NET. Никаких сторонних библиотек.

Полный код прикрепляю ниже:

program MathModCalc;
uses System, System.IO, System.Collections.Generic;
type
TRealArray = array of real;

TActivation = (actSigmoid, actTanh, actReLU);
TLayer = class
private
W: array[,] of real;
b: TRealArray;
n_in, n_out: integer;
last_input: TRealArray;
last_output: TRealArray;
activation: TActivation;
class function Sigmoid(x: real): real;
class function DSigmoid(y: real): real;
class function TanhF(x: real): real;
class function DTanh(y: real): real;
class function Relu(x: real): real;
class function DRelu(y: real): real;
function Activate(x: real): real;
function Derivative(y: real): real;
public
constructor Create(inputSize, outputSize: integer; act: TActivation);
procedure InitRandom;
function Run(const input: TRealArray): TRealArray;
function Backward(const gradient: TRealArray; lr: real): TRealArray;
procedure SaveToBinary(var bw: BinaryWriter);
procedure LoadFromBinary(var br: BinaryReader);
end;
TNeuralNetwork = class
private
layers: List<TLayer>;
public
constructor Create;
procedure AddLayer(inputSize, outputSize: integer; act: TActivation);
function Predict(const input: TRealArray): TRealArray;
function Train(const inputs, targets: array of TRealArray;
epochs: integer; lr: real): TRealArray;
procedure SaveToFile(const filename: string);
procedure LoadFromFile(const filename: string);
end;
function MakeVec(const a: array of real): TRealArray;
var i: integer;
begin
SetLength(Result, a.Length);
for i := 0 to a.Length - 1 do
Result[i] := a[i];
end;
{ TLayer }
class function TLayer.Sigmoid(x: real): real;
begin
if x < -45.0 then Result := 0.0
else if x > 45.0 then Result := 1.0
else Result := 1.0 / (1.0 + Exp(-x));
end;
class function TLayer.DSigmoid(y: real): real;
begin
Result := y * (1.0 - y);
end;
class function TLayer.TanhF(x: real): real;
var e2x: real;
begin
if x < -20.0 then Result := -1.0
else if x > 20.0 then Result := 1.0
else
begin
e2x := Exp(2.0 * x);
Result := (e2x - 1.0) / (e2x + 1.0);
end;
end;
class function TLayer.DTanh(y: real): real;
begin
Result := 1.0 - y * y;
end;
class function TLayer.Relu(x: real): real;
begin
if x > 0.0 then Result := x else Result := 0.0;
end;
class function TLayer.DRelu(y: real): real;
begin
if y > 0.0 then Result := 1.0 else Result := 0.0;
end;
function TLayer.Activate(x: real): real;
begin
case activation of
actSigmoid: Result := Sigmoid(x);
actTanh: Result := TanhF(x);
actReLU: Result := Relu(x);
else Result := Sigmoid(x);
end;
end;
function TLayer.Derivative(y: real): real;
begin
case activation of
actSigmoid: Result := DSigmoid(y);
actTanh: Result := DTanh(y);
actReLU: Result := DRelu(y);
else Result := DSigmoid(y);
end;
end;
constructor TLayer.Create(inputSize, outputSize: integer; act: TActivation);
begin
n_in := inputSize;
n_out := outputSize;
activation := act;
SetLength(W, n_out, n_in);
SetLength(b, n_out);
SetLength(last_input, n_in);
SetLength(last_output, n_out);
InitRandom;
end;
procedure TLayer.InitRandom;
var i, j: integer;
limit: real;
rnd: Random;
begin
rnd := new Random;
limit := Sqrt(6.0 / (n_in + n_out));
for i := 0 to n_out - 1 do
begin
for j := 0 to n_in - 1 do
W[i, j] := (rnd.NextDouble * 2.0 - 1.0) * limit;
b[i] := (rnd.NextDouble * 2.0 - 1.0) * limit;
end;
end;
function TLayer.Run(const input: TRealArray): TRealArray;
var i, j: integer;
s: real;
begin
for j := 0 to n_in - 1 do
last_input[j] := input[j];
for i := 0 to n_out - 1 do
begin
s := b[i];
for j := 0 to n_in - 1 do
s := s + W[i, j] * input[j];
last_output[i] := Activate(s);
end;
Result := last_output;
end;
function TLayer.Backward(const gradient: TRealArray; lr: real): TRealArray;
var i, j: integer;
delta, prev_grad: TRealArray;
begin
SetLength(delta, n_out);
SetLength(prev_grad, n_in);
for i := 0 to n_out - 1 do
delta[i] := gradient[i] * Derivative(last_output[i]);
for j := 0 to n_in - 1 do
begin
prev_grad[j] := 0.0;
for i := 0 to n_out - 1 do
prev_grad[j] := prev_grad[j] + W[i, j] * delta[i];
end;
for i := 0 to n_out - 1 do
begin
for j := 0 to n_in - 1 do
W[i, j] := W[i, j] - lr * delta[i] * last_input[j];
b[i] := b[i] - lr * delta[i];
end;
Result := prev_grad;
end;
procedure TLayer.SaveToBinary(var bw: BinaryWriter);
var i, j: integer;
begin
bw.Write(n_in);
bw.Write(n_out);
bw.Write(Ord(activation));
for i := 0 to n_out - 1 do
begin
for j := 0 to n_in - 1 do
bw.Write(W[i, j]);
bw.Write(b[i]);
end;
end;
procedure TLayer.LoadFromBinary(var br: BinaryReader);
var i, j: integer;
begin
for i := 0 to n_out - 1 do
begin
for j := 0 to n_in - 1 do
W[i, j] := br.ReadDouble;
b[i] := br.ReadDouble;
end;
end;
constructor TNeuralNetwork.Create;
begin
layers := new List<TLayer>;
end;
procedure TNeuralNetwork.AddLayer(inputSize, outputSize: integer; act: TActivation);
begin
layers.Add(new TLayer(inputSize, outputSize, act));
end;
function TNeuralNetwork.Predict(const input: TRealArray): TRealArray;
var i: integer;
begin
Result := input;
for i := 0 to layers.Count - 1 do
Result := layers[i].Run(Result);
end;
function TNeuralNetwork.Train(const inputs, targets: array of TRealArray;
epochs: integer; lr: real): TRealArray;
var
epoch, sample, i, ns: integer;
output, grad, errors: TRealArray;
totalError, mse: real;
begin
ns := inputs.Length;
SetLength(errors, epochs);
for epoch := 0 to epochs - 1 do
begin
totalError := 0.0;
for sample := 0 to ns - 1 do
begin
output := Predict(inputs[sample]);
for i := 0 to output.Length - 1 do
totalError := totalError + Sqr(output[i] - targets[sample][i]);
SetLength(grad, output.Length);
for i := 0 to output.Length - 1 do
grad[i] := output[i] - targets[sample][i];
for i := layers.Count - 1 downto 0 do
grad := layers[i].Backward(grad, lr);
end;
mse := totalError / ns;
errors[epoch] := mse;
if epoch mod 500 = 0 then
Writeln(' Эпоха ', epoch:5, ': MSE = ', mse:0:8);
end;
Result := errors;
end;
procedure TNeuralNetwork.SaveToFile(const filename: string);
var fs: FileStream;
bw: BinaryWriter;
i: integer;
begin
fs := new FileStream(filename, FileMode.Create);
bw := new BinaryWriter(fs);
try
bw.Write(layers.Count);
for i := 0 to layers.Count - 1 do
layers[i].SaveToBinary(bw);
finally
bw.Close;
fs.Close;
end;
Writeln('Модель сохранена в файл: ', filename);
end;
procedure TNeuralNetwork.LoadFromFile(const filename: string);
var fs: FileStream;
br: BinaryReader;
cnt, i: integer;
begin
fs := new FileStream(filename, FileMode.Open);
br := new BinaryReader(fs);
try
cnt := br.ReadInt32;
if cnt <> layers.Count then
Writeln('Предупреждение: число слоев в файле не совпадает');
for i := 0 to Min(cnt, layers.Count) - 1 do
layers[i].LoadFromBinary(br);
finally
br.Close;
fs.Close;
end;
Writeln('Модель загружена из файла: ', filename);
end;
procedure DemoXOR;
var
nn: TNeuralNetwork;
inputs, targets: array of TRealArray;
i: integer;
pred: TRealArray;
errVec: TRealArray;
begin
Writeln;
Writeln('-------------------------------------------');
Writeln('ДЕМО 1: XOR (исключающее ИЛИ)');
Writeln('Архитектура: 2 -> 4 (tanh) -> 1 (sigmoid)');
Writeln('-------------------------------------------');
Writeln;
nn := new TNeuralNetwork;
nn.AddLayer(2, 4, actTanh);
nn.AddLayer(4, 1, actSigmoid);
SetLength(inputs, 4);
SetLength(targets, 4);
SetLength(inputs[0], 2); inputs[0][0] := 0; inputs[0][1] := 0;
SetLength(targets[0], 1); targets[0][0] := 0;
SetLength(inputs[1], 2); inputs[1][0] := 0; inputs[1][1] := 1;
SetLength(targets[1], 1); targets[1][0] := 1;
SetLength(inputs[2], 2); inputs[2][0] := 1; inputs[2][1] := 0;
SetLength(targets[2], 1); targets[2][0] := 1;
SetLength(inputs[3], 2); inputs[3][0] := 1; inputs[3][1] := 1;
SetLength(targets[3], 1); targets[3][0] := 0;
Writeln('Обучение (5000 эпох, lr = 0.7)...');
errVec := nn.Train(inputs, targets, 5000, 0.7);
Writeln;
Writeln('Итоговая ошибка: ', errVec[errVec.Length - 1]:0:8);
Writeln;
Writeln('Результаты:');
Writeln(' Вход -> Выход сети (ожидание)');
for i := 0 to 3 do
begin
pred := nn.Predict(MakeVec([inputs[i][0], inputs[i][1]]));
Write(' [', inputs[i][0]:1:0, ', ', inputs[i][1]:1:0, '] -> ');
Write(pred[0]:0:6, ' (', targets[i][0]:1:0, ')');
if Abs(pred[0] - targets[i][0]) < 0.5 then
Writeln(' +')
else
Writeln(' -');
end;
end;
procedure DemoSine;
var
nn: TNeuralNetwork;
inputs, targets: array of TRealArray;
i: integer;
x, y_true, y_pred: real;
errVec: TRealArray;
begin
Writeln;
Writeln('-------------------------------------------');
Writeln('ДЕМО 2: sin(x) - аппроксимация функции');
Writeln('Архитектура: 1 -> 16 (tanh) -> 1 (tanh)');
Writeln('-------------------------------------------');
Writeln;
nn := new TNeuralNetwork;
nn.AddLayer(1, 16, actTanh);
nn.AddLayer(16, 1, actTanh);
SetLength(inputs, 200);
SetLength(targets, 200);
for i := 0 to 199 do
begin
x := (i / 199.0) * 2.0 * Pi;
SetLength(inputs[i], 1);
inputs[i][0] := x / (2.0 * Pi);
SetLength(targets[i], 1);
targets[i][0] := Sin(x);
end;
Writeln('Обучение (8000 эпох, lr = 0.3)...');
errVec := nn.Train(inputs, targets, 8000, 0.3);
Writeln;
Writeln('Итоговая ошибка: ', errVec[errVec.Length - 1]:0:8);
Writeln;
Writeln('Выборочные значения:');
Writeln(' x sin(x) Предсказание Ошибка');
for i := 0 to 10 do
begin
x := (i / 10.0) * 2.0 * Pi;
y_pred := nn.Predict(MakeVec([x / (2.0 * Pi)]))[0];
y_true := Sin(x);
Writeln(' ', x:0:3, ' ', y_true:0:6, ' ', y_pred:0:6, ' ', Abs(y_pred - y_true):0:6);
end;
end;
procedure EngineeringCalculator;
var
choice: string;
a, b, res: real;
done: boolean;
begin
done := false;
while not done do
begin
Writeln;
Writeln(' ИНЖЕНЕРНЫЙ КАЛЬКУЛЯТОР');
Writeln;
Writeln(' АРИФМЕТИКА:');
Writeln(' 1. Сложение a + b');
Writeln(' 2. Вычитание a - b');
Writeln(' 3. Умножение a * b');
Writeln(' 4. Деление a / b');
Writeln(' 5. Степень a ^ b');
Writeln(' 6. Корень n-й степени (a)√b');
Writeln;
Writeln(' ТРИГОНОМЕТРИЯ (углы в градусах!):');
Writeln(' 7. sin(x) 8. cos(x)');
Writeln(' 9. tan(x) 10. arcsin(x)');
Writeln(' 11. arccos(x) 12. arctan(x)');
Writeln;
Writeln(' ЛОГАРИФМЫ И СТЕПЕНИ:');
Writeln(' 13. ln(x) 14. lg(x) (log10)');
Writeln(' 15. log(a,b) 16. exp(x)');
Writeln(' 17. sqrt(x) 18. |x| (модуль)');
Writeln;
Writeln(' ДОПОЛНИТЕЛЬНО:');
Writeln(' 19. x! (факториал)');
Writeln(' 20. radians -> degrees');
Writeln(' 21. degrees -> radians');
Writeln(' 22. π (вывести число Pi)');
Writeln(' 23. e (вывести число e)');
Writeln;
Writeln(' 0 — Вернуться в меню');
Writeln;
Write('Выберите операцию: ');
Readln(choice);
case choice of
'0': done := true;
'1':
begin
Write('a = '); Readln(a);
Write('b = '); Readln(b);
res := a + b;
Writeln(a:0:10, ' + ', b:0:10, ' = ', res:0:10);
end;
'2':
begin
Write('a = '); Readln(a);
Write('b = '); Readln(b);
res := a - b;
Writeln(a:0:10, ' - ', b:0:10, ' = ', res:0:10);
end;
'3':
begin
Write('a = '); Readln(a);
Write('b = '); Readln(b);
res := a * b;
Writeln(a:0:10, ' * ', b:0:10, ' = ', res:0:10);
end;
'4':
begin
Write('a = '); Readln(a);
Write('b = '); Readln(b);
if Abs(b) < 1e-15 then
Writeln('Ошибка: деление на ноль!')
else
begin
res := a / b;
Writeln(a:0:10, ' / ', b:0:10, ' = ', res:0:10);
end;
end;
'5':
begin
Write('a (основание) = '); Readln(a);
Write('b (показатель) = '); Readln(b);
if (a < 0) and (Abs(b - Round(b)) > 1e-12) then
Writeln('Ошибка: отрицательное основание в дробной степени')
else
begin
res := Power(a, b);
Writeln(a:0:6, ' ^ ', b:0:6, ' = ', res:0:10);
end;
end;
'6':
begin
Write('a (степень корня) = '); Readln(a);
Write('b (подкоренное) = '); Readln(b);
if (a <= 0) or (Abs(a - Round(a)) > 1e-12) then
Writeln('Ошибка: степень корня должна быть целым положительным числом')
else if (b < 0) and (Round(a) mod 2 = 0) then
Writeln('Ошибка: корень чётной степени из отрицательного числа')
else
begin
if b < 0 then
res := -Power(-b, 1.0 / a)
else
res := Power(b, 1.0 / a);
Writeln('root(', Round(a):1, ', ', b:0:6, ') = ', res:0:10);
end;
end;
'7':
begin
Write('x (градусы) = '); Readln(a);
res := Sin(a * Pi / 180.0);
Writeln('sin(', a:0:6, ' deg) = ', res:0:10);
end;
'8':
begin
Write('x (градусы) = '); Readln(a);
res := Cos(a * Pi / 180.0);
Writeln('cos(', a:0:6, ' deg) = ', res:0:10);
end;
'9':
begin
Write('x (градусы) = '); Readln(a);
if Abs(Cos(a * Pi / 180.0)) < 1e-12 then
Writeln('Ошибка: тангенс не определён для этого угла')
else
begin
res := Tan(a * Pi / 180.0);
Writeln('tan(', a:0:6, ' deg) = ', res:0:10);
end;
end;
'10':
begin
Write('x = '); Readln(a);
if (a < -1.0) or (a > 1.0) then
Writeln('Ошибка: аргумент должен быть в [-1, 1]')
else
begin
res := ArcSin(a) * 180.0 / Pi;
Writeln('arcsin(', a:0:6, ') = ', res:0:6, ' deg');
end;
end;
'11':
begin
Write('x = '); Readln(a);
if (a < -1.0) or (a > 1.0) then
Writeln('Ошибка: аргумент должен быть в [-1, 1]')
else
begin
res := ArcCos(a) * 180.0 / Pi;
Writeln('arccos(', a:0:6, ') = ', res:0:6, ' deg');
end;
end;
'12':
begin
Write('x = '); Readln(a);
res := ArcTan(a) * 180.0 / Pi;
Writeln('arctan(', a:0:6, ') = ', res:0:6, ' deg');
end;
'13':
begin
Write('x = '); Readln(a);
if a <= 0 then
Writeln('Ошибка: логарифм от неположительного числа')
else
begin
res := Ln(a);
Writeln('ln(', a:0:6, ') = ', res:0:10);
end;
end;
'14':
begin
Write('x = '); Readln(a);
if a <= 0 then
Writeln('Ошибка: логарифм от неположительного числа')
else
begin
res := Log10(a);
Writeln('lg(', a:0:6, ') = ', res:0:10);
end;
end;
'15':
begin
Write('a (основание логарифма) = '); Readln(a);
Write('b (аргумент) = '); Readln(b);
if (a <= 0) or (a = 1) or (b <= 0) then
Writeln('Ошибка: неверные аргументы (a>0, a<>1, b>0)')
else
begin
res := Ln(b) / Ln(a);
Writeln('log_', a:0:3, '(', b:0:6, ') = ', res:0:10);
end;
end;
'16':
begin
Write('x = '); Readln(a);
res := Exp(a);
Writeln('exp(', a:0:6, ') = ', res:0:10);
end;
'17':
begin
Write('x = '); Readln(a);
if a < 0 then
Writeln('Ошибка: корень из отрицательного числа')
else
begin
res := Sqrt(a);
Writeln('sqrt(', a:0:6, ') = ', res:0:10);
end;
end;
'18':
begin
Write('x = '); Readln(a);
res := Abs(a);
Writeln('|', a:0:6, '| = ', res:0:10);
end;
'19':
begin
Write('x = '); Readln(a);
if (a < 0) or (a > 170) then
Writeln('Ошибка: факториал для x<0 или x>170 (переполнение)')
else
begin
res := 1.0;
for var k := 2 to Round(a) do
res := res * k;
Writeln(Round(a), '! = ', res:0:0);
end;
end;
'20':
begin
Write('radians = '); Readln(a);
res := a * 180.0 / Pi;
Writeln(a:0:6, ' rad = ', res:0:6, ' deg');
end;
'21':
begin
Write('degrees = '); Readln(a);
res := a * Pi / 180.0;
Writeln(a:0:6, ' deg = ', res:0:6, ' rad');
end;
'22':
begin
Writeln('pi = ', Pi:0:15);
end;
'23':
begin
Writeln('e = ', Exp(1.0):0:15);
end;
else
Writeln('Неверный выбор. Попробуйте снова.');
end;
if choice <> '0' then
begin
Writeln;
Write('Нажмите Enter для продолжения...');
Readln;
end;
end;
end;
var
cmd: string;
begin
Console.OutputEncoding := Encoding.UTF8;
while true do
begin
Writeln('======================================');
Writeln(' Нейросеть на PascalABC.NET');
Writeln(' Полносвязный перцептрон');
Writeln('======================================');
Writeln;
Writeln('Выберите раздел:');
Writeln(' 1 - XOR (исключающее ИЛИ)');
Writeln(' 2 - sin(x) (аппроксимация функции)');
Writeln(' 3 - Обе демонстрации');
Writeln(' 4 - Инженерный калькулятор');
Writeln(' q - Выход');
Writeln;
Write('Ваш выбор: ');
Readln(cmd);
case cmd of
'1': DemoXOR;
'2': DemoSine;
'3':
begin
DemoXOR;
DemoSine;
end;
'4': EngineeringCalculator;
'q': Break;
else
begin
Writeln('Неверный выбор. Попробуйте снова.');
Writeln;
Write('Нажмите Enter...');
Readln;
end;
end;
end;
end.