Приложение 1. Компьютерное моделирование нейросетей

PROGRAM PERC;

(* P E R C  -  Учебная программа, реализующая однослойный
               PERCEPTRON.

               ДАТА:  26 октября 1994 г.
               АВТОР: С.А.Терехов (email: sta@ch70.chel.su)
*)

CONST
    CMaxInp     = 20;       (* Максимальное число входов *)
    CMaxOut     = 10;       (* Максимальное число выходов *)
    CMaxImages  = 200;      (* Максимальное число образов *)
    CEta        = 0.75;     (* Темп обучения *)
    CError      = 5.0e-3;   (* Граница требуемой ошибки *)
    CCounter    = 1000;     (* Максимальное число итераций *)
    CInitWeight = 5.0;      (* Максимальное начальное значение
                               случайных синаптических весов *)
    CBiasNeuron = 1.0;      (* Активность нейрона-порога *)

TYPE
    TMatrix     = ARRAY[0..CMaxInp,1..CMaxOut] OF REAL;
                    (* Нулевой столбец содержит значения порогов *)
    TInpVector  = ARRAY[1..CMaxInp] OF REAL;
    TOutVector  = ARRAY[1..CMaxOut] OF REAL;

    (* Структура сети *)
    TPerceptron = RECORD   
        NInp : INTEGER;     (* Число входов *)
        NOut : INTEGER;     (* Число выходов *)
        Inp  : TInpVector;  (* Текущий вектор входов *)
        Out  : TOutVector;  (* Текущий вектор выходов *)
        W    : Tmatrix;     (* Матрица связей *)
    END;

    (* Запись в базе данных - обучающей выборке *)
    TBaseRecord = RECORD
        X    : TInpVector;
        Y    : TOutVector;
    END;

    (* Структура базы данных *)   
    TBase = RECORD
        NImages : INTEGER;  (* Число обучающих образов *)
        Images  : ARRAY[1..CMaxImages] OF TBaseRecord;
    END;

VAR
    VNet                  : TPerceptron;
    VBase                 : TBase;
    VOK                   : BOOLEAN;
    VError, VTemp, VDelta : REAL;
    VCounter, Vi, Vj, Vk  : INTEGER;
    VFile                 : FILE OF TPerceptron;

PROCEDURE InitAll;
(* Инициализация нейронной сети с 10 входами и одним выходом,
   задание начальных случайных значений матрицы связей *)
VAR
    Li, Lj, Lk : INTEGER;
BEGIN
    WITH VNet, VBase DO
    BEGIN
        NInp := 10;
        NOut := 1;
        FOR Li := 0 TO NInp DO
            FOR Lj := 1 TO NOut DO
                 W[Li,Lj] := CInitWeight*(RANDOM-0.5);
    END;
    VOK := TRUE;
END;

PROCEDURE GetDataBase;
(* Генерация обучающей выборки из 200 случайных образов.
   При определении правильного числа единиц используется прямой
   подстчет *)
VAR
    Li, Lj, Lk : INTEGER;
BEGIN
    VOK := TRUE;
    WITH VBase, VNet DO
    BEGIN
        NImages := 200;
        FOR Li:= 1 TO NImages DO
        BEGIN
            Lk := 0;
            FOR Lj:=1 TO NInp DO
            BEGIN
                (* Случайно 0 или 1 *)
                Images[Li].X[Lj] := RANDOM( 2 );
                (* Подсчет единиц *)
                IF ( Images[Li].X[Lj] > 0 )
                    THEN Lk := Lk + 1;
            END;
            (* Выход равен единице, если в данном входном векторе
               число единиц больше числа нулей *)
            IF ( Lk > (NInp-Lk) )
                THEN Images[Li].Y[1] := 1
                ELSE Images[Li].Y[1] := 0
        END;
    END;
END;

PROCEDURE SaveNet;
(* Запись параметров нейронной сети в файл SAMPLE.DAT.
   Производится контроль за операциями вывода с использованием
   ключа I+ и I- компилятора ТУРБО ПАСКАЛЯ *)
BEGIN
    ASSIGN( VFile, 'SAMPLE.DAT' );
    {$I-}
    REWRITE( VFile );
    {$I+}
    VOK := (IOResult = 0);

    IF VOK THEN
    BEGIN
        {$I-}
        WRITE( VFile, VNet );
        CLOSE ( VFile );
        {$I+}
        VOK := (IOResult = 0);
    END;
END;

FUNCTION Sigmoid( Z: REAL ): REAL;
(* Сигмоидальная переходная функция нейрона *)
BEGIN
   Sigmoid := 1.0/(1.0+EXP(-Z));
END;

(* Основная программа *)
BEGIN
    WRITELN('<< P E R C E P T R O N >> (Нейроимитатор) ');

WRITELN('----------------------------------------- ');
    VOK := TRUE;
    (* Инициализация с контролем ошибки *)
    RANDOMIZE;
    InitAll;
    IF (NOT VOK) THEN
    BEGIN
        WRITELN('Ошибка инициализации');
        HALT;
    END;

    (* Генерация базы данных *)
    VOK := TRUE;
    GetDataBase;
    IF (NOT VOK) THEN
    BEGIN
        WRITELN('Ошибка при генерации базы данных');
        HALT;
    END;

    (* Цикл обучения *)
    VOK := TRUE;
    VCounter := 0;
    WITH VNet, VBase DO
        REPEAT
            VError := 0.0;
            (* Цикл по обучающей выборке *)
            FOR Vi := 1 TO NImages DO
            BEGIN
                (* Подача очередного образа на входы сети *)
                FOR Vj := 1 TO NInp DO
                BEGIN
                    Inp[Vj] := Images[Vi].X[Vj];
                END;

                (* Цикл по нейронам. При аппаратной реализации
                   будет выполняться параллельно !!! *)
                FOR Vk := 1 TO NOut DO
                BEGIN
                    (* Состояние очередного нейрона *)
                    VTemp := CBiasNeuron*W[0,Vk];
                    FOR Vj := 1 TO NInp DO
                    BEGIN
                        VTemp := VTemp +
                            Inp[Vj]*W[Vj,Vk];
                    END;
                    Out[Vk] := Sigmoid( VTemp );

                    (* Накопление ошибки *)
                    VDelta := Images[Vi].Y[Vk]-Out[Vk];
                    VError := VError + 0.5*SQR( VDelta );

                    (* Обучение по дельта-правилу Розенблатта *)
                    W[0,Vk] := W[0,Vk] +
                        CEta*CBiasNeuron*VDelta;
                    FOR Vj := 1 TO NInp DO
                    BEGIN
                        W[Vj,Vk] := W[Vj,Vk] +
                            CEta*Inp[Vj]*VDelta;
                    END;
                END;
            END;
            VCounter := VCounter + 1;
        UNTIL ( (VCounter >= CCounter) OR
                (VError <= CError) );
        (* Цикл завершен при достижении максимального числа
           итераций или минимально достаточной ошибки *)

    WRITELN( 'Выполнено ', VCounter, ' итераций');
    WRITELN( 'Ошибка обучения ', VError );

    (* Сохранение результатов обучения на диске *)
    SaveNet;
    IF (NOT VOK) THEN
    BEGIN
        WRITELN('Ошибка при записи на диск');
        HALT;
    END;

    WRITE('Нейронная сеть обучена, параметры');
    WRITELN(' записаны в файл SAMPLE.DAT');
END.

Результат работы программы PERC
<< P E R C E P T R O N >> (Нейроимитатор) 
----------------------------------------- 
Выполнено 243 итераций 
Ошибка обучения  4.9997994218E-03
Нейронная сеть обучена, параметры записаны в файл
SAMPLE.DAT

Текст программы TEST.
PROGRAM TEST;

(* T E S T - Тестирующая программа для
нейроимитатора PERC *)

CONST
    CMaxInp     = 20;
    CMaxOut     = 10;
    CMaxImages  = 15;
    CBiasNeuron = 1.0;

TYPE
    TMatrix     = ARRAY[0..CMaxInp,1..CMaxOut] OF REAL;
    TInpVector  = ARRAY[1..CMaxInp] OF REAL;
    TOutVector  = ARRAY[1..CMaxOut] OF REAL;
    TPerceptron = RECORD
        NInp : INTEGER;
        NOut : INTEGER;
        Inp  : TInpVector;
        Out  : TOutVector;
        W    : TMatrix;
    END;

VAR
    VNet        : TPerceptron;
    VTemp       : REAL;
    VCorrect    : REAL;
    Vi, Vj, Vk  : INTEGER;
    VOK         : BOOLEAN;
    VFile       : FILE OF TPerceptron;

PROCEDURE LoadNet;
(* Чтение параметров нейронной сети из файла SAMPLE.DAT.
   Производится контроль за операциями ввода с использованием
   ключа I+ и I- компилятора ТУРБО ПАСКАЛЯ *)

BEGIN
    ASSIGN( VFile, 'SAMPLE.DAT' );
    {$I-}
    RESET( VFile );
    {$I+}
    VOK := (IOResult = 0);

    IF VOK THEN
    BEGIN
        {$I-}
        READ( VFile, VNet );
        CLOSE ( VFile );
        {$I+}
        VOK := (IOResult = 0);
    END;
END;

FUNCTION Sigmoid( Z: REAL ): REAL;
BEGIN
   Sigmoid := 1.0/(1.0+EXP(-Z));
END;

BEGIN
    VOK := TRUE;
    RANDOMIZE;
    (* Чтение параметров обученной нейросети *)
    LoadNet;
    IF (NOT VOK) THEN
    BEGIN
        WRITELN('Ошибка при чтении файла');
        HALT;
    END;
    VOK := TRUE;
    WITH VNet DO
    BEGIN
        WRITELN('<<P E R C E P T R O N>> (Тестирующая программа)');
        WRITELN('-----------------------------------------------');
        WRITELN(' ВОПРОС                 ОТВЕТ  ВЕРНЫЙ ОТВЕТ  ');
        WRITELN('-----------------------------------------------');
        FOR Vi := 1 TO CMaxImages DO
        BEGIN
            (* Подача на вход случайного образа *)
            Vk := 0;
            FOR Vj:=1 TO NInp DO
            BEGIN
                (* Случайно 0 или 1 *)
                Inp[Vj] := RANDOM( 2 );
                (* Подсчет единиц *)
                IF ( Inp[Vj] > 0 )
                THEN Vk := Vk + 1;
            END;
            (* Правильный ответ известен ! *)
            IF ( Vk > (NInp-Vk) )
            THEN VCorrect := 1.0
            ELSE VCorrect := 0.0;
            (* Ответ выдает нейросеть *)
            FOR Vk := 1 TO NOut DO
            BEGIN
                VTemp := CBiasNeuron*W[0,Vk];
                FOR Vj := 1 TO NInp DO
                BEGIN
                    VTemp := VTemp +
                         Inp[Vj]*W[Vj,Vk];
                END;
                Out[Vk] := Sigmoid( VTemp );
            END;
            (* Выдача результатов *)
            FOR Vj := 1 TO NInp DO
                WRITE( Inp[Vj]:2:0 );
            WRITELN('    ',Out[1]:4:2,'    ', VCorrect:2:0);
        END;
    END;
    WRITELN('-------------------------------------------------');
END.

Результат работы программы TEST.

<<P E R C E P T R O N>> (Тестирующая программа)
-----------------------------------------------
 ВОПРОС                 ОТВЕТ    ВЕРНЫЙ ОТВЕТ
-----------------------------------------------
 0 0 0 0 1 1 1 1 0 0    0.00     0
 0 0 1 0 0 0 0 1 0 1    0.00     0
 1 1 0 0 0 0 0 1 0 0    0.00     0
 1 1 1 1 0 1 0 1 1 1    1.00     1
 0 1 1 1 0 1 1 0 0 0    0.01     0
 1 0 1 0 1 0 1 1 1 0    0.99     1
 1 0 1 1 1 0 0 1 1 0    0.98     1
 1 0 1 1 1 1 0 0 1 1    1.00     1
 1 1 0 1 1 1 1 0 1 0    1.00     1
 1 1 0 1 1 1 0 0 0 1    1.00     1
 0 0 0 0 1 1 0 1 0 1    0.00     0
 1 0 0 1 0 0 0 0 0 1    0.00     0
 1 0 0 1 0 0 0 1 1 0    0.00     0
 0 1 0 1 1 1 0 1 0 0    0.02     0
 1 1 1 1 1 1 0 1 1 0    1.00     1
--------------------------------------------