Искусственные нейронные сети

Близость - критичная сторона алгоритма обучения Кохонена. Обновляя, в дополнение к выигравшим, окружающие элементы алгоритм обучения Кохонена аккумулирует зависимые данные в одной области топологической карты. Во время обучения размер этой области прогрессивно уменьшается, одновременно уменьшается и скорость обучения. Таким образом, сначала проводится прикидка (кластеры с большим количеством элементов, реагируют на похожие обучающие образцы), а затем осуществляется более точная деталировка (отдельные элементы в кластере реагируют на обучающие образцы).

В сети Кохонена ошибкой считается расстояние между вектором весов выигравшего элемента и входным вектором.

5. Создание сети Кохонена

Создайте сеть Кохонена, состоящую из 2 слоев (входного и слоя топологической карты). Это можно сделать в окне Создание ИНС (Network Creation) (рис. 1), которое вызывается с помощью команды меню Файл/Создать/Сеть (File/New/Network).

Для представления двухмерного выходного слоя в системе Trajan задается кроме количества элементов в слое (Units) еще и ширина слоя (Width): система определяет высоту слоя как отношение общего числа элементов выходного слоя к ширине слоя.

Замечание

Для любого слоя любого типа сети можно задавать параметр width. Однако принципиальное значение этот параметр имеет только для сети Кохонена. В остальных сетях это только изменит отображение сети на экране.

Задайте следующие значения:

первый слой - Units - 4, Width - 1;

второй слой - Units - 16, Width - 4.

Нажмите кнопку Создать/Create.

Структура созданной сети Кохонена приведена на рис. 2.

6. Обучение сети Кохонена

Сети Кохонена, в отличие от остальных нейронных сетей, используются особым образом, и у системы Trajan есть все возможности для работы с ними:

Окно Частоты побед (Win Frequencies) для иллюстрации, где в сети сформировались кластеры;

Окно Топологическая карта (Topological мар) для иллюстрации, какой образец отнесен к какому кластеру. Это окно поможет Вам заранее задать имена элементам и образцам.

Загрузите обучающую последовательность. Откройте меню Файл/Открыть/Образец (File/Open/Pattern) и выберите необходимый вам файл в появившемся окне.

Необходимо отметить, что обычно образцы последовательности для сети Кохонена характеризуются только входными значениями признаков. Решения учителя для них нейзвестны.

Окно обучения Кохонена (Kohonen Training) (рис. 3) (команда меню Обучение/ Kohonen (Train/Kohonen)) включает начальные и конечные параметры для скорости обучения (коэффициента корреляции) и для размера области близости (соседства). Обычно обучение Кохонена разбивают на две части - фаза прикидки и фаза подстройки.

Скорость обучения/Learning Rate

Скорость обучения в алгоритме Кохонена линейно изменяется от первого цикла обучения до последнего.

Обычно алгоритм обучения запускают в две стадии.

На первой стадии используют изначально высокую скорость обучения (например, от 0.9 до 0.1), большой размер окрестности (например, от 2 до 1) и небольшое число циклов (например, 100).

На второй стадии используют неизменные скорость обучения (например, 0.01), небольшой размер окрестности (например, 0) и большое число циклов (например, 10000).

Окрестность

Это значение определяет количество рассматриваемых соседних элементов (нейронов) вокруг выигравшего элемента. Например, при размере окрестности равном 2, число элементов - 55.

Реинициализация/Reinitialise

При работе алгоритма Кохонена нажатие кнопки Реинициализация/Reinitialise изменяет только выходной слой радиальных элементов.

В нашем примере вполне достаточно провести два запуска сети по 50 циклов (эпох) в каждом.

При первом запуске уменьшите Скорость обучения/Learning Rate от начального значения 0.5 до конечного 0.1 и оставьте постоянным размер Окрестности/Neighbourhood - 1.

При втором запуске установите постоянную Скорость обучения/Learning Rate 0.1 при размере Окрестности/Neighbourhood - 0.

График ошибки обучения

Как и в случае работы алгоритма обратного распространения ошибки средняя квадратичная ошибка сети изображается на Графике ошибки (рис.5). Однако в данном случае она имеет совершенно другой смысл.

При работе алгоритма обратного распространения ошибка определятся через расстояние между решениями учителя и нейросети. На графике отображается полная выходная ошибка по всем образцам.

Алгоритм сетей Кохонена определяет ошибку как расстояние между входным вектором и вектором выигравшего элемента выходного слоя. На графике показывается общая входная ошибка по всем образцам.

На рис. 4 приведена диаграмма ошибок для отдельных образцов, а на рис. 5 - изменение средней квадратичной ошибки по всем образцам.

Как только сеть обучена, вы можете изучить ее и определить где сформировались кластеры и чему они соответствуют. В нашем случае анализ сети провести достаточно легко, поскольку мы изначально знали какими должны быть результаты работы сети, что не типично для случаев использования сетей Кохонена.

7. Работа с сетью Кохонена.

Окна Частоты побед (Win Frequencies) и Топологическая карта (Topological Map) дают возможность анализировать сеть Кохонена и осуществлять кластеризацию с помощью сети.

Частоты побед

Откройте окно Частоты побед (Win Frequencies) (рис. 6), вызвав его командой меню Статистика/Частоты побед (Statistics/Win Frequencies). В этом режиме система прогоняет все входные образцы и подсчитывает, сколько раз каждый элемент топологического слоя выигрывает (т.е. находится ближе всего к проверяемому образцу). Высокое число побед показывает центры кластеров на топологической карте.

Элементы с нулевыми частотами побед вообще не используются, и их наличие обычно показывает, что обучение прошло не очень успешно (т.к. сеть использует не все предоставленные ей ресурсы). Однако в данном случае, из-за небольшого количества входных образцов допустимо наличие неиспользованных элементов.

Частоты побед (Win Frequencies) показываются отдельно для обучающих и проверочных образцов (разделены толстой горизонтальной линией). Если расположение кластеров значительно отличается в этих двух половинах, это показывает, что сеть не научилась правильно обобщать данные. В нашем примере это не важно, т.к. обучающая последовательность очень мала для самообучения.

Топологическая карта

Как только распределение центров кластеров определено, можно открыть окно Topological Map (Топологическая карта) и просмотреть сеть с целью идентификации кластеров (рис.7).

Топологическая карта (Topological Map) отображает выходной слой графически в двумерном пространстве. Для каждого элемента топологического слоя отображается его близость к текущему образцу с помощью черного квадрата (чем больше квадрат, тем ближе), и выигравший элемент обведен тонким прямоугольником.

Если проверить несколько образцов (самое удобное нажимать стрелку вверх справа от поля Образец (Pattern)), можно заметить, что похожие образцы объединены в группы, и близкие элементы расположены рядом друг с другом.

На этом этапе можно начинать именовать элементы (давать осмысленные имена) для того, чтобы показать их принадлежность к кластеру.

В нашем примере первые десять образцов относились к виду Setosa.

Выполните (Run) первый образец, затем дайте имя выигравшему элементу: введите название Setosa в поле имени элемента (Модуля) (справа от поля номера элемента), и нажмите RETURN. Топологическая карта (Topological Map) автоматически обновится и отобразит новое имя.

Прогоните остальные девять образцов (нажимая стрелка вверх справа от поля образца), и назовите их выигравшие элементы точно также.

Замечание

Чтобы не набирать на клавиатуре одно и тоже имя каждый раз, просто скопируйте его в буфер (выделите и нажмите CTRL+INSERT), а затем вставляйте в нужное место путем нажатия SHIFT+INSERT. Также можно не нажимать RETURN после каждого имени. Когда вы нажимаете стрелку вверх Топологическая карта автоматически обновляется.

Дайте названия всем элементам. Образцы 11-20 относятся к виду Versicolour, образцы 21-30 к виду Virginica.

Вы можете обнаружить элемнты, выигравшие в обоих этих видах, отметьте их как Dubious.

Когда вы проверите все образцы обучающей последовательности, отметьте оставшиеся (неизвестные) элементы как Неиспользованные. Или запустите вновь все образцы и посмотрите какому типу образцов неиспользованные элементы отвечают сильнее всего. Дайте им соответствующее название.

Как только все элементы поименованы, можно посмотреть, как сеть Кохонена классифицировала проверочные образцы.

Если Вы используете сеть Кохонена и не знаете заранее, какие должны быть кластеры (что является обычным случаем применения сети Кохонена), поступите следующим образом: просто дайте полученным кластерам символические имена, а затем посмотрите входные данные и определите значение кластеров. Для этого у системы есть возможность прямо в окне топологической карты (Topological Map) давать имена образцам.

Проведите следующие действия:

Обучите сеть Кохонена;

Используйте окно частоты побед (Win Frequencies), чтобы определить кластеры на топологической карте (Topological Map);

Назовите кластеры символическими именами (например C1, C2, и т.д.);

Прогоните образцы на топологической карте (Topological Map) и присвойте образцам имена соответствующих кластеров;

Исследуйте входные данные (возможно их источник) и определите, что представляет собой каждый кластер;

Поменяйте символические имена на смысловые.

Прогоните образцы еще раз и дайте им новые имена в зависимости от выигравшего элемента.

8. Задание

Ознакомьтесь с описанием лабораторной работы.

Следуя рекомендациям пункта 5, создайте новую сеть Кохонена.

Загрузите файл smallir.pat (он был создан вами во время выполнения лабораторной работы №2). При выполнении данной лабораторной работы рекомендуется иметь листинг этого файла, файла iris.pat, а также отчет по лабораторной работе №2. Это поможет вам более наглядно проанализировать работу сети, полученные кластеры и проверить значения кластеров. Хотя, напоминаем еще раз, при решении задачи кластеризации априорные значения кластеров и принадлежность им элементов обычно неизвестны.

Следуя инструкциям пункта 6 обучите сеть. Продемонстрируйте преподавателю структуру сети, график ошибки обучения, окно Частоты побед. Объясните полученные результаты.

Откройте окно Топологическая карта. Выполните анализ кластеров, дайте имена кластерам и образцам, как описано в пункте 7. Сохраните результаты.

Проведите реинициализацию сети. Обучите сеть заново. Просмотрите полученные результаты. Изменилось ли что-либо? Почему?

Проведите обучение сети, задавая другие значения скорости обучения, размера окрестности. Проведите анализ полученных кластеров. Как повлияло изменение этих параметров на результаты работы?

Протестируйте на обученной сети другую последовательность образцов (файл iris.pat, или другая сокращенная последовательность из этого файла). Сделайте выводы.

Представьте в качестве отчета листинги файлов образцов, обученных сетей, графики ошибки обучеия, результаты частот побед и топологические карты с именами элементов по всем проведенным экспериментам.

9. Контрольные вопросы

Для решения каких задач применяются самоорганизующиеся карты Кохонена?

Каков смысл параметров, передаваемых функции обучения Кохонена?

Что такое топологическая карта? Опишите возможности ее использования в системе Trajan.

Каким образом можно оценить качество обучения SOM средствами системы Trajan?

Приложение 2

Вопросы контролирующего курса

Вопросы обучающего курса представлены в следующем формате:

Вопрос

Правильный ответ

Неправильный ответ 1

Неправильный ответ 2

При проведении тестирования ответы перемешиваются.

Список вопросов:

Для обучения сетей Кохонена используется

обучение без учителя

обучение с учителем

смешанное обучение

Самоорганизующиеся карты это название

сетей Кохонена

скрытого слоя RBF-сетей

сетей, способных к обучению без учителя

Какое количество слоев имеют сети Кохонена?

всегда 2 слоя

1-3 слоя

любое, в зависимости от решаемой задачи

Какой нейрон называется нейроном-"победителем"?

тот, для которого значение функции близости максимально

тот, для которого значение функции близости минимально

нейрон, определяющий класс с максимальным числом образов

Проводится ли коррекция весовых векторов на стадии самообучения сети Кохонена?

да, нейрона-"победителя" и остальных активных нейронов слоя Кохонена

да, только нейрона-"победителя"

нет

Основное назначение сетей радиальных базисных функций

аппроксимация многомерных функций

решение задач автоматической классификации

прогнозирование

Сколько слоев имеют RBF-сети?

3

2

в зависимости от решаемой задачи

Радиальные базисные функции вычисляются

в скрытом слое RBF-сети

в выходном слое RBF-сети

перед подачей образов во входном слое RBF-сети

Для чего вводится параметр "лямбда" в RBF-сетях?

для определения весовых коэффициентов при наличии шума во входных данных

для вычисления опорных точек

для предварительной обработки входных векторов

При решении задачи аппроксимации функций необходимо

минимизировать суммарную ошибку по всем опорным точкам

чтобы искомая функция f проходила через все опорные точки

чтобы искомая функция f проходила через все точки обучающей последовательности

Когда достигается лучшее решение задачи аппроксимации при использовании вариационного исчисления?

когда функционал минимален

когда функционал максимален

только когда функционал равен нулю

Когда необходимо введение полинома в аппроксимирующую функцию?

при использовании некоторых центральных функций, кроме функции Гаусса

всегда

только для функции Гаусса

Алгоритм обратного распространения относится к методу обучения

с учителем

без учителя

смешанному

Сколько слоев может содержать персептрон?

От 1 до бесконечности

Всегда 3

Менее двух

Чем определяется принадлежность нейрона к классу входных, выходных или скрытых нейронов?

Тип нейрона задается явно

Принадлежность определяется положением нейрона в сети

Принадлежность определяется номером

На что влияет коэффициент корреляции?

На скорость обучения и сходимость

На топологию обученной сети

На способность сети отсекать глобальные минимумы из дерева решений

Как связаны нейроны в многослойных персептронах?

нейроны одного слоя только с нейронами прилегающих слоев без рекуррентных связей

нейроны одного слоя с нейронами прилегающих слоев с обратными связями

все со всеми

В алгоритме обратного распространения обратно передается

ошибка между желаемым и реальным выходным значением каждого нейрона выходного слоя

ошибка между входным значением нейрона входного слоя и выходным значением нейрона выходного слоя

весовой вектор нейрона выходного слоя

Алгоритм Дельта-правило использует

производную функции ошибки

производную взвешенной суммы весов выходного слоя

сигмоидную функцию ошибки

Что такое емкость нейронной сети?

число образов, которые она способна научиться распознавать

число нейронов в сети

число нейронов в выходном слое сети

RPROP-алгоритм основан на использовании

значения знака градиента

значения градиента

добавления момента

В чем состоит цель обучения репликативной нейронной сети

чтобы вектор, воспроизводимый выходным слоем сети, совпадал с вектором, поданным на входной слой

чтобы вектор, воспроизводимый выходным слоем сети, совпадал с ожидаемым выходным вектором

чтобы вектор, воспроизводимый выходным слоем сети представлял входную информацию в сокращенном виде

Как называется в генетическом алгоритме обмен частями двух индивидов?

рекомбинация

мутация

селекция

В каком случае не используется генетический алгоритм?

оптимизация объема обучающей последовательности

оптимизация весовой матрицы

оптимизация топологии сети

В чем состоит задача классификации образов?

В указании принадлежности входного образа одному или нескольким предварительно определенным учителем классам

В исследовании свойств данных, извлечения и сжатия информации

В автоматическом распределении образов по множеству классов, в зависимости от схожести их входных аттрибутов

По архитектуре связей ИНС могут быть сгруппированы в два класса:

сети прямого распространения информации и сети с обратными связями

сети с обратными связями и реккурентные сети

рекуррентные сети и динамические сети

Приложение 4

Листинг контролирующей программы

cgi_res.pas

{$N+}program cgi_res;uses SysUtils;const INPUTS = 12; HIDDEN1 = 12; OUTPUTS = 4; HIDDEN1_INDEX = INPUTS; OUTPUT_INDEX = HIDDEN1_INDEX+HIDDEN1; NUMNEURONS = INPUTS+HIDDEN1+OUTPUTS;var NEURON:array[0..NUMNEURONS-1]of double;

ans:array[1..INPUTS]of string[1];

h:array[1..INPUTS]of string[3];

check_in:array[0..INPUTS-1]of double;

check_out:array[0..OUTPUTS-1]of double;

st,in_str,fio,grp:string;

i,max:byte;

(* Weight arrays *)

const W_In_H1:array[0..HIDDEN1-1,0..INPUTS+1-1]of double = (

(0.109022, -0.0539257, -0.368034, -0.471941, -0.14011, 2.33927, -0.909139,

-0.322244, -1.40411, -0.195163, -0.184279, -0.124136, 0.314774),

(-0.715285, -1.01007, -0.896435, -1.04527, -0.986676, -0.492673, -1.27935,

-0.760259, -0.83849, -0.470172, -0.635299, -0.722786, 1.68905),

(0.781771, 0.585087, 0.698981, 0.0769728, 0.849104, 1.3434, 0.677218,

0.16054, -2.58012, -0.126845, -0.0477314, -0.0215265, -0.341294),

(-0.115014, -0.299009, -0.386707, -0.00167638, 0.00157645, -0.568074, -0.0401864,

-0.175029, 0.050284, 0.00745735, 0.0164164, -0.313791, 0.516574),

(1.69567, -0.00457102, -0.0258746, -2.53526, -0.0675847, 2.03239, -0.611646,

0.11374, 0.326477, 3.3361, -0.307153, -0.0233276, -0.101178),

(0.323127, 0.453094, 1.43307, -1.17937, -1.30469, -0.739903, -1.17307,

-0.0469102, 1.16848, -2.81881, 0.203912, -1.46856, 0.127351),

(-0.168771, -0.052278, -0.0937404, 0.138683, -0.394373, -0.0080455, -0.665677,

-0.0575857, -0.390231, -0.077412, 0.133436, -0.0252823, 0.147023),

(-0.562288, -2.02446, -6.6931, -0.218433, -0.0113713, 0.724795, 0.0589764,

-0.530525, 0.0380381, 1.67573, -1.0224, -1.14925, 0.438447),

(0.698312, -0.0160047, 1.53373, -1.44304, -0.4157, 2.64013, -0.818845,

0.862477, 5.69266, -0.957385, -0.0989055, -0.580727, -0.00278491),

(-1.52924, 0.347028, -0.242113, 0.252351, 0.798555, -0.280498, 0.53143,

0.597981, 4.06578, 0.815546, 1.94425, -0.444688, -0.0898223),

(-0.0374775, -0.471714, -0.0143863, -0.27478, -0.0654873, -0.163415, -0.0978362,

-0.384747, 0.0309396, -0.00209866, -0.243247, -0.470842, 0.498723),

(-0.0497225, -0.0284349, 0.0242167, -2.14155, -0.00824269, -0.0183397, 0.103547,

0.0900314, 0.0350896, -0.0246594, -1.62929, 0.108472, 0.211198)

);

const W_H1_Out:array[0..OUTPUTS-1,0..HIDDEN1+1-1]of double = (

(-0.0417788, 12.4763, -0.0492676, -0.692518, 0.170335, -0.956991, -0.0457157,

-0.853115, 0.0116715, -2.03634, -0.505628, -0.0066435, -0.0376796),

(-2.29736, -22.4874, 0.600889, 1.61897, -0.813111, 8.56052, 0.00762325, 8.00798,

-2.84516, 0.0328812, 2.55626, 1.1535, -0.0463112),

(10.4161, -12.1323, -6.40036, 5.11533, -0.111914, -10.3867, 0.0734312, -11.4413,

-0.0479404, -0.0105011, 2.59167, 2.88688, -0.0289983),

(-5.28685, 0.0179245, 3.75147, -2.29328, 1.07041, 3.82189, -7.86089, -4.68059,

1.79581, 0.82398, -9.13616, -4.97627, 0.219971)

);

(* Nonlinearity functions *)

function sigmoid(x:double):double;

begin

sigmoid:=1.0/(1.0+exp(-x));

end;

(* Compute the network response

* Arguments:

* inpts (double) array containing the input values

* outpts (double) array which receives the results

*)

procedure eval_net(var inpts,outpts:array of double);

var i,j:integer;

begin

{ /* Zero neuron sums */}

for i:=0 to NUMNEURONS-1 do NEURON[i] := 0.0;

{ /* Apply inpts */}

for i:=0 to INPUTS-1 do NEURON[i] := inpts[i];

{ /* Compute hidden layer #1 */}

for i:=0 to HIDDEN1-1 do

begin

for j:=0 to INPUTS-1 do

begin

NEURON[HIDDEN1_INDEX + i]:=NEURON[HIDDEN1_INDEX + i]+

NEURON[j]*W_In_H1[i][j];

end;

NEURON[HIDDEN1_INDEX + i]:=NEURON[HIDDEN1_INDEX + i] +W_In_H1[i][INPUTS];

NEURON[HIDDEN1_INDEX + i]:= sigmoid( NEURON[HIDDEN1_INDEX + i] );

end;

{ /* Compute network outputs */}

for i:=0 to OUTPUTS-1 do

begin

for j:=0 to HIDDEN1-1 do

begin

NEURON[OUTPUT_INDEX + i] :=NEURON[OUTPUT_INDEX + i] +NEURON[HIDDEN1_INDEX + j]*W_H1_Out[i][j];

end;

NEURON[OUTPUT_INDEX + i] := NEURON[OUTPUT_INDEX + i]+W_H1_Out[i][HIDDEN1]; {/* BIAS */}

NEURON[OUTPUT_INDEX + i] := sigmoid( NEURON[OUTPUT_INDEX + i] );

end;

{ /* Copy outputs to outpt array */}

for i:=0 to OUTPUTS-1 do

outpts[i] := NEURON[OUTPUT_INDEX + i];

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE> Результаты теста</TITLE></HEAD><BODY>');

write('<p><font size=5 ><center><i> Вы закончили финальный тест!</i><p></center></FONT>');

end;

Procedure Fin;

begin

writeln('</BODY></HTML>');end; procedure Analize;var buf:string;beginbuf:=''; read(input,in_str);st:=in_str;for i:=1 to INPUTS do begin buf:='rad'+IntToStr(i)+'='; if pos(buf,st) > 0 then delete(st,pos(buf,st),length(buf));

ans[i]:=copy(st,1,pos('&',st)); delete(st,1,pos('&',st));

write(st,'<p>');}

end; {for}

if pos('hid=',st) > 0 then delete(st,pos('hid=',st),length('hid=')); for i:=1 to INPUTS do begin h[i]:=st[1+3*(i-1)]; end; delete(st,1,pos('+',st)); delete(st,1,6);

fio:=copy(st,1,pos('%',st)-1); delete(st,1,pos('grp',st)+5);

grp:=st;

for i:=1 to INPUTS do

if ans[i]=h[i] then check_in[i-1]:=1

else check_in[i-1]:=0;

eval_net(check_in,check_out);

end;

BEGIN HEAD; ANALIZE; write('<h3> Испытуемый: ',fio,' <p>');

write(' группа : ',grp,' <p>');

max:=0;

for i:=0 to OUTPUTS-1-1 do

if check_out[max]>check_out[i+1] then max:=max

else max:=i+1;

case max of

0:begin

write('<h3> Ваша оценка - <FONT SIZE=6>2 (=+ L-+TT+TT+¦LT+T-=+)</FONT> <p></h3>')

end;

1:begin

write('<h3> Ваша оценка - <FONT SIZE=6>3 (L-+TT+TT+¦LT+T-=+)</FONT> <p></h3>')

end;

2:begin

write('<h3> Ваша оценка - <FONT SIZE=6>4 (-+¦+++)</FONT> <p></h3>')

end;

3:begin

write('<h3> Ваша оценка - <FONT SIZE=6>5 (+TTL+=+)</FONT> <p></h3>')

end;

end; {case}

FIN;

END.

cgi_form.pas

program cgi_form;uses SysUtils; const v1='v1';

v2='v2';

v3='v3';

v4='v4';

v5='v5';

v6='v6';

a1='1';

a2='2';

a3='3';

type mas=array[1..3,0..3]of byte;

var st,

in_str,

name,

fio,

grp,

file_name,

a:string;

f:text;

q_num:integer;

y,

ind,

cal:byte;

quest_mas:mas;

h:array[1..12]of string[3];

Procedure Error;

begin

writeln('Content-type: text/html '); writeln(''); writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">'); writeln('<HTML><HEAD><TITLE>PAZiC </TITLE></HEAD><BODY bgcolor=#FF0000>');

writeln('<H1>Error- Ошибка!!!</H1>');

writeln('</BODY></HTML>');

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>Контрольные вопросы</TITLE></HEAD><BODY>');

write('<form method=post action="/advcgi/cgi-res.exe">');

end;

Procedure Fin;begin write('<center><P align=center> <INPUT type="submit" value="Проверь cебя "></p></center>'); writeln('</BODY></HTML>');end; Procedure Analize_Name;

begin

name:='';

read(input,in_str); st:=in_str;

delete(st,1,(pos('fam=',st)+3));

name:=copy(st,1,pos('&grp=',st)-1); fio:=name;

delete(st,1,(pos('&grp=',st)+4)); grp:=st;

name:=name+' '+st;

end;

Procedure Point_Q (ind:byte);

var buf:string; i,probel:word;

begin

reset(f); readln(f,buf); probel:=ind+3*(ind-1); i:=0;

while not (eof(f)) do begin

readln(f,buf);

if buf='' then i:=i+1;

if i=probel then break;

end;

end;

Procedure Point_A(n:byte);

var buf:string; i:word;

begin

i:=0;

while not (eof(f)) and (i<>n) do begin

readln(f,buf);

if buf='' then i:=i+1;

end;

end;

Procedure Wr;

var buf:string;

begin

buf:='Buffer';

while not (eof(f)) and (buf<>'') do begin

readln(f,buf);

writeln(buf);

end;

end;

Procedure Init(q:byte; var q_m:mas);

var i:byte;

begin

if q < 3 then begin

repeat q_m[1,0]:=random(3); until q_m[1,0]<>0;{1- question find randomly}

repeat q_m[1,1]:=random(4); until q_m[1,1]<>0;{1- answer find randomly}

repeat q_m[1,2]:=random(4);

until (q_m[1,2]<>q_m[1,1])and(q_m[1,2]<>0);

q_m[1,3]:=3-(q_m[1,1]+q_m[1,2])+3;

q_m[2,0]:=2-q_m[1,0]+1;{2-last question}

repeat q_m[2,1]:=random(4); until q_m[2,1]<>0;{1- answer find randomly}

repeat q_m[2,2]:=random(4);

until (q_m[2,2]<>q_m[2,1])and(q_m[2,2]<>0);

q_m[2,3]:=3-(q_m[2,1]+q_m[2,2])+3;

for i:=0 to 3 do q_m[3,i]:=0;

end

else begin

repeat q_m[1,0]:=random(q_num+1); until (q_m[1,0]<>0);{1- question find randomly}

repeat q_m[2,0]:=random(q_num+1); until (q_m[2,0]<>q_m[1,0])and(q_m[2,0]<>0);{1- question find randomly}

repeat q_m[3,0]:=random(q_num+1);

until (q_m[3,0]<>q_m[2,0])and(q_m[3,0]<>q_m[1,0])and(q_m[3,0]<>0);{1- question find randomly}

for i:=1 to 3 do begin

repeat q_m[i,1]:=random(4); until q_m[i,1]<>0;{1- answer find randomly}

repeat q_m[i,2]:=random(4); until (q_m[i,2]<>q_m[i,1])and(q_m[i,2]<>0);

q_m[i,3]:=3-(q_m[i,1]+q_m[i,2])+3;

end;

end;

end;

Function Hide(right:byte):string;

var s:word;

begin

if right = 1 then repeat s:=random(200); until (s> 100);

if right = 2 then repeat s:=random(300); until (s> 200);

if right = 3 then repeat s:=random(400); until (s> 300);

Hide:=IntToStr(s);

end;

begin

randomize;

Analize_Name;

cal:=0;

Head;

write('<p><font size=5><center><i>',fio,', Вам необходимо ответить на следующие вопросы:</i><p></center>');

write('<center>');

write('<table width=100% ');

write('border=3 bordercolor=#FFFFFF bordercolordark=#FFFFFF bordercolorlight=#FFFFFF>');

for ind:=1 to 6 do begin

if ind=1 then file_name:=v1;

if ind=2 then file_name:=v2;

if ind=3 then file_name:=v3;

if ind=4 then file_name:=v4;

if ind=5 then file_name:=v5;

if ind=6 then file_name:=v6;

{$I-}

assign(f,file_name); reset(f);

if ioresult<>0 then begin Error; exit end;

{$I+}

readln(f,st); q_num:=StrToInt(st);{Read questions number}

Init(q_num,quest_mas);

for y:=1 to 2 do begin

if quest_mas[y,0]=0 then break;

inc(cal);

write('<tr><td>');

a:='rad'+IntToStr(cal);

Point_Q(quest_mas[y,0]); write(IntToStr(cal),'. ');Wr;

write('</td>');

write('<td>');

write('<input type=radio name="',a,'" value="',a1,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,1]); Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a2,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,2]);Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a3,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,3]);Wr;

write('<br>');

write('</td>');

{Which question is right}

if quest_mas[y,1] = 1 then h[{y}cal]:=Hide(1);

if quest_mas[y,2] = 1 then h[{y}cal]:=Hide(2);

if quest_mas[y,3] = 1 then h[{y}cal]:=Hide(3);

end;

write('</tr>');

close(f);

end;

write('</table></center>');

st:='';

for y:=1 to 12 do st:=st+h[y];

write('<input type=hidden name="hid" Value="',st,' ',in_str{file_name},'">');

Fin

end.

cgi_file.pas

program cgi_file;uses SysUtils;type mas=array[1..3,0..3]of byte;var st,in_str,instr,file_name,a,a1,a2,a3:string; f:text; q_num:integer; y,cal:byte;

quest_mas:mas;h:array[1..3]of string[3];

Procedure Error;

begin

writeln('Content-type: text/html ');

writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>PAZiC </TITLE></HEAD><BODY bgcolor=#FF0000>');

writeln('<H1>Error-+Ошибка!!!</H1>');

writeln('</BODY></HTML>');

end;

Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE> Промежуточные вопросы</TITLE></HEAD><BODY>');

write('<p><font size=5><center><i>Для продолжения обучения,<p>Вам необходимо ответить на следующие вопросы:</i><p></center>');

write('<form method=post action="/advcgi/cgi-an.exe">');

end;

Procedure Fin;

begin

write('<center><P align=center> <INPUT type="submit" value="¦ЁютхЁ№ Tхс "></p></center>');

writeln('</BODY></HTML>');

end;

Procedure Analize_File_Name;

begin

file_name:='';

read(input,in_str); st:=in_str; instr:=in_str;

delete(in_str,1,4);

if pos('hid=',st) > 0 then delete(st,1,(pos('hid=',st)+3));

if pos('+',st) > 0 then delete(st,pos('+',st),length(st));

file_name:=st;

end;

Procedure Point_Q (ind:byte);

var buf:string; i,probel:word;

begin

reset(f); readln(f,buf); probel:=ind+3*(ind-1); i:=0;

while not (eof(f)) do begin

readln(f,buf);

if buf='' then i:=i+1;

if i=probel then break;

end;

end;

Procedure Point_A(n:byte);

var buf:string; i:word;

begin

i:=0;

while not (eof(f)) and (i<>n) do begin

readln(f,buf);

if buf='' then i:=i+1;

end;

end;

Procedure Wr;

var buf:string;

begin

buf:='Buffer';

while not (eof(f)) and (buf<>'') do begin

readln(f,buf);

writeln({fo,}buf);

end;

end;

Procedure Init(q:byte; var q_m:mas);

var i:byte;

begin

if q < 3 then begin

repeat q_m[1,0]:=random(3); until q_m[1,0]<>0;{1- question find randomly}

repeat q_m[1,1]:=random(4); until q_m[1,1]<>0;{1- answer find randomly}

repeat q_m[1,2]:=random(4);

until (q_m[1,2]<>q_m[1,1])and(q_m[1,2]<>0);

q_m[1,3]:=3-(q_m[1,1]+q_m[1,2])+3;

q_m[2,0]:=2-q_m[1,0]+1;{2-last question}

repeat q_m[2,1]:=random(4); until q_m[2,1]<>0;{1- answer find randomly}

repeat q_m[2,2]:=random(4);

until (q_m[2,2]<>q_m[2,1])and(q_m[2,2]<>0);

q_m[2,3]:=3-(q_m[2,1]+q_m[2,2])+3;

for i:=0 to 3 do q_m[3,i]:=0;

end

else begin

repeat q_m[1,0]:=random(q_num+1); until (q_m[1,0]<>0);{1- question find randomly}

repeat q_m[2,0]:=random(q_num+1); until (q_m[2,0]<>q_m[1,0])and(q_m[2,0]<>0);{1- question find randomly}

repeat q_m[3,0]:=random(q_num+1);

until (q_m[3,0]<>q_m[2,0])and(q_m[3,0]<>q_m[1,0])and(q_m[3,0]<>0);{1- question find randomly}

for i:=1 to 3 do begin

repeat q_m[i,1]:=random(4); until q_m[i,1]<>0;{1- answer find randomly}

repeat q_m[i,2]:=random(4); until (q_m[i,2]<>q_m[i,1])and(q_m[i,2]<>0);

q_m[i,3]:=3-(q_m[i,1]+q_m[i,2])+3;

end;

end;

end;

Function Hide(right:byte):string;

var s:word;

begin

if right = 1 then repeat s:=random(200); until (s> 100);

if right = 2 then repeat s:=random(300); until (s> 200);

if right = 3 then repeat s:=random(400); until (s> 300);

Hide:=IntToStr(s);

end;

begin

randomize;

Analize_File_Name;

{$I-}

assign(f,file_name); reset(f);

if ioresult<>0 then begin Error; exit end;

{$I+}

Head;

readln(f,st); q_num:=StrToInt(st);{Read questions number}

Init(q_num,quest_mas);

write('<center>');

write('<table width=100% ');

write('border=3 bordercolor=#FFFFFF bordercolordark=#ffffff bordercolorlight=#FFFFFF>');

for y:=1 to 3 do begin if quest_mas[y,0]=0 then break; inc(cal); write('<tr><td>'); a:='rad'+IntToStr(y); a1:='1'; a2:='2'; a3:='3'; Point_Q(quest_mas[y,0]); write(IntToStr(cal),'. '); Wr;

write('</td>');

write('<td>');

write('<input type=radio name="',a,'" value="',a1,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,1]); Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a2,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,2]);Wr;

write('<br>');

write('<input type=radio name="',a,'" value="',a3,'">');

Point_Q(quest_mas[y,0]); Point_A(quest_mas[y,3]);Wr;

write('<br>');

write('</td>');

{Which question is right}

if quest_mas[y,1] = 1 then h[y]:=Hide(1);

if quest_mas[y,2] = 1 then h[y]:=Hide(2);

if quest_mas[y,3] = 1 then h[y]:=Hide(3);

end;

write('</tr></table>');

write('</center>');

write('<input type=hidden name="hid" Value="',h[1],h[2],h[3],' ',in_str{file_name},'">');

close(f);

Fin

end.

cgi_an.pas

program cgi_an;var st,in_str,hid,ff:string; h,ans_mas:array[1..3]of string[3];Procedure Head;

begin

writeln('Content-type: text/html ');writeln('');

writeln('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');

writeln('<HTML><HEAD><TITLE>Результат</TITLE></HEAD><BODY>');

end;

Procedure Fin;

begin

writeln('</BODY></HTML>');

end;

function Analize:boolean;

var i,j:byte;buf,bf:string;

begin

read(input,in_str);

st:=in_str;

if pos('hid=',st) > 0 then begin

buf:=copy(st,(pos('hid=',st)+4),length(st));

bf:=copy(buf,1,(pos('+',buf)-1));

ff:=copy(st,(pos('%2B',st)+3),((pos('.htm',st)+4)- (pos('%2B',st)+3)) );

delete(st,pos('hid=',st),length(st));

if length(bf)=3 then begin j:=1; h[2]:=' '; h[3]:=' ';end;

if length(bf)=6 then begin j:=2; h[3]:=' ';end;

if length(bf)=9 then j:=3;

for i:=1 to j do h[i]:=copy(bf,(i+2*(i-1)),(i+2*(i-1))+2);

delete(buf,1,(pos('+',buf))); delete(buf,pos('%2B',buf),length(buf));

hid:=buf;

if hid[1]='l' then delete(hid,1,1);

end;

if pos('rad1=',st) > 0 then begin

buf:=copy(st,(pos('rad1=',st)+5),(pos('&',st)-6));

{delete(buf,1,6);} delete(st,1,pos('&',st));

ans_mas[1]:=buf;

end;

if pos('rad2=',st) > 0 then begin

buf:=copy(st,(pos('rad2=',st)+5),pos('&',st)-6);

delete(st,1,pos('&',st));

ans_mas[2]:=buf;

end

else ans_mas[2]:=' ';

if pos('rad3=',st) > 0 then begin

buf:=copy(st,(pos('rad3=',st)+5),pos('&',st)-6);

delete(st,1,pos('&',st));

ans_mas[3]:=buf;

end {if}

else ans_mas[3]:=' ';

if (ans_mas[1]=h[1][1])and(ans_mas[2]=h[2][1])and(ans_mas[3]=h[3][1]) then

Analize:=true

else Analize:=false;

end;

begin

Head;

if Analize then begin

write('<p><center><font size=5><i> Вы абсолютно правы! </i><p>');

write('<p><center><font size=5> Продолжаем обучение... <p>');

write('<meta http-equiv="Refresh" content="2; url=/',ff,'">');

write('<a href="http://158.250.47.76/',ff,' "TARGET=_MAIN>Ok</a></center>');

end

else begin

write('<p><center><font size=5> Вам надо повторить материал<p>');

write('<meta http-equiv="Refresh" content="2; url=http://158.250.47.76/',hid,'.htm">');

write('<a href="http://158.250.47.76/',hid,'.htm">Ok</a> </center>');

end;

Fin

end.

Размещено на Allbest.ru