- Код: Выделить всё
program NeuralTicTacToe;
{$mode objfpc}{$H+}
{
TicTacToe with Ai.
For GNU/Linux 64 bit version.
Version: 1.
Written on FreePascal (https://freepascal.org/).
Copyright (C) 2025 Artyomov Alexander
Used https://chat.deepseek.com/
http://self-made-free.ru/
aralni@mail.ru
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
}
uses
SysUtils, Math, StrUtils, Classes, NeuralNetwork, DataUtils;
type
TBoard = array[0..2, 0..2] of Char; // Доска 3x3
TMove = record
Row, Col: Integer;
end;
TGameState = (gsPlaying, gsXWon, gsOWon, gsDraw);
TPlayerType = (ptHuman, ptComputer);
const
EMPTY = '.';
PLAYER_X = 'X';
PLAYER_O = 'O';
var
Board: TBoard;
CurrentPlayer: Char;
GameState: TGameState;
NeuralNet: TNeuralNetwork;
TrainingData: TDoubleMatrix;
TrainingLabels: TDoubleArray;
MoveCount: Integer;
Experience: Integer = 0; // Счётчик сыгранных игр
// Инициализация доски
procedure InitializeBoard;
var
i, j: Integer;
begin
for i := 0 to 2 do
for j := 0 to 2 do
Board[i][j] := EMPTY;
CurrentPlayer := PLAYER_X;
GameState := gsPlaying;
MoveCount := 0;
end;
// Преобразование координат шахматного стиля (a1, b2 и т.д.) в индексы массива
function ChessNotationToIndices(const moveStr: string; out row, col: Integer): Boolean;
begin
Result := False;
if Length(moveStr) <> 2 then Exit;
col := Ord(LowerCase(moveStr[1])) - Ord('a');
row := Ord(moveStr[2]) - Ord('1');
Result := (row >= 0) and (row <= 2) and (col >= 0) and (col <= 2);
end;
// Преобразование индексов массива в шахматную нотацию
function IndicesToChessNotation(row, col: Integer): string;
begin
Result := Chr(Ord('a') + col) + Chr(Ord('1') + row);
end;
// Отображение доски
procedure DisplayBoard;
var
i, j: Integer;
begin
WriteLn(' a b c');
for i := 0 to 2 do
begin
Write(i+1, ' ');
for j := 0 to 2 do
begin
Write(Board[i][j], ' ');
end;
WriteLn;
end;
end;
// Проверка на победу
function CheckWin: Boolean;
var
i: Integer;
begin
// Проверка строк и столбцов
for i := 0 to 2 do
begin
if (Board[i][0] = CurrentPlayer) and (Board[i][1] = CurrentPlayer) and (Board[i][2] = CurrentPlayer) then
Exit(True);
if (Board[0][i] = CurrentPlayer) and (Board[1][i] = CurrentPlayer) and (Board[2][i] = CurrentPlayer) then
Exit(True);
end;
// Проверка диагоналей
if (Board[0][0] = CurrentPlayer) and (Board[1][1] = CurrentPlayer) and (Board[2][2] = CurrentPlayer) then
Exit(True);
if (Board[0][2] = CurrentPlayer) and (Board[1][1] = CurrentPlayer) and (Board[2][0] = CurrentPlayer) then
Exit(True);
Result := False;
end;
// Проверка на ничью
function CheckDraw: Boolean;
var
i, j: Integer;
begin
for i := 0 to 2 do
for j := 0 to 2 do
if Board[i][j] = EMPTY then
Exit(False);
Exit(True);
end;
// Преобразование доски в вектор для нейросети
function BoardToVector: TDoubleArray;
var
i, j, idx: Integer;
begin
SetLength(Result, 9);
idx := 0;
for i := 0 to 2 do
for j := 0 to 2 do
begin
if Board[i][j] = PLAYER_X then
Result[idx] := 1.0
else if Board[i][j] = PLAYER_O then
Result[idx] := -1.0
else
Result[idx] := 0.0;
Inc(idx);
end;
end;
// Защищенная сигмоида с проверкой на переполнение
function SafeSigmoid(x: Double): Double;
begin
if x > 30 then Exit(1.0);
if x < -30 then Exit(0.0);
Result := 1.0 / (1.0 + Exp(-x));
end;
function CheckWinForBoard(const board: TBoard; player: Char): Boolean;
var
i: Integer;
begin
// Проверка строк и столбцов
for i := 0 to 2 do
begin
if (board[i][0] = player) and (board[i][1] = player) and (board[i][2] = player) then
Exit(True);
if (board[0][i] = player) and (board[1][i] = player) and (board[2][i] = player) then
Exit(True);
end;
// Проверка диагоналей
if (board[0][0] = player) and (board[1][1] = player) and (board[2][2] = player) then
Exit(True);
if (board[0][2] = player) and (board[1][1] = player) and (board[2][0] = player) then
Exit(True);
Result := False;
end;
function FindWinningMove(player: Char): Integer;
var
i, r, c: Integer;
testBoard: TBoard;
begin
Result := -1;
for i := 0 to 8 do
begin
r := i div 3;
c := i mod 3;
if Board[r][c] = EMPTY then
begin
testBoard := Board;
testBoard[r][c] := player;
if CheckWinForBoard(testBoard, player) then
Exit(i);
end;
end;
end;
procedure ApplyStrategicWeights(var output: TDoubleArray);
begin
// Центр более важен
output[4] := output[4] * 1.3;
// Углы важнее при определённых условиях
if (Board[0][0] = EMPTY) or (Board[0][2] = EMPTY) or
(Board[2][0] = EMPTY) or (Board[2][2] = EMPTY) then
begin
output[0] := output[0] * 1.2;
output[2] := output[2] * 1.2;
output[6] := output[6] * 1.2;
output[8] := output[8] * 1.2;
end;
end;
// Выбор хода нейросетью
function NeuralNetMove: TMove;
var
inputVector, outputVector: TDoubleArray;
i, bestMove: Integer;
bestScore: Double;
validMoves: array of Integer;
begin
inputVector := BoardToVector;
// Добавляем стратегическую логику
if Experience > 30 then
begin
// Проверка на выигрышный ход
bestMove := FindWinningMove(CurrentPlayer);
if bestMove >= 0 then
begin
Result.Row := bestMove div 3;
Result.Col := bestMove mod 3;
Exit;
end;
// Блокировка выигрыша противника
if CurrentPlayer = PLAYER_O then
begin
bestMove := FindWinningMove(PLAYER_X);
if bestMove >= 0 then
begin
Result.Row := bestMove div 3;
Result.Col := bestMove mod 3;
Exit;
end;
end;
end;
// Основной интеллектуальный ход
try
outputVector := PredictNetwork(NeuralNet, inputVector);
// Применяем стратегические приоритеты
ApplyStrategicWeights(outputVector);
bestMove := -1;
bestScore := -Infinity;
for i := 0 to 8 do
begin
if (Board[i div 3][i mod 3] = EMPTY) and (outputVector[i] > bestScore) then
begin
bestScore := outputVector[i];
bestMove := i;
end;
end;
if bestMove >= 0 then
begin
Result.Row := bestMove div 3;
Result.Col := bestMove mod 3;
Exit;
end;
except
on E: Exception do
WriteLn('Ошибка предсказания: ', E.Message);
end;
// Резервный случайный ход
SetLength(validMoves, 0);
for i := 0 to 8 do
if Board[i div 3][i mod 3] = EMPTY then
begin
SetLength(validMoves, Length(validMoves)+1);
validMoves[High(validMoves)] := i;
end;
if Length(validMoves) > 0 then
begin
bestMove := validMoves[Random(Length(validMoves))];
Result.Row := bestMove div 3;
Result.Col := bestMove mod 3;
end
else
begin
Result.Row := 0;
Result.Col := 0;
end;
end;
// Добавление хода в обучающую выборку
procedure AddToTrainingData(const move: TMove);
var
inputVector: TDoubleArray;
outputVector: TDoubleArray;
moveIdx: Integer;
begin
inputVector := BoardToVector;
SetLength(outputVector, 9);
FillChar(outputVector[0], Length(outputVector) * SizeOf(Double), 0);
moveIdx := move.Row * 3 + move.Col;
outputVector[moveIdx] := 1.0;
// Добавляем в обучающую выборку
SetLength(TrainingData, Length(TrainingData) + 1);
TrainingData[High(TrainingData)] := inputVector;
SetLength(TrainingLabels, Length(TrainingLabels) + 1);
TrainingLabels[High(TrainingLabels)] := moveIdx;
end;
// Обучение нейросети на накопленных данных
procedure TrainNeuralNet;
var
effectiveLearningRate: Double;
begin
if Length(TrainingData) > 0 then
begin
try
// Динамический learning rate (уменьшается с опытом)
effectiveLearningRate := 0.1 / (1.0 + Experience * 0.01);
NeuralNet.learningRate := Max(effectiveLearningRate, 0.001);
// Увеличиваем количество эпох с опытом
TrainNetwork(NeuralNet, TrainingData, TrainingLabels, 5 + Experience div 10, Experience);
Inc(Experience);
WriteLn('Опыт компьютера: ', Experience);
except
on E: Exception do
WriteLn('Ошибка обучения: ', E.Message);
end;
SetLength(TrainingData, 0);
SetLength(TrainingLabels, 0);
end;
end;
// Ход игрока
procedure PlayerMove;
var
moveStr: string;
row, col: Integer;
validMove: Boolean;
Move: TMove;
begin
repeat
Write('Ваш ход (например, a1, b2 и т.д.): ');
ReadLn(moveStr);
validMove := ChessNotationToIndices(moveStr, row, col);
if not validMove then
begin
WriteLn('Некорректный ввод. Используйте букву от a до c и цифру от 1 до 3 (например, a1).');
Continue;
end;
if Board[row][col] <> EMPTY then
begin
WriteLn('Эта клетка уже занята!');
validMove := False;
end;
until validMove;
Board[row][col] := CurrentPlayer;
Move.Row := row; Move.Col := col;
AddToTrainingData(Move); // Запоминаем ход игрока для обучения
end;
// Ход компьютера
procedure ComputerMove;
var
move: TMove;
begin
WriteLn('Компьютер думает...');
move := NeuralNetMove;
Board[move.Row][move.Col] := CurrentPlayer;
WriteLn('Компьютер сделал ход: ', IndicesToChessNotation(move.Row, move.Col));
end;
// Основной игровой цикл
procedure PlayGame;
var
response: Char;
begin
InitializeBoard;
DisplayBoard;
while GameState = gsPlaying do
begin
if CurrentPlayer = PLAYER_X then
PlayerMove
else
ComputerMove;
Inc(MoveCount);
DisplayBoard;
if CheckWin then
begin
if CurrentPlayer = PLAYER_X then
GameState := gsXWon
else
GameState := gsOWon;
WriteLn('Игрок ', CurrentPlayer, ' победил!');
end
else if CheckDraw then
begin
GameState := gsDraw;
WriteLn('Ничья!');
end;
if CurrentPlayer = PLAYER_X then
CurrentPlayer := PLAYER_O
else
CurrentPlayer := PLAYER_X;
end;
// После игры обучаем нейросеть на новых данных
TrainNeuralNet;
end;
// Главная программа
var
playAgain: Char;
begin
Randomize;
// Инициализация нейросети (3 слоя: 9 входов, 18 скрытых нейронов, 9 выходов)
SafeInitializeNetwork(NeuralNet, [9, 18, 9], 0.01, 0.001);
WriteLn('Нейросетевая игра "Крестики-нолики"');
WriteLn('Используйте шахматную нотацию для ходов (a1, b2, c3 и т.д.)');
WriteLn('Вы играете за X, компьютер за O');
repeat
PlayGame;
Write('Хотите сыграть ещё раз? (y/n): ');
ReadLn(playAgain);
until LowerCase(playAgain) <> 'y';
FreeNetwork(NeuralNet);
WriteLn('До свидания!');
end.
- Код: Выделить всё
unit NeuralNetwork;
{$MODE OBJFPC}{$H+}{$RANGECHECKS ON}
{
NeuralNetwork for NeuralTicTacToe.
For GNU/Linux 64 bit version.
Version: 1.
Written on FreePascal (https://freepascal.org/).
Copyright (C) 2024-2025 Artyomov Alexander
Used https://chat.deepseek.com/
http://self-made-free.ru/
aralni@mail.ru
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
}
interface
uses
SysUtils, Math, DataUtils;
const
MAX_EXPERIENCE = 1000;
MIN_LEARNING_RATE = 0.0001;
INIT_LEARNING_RATE = 0.1;
type
TLayer = record
weights: TDoubleMatrix; // Веса слоя
biases: TDoubleArray; // Смещения (bias)
output: TDoubleArray; // Выходные значения нейронов
end;
TNeuralNetwork = record
layers: array of TLayer; // Слои сети
learningRate: Double; // Скорость обучения
lambda: Double; // Параметр L2-регуляризации
end;
procedure InitializeNetwork(var network: TNeuralNetwork; const layerSizes: array of Integer; learningRate: Double; lambda: Double = 0.0);
procedure ForwardPropagation(var network: TNeuralNetwork; const input: TDoubleArray);
procedure BackwardPropagation(var network: TNeuralNetwork; const input: TDoubleArray; target: Double); // Изменён тип target на Double
procedure TrainNetwork(var network: TNeuralNetwork;
x: TDoubleMatrix;
y: TDoubleArray;
epochs: Integer;
experience: Integer);
function PredictNetwork(const network: TNeuralNetwork; const input: TDoubleArray): TDoubleArray;
procedure FreeNetwork(var network: TNeuralNetwork);
procedure SafeInitializeNetwork(var network: TNeuralNetwork; const layers: array of Integer; learningRate, lambda: Double);
function ValidateVector(const vec: TDoubleArray): Boolean;
function Sigmoid(x: Double): Double;
function Tanh(x: Double): Double;
function ReLU(x: Double): Double;
function LeakyReLU(x: Double): Double;
function Softmax(const x: TDoubleArray): TDoubleArray;
function SafeSoftmax(const x: TDoubleArray): TDoubleArray;
function SafeExp(x: Double): Double;
function SafeSigmoid(x: Double): Double;
implementation
function ReLU(x: Double): Double;
begin
if x > 0 then
Result := x
else
Result := 0;
end;
function LeakyReLU(x: Double): Double;
begin
if x > 0 then
Result := x
else
Result := 0.01 * x; // Малый наклон для отрицательных значений
end;
// Функция для генерации массива случайных чисел
function RandomArray(size: Integer; minVal, maxVal: Double): TDoubleArray;
var
i: Integer;
begin
SetLength(Result, size); // Явная инициализация массива
for i := 0 to High(Result) do
Result[i] := minVal + (maxVal - minVal) * Random;
end;
// Сигмоида
function Sigmoid(x: Double): Double;
begin
Result := 1.0 / (1.0 + Exp(-x));
end;
// Гиперболический тангенс
function Tanh(x: Double): Double;
begin
Result := (Exp(2 * x) - 1) / (Exp(2 * x) + 1);
end;
// Softmax
function Softmax(const x: TDoubleArray): TDoubleArray;
var
i: Integer;
maxVal, sum: Double;
begin
SetLength(Result, Length(x));
// Находим максимальное значение для численной стабильности
maxVal := x[0];
for i := 1 to High(x) do
if x[i] > maxVal then
maxVal := x[i];
// Вычисляем экспоненты и сумму
sum := 0.0;
for i := 0 to High(x) do
begin
Result[i] := Exp(x[i] - maxVal); // Сдвиг для стабильности
sum := sum + Result[i];
end;
// Нормализуем
if sum > 0 then
begin
for i := 0 to High(Result) do
Result[i] := Result[i] / sum;
end
else
begin
// Защита от деления на ноль
for i := 0 to High(Result) do
Result[i] := 1.0 / Length(Result);
end;
end;
// Инициализация сети
procedure InitializeNetwork(var network: TNeuralNetwork; const layerSizes: array of Integer;
learningRate: Double; lambda: Double = 0.0);
var
i, j: Integer;
fan_in, fan_out: Integer;
limit: Double;
begin
network.learningRate := learningRate;
network.lambda := lambda;
SetLength(network.layers, Length(layerSizes) - 1);
for i := 0 to High(network.layers) do
begin
// Инициализация Xavier/Glorot для лучшего обучения
fan_in := layerSizes[i];
fan_out := layerSizes[i+1];
limit := sqrt(6.0 / (fan_in + fan_out));
SetLength(network.layers[i].weights, layerSizes[i+1], layerSizes[i]);
SetLength(network.layers[i].biases, layerSizes[i+1]);
SetLength(network.layers[i].output, layerSizes[i+1]);
for j := 0 to High(network.layers[i].weights) do
begin
network.layers[i].weights[j] := RandomArray(layerSizes[i], -limit, limit);
network.layers[i].biases[j] := -limit + 2 * limit * Random;
end;
end;
end;
function SafeSoftmax(const x: TDoubleArray): TDoubleArray;
var
i: Integer;
maxVal, sum: Double;
begin
SetLength(Result, Length(x));
// Находим максимум для численной стабильности
maxVal := MaxValue(x);
// Вычисляем экспоненты с защитой
sum := 0.0;
for i := 0 to High(x) do
begin
Result[i] := Exp(x[i] - maxVal);
if IsNan(Result[i]) then Result[i] := 0;
sum := sum + Result[i];
end;
// Нормализация с защитой
if sum <= 0 then sum := 1;
for i := 0 to High(Result) do
Result[i] := Result[i] / sum;
end;
// Прямое распространение (Forward Propagation)
procedure ForwardPropagation(var network: TNeuralNetwork; const input: TDoubleArray);
var
i, j, k: Integer;
sum: Double;
begin
// Проверка входных данных
if Length(input) = 0 then
raise Exception.Create('Input array is empty');
// Проверка соответствия размеров
if Length(input) <> Length(network.layers[0].weights[0]) then
raise Exception.Create(Format(
'Input size mismatch. Expected %d, got %d',
[Length(network.layers[0].weights[0]), Length(input)]));
// Обработка слоёв с дополнительными проверками
for i := 0 to High(network.layers) do
begin
for j := 0 to High(network.layers[i].weights) do
begin
sum := 0.0;
// Проверка индексов перед доступом
if (i > 0) and (Length(network.layers[i-1].output) <= High(network.layers[i].weights[j])) then
raise Exception.Create(Format(
'Index out of bounds in layer %d, neuron %d: weights length %d, previous layer output %d',
[i, j, Length(network.layers[i].weights[j]), Length(network.layers[i-1].output)]));
for k := 0 to High(network.layers[i].weights[j]) do
begin
// Проверка весов
if IsNan(network.layers[i].weights[j][k]) then
network.layers[i].weights[j][k] := 0;
// Безопасный доступ к входным данным
if i = 0 then
begin
if k > High(input) then
raise Exception.Create(Format(
'Input index out of bounds: %d (input size %d)',
[k, Length(input)]));
sum := sum + network.layers[i].weights[j][k] * input[k];
end
else
begin
if k > High(network.layers[i-1].output) then
raise Exception.Create(Format(
'Previous layer output index out of bounds: %d (output size %d)',
[k, Length(network.layers[i-1].output)]));
sum := sum + network.layers[i].weights[j][k] * network.layers[i-1].output[k];
end;
end;
sum := sum + network.layers[i].biases[j];
// Активация
if i < High(network.layers) then
network.layers[i].output[j] := LeakyReLU(sum)
else
network.layers[i].output[j] := sum; // Для выходного слоя
end;
// Softmax только для выходного слоя
if i = High(network.layers) then
network.layers[i].output := SafeSoftmax(network.layers[i].output);
end;
end;
// Обратное распространение (Backward Propagation)
procedure BackwardPropagation(var network: TNeuralNetwork; const input: TDoubleArray; target: Double);
var
i, j, k: Integer;
error, derivative: Double;
deltas: array of TDoubleArray;
begin
// Инициализация массива deltas
SetLength(deltas, Length(network.layers));
for i := 0 to High(deltas) do
SetLength(deltas[i], Length(network.layers[i].output));
// Вычисляем ошибку на выходном слое
for i := 0 to High(network.layers[High(network.layers)].output) do
begin
error := network.layers[High(network.layers)].output[i] - target;
deltas[High(deltas)][i] := error;
end;
// Распространяем ошибку назад
for i := High(network.layers) downto 1 do
begin
for j := 0 to High(network.layers[i].weights) do
begin
derivative := 1.0 - Sqr(network.layers[i].output[j]); // Производная Tanh
deltas[i - 1][j] := 0.0;
for k := 0 to High(network.layers[i - 1].output) do
begin
// Проверка, чтобы не выйти за пределы массива
if (k <= High(deltas[i])) and (k <= High(network.layers[i].weights[j])) then
deltas[i - 1][j] := deltas[i - 1][j] + network.layers[i].weights[j][k] * deltas[i][k] * derivative;
end;
end;
end;
// Обновляем веса и смещения с учётом L2-регуляризации
for i := 0 to High(network.layers) do
begin
for j := 0 to High(network.layers[i].weights) do
begin
for k := 0 to High(network.layers[i].weights[j]) do
begin
// Проверка, чтобы не выйти за пределы массива
if (k <= High(network.layers[i].output)) then
begin
network.layers[i].weights[j][k] := network.layers[i].weights[j][k] - network.learningRate * (deltas[i][j] * network.layers[i].output[k] + network.lambda * network.layers[i].weights[j][k]);
end;
end;
network.layers[i].biases[j] := network.layers[i].biases[j] - network.learningRate * deltas[i][j];
end;
end;
end;
// Обучение сети
// Модифицированная процедура обучения с защитой от переполнения
procedure TrainNetwork(var network: TNeuralNetwork;
x: TDoubleMatrix; // Убрали const
y: TDoubleArray; // Убрали const
epochs: Integer;
experience: Integer);
var
i, j, k: Integer;
effectiveLR: Double;
localX: TDoubleMatrix; // Локальная копия для обучения
localY: TDoubleArray; // Локальная копия меток
begin
if Length(x) = 0 then Exit;
// Создаем локальные копии данных для обучения
localX := CopyMatrix(x);
localY := CopyArray(y);
// Ограничиваем размер обучающей выборки
if Length(localX) > 50 then
begin
SetLength(localX, 50);
SetLength(localY, 50);
end;
// Адаптивный learning rate
effectiveLR := INIT_LEARNING_RATE * (1.0 - experience/MAX_EXPERIENCE);
network.learningRate := Max(effectiveLR, MIN_LEARNING_RATE);
// Нормализация входных данных
for i := 0 to High(localX) do
for j := 0 to High(localX[i]) do
localX[i][j] := Max(-1.0, Min(1.0, localX[i][j]));
// Остальной код обучения остается прежним, но работаем с localX и localY
for i := 1 to Min(epochs, 10 + experience div 20) do
begin
for j := 0 to High(localX) do
begin
try
ForwardPropagation(network, localX[j]);
BackwardPropagation(network, localX[j], localY[j]);
// Ограничение весов
for k := 0 to High(network.layers) do
begin
network.layers[k].weights :=
ClipMatrix(network.layers[k].weights, -5.0, 5.0);
network.layers[k].biases :=
ClipVector(network.layers[k].biases, -5.0, 5.0);
end;
except
on E: Exception do
WriteLn('Обучение пропущено: ', E.Message);
end;
end;
end;
end;
// Предсказание
function PredictNetwork(const network: TNeuralNetwork; const input: TDoubleArray): TDoubleArray;
var
networkCopy: TNeuralNetwork;
begin
// Создаём копию сети, чтобы не изменять оригинальную
networkCopy := network;
ForwardPropagation(networkCopy, input);
Result := networkCopy.layers[High(networkCopy.layers)].output;
end;
// Освобождение памяти
procedure FreeNetwork(var network: TNeuralNetwork);
var
i: Integer;
begin
for i := 0 to High(network.layers) do
begin
SetLength(network.layers[i].weights, 0);
SetLength(network.layers[i].biases, 0);
SetLength(network.layers[i].output, 0);
end;
SetLength(network.layers, 0);
end;
function ValidateVector(const vec: TDoubleArray): Boolean;
var
i: Integer;
begin
Result := False;
if Length(vec) = 0 then Exit;
for i := 0 to High(vec) do
begin
if IsNan(vec[i]) or IsInfinite(vec[i]) then Exit;
if (vec[i] > 1e10) or (vec[i] < -1e10) then Exit;
end;
Result := True;
end;
procedure SafeInitializeNetwork(var network: TNeuralNetwork;
const layers: array of Integer; learningRate, lambda: Double);
var
i: Integer;
begin
if Length(layers) < 2 then
raise Exception.Create('Network must have at least 2 layers');
for i := 0 to High(layers) do
begin
if layers[i] <= 0 then
raise Exception.Create(Format(
'Invalid layer size %d at position %d', [layers[i], i]));
end;
InitializeNetwork(network, layers, learningRate, lambda);
end;
function SafeExp(x: Double): Double;
begin
if x > 50 then Exit(Exp(50));
if x < -50 then Exit(Exp(-50));
Result := Exp(x);
end;
function SafeSigmoid(x: Double): Double;
begin
if x > 30 then Exit(1.0);
if x < -30 then Exit(0.0);
try
Result := 1.0 / (1.0 + SafeExp(-x));
except
Result := 0.5;
end;
end;
end.
- Код: Выделить всё
unit DataUtils;
{$MODE OBJFPC}{$H+}{$RANGECHECKS ON}
interface
{
Data Utils for Ai.
For GNU/Linux 64 bit version.
Version: 1.
Written on FreePascal (https://freepascal.org/).
Copyright (C) 2024-2025 Artyomov Alexander
Used https://chat.deepseek.com/
http://self-made-free.ru/
aralni@mail.ru
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
}
uses
SysUtils, Classes,streamex,strutils,Math;
type
TDoubleArray = array of Double;
TDoubleMatrix = array of TDoubleArray;
TDoubleMatrixArray = array of TDoubleMatrix;
TAdamState = record
M, V: TDoubleMatrix;
Beta1, Beta2: Double;
Timestep: Integer;
end;
TAdamVectorState = record
M, V: TDoubleArray;
Beta1, Beta2: Double;
Timestep: Integer;
end;
procedure LoadData(const filename: String; var data: TDoubleMatrix);
procedure NormalizeData(var data: TDoubleMatrix);
procedure AddPolynomialFeatures(var data: TDoubleMatrix; degree: Integer);
procedure PrintMatrix(const matrix: TDoubleMatrix; maxRows: Integer = 10; maxCols: Integer = 10; precision: Integer = 4);
function ClipMatrix(const m: TDoubleMatrix; minVal, maxVal: Double): TDoubleMatrix;
function ClipVector(const v: TDoubleArray; minVal, maxVal: Double): TDoubleArray;
function CopyMatrix(const m: TDoubleMatrix): TDoubleMatrix;
function CopyArray(const a: TDoubleArray): TDoubleArray;
implementation
procedure AddPolynomialFeatures(var data: TDoubleMatrix; degree: Integer);
var
i, j, k, originalCols: Integer;
begin
if Length(data) = 0 then
raise Exception.Create('Data is empty');
originalCols := Length(data[0]);
for i := 0 to High(data) do
begin
for j := 2 to degree do
begin
for k := 0 to originalCols - 1 do
begin
SetLength(data[i], Length(data[i]) + 1);
data[i][High(data[i])] := Power(data[i][k], j);
end;
end;
end;
end;
procedure LoadData(const filename: String; var data: TDoubleMatrix);
var
fileStream: TFileStream;
reader: TStreamReader;
line: String;
i, j, validCols: Integer;
values: TStringArray;
value: Double;
isHeader: Boolean;
begin
if not FileExists(filename) then
raise Exception.Create('File not found: ' + filename);
fileStream := TFileStream.Create(filename, fmOpenRead);
try
reader := TStreamReader.Create(fileStream);
try
i := 0;
isHeader := True; // Предполагаем, что первая строка - заголовок
while not reader.Eof do
begin
line := reader.ReadLine;
values := SplitString(line, ',');
// Пропускаем пустые строки
if Length(values) = 0 then Continue;
// Пропускаем строку заголовка
if isHeader then
begin
isHeader := False;
Continue;
end;
SetLength(data, i + 1);
validCols := 0;
for j := 0 to High(values) do
begin
// Пытаемся преобразовать в число, пропускаем если не удаётся
if TryStrToFloat(values[j], value) then
begin
if validCols >= Length(data[i]) then
SetLength(data[i], validCols + 1);
data[i][validCols] := value;
Inc(validCols);
end;
end;
Inc(i);
end;
finally
reader.Free;
end;
finally
fileStream.Free;
end;
end;
procedure NormalizeData(var data: TDoubleMatrix);
var
i, j: Integer;
minVal, maxVal, range: Double;
begin
if Length(data) = 0 then
raise Exception.Create('Data is empty');
for j := 0 to High(data[0]) do
begin
minVal := data[0][j];
maxVal := data[0][j];
// Находим min и max в столбце
for i := 0 to High(data) do
begin
if data[i][j] < minVal then minVal := data[i][j];
if data[i][j] > maxVal then maxVal := data[i][j];
end;
// Нормализуем с проверкой деления на ноль
range := maxVal - minVal;
if range = 0 then
begin
// Если все значения одинаковые, устанавливаем в 0.5 или оставляем как есть
for i := 0 to High(data) do
data[i][j] := 0.5; // или data[i][j] := data[i][j] - minVal;
end
else
begin
for i := 0 to High(data) do
data[i][j] := (data[i][j] - minVal) / range;
end;
end;
end;
procedure PrintMatrix(const matrix: TDoubleMatrix; maxRows: Integer = 10; maxCols: Integer = 10; precision: Integer = 4);
var
i, j, displayedRows, displayedCols: Integer;
rowStr: string;
begin
if Length(matrix) = 0 then
begin
WriteLn('Matrix is empty');
Exit;
end;
// Определяем сколько строк и столбцов будем выводить
displayedRows := Min(maxRows, Length(matrix));
displayedCols := Min(maxCols, Length(matrix[0]));
WriteLn('Matrix [', Length(matrix), 'x', Length(matrix[0]), ']:');
for i := 0 to displayedRows - 1 do
begin
rowStr := '';
for j := 0 to displayedCols - 1 do
begin
// Форматируем число с заданной точностью
rowStr := rowStr + Format('%.' + IntToStr(precision) + 'f', [matrix[i][j]]) + ' ';
end;
// Добавляем многоточие, если не все столбцы показаны
if displayedCols < Length(matrix[0]) then
rowStr := rowStr + '...';
WriteLn(rowStr);
end;
// Добавляем многоточие, если не все строки показаны
if displayedRows < Length(matrix) then
WriteLn('... (', Length(matrix) - displayedRows, ' more rows)');
end;
function ClipMatrix(const m: TDoubleMatrix; minVal, maxVal: Double): TDoubleMatrix;
var
i, j: Integer;
begin
SetLength(Result, Length(m));
for i := 0 to High(m) do
begin
SetLength(Result[i], Length(m[i]));
for j := 0 to High(m[i]) do
Result[i][j] := Max(minVal, Min(maxVal, m[i][j]));
end;
end;
function ClipVector(const v: TDoubleArray; minVal, maxVal: Double): TDoubleArray;
var
i: Integer;
begin
SetLength(Result, Length(v));
for i := 0 to High(v) do
Result[i] := Max(minVal, Min(maxVal, v[i]));
end;
function CopyMatrix(const m: TDoubleMatrix): TDoubleMatrix;
var
i: Integer;
begin
SetLength(Result, Length(m));
for i := 0 to High(m) do
Result[i] := Copy(m[i]);
end;
function CopyArray(const a: TDoubleArray): TDoubleArray;
begin
Result := Copy(a);
end;
end.
Makefile
- Код: Выделить всё
all:
fpc -gl -B -CX -XX -O3 -CfSSE64 NeuralTicTacToe.pas
clean:
rm -f NeuralTicTacToe *.ppu *.o
