freepascal.ru

Крестики-нолики. В качестве противника не алгоритм, а нейросеть, ИИ. Обучается у противника, то есть у игрока и с каждой партией играет сильнее.

Код: Выделить всё

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


Штука интересная, но, увы, не слишком полезная... Интересно, можно ли похожим образом (то есть сравнительно простым, без привлечения «тяжелой артиллерии» полноценных LLM) сделать, например, «нечеткий поиск» в списке строк или обработку результатов, полученных с Гугла и других поисковиков, или сортировку картинок по «степени похожести» на образец и т. д.