Энциклопедия Turbo Pascal. Главы 1-4
Страница 43. Динамическое распределение памяти и задачи искусственного интеллекта


Динамическое распределение памяти и задачи искусственного интеллекта

     Хотя Паскаль не является основным языком,  который использу-
ется при  решении задач искусственного интеллекта,  его можно ис-
пользовать и в этой области.  Основной чертой многих программ  из
области искусственного  интеллекта является наличие списка инфор-
мационных элементов, который может расширяться программой автома-
тически по мере ее "обучения".  В таком языке как Пролог, который
считается основным языком  искусственного  интеллекта,  поддержка
списка обеспечивается автоматически.  На языке Паскаль такие про-
цедуры должны программироваться с применением связанных списков и
механизма динамического  распределения  памяти.  Хотя  приводимый
пример является очень простым,  те же принципы применимы для раз-
работки более сложных "разумных" программ.
     Одну интересную область искусственного интеллекта составляют
программы, работа  которых напоминает поведение людей. Знаменитая
программа "Элиза", например, ведет себя как психиатр. Совсем неп-
лохо иметь программу, которая может "разговаривать" на любую тему
- как было бы хорошо запустить такую программу, когда вы устанете
от программирования и почувствуете себя одиноким! Ниже приводить-
ся очень простая версия такой программы. В ней используются слова
и их  определения  для  ведения простого диалога с пользователем.
Одной общей чертой всех программ искусственного интеллекта  явля-
ется связь информационного элемента с его смыслом. В этом примере
слова связываются с их смыслом. Ниже описывается запись, предназ-
наченная для содержания каждого слова, его определения, части ре-
чи и его дополнения:

        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.

     Эта программа составляется несложно.  Вы можете ее несколько
усовершенствовать.  Можно, например, выделить из предложения гла-
голы и заменить их на альтернативные  в  комментарии.  Вы  можете
также предусмотреть возможность задавать вопросы.

 
« Предыдущая статья