Головна |
Абсолютна точність виходить тільки у випадку програмування обчислень з цілими числами обмеженої величини. У загальному випадку при неправильному програмуванні результат обчислень може мати неприпустимо велику погрішність чи бути помилковим. Перший випадок відноситься до втрати значимості, коли у відведених для кодування числа розрядах використовуються тільки самі молодші. Другий випадок відноситься до переповнення розрядної сітки, коли число не міститься у відведених для його кодування розрядах. Тому при програмуванні обчислень необхідно вибирати такий масштаб представлення чисел, щоб, з одного боку, повніше використовувати розрядну сітку, а з іншого боку - не допустити її переповнення. Якщо підбором масштабів не удається вирішити задачу приведення результатів вимірів до цілочислового представлення, то можна використовувати представлення чисел з фіксованою комою (в англомовних країнах для поділу цілої і дробової частин числа використовується точка). Притім позицію коми можна фіксувати між розрядами якогось байта чи між байтами, що представляють число. Використання представлення чисел з фіксованою комою не означає якого-небудь додаткового кодування. Потрібно тільки внести ці зведення в документацію на програми (наприклад, у коментарі) і враховувати при програмуванні. При використанні представлення чисел з фіксованою комою перед додаванням і відніманням чисел з різними положеннями коми потрібен зсув одного з операндів, а після множення і ділення майже завжди потрібен зсув результату.
При обробці вимірів може виявитися, що молодші результати коду числа не достовірні унаслідок впливу шумів і перешкод. Цей випадок утрати точності буде розглянутий у главі про програмування фільтрації сигналів. Щоб уникнути нагромадження додаткових погрішностей обчислень доцільно виконувати обчислення з результатами вимірів, обробленими таким чином, щоб погрішності вимірів були зведені до мінімуму.
При використанні байтового формату абсолютна погрішність представлення чисел не може бути менше 0,4 % від максимального значення для позитивних чисел чи 0,8% від максимального модуля для позитивних і негативних чисел. Якщо не вдається підібрати масштаб і/або вимагаються менші погрішності, то приходиться представляти відповідні числа декількома байтами. При використанні двох байтів погрішність представлення чисел може бути значно знижена. Результати обчислень будуть містити великі чи менші погрішності в залежності від погрішностей вихідних чисел і від дій, виконаних над цими числами. Відомо, що при додаванні і відніманні абсолютна погрішність результату обмежена сумою абсолютних погрішностей операндів, а при множенні і діленні відносна погрішність результату обмежена сумою відносних погрішностей операндів. Якщо модулі операндів близькі, то при відніманні для однакових знаків операндів чи додаванні для різних знаків погрішність може перевищити результат операції. Тому варто ретельно перевіряти розрахункові формули з погляду нагромадження погрішностей рахунка. Найчастіше дві математично рівноцінні формули можуть давати істотно різні результати, тому що в дискретній математиці пересувальний і сполучний закони виконуються не завжди.
Як тривіальний приклад джерела систематичної погрішності можна привести операцію цілочислового розподілу. Оскільки частка в цьому випадку завжди виходить з недостачою, для зменшення математичного чекання погрішності обчислення частки потрібно перед операцією ділення додати до діленого половину дільника. Якщо сума діленого і половини дільника не перевершує 255, то це можна зробити додаванням трьох команд:
RLC A ; подвоїти ділене
ADD А, В ; додати дільник
RRC А ; розділити суму на 2
DIV АВ ; обчислити частку
Аналогічним чином можна більш-менш істотно зменшити систематичні погрішності обчислень, якщо такі вдається виявити за допомогою аналізу розрахункових формул.
Програмісту варто пам'ятати про можливість виходу результату за межі представлення чисел при заданому форматі і способі кодування. У ході розробки програми такі можливості повинні бути виключені, хоча від такого роду помилок ніхто не застрахований. Тут також можливі різні підходи. Наприклад, можна на етапі налагодження програми робити контроль результатів з видачею діагностичних сигналів на зовнішні порти мікроконтролера. Коли програма буде налагоджена, то ці блоки контролю можна забрати. Але при використанні такого підходу важко забезпечити всеосяжну перевірку програми.
Для контролю виходу результату за межі розрядної сітки можна використовувати біти С і OV регістра PSW. Індикатором виходу за межі розрядної сітки при додаванні і відніманні позитивних чисел є установка біта переносу в 1. Біт переповнення встановлюється в 1 у випадку переповнення результату при додаванні і відніманні чисел зі знаком. Його можна також використовувати для індикації ділення на 0 і виходу добутку за межі 255. Варто враховувати, що команди множення і ділення записують у біт переносу 0, тому вихід результату додавання чи віднімання позитивних чисел за межі розрядної сітки потрібно перевіряти відразу після виконання команд додавання і віднімання. Біт переносу використовується для арифметичних операцій з числами, що представлені декількома байтами. Він забезпечує інформаційний зв'язок між байтами, тому аналіз умісту бітів переносу і переповнення потрібно робити після обчислення старшого байта результату.
Інший підхід заснований на обмеженні результатів обчислень у випадку їхнього переповнення. За фізичним змістом як результати вимірів, так і обчислені по них значення керуючих впливів не можуть виходити за визначені межі. Крім того, в автоматичному регулюванні часто доцільно використовувати обмеження деяких керуючих параметрів. При використанні другого підходу налагодження програми з погляду переповнення розділяється на налагодження незалежних блоків обмеження декількох параметрів. У цьому випадку після обчислення параметра, значення якого потрібно обмежити, варто перевірити його поточне значення й у разі потреби записати у відповідний осередок максимальне чи мінімальне значення.
Розглянемо найпростіший випадок обмеження позитивного значення після виконання операції додавання:
top: .= 100 ; числова підстановка для максимуму
JC рmа ; перехід по виходу за межі байта
CJNE A, #top, chg ; порівняння з максимальним значенням
SJMP nch ; перехід при максимальному значенні
chg: JC nch ; перехід, якщо обмеження не потрібно
рmа: MOV A, #top ; запис максимального значення
nch: NOP ; для запису мітки
У результаті виконання наведеної послідовності команд результат додавання завжди буде знаходитися в заданих межах. Якщо значення top не перевищує 255, то наведений блок може бути використаний для обмеження не тільки після команди додавання, але і після команди прямого рахунку. Для обмеження результатів додавання і віднімання при використанні негативних чисел із записом у додатковому коді програма небагато ускладнюється. У цьому випадку значення top повинне бути позитивним, а значення bot - негативним.
top: .= 100 ; числова підстановка для максимуму
bot: .= -100 ; числова підстановка для мінімуму
JNB OV, chk ; перехід за відсутністю переповнення
JB А.7, рmа ; перехід, якщо більше
SJMP pmi ; перехід, якщо менше
chk: JB A. 7, neg ; перехід по негативному знаку
CJNE A, #top, chp ; перевірка за максимумом
SJMP nch ; перехід по рівності максимуму
chp: JC nch ; перехід, якщо обмеження не потрібно
рmа: MOV A, #top ; запис максимального значення
SJMP nch ; на вихід із блока
neg: CJNE A, #bot, chm ; перевірка за мінімумом
chm: JNC nch ; перехід, якщо обмеження не потрібно
pmi: MOV A, #bot ; запис мінімуму
nch: NOP ; для запису мітки
Якщо значення максимуму і мінімуму розташовані не на краю діапазону представлення чисел, то цей блок забезпечує обмеження і після виконання команд прямого і зворотного рахунків.
Зведення команд і8051 за абеткою
ACALL n ; ПЕРЕХІД ДО ПІДПРОГРАМИ ближній
ADD[З] A, {#|R|@|d} ; ДОДАВАННЯ [З УРАХУВАННЯМ
; ПЕРЕНОСУ]
AJMP n ; ПЕРЕХІД БЕЗУМОВНИЙ ближній
ANL. A, {#|R|@|d} ; І
ANL d, {A|#} ; І
ANL С, [/][ ; І з [зворотним] кодом біта
CJNE A, {#|d}, s ; ПЕРЕХІД ПО НЕРІВНОСТІ короткий
CJNE {R|@ #, s ; ПЕРЕХІД ПО НЕРІВНОСТІ короткий
CLR {А|b|С} ; ОЧИЩЕННЯ {накопичувача|біта}
CPL {А|b|С} ; ОДЕРЖАННЯ ЗВОРОТНОГО КОДУ
; {накопичувача|біта}
DA A ; КОРЕКЦІЯ двійково-десяткового коду
DEC {A|R|@|d} ; ЗМЕНШЕННЯ НА 1
DIV АВ ; РОЗПОДІЛ
DJNZ {R|d}, s ; ЗМЕНШЕННЯ НА 1 І ПЕРЕХІД ПО НІ
; 0 короткий
INC {A|R|@|d} ; ЗБІЛЬШЕННЯ НА 1
INC D ; ЗБІЛЬШЕННЯ НА 1
J{NB|B[C]} b, s ; ПЕРЕХІД ПО {0|1[з очищенням]} короткий
J[N]C s ; ПЕРЕХІД ПО 1 [0] ПЕРЕНОСУ короткий
JMP @A+D ; БЕЗУМОВНИЙ ПЕРЕХІД НЕПРЯМИЙ
J[N]Z s ; ПЕРЕХІД ПО НУЛЮ [НЕ НУЛЮ] короткий
LCALL f ; ПЕРЕХІД ДО ПІДПРОГРАМИ далекий
LJMP f ; БЕЗУМОВНИЙ ПЕРЕХІД далекий
MOV A, {#|R|@|d} ; ПЕРЕСИЛАННЯ
MOV d, {A|#|R|@|d} ; ПЕРЕСИЛАННЯ
MOV {R|@} {A|#|d} ; ПЕРЕСИЛАННЯ
MOV D, # ; ПЕРЕСИЛАННЯ
MOV {b, с|С,b} ; ПЕРЕСИЛАННЯ біта
MOVC A, @A+{D|P} ; ПЕРЕСИЛАННЯ з ПЗП
MOVX A, {@D|@} ; ПЕРЕСИЛАННЯ з зовнішнього ОЗП
MOVX {@D|@}, А ; ПЕРЕСИЛАННЯ в зовнішнє ОЗП
MUL АВ ; МНОЖЕННЯ
NOP ; НЕМАЄ ОПЕРАЦІЇ
ORL A, {#|R|@|d} ; АБО
ORL d, {A|#} ; АБО
ORL C, [ / ] b ; АБО з [зворотним] кодом біта
POP d ; ЧИТАННЯ ЗІ СТЕКА
PUSH d ; ЗАПИС У СТЕК
RET[I] ; ПОВЕРНЕННЯ [З ПЕРЕРИВАННЯ]
R{L|R}[C] А ; ЗСУВ {ВЛІВО|ВПРАВО}[через біт
; переносу]
SETB {b|С} ; ЗАПИС 1 у біт
SJMP s ; БЕЗУМОВНИЙ ПЕРЕХІД короткий
SUBB A, {#|R|@|d} ; ОБЧИСЛЕННЯ З УРАХУВАННЯМ
; ПОЗИКИ
SWAP А ; ОБМІН НАПІВБАЙТІВ
ХСН A, {R|@|d} ; ОБМІН БАЙТІВ
XCHD А, @ ; ОБМІН МОЛОДШИХ НАПІВБАЙТІВ
; МІЖ БАЙТАМИ
XRL A, {#|R|@|d} ; ВИКЛЮЧНЕ АБО
XRL d, {А|#} ; ВИКЛЮЧНЕ АБО
УМОВНІ ПОЗНАЧКИ
{ | } обов'язковий вибір одного із варіантів у дужках
[ ] використання варіанта при необхідності
# операнд записаний у ПЗП (відповідно до розміру
приймача)
@ непряма адресація через регістр RO чи R1
@A+D непряма адресація через суму DPTR і нагромаджувача
@А+Р непряма адресація через суму лічильника команд і
нагромаджувача
@D непряма адресація через DPTR
А операндом є вміст нагромаджувача
АВ операнди містяться в нагромаджувачі і регістрі В
З операндом є вміст біта переносу
D операндом є вміст регістра DPTR
R операндом є вміст регістра (від RO до R7)
b операндом є адресуємий біт
d операндом є адресуємий байт
f адреса в ПЗП від 0 до 64 кбайтів
n адреса в поточній сторінці ПЗП (розмір сторінки 4 кбайти)
s зсув щодо адреси команди від - 128 до + 127
___
Введите номер начального состояния _
2 Enter
Изменить выходной символ связи:
из 1 Enter
в 1 Enter
номер связи (0-1) _
1 Enter
выходной символ: 1 Enter
Все введенное Вами правильно? (Y/N)
Y
Если информация введена неправильно, то после ввода «N» программа предоставляет возможность повторить ввод. Для изменения конечного состояния связи 1/1 в первой вершине автомата используем режим 3:
Связь:
из 1 Enter
в 1 Enter
номер (0-1) 1 Enter
Перебросить в 2 Enter
Все введенное Вами правильно? (y/n)
Y
В результате на экране получим автомат:
1 2
1 0/1 1/1
2 1/0 0/0
Начальное состояние: 2
Перед началом работы программы при необходимости могут бить изменены основные константы программы:
MaxState - максимально возможное количество состояний конечного автомата, исходное значение - 10;
Radix - основание системы счисления входной последовательности, исходное значение - 2;
IdealKoef - коэффициент, задающий процент правильных предсказаний на входной последовательности синтезируемого автомата, исходное значение - 0,9;
ValLen - длина входной последовательности, исходное значение - 10.
4. ИНДИВИДУАЛЬНЫЕ ЗАДАНИЯ
4.1. В соответствии с заданным вариантом определить:
- влияние изменения вероятностей появления различного вида мутаций на число автоматов, синтезируемых в процессе поиска заданного автомата.
- процент правильных предсказаний лучших автоматов как функцию общего числа синтезированных автоматов.
4.2. Проанализировать входную последовательность с помощью частотных матриц и использовать полученную информацию для задания исходного автомата. Сравнить результаты синтеза автомата с использованием априорной информации и без нее.
5. СОДЕРЖАНИЕ ОТЧЕТА
5.1. Тема практических занятий.
5.2. Индивидуальное задание.
5.3. Результаты выполнения пунктов 4.1 и 4.2 практических занятий.
Отчет может быть предъявлен на магнитном носителе или бумаге.
Варианты индивидуальных заданий
Номер варианта | Значность алфавита входной последовательности | Длина входной последовательности | Максимальное число рядом стоящих одинаковых символов | Число групп одинаковых символов | Используемые для анализа частотные матрицы |
F2, F3 | |||||
F2 | |||||
F1 | |||||
F3 | |||||
F4 | |||||
F1,F2 | |||||
F4 | |||||
F2, F3 | |||||
F3 | |||||
F3 | |||||
F3, F4 | |||||
F1, F4 | |||||
F2 | |||||
F4 | |||||
F1 | |||||
F1, F3 | |||||
F3 | |||||
F2, F3 | |||||
F3, F4 | |||||
F1, F2 | |||||
F4 | |||||
F2 | |||||
F1, F4 | |||||
F3 |
Program Evoi;
uses Crt;
{
MaxState - максимально возможное число состояний автомата
Radix - основание системы счисления для входной последовательноcти
MaxNum - наибольшая цифра заданной системы счисления
Illegal - значение веса, свидетельствующее о том, что связь,
имеющая такой вес, свободна (например, в двоичной
системе это значение 2/2)
IdealKoef - заданный процент правильных предсказаний на обучающей
последовательности синтезируемого автомата
MaxMut - число разновидностей мутаций, в данном случае их 5:
1) добавить состояние (AddState);
2) Удалить состояние (DelState);
3) Перебросить связь на другое состояние, возможно,
изменив ее выходной сигнал (DelAdj);
4) Изменить выходной сигнал связи (ChangeWgt);
5) Принять другое состояние в качестве входа
(Change First).
ValLen - длина входной последовательности
Steps - количество мутаций, после которого надо запросить
подтверждение на продолжение работы программы
VerErr - Ошибка, допустимая при вводе вероятностей
(максимальное отклонение суммы вероятностей от 1)}
Const
MaxState=10;
Radix=2;
MaxNum=Radix-1;
Illegal=Radix shl 8 + Radix;
IdealKoef=0.9;
MaxMut=5;
ValLen=10;
F8=#66;
F9=#67;
Esc=#27;
Enter=#13;
Steps:longint=500;
VerErr=0.01;
{ --- ТИПЫ ---
Alt : алфавит, используемый конечным автоматом
Diap,index: диапазон значений счетчика состояний }
type
Alf=0..MaxNum;
Diap=0..MaxState;
Index=1..MaxState;
MutType=1..MaxMut;
ValLenType=0..ValLen;
VerType=array [MutType] of real;
ValType=array [ValLenType] of Alf;
KeySet=set of char;
{ Еще константы ---
Delta : константа для изменения вероятности мутаций
Ver : вероятности мутаций }
const
Delta=1/5/MaxMut;
Ver:VerType=(
{AddState} 1/MaxMut-Delta,
{DelState} 1/MaxMut+Delta,
{DelAdj } 1/MaxMut,
{ChangeWg t} 1/MaxMut,
{Change?irst}1/MaxMut);
Keys12:KeySet=['1','2'];
Keys01:KeySet=['0','1'];
KeysYN:KeySet=['y', 'n', 'Y', 'N' ];
Keys12345Esc:KeySet=['1','2','3','4','5',Esc];
Keys12345Ent:KeySet=['1','2','3','4','5',Enter];
Keys1_6EE:KeySet=['1','2','3','4','5','6',Enter,Esc];
{ --- Переменные ---
Vers : внутренняя для вычисления вероятностей ValsOut: выходная последовательность }
var
Vers:VerType;
ValsOut:ValType;
{ --- Основная часть ---
WgtRec : описывает связь: Win- вход, Wout- выход
GrafRec: структура данных, представляющая граф
Поля:
First: вход графа
States: матрица переходов. Ее элементы определяют число связей,
идущих из состояния X в состояние у (0 означает, что нет ни одной связи.
Wgt: матрица весов. Ее элементы типа WgtRec определяют вес каждой из связей x->Y (например, 1/0, о/О и т. д.)
CurStates: количество состояний
OurStt: текущее состояние
Koef: коэффициент правильности работы
Graf : собственно граф
Поля:
Body: граф, с которым производятся все операции
GrafError: состояние после выполненной операции:
ошибка была (true) или нет (false)
Avt : конечный автомат
Поля:
Best: лучший автомат, используемый для селекции
Trace флаг пошагового режима (true- включен)
Value входная последовательность
NMuts количество мутаций }
type
WgtRec=
Record
Win,Wout:Alf;
end;
GrafRec=
Object
First: Diap;
States: array [Index,Index] of Diap; { матрица переходов } { показывает, сколько связей }
Wgt: array [Alf,Index,Index] of WgtRec; { матрица весов }
CurStates: Diap; { max. состояние }
CurStt : Diap; { текущее состояние.}
Koef : real;
end;
Graf =
Object
Body:GrafRec;
GrafError:boolean;
Constructor Init;
Destructor Done;
Procedure AddAdJ (from,_to:Index;W:WgtRec);virtual;
Procedure DelAdj (from,_to,NewAdj:Index;which:Alf);virtual;
Function NWgt (from,_to:Index):Diap; { КОЛ-ВО связей }
Procedure ChangeWgt (from,_to:Index;Which:Alf;NewWgt:WgtRec);
Procedure AddState;virtual;
Procedure DelState;virtual;
Procedure Draw;virtual;
end;
Avt=
object(Graf)
Best:GrafRec;
Trace: boolean;
Value: ValType;
NMuts: longint;
Constructor Init;
Procedure Config;virtual;
Procedure Advlnit;virtual;
Procedure DoTheBest;
Procedure Draw;virtual;
Function MutNum:MutType; { как мутировать }
Procedure Mutation;
Procedure Store;
Procedure Restore;
Function IsBest :boolean;
Procedure GetKoef;
Procedure AddState;virtual; { добавить состояние и выходы из него }
Procedure DelState;virtual;
Procedure DelAdj (from,_to,NewAdj:Index;Which:Alf);virtual;
{ переброска связи в другое состояние }
Procedure _DelAdj;
Procedure AddAdj (from,_to:Index;W:WgtRec);virtual;
Procedure _ChangeWgt;
Procedure ChangeWgt (from,_to:Index;Which:Alf;NewWgt:WgtRec);
Procedure ChangeFirst (NewFirst: Index);
Procedure _ChangeFirst;
Procedure DelAdj_ask;
Procedure ChangeWgt_ask;
Procedure ChangeFirst_ask;
end; { A V Т }
{--- Глобальные функции ---
***** GetVal ****
Выдает символ входной последовательности с номером t }
Function GetVal(t:ValLenType):Alf;
var
x:longint;
Function f(p:longint):longint;
{ функция, задающая входную последовательность;
в принципе может быть произвольной }
var
ff:real;
Begin
ff:= (sqrt (p*4));
f:=abs (round(ff));
End; { GetVal.f }
Begin
x:=f(t);
GetVal:=x mod Radix;
End; { GetYal }
{ ***** GetKey ****
Читает символ из множества ks с клавиатуры }
Function GetKey (var ks :KeySet;echo:boolean):char;
var
c:char;
Begin
Repeat
c:=Readkey
until c in ks;
If echo then Write (c,' ');
GetKey:=c;
End; { GetKey }
{ **** GetNum *****
Читает с клавиатуры число, пока оно не будет введено правильно
Min, Max: диапазон значений вводимого числа }
Function GetNum (Min, Max: longint): longint;
var
s:string;
ec:integer;
n:longint;
Begin
Repeat
Readln (s);
Val (s,n,ec);
until (ec=0) and (n<=Max) and (n>=Min);
GetNum:=n;
End; { GetNum }
{ ***** GetReal ***** To же самое, но для вещественных чисел }
Function GetReal (Min,Max:real):real;
var
s:string;
ec:integer;
n:real;
Begin
Repeat
Readln (s);
Val (s,n,ec);
until (ec=0) and (n<=Max+1e-10) and (n>=Min-1e-10);
GetReal:=n;
End; { GetReal }
{ ***** confirm ***** Запрашивает подтверждение у пользователя Возврат:
true, если ответ ДА
false- если НЕТ }
Function Confirm:boolean;
Begin
Writeln (#13#10'Bce введенное Вами правильно? (Y/N)');
Confirm:=UpCase(GetKey (KeysYN,false))='Y';
End; { Confirm }
{ --- Методы графа ---
**** init ****
обнуляет все, что можно; кроме того, заносит в матрицу
весов значения, свидетельствующие о пустоте связей (Illegal) }
Constructor Graf.Init;
begin
TextMode(CO80);
ClrScr;
GrafError:=false;
With Body do
begin
First:=0;
CurStates:=0;
CurStt:=0;
Koef:=0.0;
FillChar (Wgt,SizeOf(Wgt),byte(Radix));
FillChar (States,SizeOf(States),0);
end;
End; { Graf.Init }
{ *** РППР ****
Просто подождать нажатия клавиши }
Destructor Graf.Done;
Begin
GotoXY (28,25);
Write ('Нажмите любую клавишу');
ReadKey;
End; { Graf.Done }
{ **** DelAdj ****
Удалить связь с номером which из состояния
from в состояние
_to и сдвинуть остальные
Переменные:
i : счетчик
w : вес
w1: для обхода Range check error при стирании связи }
Procedure Graf.DelAdj(from, _to, NewAdj: Index; which: Alf);
var
i:-1..MaxNum;
w:WgtRec;
w1:word absolute w;
Begin
GrafError:=false;
If (from>Body.CurStates)or(_to>Body.CurStates)or(NWgt(from,_to)=0) then
begin
GrafError:= true;
Exit;
end;
w1:=Illegal;
With Body do
begin
Dec(States [from,_to]);
For i:=which to States [from,_to]-1 do
Wgt [i,from,_to]:=Wgt [i+1,from,_to];
Wgt[States [from,_to],from,_to]:=w;
end;
End; { Graf.DelAdj }
{ **** AddAdj *****
Добавление связи из from в _to с весом w }
Procedure Graf.AddAdj (from,_to:Index;W:WgtRec);
var
i,N:Diap;
j:-1..MaxState;
Begin
GrafError:= false;
N:=NWgt (from,_to);
With Body do
begin
If (N=Radix)or(from>CurStates)or(_to>CurStates) then
begin
GrafError:=true;
Exit;
end;
Inc (States [from,_to]);
Wgt [N,from,_to]:=W;
end;
End; { Graf.AddAdj }
{ *** NWgt ****
Количество связей from -> _to }
Function Graf.NWgt (from,_to:Index):Diap;
Begin
GrafError:=false;
If (from>Body.CurStates)or(_to>Body.CurStates) then
begin
GrafError:=true;
NWgt:=0;
Exit;
end;
NWgt:=Body.States [from,_to];
End; { Graf.NWgt }
{ *** changeWgt ****
Изменить вес связи from->_to с номером Which на NewWgt }
Procedure Graf.ChangeWgt (from,_to:Index;Which:Alf;NewWgt:WgtRec);
Begin
GrafError:=false;
If (from>Body.CurStates) or (_to>Body.CurStates)or (NWgt(from,_to)<Which) then
begin
GrafError:= true;
Exit;
end;
Body.Wgt [Which,from,_to]:=NewWgt;
End; { Graf.ChangeWgt }
{ **** AddState **** Добавление состояния }
Procedure Graf.AddState;
Begin
GrafError:=false;
With Body do
begin
If CurStates=MaxState then
begin
GrafError:=true;
Exit;
end;
Inc(CurStates);
FillChar (States[CurStates,1],MaxState,0);
end;
End; { Graf.AddState }
{ **** DelState ****
Удаление последнего состояния. Переменные - аналогично Graf.DelAdj}
Procedure Graf.DelState;
var
w:WgtRec;
w1:word absolute w;
i:Diap;
J:Alf;
Begin
GrafError := false;
With Body do
begin
If CurStates<=1 then
begin
GrafError:=true;
Exit;
end;
w1 := Illegal;
For i:=1 to CurStates do
For j:=0 to MaxNum do
Wgt[j,CurStates,i]:=w;
If First=CurStates then Dec (First);
Dec(CurStates);
end;
End; { Graf.DelState }
{ **** Draw **** Изображение графа на экране }
Procedure Graf.Draw;
var
i,j:Diap;
k:Alf;
x,xx,y:byte;
Begin
ClrScr;
With Body do
begin
Write (' ');
For i:=1 to CurStates do Write (i:2,' ');
Writeln(i:2,' ');
For i:=1 to CurStates do
begin
Write (i:2,' ');
For j:=1 to CurStates do
begin
y:=WhereY;
x:=WhereX;
If States [i,j]=0 then
begin
Write ('--- ');
xx:=WhereX;
end
else
begin
For k:=0 to States [i,j]-1 do
begin
x:=WhereX;
Write (Wgt[k,i,j].Win,'/',Wgt[k,i,j].Wout,' ');
xx:=WhereX;
GotoXY (x,WhereY+1);
end; { for k... }
end; { else }
GotoXY (xx,y);
end; { for j...}
GotoXY (1,WhereY+Radix);
end; { for i... }
end; {. with }
End; { Graf.Draw }
{ --- Методы конечного автомата ---
*** Init ****
Установка режимов работы, вычисление вероятностей
мутаций и получение входной последовательности }
Constructor Avt.Init;
var
i: 1..MaxMut;
s: real;
x: ValLenType;
c: char;
ec:integer;
Begin
Inherited Init;
s:=0;
FillChar (ValsOut, SizeOf(ValsOut),Radix);
For x:=0 to ValLen do Value [x]:=GetVal(x);
Steps :=0;
NMuts:=0;
Config;
For i:=1 to MaxMut do
begin
s:=s+Ver[i];
Vers[i]:=s;
end;
Best:=Body;
If not Trace then Writeln ('Пожалуйста подождите...');
End; { Avt.Init }
{ **** Oonfig **** Задание опций для генерации автомата }
Procedure Avt.Config;
Procedure TraceMode;
Begin
Trace:=true;
End;
Procedure RandMut;
Begin
Randomize;
End;
Procedure ManualVers;
const
verstr:array[MutType] of string =
('добавления состояния','удаления состояния', 'переброски связи',
'изменения веса', 'изменения начального состояния');
var
i: MutType;
c: char;
s: real;
Begin
Repeat
Repeat
ClrScr;
Writeln ('Вероятности...');
For i:=1 to MaxMut do
Writeln (i,'...',verstr[i]);
Writeln ('Enter.. принять эти вероятности');
For i:=1 to MaxMut do
begin
GotoXY (40,i+1);
Write (Ver[i]:10:8);
end;
c:=GetKey (Keys12345Ent, false);
If c=Enter then break;
i:=byte (c)-byte('O');
GotoXY (1 ,10);
Write ('Введите вероятность ',verstr[i],'> ');
Ver[i]:=GetReal (0,1);
until false;
s:=0;
For i:=1 to MaxMut do s:=s+Ver[i];
If (s<1-VerErr) or (s>1+VerErr) then
begin
GotoXY(10, 10);
Writeln ('Сумма вероятностей должна быть равна 1, а не ',s:10:8);
ReadKey;
end;
until (s>1-VerErr) and (s<1+VerErr);
End;
Procedure ManualVals;
var
x:ValLenType;
Begin
ClrScr;
Repeat
Clrscr;
Writeln('Введите ',ValLen+1,' знач. входной последоват.');
For x:=0 to ValLen do
begin
Write (x,'>');
Value [x]:=GetNum (0,MaxNum);
end;
until Confirm;
End;
Procedure Confirmation;
Begin
ClrScr;
Write ('Введите количество мутаций, после которого запрашивать ' +
'подтверждение ');
Steps:=GetNum(0,$7FFFFFFF);
End;
type
ba=array[1..6] of boolean;
const
opt: ba= (false, true, false, false, false, false);
var
c:char;
i:byte;
Begin
Writeln (
'1... пошаговый режим НЕТ'#13#10,
'2... случайные мутации ДА'#13#10,
'3... задание вероятностей мутаций НЕТ'#13#10,
'4... задание входной последовательности НЕТ'#13#10,
'5... периодический запрос подтверждения НЕТ'#13#10,
'6... задание исходного автомата НЕТ'#13#10,
'Enter.. начало генерации конечного автомата'#13#10,
'Esc... выход');
GotoXY (1,25);
Write ('');
Repeat
c:=GetKey (Keys1_6EE,false);
Case c of
Enter:break;
Esc:Halt (1);
end;
i:=byte(c)-byte('0');
opt[i]:=not opt[i];
GotoXY (56,i);
If opt[i] then Write ('ДА ') else Write ('НЕТ');
until false;
If opt[1] then TraceMode;
If opt[2] then RandMut;
If opt[3] then ManualVers;
If opt[4] then ManualVals;
If opt[5] then Confirmation;
If opt[6] then Advlnit;
ClrScr;
End; { Avt.Config }
{ **** Advlnit ****
Ввод автомата вручную. Перекройте этот метод, если в качестве исходного необходимо взять какой-то определенный автомат. }
Procedure Avt.Advlnit;
{ Если необходим исходный автомат с 3-мя состояниями и связями:
1 1 2 3
1 1/0 0/0 ---
2 --- 0/1 1/0 ---
3 --- 0/1 1/1 ---
этот метод должен выглядеть примерно так:
var
W:WgtRec;
i:Index;
}
var c:char;
Begin
{ For i:=1 to 3 do AddState;
W.in :=1; W.out :=0; AddAdj (1, 1 ,W);
W.in :=0; W.out :=0; AddAdj (1, 2, W);
W.in :=0; W.out :=1; AddAdj (2, 2, W);
W.in :=1; W.out :=0; AddAdj (2, 2, W);
W.in :=0; W.out :=1; AddAdj (3, 2, W);
W.in :=1; W.out :=1; AddAdj (3 3,W) }
Repeat
ClrScr;
Window(1,1,80,25);
Graf.Draw;
Writeln ('Начальное состояние: ',Body.First);
Window (45,1,80,25);
Writeln (
'1... добавить состояние и выходы из него'#13#10 +
'2... удалить последнее состояние'#13#10+
'3... перебросить связь на другое состояние'#13#10+
'4... изменить выходной вес связи'#13#10+
'5... принять другое состояние в качестве входа',
#13#10'Esc. принять этот автомат за исходный');
c:=GetKey(Keys12345Esc,false);
Case c of
'1': AddState;
'2': DelState;
'3': DelAdj_ask;
'4': ChangeWgt_ask;
'5': ChangeFirst_ask;
end;
until c=Esc;
Window (1, 1, 80, 25);
ClrScr;
End; {. Avt.AdvInit }
{ **** DoTheBest ****
Сгенерировать автомат, отвечающий заданным требованиям. Генерация осуществляется так:
1) Осуществляется какая-нибудь мутация и вычисляется коэффициент
2) Если он больше, чем у текущего Best, то этот автомат сохраняется, в гпээтивном случае восстанавливается прежний автомат. }
Procedure Avt.DoTheBest;
var
c:char;
Begin
Repeat
Repeat
Mutation
until not GrafError;
GetKoef;
If Trace then
begin
Window (55,1,80,4);
Writeln ('F8... шаг'#13#10+
'F9... выполнение до конца'#13#10+
'Esc.. выход');
Window (1,1,80,25);
Repeat
Repeat
c:=ReadKey;
If c=Esc then Exit;
until c=#0;
c:=ReadKey
until c in [F8, F9];
If c=F8 then
begin
ClrScr;
Draw;
end
else
begin
Write ('OK'#7);
ClrScr;
Write ('Please wait...');
Trace:=false;
end;
end;
If IsBest then
begin
Store;
Inc (NMuts);
If (Steps<>0) and (NMuts mod Steps=0) and not Trace then
begin
Write(#13'Произошло ',Nmuts,' мутаций. Продолжить? (Y/N)');
c:=UpCase(GetKey (KeysYN, true));
DelLine;
If c='N' then Break;
end;
end
else Restore;
until Best.Koef>=IdealKoef-1e-10;
End;
{ *** Draw ***
Вывод автомота на экран вместе с результатами его деятельности }
Procedure AVT. Draw;
Procedure WriteMas (var m:ValType;start:byte);
var i:0..ValLen;
Begin
For i:=start to ValLen do
Write (m[i],' ');
End; { Avt.Draw.WriteMas }
Begin
Inherited Draw;
Window (45,10,80,25);
Write ('ВХОД: ');
WriteMas (Value,0);
Write (#13#10'ВЫХОД: ');
WriteMas (ValsOut,1);
Writeln (#13#10'Интеллект:',Body.Koef:5:2);
Writeln ('Начальное состояние: ',Body.First);
Writeln ('Количество мутаций: ',NMuts);
Window (1,1,80,25);
End; { Avt.Draw } { **** Mutation ****
Случайная мутация конечного автомата.
Если в процессе мутации пг^кчошла ошибка, то флаг GrafError поднят }
Procedure Avt.Mutation;
Begin
GrafError:=false;
Case MutNum of
1:AddState;
2:DelState;
3:_DelAdj;
4:_ChangeWgt;
5:_ChangeFirst;
end;
End; { Avt.Mutation }
{ *** store ****
Сохранить текущий автомат для дальнейшей селекции }
Procedure Avt.Store;
Begin
Best:=Body;
End; { Avt.Store }
{ **** Restore ***
Восстановить ранее запомненный автомат после неудачной мутации }
Procedure Avt.Restore;
Begin
Body:=Best;
End; { Avt.Restore }
{ **** IsBest ****
Является ли текущий автомат (Body) лучше, чем Best ? }
Function Avt.IsBest :boolean;
Begin
IsBest:=Body.Koef >= Best.Koef;
End; { Avt.IsBest }
{ *** GetKoef ****
Вычислить коэффициент, т. е. отношение числа правильных предсказаний к длине входной последовательности }
Procedure Avt.GetKoef;
var
i:Diap;
j:-1..MaxNum;
k:1 ..ValLen;
_value:longint;
right:longint; { совпадений }
Begin
right:=0;
With Body do
begin
CurStt:=First;
For k:=1 to ValLen do { для всей входной последовательности }
begin
_value:=Value [ k-1];
For i:=1 to CurStates do { по всем состояниям }
For j:=0 to NWgt (CurStt,i)-1 do { по всем связям CurStt->i }
begin
If _value=Wgt[j,CurStt,i].Win then { сделать переход }
begin
ValsOut [ k ]:=Wgt [ j, CurStt, i ]. Wout;
CurStt:=i; { перейти в i-тое состояние }
Break;
end;
end; { for j... }
If value[k]=ValsOut[k] then Inc(right);{ если угадал, то }
end; { for k... }
Koef:=right/ValLen;
end; { with body... }
End; { Avt.GetKoef }
{ **** AddState ****
Добавить состояние и связи (две - в 'случае двоичной системы счисления), идущие из добавленного состояния куда-нибудь }
Procedure Avt.AddState;
var
from,_to:Index;
W:WgtRec;
i:Alf;
Begin
Inherited AddState;
If GrafError then Exit;
If Body.First=0 then Body.First:=1;
from:=Body.CurStates;
For i:=0 to MaxNum do
Repeat
GrafError:=false;
_to:=Random (Body.CurStates)+1;
W.win:=Random (Radix);
W.wout:=Random (Radix);
AddAdj (from,_to,W)
until not GrafError;
End; { Avt.AddState }
{ **** MutNum ****
Выдать случайный-номер мутации с учетом их вероятностей }
Function Avt. MutNum :MutType;
var
i:MutType;
MN:real;
Begin
MN:=Random;
For i:=1 to MaxMut do If MN<=Vers[i] then
begin
MutNum:=i;
Break;
end;
End; { Avt.MutNum } { *;";** AddAdj t^**
Добавить связь from->_to с весом w с учетом проверки на допустимость существования такой связи
(из одного состояния не может выходить более одной связи для каждого значения w.in). }
Procedure Avt.AddAdj (from,_to:Index;W:WgtRec);
var
i,j:-1..MaxState;
Begin
{ Проверим, есть ли выход из этого состояния с весом W.Win }
With Body do
For i:=1 to CurStates do
For j:=0 to NWgt (from,i)-1 do
If Wgt [j,from,i].Win=W.Win then
begin
GrafError:=true;
Exit;
end ;
Inherited AddAdj (from,_to,w);
End; { Avt.AddAdj }
{ *** DelAdj ****
Переброска связи from->_to под номером which в другое место }
Procedure Avt.DelAdj (from,_to,NewAdj:Index;which:Alf);
var
W:WgtRec;
Begin
GrafError:=false;
If (NewAdj<1) or (NewAdj>Body.CurStates) then
begin
GrafError:=true;
Exit;
end ;
W:=Body.Wgt [which,from,_to];
Inherited DelAdj (from,_to,NewAdj,which);
If not GrafError then AddAdj (from,NewAdj,W);
End; { Avt.DelAdj }
{ **** _DelAdj ****
Просто подбирает случайные параметры для DeiAdj }
Procedure Avt._DelAdj;
var
from, _to, NewAdj: Index;
which:Alf;
Begin
GrafError:=false;
from:=Random (Body.CurStates)+1;
_to:=Random (Body.CurStates)+1;
which:=Random (Body.States [from,_to]);
NewAdj:=Random (Body.CurStates)+1;
DelAdj (from,_to,NewAdj,which);
End; { Avt._DelAdj }
{ *** DelState ****
Удаление последнего состояния и идущих в него связей }
Procedure Avt.DelState;
var
i:-1..MaxState;
j:Diap;
good:boolean;
W:WgtRec;
w1:word absolute w;
Begin
GrafError:=false;
With Body do
begin
For i:=1 to CurStates-1 do
For j:=1 to NWgt (i, CurStates) do
Repeat
good:=true;
DelAdj (i,CurStates,Random(CurStates)+1,j-1);
{ удаление всех связей, входящих в удаляемое состояние }
w1 :=word(Wgt [j-1 ,i,CurStates]);
If w1 <> Illegal then good:=false;
until good;
end;
Inherited DelState;
End; { Avt.DelState }
{ *** QhangeWgt **** Изменить выходной вес (W.out) у связи }
Procedure Avt.ChangeWgt (from,_to:Index;Which:Alf;NewWgt:WgtRec);
var
W:WgtRec;
Begin
GrafError:=false;
If (Body. CurStates=0)or (Body.Wgt[which, from, _to].Win=Radix) then
begin
GrafError:= true;
Exit;
end;
W:=Body.Wgt [which,from,_to];
W.wout:=NewWgt.Wout;
Inherited ChangeWgt (from,_to,which,W);
End; { Avt._ChangeWgt }
{ **** _ChangeWgt ****
Случайным образом изменить выходной вес (w.out) какой-либо связи}
Procedure Avt._ChangeWgt;
var
W:WgtRec;
from,_to: Diap;
which:Alf;
Begin from:=Random (Body.CurStates)+1 ;
_to:=Random (Body.CurStates)+1 ;
which:=Random (Body.States [from,_to]);
W.win:=Random (Radix);
W.wout:=Random (Radix);
ChangeWgt (from,_to,which,W);
End; { Avt._ChangeWgt } { "*** ChangeFirst ****
Изменить номер состояния, используемого в качестве начального }
Procedure Avt.ChangeFirst (NewFirst:Index);
Begin
GrafError:=false;
If (Body.CurStates<2) or (NewFirst>Body.CurStates) then
begin
GrafError:= true;
Exit;
end;
Body.First:=NewFirst;
End; { Avt.ChangeFirst }
Procedure Avt._ChangeFirst;
var
entr:Index;
Begin
entr:=Random (Body.CurStates)+1;
ChangeFirst(entr);
End;
{ *** DelAdj_ask **** Удаление свл&и с запросом }
Procedure Avt.DelAdj_ask;
var
from,_to,NewDest:Index;
which:Alf;
W:WgtRec;
Begin
Repeat
GrafError:=false;
Write ('СВЯЗЬ:'#13#10'ИЗ ');
from:=GetNum (1,MaxState);
Write ('B ');
_to:=GetNum (1 ,MaxState);
Write ('номер (О-',MaxNum,')');
which:=GetNum (0,MaxNum);
Write ('Перебросить в ');
NewDest:=GetNum (1,MaxState);
until Confirm;
DelAdj(from, _to, NewDest, which);
End; { DelAdj_ask }
{ **** ChangePirst_ask **** Изменение входа с запросом }
Procedure Avt.ChangeFirst_ask;
var
entr:Index;
Begin
GrafError:=false;
Write ('Введите номер начального состояния ');
entr:=GetNum(1,MaxState);
ChangeFirst (entr);
End; { ChangeFirst_ask }
{ **** ChangeWgt_ask **** Изменение веса связи с запросом }
Procedure Avt.ChangeWgt_ask;
var
from,_to:Index;
which:Alf;
W:WgtRec;
Begin
Repeat
GrafError:=false;
Write ('Изменить вес связи:'#13#10'из ');
from:=GetNum (1,MaxState);
Write ('В ');
_to:=GetNum (1,MaxState);
Write (#13#10'номер СВЯЗИ (О-',MaxNum,')');
which:= GetNum (0,MaxNum);
Write (#13#10'выходной вес: ');
W.wout:=GetNum(0,MaxNum);
until Confirm;
ChangeWgt (from,_to,which,w);
End; { Change?irst_ask }
var Device:Avt;
Begin
Device.Init;
Device.DoTheBest;
Device.Draw;
Device.Done;
End.