Динамическое распределение памяти и задачи искусственного интеллекта
Хотя Паскаль не является основным языком, который использу-
ется при решении задач искусственного интеллекта, его можно ис-
пользовать и в этой области. Основной чертой многих программ из
области искусственного интеллекта является наличие списка инфор-
мационных элементов, который может расширяться программой автома-
тически по мере ее "обучения". В таком языке как Пролог, который
считается основным языком искусственного интеллекта, поддержка
списка обеспечивается автоматически. На языке Паскаль такие про-
цедуры должны программироваться с применением связанных списков и
механизма динамического распределения памяти. Хотя приводимый
пример является очень простым, те же принципы применимы для раз-
работки более сложных "разумных" программ.
Одну интересную область искусственного интеллекта составляют
программы, работа которых напоминает поведение людей. Знаменитая
программа "Элиза", например, ведет себя как психиатр. Совсем неп-
лохо иметь программу, которая может "разговаривать" на любую тему
- как было бы хорошо запустить такую программу, когда вы устанете
от программирования и почувствуете себя одиноким! Ниже приводить-
ся очень простая версия такой программы. В ней используются слова
и их определения для ведения простого диалога с пользователем.
Одной общей чертой всех программ искусственного интеллекта явля-
ется связь информационного элемента с его смыслом. В этом примере
слова связываются с их смыслом. Ниже описывается запись, предназ-
наченная для содержания каждого слова, его определения, части ре-
чи и его дополнения:
type
str80 = string[80];
str30 = string[30];
VocabPointer = "тильда"vocab;
vocab = record
typ: char; { часть речи }
connotate: char; { дополнение }
word: str30; { само слово }
def: str80; { определение }
next: VocabPointer; { указатель на следующую
запись }
prior: VocabPointer; { указатель на предыдущую
запись }
end
В приводимой ниже программе делается ввод слова, его опреде-
ления, типа слова и его дополнения типа "хорошо", "плохо" и
"безразлично". Для поддержки такого словаря строится связанный
список с использованием механизма динамического выделения памяти.
Функция "DLS_Store" создает и поддерживает упорядоченный список
слов словаря. После ввода нескольких слов в словарь можно начать
диалог с ЭВМ. Например, вы можете ввести такое предложение, как
"Сегодня хороший день". Программа будет просматривать предложения
для поиска имени существительного, которое находится в словаре.
Если оно найдено, то будет выдано замечание об этом имени сущест-
вительном, зависящее от его смысла. Если программа встретит ей
"неизвестные" слова, то она попросит ввести его и определить его
характеристики. Для завершения диалога вводится слово "quit".
Процедура "Talk" является частью программы, которая поддер-
живает диалог. Вспомогательная функция "Dissect" выделяет из
предложения слова. В переменной "sentence" содержится введенное
вами предложение. Выделенное из предложения слово помещается в
переменную "word". Ниже приводятся функции "Talk" и "Dissect":
{ поочередное выделение слов из предложения }
procedure Dissect(var s:str80;var w:str30);
var
t, x:integer;
temp:str80;
begin
t :=1;
while(s[t]=' ') do t := t+1;
x := t;
while(s[t]=' ') and (t<=Length(s)) do t := t+1;
if t<=Length(s) then t := t-1;
w := copy(s, x, t-x+1);
temp := s;
s := copy(temp,t+1,Length(s))
end;
{ формирование ответов на основании введенного пользователем
предложения }
procedure Talk;
var
sentence: str80
word: str30
w: VocabPointer;
begin
Writeln('Conversation mode (quit to exit)');
repeat
Write(': ')
Readln(sentence)
repeat
Dissect(sentence,word);
if w <> nil then begin
if w^.type = 'n' then
begin
case w^.connotate of
'g': Write('I like ');
'b': Write('I do not like ');
end;
Writeln(w^.def);
end;
else Writeln(w^.def);
end;
else if word <>'quit' then
begin
Writeln(word,'is unknown.');
enter(TRUE);
end;
until Length(sentence) = 0;
until word = 'quit';
end;
Ниже приводится вся программа:
{ программа, которая позволяет вести очень простой диалог }
program SmartAlec;
type
str80 = string[80];
str30 = string[30];
VocabPointer = ^vocab
vocab = record;
typ: char; { часть речи }
connotate: char; { дополнение }
word: str80; { само слово }
def: str30; { определение }
next: VocabPointer; { указатель на следующую
запись }
prior: VocabPointer; { указатель на предыдущую
запись }
DataItem = vocab;
DataArray = array [1..100] of VocabPointer
filtype = file of vocab;
var
test: DataArray;
smart: filtype;
start, last:VocabPointer;
done: boolean;
{ возвращает функцию, выбранную пользователем }
function MenuSelect:char;
var
ch: char;
begin
Writeln('1. Enter words');
Writeln('2. Delete a word');
Writeln('3. Display the list');
Writeln('4. Search for a word');
Writeln('5. Save the list');
Writeln('6. Load the list');
Writeln('7. Converse');
Writeln('8. Quit');
repeat
Writeln;
Write('Enter your choice: ');
Readln(ch);
ch := UpCase(ch);
until (ch>='1') and (ch<='8')
MenuSelect := ch;
end;{ конец выбора по меню }
{ добавление элементов в словарь }
function DLS_Store(info, start: VocabPointer;
var last: VocabPointer): VocabPointer;
var
old, top: VocabPointer;
done: boolean;
begin
top := start;
old := nil;
done := FALSE;
if start = nil then begin { первый элемент списка }
info^.next := nil;
last := info;
info^.prior :=nil;
DLS_Store := info;
end else
begin
while (start<>nil) and (not cone) do
begin
if start^.word < info^.word then
begin
old := start;
start := start^.next;
end else
begin { вставка в середину }
if old <>nil then
begin
old^.next := info;
info^.next := start;
start^.prior := info;
info^.prior := old;
DLS_Store := top; { сохранение начала }
done := TRUE;
end else
begin
info^.next := start;{новый первый элемент }
info^.prior := nil;
DLS_Store := info;
done := TRUE;
end;
end;
end; { конец цикла }
if not done then begin
last^.next := info;
info^.next := nil;
info^.prior := last;
last := info;
DLS_Store := top; { сохранение начала }
end;
end;
end; { конец функции DLS_Store }
{ удаление слова }
function DL_Delete(start: VocabPointer
key: str[80]:) VocabPointer
var
temp, temp2: VocabPointer
done: boolean;
begin
if star^.num = key then begin { первый элемент
списка }
DL_Delete := start^.next;
if temp^.next <> nil then
begin
temp := start^.next;
temp^.prior := nil;
end;
dispose(start);
end else
begin
done := FALSE;
temp := start^.next;
temp2 := start;
while (temp <> nil) and (not done) do
begin
if temp^.word = key then
begin
temp2^.next := temp^.next;
if temp^.next = <> nil then
temp^.next^.prior := temp2
done := TRUE;
if last := temp then last := last^.prior
dispose(temp);
end else
begin
temp2 := temp;
temp := temp^.next;
end;
end;
DL_Delete := start; { начало не изменяется }
if not done then Writeln('not found');
end;
end; { конец функции DL_Delete }
{ удаление слова, заданного пользователем }
procedure remove;
var
name:str80;
begin
Writeln('Enter word to delete: ');
Readln(name);
start := DL_Delete(start,name);
end; { конец процедуры удаления слова, заданного
пользователем}
{ ввод слов в базу данных }
procedure Enter;
var
info: VocabPointer;
done: boolean;
begin
done := FALSE;
repeat
new(info) { получить новую запись }
Write('Enter word: ');
Readln(info^.word);
if Length(info^.word)=0 then done := TRUE
else
begin
Write(Enter type(n,v,a): ');
Readln(info.typ);
Write(Enter connotation (g,b,n): ');
Readln(info.connotation);
Write(Enter difinition: ');
Readln(info.dif);
start := DLS_Store(info, start, last); { вставить
запись }
end;
until done or one;
end; { конец ввода }
{ вывод слов из базы данных }
procrdure Display(start: VocabPointer);
begin
while start <> nil do begin
Writeln('word',start^.word);
Writeln('type',start^.typ);
Writeln('connotation',start^.connotation);
Writeln('difinition',start^.def);
Writeln;
start := start^.next
end;
end; {конец процедуры вывода }
{ поиск заданного слова }
function Search(start: VocabPointer; name: str80):
VocabPointer;
var
done: boolean;
begin
done := FALSE
while (start <> nil) and (not done) do begin
if word = start^.word then begin
search := start;
done := TRUE;
end else
start := star^.next;
end;
if start = nil then search := nil; { нет в списке }
end; { конец поиска }
{ поиск слова,заданного пользователем }
procedure Find;
var
loc: VocabPointer;
word: str80;
begin
Write('Enter word to find: ');
Readln(word);
loc := Search(start, word);
if loc <> nil then
begin
Writeln('word',loc^.word);
Writeln('type',loc^.typ);
Writeln('connotation',loc^.connotation);
Writeln('difinition',loc^.def);
Writeln;
end;
else Writeln('not in list')
Writeln;
end; { Find }
{ записать словарь на диск }
procedure Save(var f:FilType; start: VocabPointer):
begin
Writeln('saving file');
rewrite(f);
while start <> nil do begin
write(f,start);
start := start^.next;
end;
end;
{ загрузить словарь с диска }
procedure Load(var f:FilType; start: VocabPointer):
VocabPointer;
var
temp, temp2: VocabPointer
first: boolean;
begin
Writeln('load file');
reset(f);
while start <> nil do begin
temp := start^.next
dispose(start);
start := temp;
end;
start := nil; last := nil;
if not eof(f) then begin
New(temp);
Read(f,^temp)
start := DLS_Store(temp,start,last);
end;
Load := start;
end; { Load }
{ поочередное выделение слов из предложения }
procedure Dissect(var s:str80;var w:str30);
var
t, x:integer;
temp:str80;
begin
t :=1;
while(s[t]=' ') do t := t+1;
x := t;
while(s[t]=' ') and (t<=Length(s)) do t := t+1;
if t<=Length(s) then t := t-1;
w := copy(s, x, t-x+1);
temp := s;
s := copy(temp,t+1,Length(s))
end;
{ формирование ответов на основании введенного пользователем
предложения }
procedure Talk;
var
sentence: str80
word: str30
w: VocabPointer;
begin
Writeln('Conversation mode (quit to exit)');
repeat
Write(': ')
Readln(sentence)
repeat
Dissect(sentence,wort);
w := Search(start, word);
if w <> nil then begin
if w^.type = 'n' then
begin
case w^.connotate of
'g': Write('I like ');
'b': Write('I do not like ');
end;
Writeln(w^.def);
end;
else Writeln(w^.def);
end;
else if word <>'quit' then
begin
Writeln(word,'is unknown.');
enter(TRUE);
end;
until Length(sentence) = 0;
until word = 'quit';
end;
begin
start := nil;
last := nil;
done := FALSE;
Assign(smart,'smart.dfd')
repeat
case MenuSelect of
'1': Enter(FALSE);
'2': Remove;
'3': Display(start);
'4': Find;
'5': Save(smart,start);
'6': start := Load(smart,start);
'7': Talk;
'8': done := TRUE;
end;
until done=TRUE;
end.
Эта программа составляется несложно. Вы можете ее несколько
усовершенствовать. Можно, например, выделить из предложения гла-
голы и заменить их на альтернативные в комментарии. Вы можете
также предусмотреть возможность задавать вопросы.
