Энциклопедия Turbo Pascal. Главы 1-4 - Динамическое распределение памяти и задачи искусственного интеллекта
ОГЛАВЛЕНИЕ
Динамическое распределение памяти и задачи искусственного интеллекта
Хотя Паскаль не является основным языком, который используется при решении задач искусственного интеллекта, его можно использовать и в этой области. Основной чертой многих программ из области искусственного интеллекта является наличие списка информационных элементов, который может расширяться программой автоматически по мере ее "обучения". В таком языке как Пролог, который считается основным языком искусственного интеллекта, поддержка списка обеспечивается автоматически. На языке Паскаль такие процедуры должны программироваться с применением связанных списков и механизма динамического распределения памяти. Хотя приводимый пример является очень простым, те же принципы применимы для разработки более сложных "разумных" программ.
Одну интересную область искусственного интеллекта составляют программы, работа которых напоминает поведение людей. Знаменитая программа "Элиза", например, ведет себя как психиатр. Совсем неплохо иметь программу, которая может "разговаривать" на любую тему - как было бы хорошо запустить такую программу, когда вы устанете от программирования и почувствуете себя одиноким! Ниже приводиться очень простая версия такой программы. В ней используются слова и их определения для ведения простого диалога с пользователем. Одной общей чертой всех программ искусственного интеллекта является связь информационного элемента с его смыслом. В этом примере слова связываются с их смыслом. Ниже описывается запись, предназначенная для содержания каждого слова, его определения, части речи и его дополнения:
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);
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;Ниже приводится вся программа:
{ программа, которая позволяет вести очень простой диалог }
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.Эта программа составляется несложно. Вы можете ее несколько усовершенствовать. Можно, например, выделить из предложения глаголы и заменить их на альтернативные в комментарии. Вы можете также предусмотреть возможность задавать вопросы.