До сайту KCOНО
9. РЕАЛ╤ЗАЦ╤Я ПРОДУКЦ╤ЙНО╥ ЕКСПЕРТНО╥ СИСТЕМИ.
10. РЕАЛ╤ЗАЦ╤Я АЛГОРИТМА ЗВОРОТНОГО ЛАНЦЮЖКА М╤РКУВАНЬ
11. ПРОГРАМУВАННЯ, ЯКЕ УПРАВЛЯ╢ТЬСЯ ДАНИМИ АБО ПОД╤ЯМИ.
12. МЕТОД З╤СТАВЛЕННЯ ╤З ЗРАЗКОМ

        9. РЕАЛ╤ЗАЦ╤Я ПРОДУКЦ╤ЙНО╥ ЕКСПЕРТНО╥ СИСТЕМИ.

    9.1. База знань.

    Найб╕льш ун╕версальним засобом запису знань ╓ запис на  основ╕ 
правил продукц╕й типу "ЯКЩО умова ТО насл╕док".В мов╕ LISP найпрос-
т╕шою структурою за такою схемою буде список, елементи якого  зада-
ють пару "умова-насл╕док":

((умова1 насл╕док1) (умова2 насл╕док2) ... (умоваN насл╕докN))
    
    Так, наприклад, можна описати таким чином якийсь план транспор-
тних  комун╕кац╕й. Для прикладу опишемо наступний план:

      МОСКВА <--------> К И ╥ В <----------------  Н╢ЖИН
                        | | |                     |   
                        | | |                     |    
ЛЬВ╤В <--------------->   |  ----------------> ЛУГАНСЬК
                          |
ДОНЕЦЬК <-------------> ХАРК╤В              


    (setq 'план-1
       '((Москва Ки╖в) (Ки╖в Москва) (Льв╕в Ки╖в) (Ки╖в Льв╕в)
         (Ки╖в Харк╕в) (Харк╕в  Ки╖в) (Донецьк Харк╕в) 
         (Харк╕в Донецьк) (Ки╖в Луганськ) (Луганськ Н╓жин)
         (Н╓жин Ки╖в)))

    Такий список плану вже зада╓ конкретну базу знань,  яка  нада╓
можлив╕сть в╕дшукувати маршрути по╖здок ╕з одного  м╕ста  в  ╕нший.
Така база знань ╓ найпрост╕шою. Можна ускладнити ╖╖, якщо умови та 
насл╕док задати у вигляд╕ деяко╖ структури. Наприклад:
(((пац╕╓нт хворий) (температура висока) (голова болить)) ;умова
 ((хвороба грип) (ймов╕рн╕сть 0.8)))                     ;насл╕док.
    Кр╕м того, мова LISP дозволя╓ кожному  об'╓кту  надати  список
атрибут╕в (список властивостей). Наприклад, символ ПАЦ╤╢НТ може ма-
ти такий список властивостей:
   ((стать чолов╕к) (народження 1972) (проживання Ки╖в))
   
    9.2. Машина виводу.            

    Машина виводу - це програмна система, яка забезпечу╓ пошук  ╕н-
формац╕╖ в баз╕ знань по первинно заданим фактам. ╤сну╓ три  основ-
них вар╕анта первинно заданих факт╕в: заданий к╕нцевий факт (ц╕ль), 
заданий початковий факт (начало), задан╕ начало та ц╕ль. 
    Машина виводу реал╕зу╓ зв'язування правил  бази знань  в ланцю-
жок м╕ркувань. При цьому може виникати необх╕дн╕сть  в  допом╕жних  
запитах на введення уточнюючих даних або нових факт╕в,якщо ц╕ль не 
досягнена.
    В залежност╕ в╕д вар╕анта первинно заданих факт╕в машина  виво-
ду може застосовувати два вар╕анта пошуку ╕нформац╕╖: в прямому на-
прямку ( умова-насл╕док) та в зворотному (насл╕док-умова).  Перший
вар╕ант отримав назву "зас╕б прямого ланцюжка м╕ркувань", другий -
"зас╕б зворотного ланцюжка м╕ркувань".
    При реал╕зац╕╖ пошуку ╕нформац╕╖, кр╕м того, можуть  застосову-
ватись методи оптим╕зац╕╖ пошуку по заданим критер╕ям, що  забезпе-
чу╓ здобуття "найкращого" р╕шення. Найкраще р╕шення,зрозум╕ло, в╕д-
пов╕да╓ заданим критер╕ям.
    Розробимо функц╕ю пошуку маршруту по заданому  в  попередньому
п╕дрозд╕л╕ списку "план-1". В якост╕ первинно  заданих факт╕в буде:
початкове м╕сто -"начало", к╕нцеве м╕сто -"к╕нець",план-1 -"карта",
зас╕б пошуку - "зас╕б". Останн╕й параметр буде пояснений пот╕м.
    Таким чином формат визову функц╕╖ буде:

    (як-про╖хати начало к╕нець карта зас╕б)

    Спочатку розробимо деяк╕ допом╕жн╕ функц╕╖.Насамперед потр╕бна
буде функц╕я вибору ╕з "карти" можливих вар╕ант╕в подальшого пере-
м╕щення п╕сля кожного попереднього:

(defun можливо (стан карта )
    (mapcan '(lambda (правило)
                      (if (eq стан (car правило))
                          (list правило)
                          nil ))
              карта))

    Стан -це задане м╕сто на "карт╕".Функц╕я поверта╓ список  вс╕х
вар╕ант╕в пари умова-насл╕док, в яких на першому м╕сц╕ сто╖ть зада-
ний "стан".
    Дал╕ реал╕зу╓мо "зас╕б", за допомогою якого  буде  проводитись
пошук:

(defun в-ширину (поточний-план)
   (append
           (можливо (cadr (car поточний-план)) план-1)
           (cdr поточний-план)))

    Вар╕ант засобу  "в-ширину"  бере  ╕з  "поточного-плану"  перше
правило, в╕дшуку╓ вс╕ можлив╕ вар╕анти по насл╕дку цього правила ╕
добавля╓ ╖х в начало "поточного-плану". Чому цей зас╕б  ма╓  назву
"в-ширину"  - буде дал╕.
    Розробимо основну функц╕ю пошуку: 

(defun пошук (к╕нець поточний-план маршрут зас╕б)
  (cond
    ((null поточний-план) (print (reverse маршрут)) nil)  
                                            ; поточний план пустий
    ((eq к╕нець (cadr (car поточний-план))) ;якщо  к╕нцевий пункт
                                    ;знайшовся в поточному-план╕,
      (print  (reverse (cons к╕нець маршрут)))) ;то зак╕нчити.
    ((member (cadr (car поточний-план)) маршрут);якщо насл╕док вже
                ;╓ в маршрут╕, то рекурсивний пошук в cdr-план╕.
        (пошук к╕нець (cdr поточний-план) маршрут зас╕б) )
                    ;якщо вс╕ попередн╕ умови не виконуються,
                    ;то перетворимо поточний-план заданим
                    ;"засобом", доповнимо "маршрут" ╕ рекурсивно
                    ;зд╕йсню╓мо подальший пошук.
    ( t (пошук к╕нець (funcall зас╕б поточний-план)
                      (cons (cadr (car поточний-план)) маршрут)
                        зас╕б ) ) ) )

    ╤, нарешт╕, розробимо головну функц╕ю:

(defun як-про╖хати (начало к╕нець карта зас╕б)
   (пошук к╕нець
          (можливо начало карта)
          (list начало)
          зас╕б
   )
)

    Тут, як бачимо, зд╕йсню╓ться виклик функц╕╖ "пошук" з заданими
початковими параметрами для начала пошуку.
    Подивимось як ця функц╕я працю╓:

    (як-про╖хати 'Льв╕в 'Н╓жин план-1 в-ширину)
    (Льв╕в Ки╖в Москва Харк╕в Донецьк Луганськ Н╓жин)

    Як бачимо, до к╕нцевого м╕ста ми д╕йшли, але з'явились пром╕ж-
н╕ м╕ста: Москва, Харк╕в та Донецьк. В задан╕й задач╕ ц╕ пром╕жн╕ 
результати зайв╕, але в ╕нших предметних вар╕антах баз знань вони 
можуть бути потр╕бними.В даному раз╕ можна рекомендувати в╕дс╕кти   
непотр╕бн╕ пункти за допомогою наступно╖ функц╕╖:

(defun в╕дс╕кти-лишн╓ (маршрут карта)
   (cond
     ((equal маршрут (в╕дс╕кти маршрут карта ))
        маршрут)
     (t (в╕дс╕кти-лишн╓ (в╕дс╕кти маршрут карта)))))      
(defun в╕дс╕кти (маршрут карта р╕шення)
    (cond
        ((null карта) nil)
        ((null маршрут) nil)
	((null (cadr маршрут))
                  (reverse (cons (car маршрут) р╕шення)))
        ((member (list (car маршрут) (cadr маршрут)) карта equal)
	   (в╕дс╕кти (cdr маршрут) карта
                     (cons (car маршрут) р╕шення))
        )
	(t (в╕дс╕кти (cdr маршрут) карта р╕шення))))

(в╕дс╕кти-лишн╓ (як-про╖хати 'Льв╕в 'Н╓жин план-1 в-ширину) план-1 )
(Льв╕в Ки╖в Луганськ Н╓жин)

    9.3. Алгоритм прямого ланцюжка м╕ркувань.

    Тепер б╕льш ретельно проанал╕зу╓мо роботу розроблено╖  функц╕╖
"як-про╖хати". Реал╕зований процес пошуку маршруту повн╕стю  зб╕га-
╓ться з процесом пошуку виходу ╕з лаб╕ринта. Для того,  щоб знайти
вих╕д, треба ретельно обстежити кожний  новий  перех╕д,  записуючи
план обходу. Таким планом в нашому раз╕ ╓ "поточний план", в якому
збер╕гаються вс╕ переходи, як╕ ще не обстежен╕. При цьому  в  "мар-
шрут╕" записуються не б╕льше одного разу вс╕ вузли,як╕ були  обсте-
жен╕.  Вузли, вс╕ переходи з якого вже обстежен╕, викреслюються ╕з 
"поточного плану" разом ╕з попередн╕м вузлом.Робота буде зак╕нчена 
т╕льки тод╕, коли повн╕стю вичерпа╓ться поточний план або  якщо  в 
поточному план╕ з'явиться к╕нцевий пункт ╕ ми до нього  вже д╕йшли. 
Якщо ми хочемо обстежити вс╕ вар╕анти, до яких   приведе   заданий 
початковий факт, то можна задати не╕снуючу ц╕ль. В нашому  випадку 
це призведе до проб╕гу по вс╕х пунктах (м╕стах). Але в  загальному 
випадку це буде т╕льки частина  правил бази знань.
    Таким чином бачимо, що в конструкц╕╖ алгоритму машини   виводу 
засобом прямого ланцюжка м╕ркувань присутн╕ наступн╕ елементи:
    - поточн╕ правила лог╕чного виводу (поточний план);
    - факти запит╕в (начало, к╕нець; взагал╕ це також ще й факти,
                      визначен╕  допом╕жними запитами);
    - факти виводу (маршрут).
    Поточн╕  зм╕нн╕ лог╕чного виводу в нашому випадку були  орган╕-
зован╕ у вигляд╕ стеку. Факти виводу повинн╕ збер╕гатися до  к╕нця 
роботи машини виводу, ╕накше можна "заблукати" та п╕ти тим  шляхом, 
який вже був пройдений. Факти виводу звуть ще "сл╕дом" машини виво-
ду.
    Алгоритм роботи машини виводу можна описати наступним чином
    (зам╕сть "стеку", як буде показано дал╕, можна застосовувати
     ╕ "чергу"):
    
    1. Ввести або визначити начальне значення зм╕нних умови  та за-
       писати ╖х в список факт╕в виводу.
    2. Вибрати ╕з БЗ та загрузити в стек можлив╕  правила  по зада-
       ним зм╕нним списку факт╕в виводу. Перев╕рити стек, якщо  в╕н
       пустий, то зак╕нчити роботу з виводом факт╕в виводу . 
    3. Перев╕рити виконання умови першого правила стека  по  списку
       факт╕в виводу. При цьому можлив╕ допом╕жн╕  запити,  якщо  в 
       умовах правила ╓ ще невизначен╕ лог╕чн╕  частини  I  та  АБО.
       П╕дтверджен╕ факти записуються в список факт╕в виводу. 
    4. Якщо правило  викону╓ться, то перев╕рити чи визначен╕ зм╕нн╕
       насл╕дка правила в списку факт╕в. Якщо не визначен╕, то запи-
       сати ╖х  в  список факт╕в виводу. Вигрузити правило ╕з стека 
       ╕ ╕ти до 2.
    5. Якщо правило не викону╓ться або викону╓ться, але здобутий на-
       сл╕док вже ╓ в списку факт╕в виводу, то вигрузити це правило 
       ╕з стека без зм╕н в списку факт╕в виводу.
    6. Перев╕рити стек. Якщо в╕н вже пустий, то йти до 2.Перев╕рити 
       список факт╕в виводу на присутн╕сть к╕нцевого факту. Якщо та-
       кий факт вже знайдений, то вийти на зак╕нчення роботи,╕накше 
       йти до 3.

       9.4. Пошук "в-ширину", "в-глибину" та "по-критер╕ю".
   
    В реал╕зац╕╖ алгоритму пошуку виходу ╕з лаб╕ринту н╕чого кращо-
го не можна придумати, як перебирати вс╕ вар╕анти до тих п╕р, поки
не буде знайдений вих╕д. Але ╓ можлив╕сть вибору вар╕анта перебору.
    В приведеному ран╕ше приклад╕ була застосована функц╕я "в-шири-
ну". Ця функц╕я перетворю╓ "поточний план" (поточн╕ правила) таким
чином, що нов╕ правила, як╕ мають р╕шення в поточн╕й точц╕ лог╕чно-
го виводу, додаються в початок поточного плану. Дал╕ алгоритм маши-
ни виводу анал╕зу╓ перше правило ╕з поточного плану. Поточний план
в такому випадку застосову╓ться як стек.  Таким  чином, ми не п╕де-
мо дал╕, поки не проанал╕зу╓мо вс╕ переходи,як╕ з'явились при вс╕х
попередн╕х анал╕зах.Такий шлях, як зда╓ться,найб╕льш над╕йний, але
найменш швидкий.
    Другий вар╕ант заключа╓ться в тому, що нов╕ переходи (правила)
додаються не в начало поточного плану, а в к╕нець. Поточний план в
такому раз╕ застосову╓ться як черга. При такому вар╕ант╕ ми  обсте-
жу╓мо переходи кожний раз до тих п╕р, поки не вийдемо в тупик. При
цьому ╓ ймов╕рн╕сть, що ми д╕станемось ц╕л╕ ран╕ш,  н╕ж  обстежимо
вс╕ виникаюч╕ переходи. Такий шлях теж над╕йний ╕ в нашому випадку
б╕льш виг╕дний. В╕н зветься пошуком "в-глибину".  Реал╕зац╕я  його 
в╕др╕зня╓ться т╕льки тим,що в функц╕╖ "в-ширину" м╕няються м╕сцями 
аргументи функц╕╖ append:

(defun в-глибину (поточний-план)
   (append
           (можливо (cadr (car поточний-план)) план-1)
           (cdr поточний-план)))

    Результати рахунку по р╕зним вар╕антам будуть, в загальному ви-
падку, р╕зними. Вар╕ант "в-глибину" може дати менше тупикових резу-
льтат╕в.
    Кр╕м того,можна реал╕зувати ще й пошук "по найкращому вар╕анту",
якщо кожний раз при модиф╕кац╕╖ поточного плану сортирувати вибран╕
правила за якимось критер╕╓м. Наприклад, задамо список,в якому кож-
ному м╕сту поставимо в в╕дпов╕дн╕сть конкретний критер╕й,наприклад,
широту м╕сцезнаходження на Земл╕:

(defun значення ()
   (setq  значення
      '((Льв╕в 2)
        (Ки╖в 3)
        (Москва 4)
        (Харк╕в  2)
        (Донецьк 1)
        (Луганськ 1)
        (Н╓жин 1)
        (Петербург 5))))

   Розробимо функц╕ю "по-критер╕ю",в як╕й на в╕дм╕ну в╕д "в-ширину"
п╕сля формування поточного плану кожний раз  будемо  сортувати план
таким чином, щоб на першому м╕сц╕ були  м╕ста,  як╕ знаходяться  на
менш╕й широт╕, тобто ближе до п╕вдня:

(defun по-критер╕ю (план)
   (sort (append (можливо (cadr (car план)) план-1)
                  (cdr план)
         ) 'критер╕й ))
(defun критер╕й (x y)
  (<= (cadr (assoc (cadr x) (значення)))
      (cadr (assoc (cadr y) (значення)))))

    Перев╕римо в робот╕:
(як-про╖хати 'Льв╕в 'Н╓жин план-1 по критер╕ю)
(Льв╕в Ки╖в Луганськ Н╓жин)

    В даному випадку ми одразу знайшли шлях без тупик╕в ╕ "самий"
п╕вденний.

     10. РЕАЛ╤ЗАЦ╤Я АЛГОРИТМА ЗВОРОТНОГО ЛАНЦЮЖКА М╤РКУВАНЬ.

    10.1. Загальн╕ положення.

    Як було вже сказано в попередньому розд╕л╕,кр╕м алгоритма пря-
мого ланцюжка м╕ркувань, який ╓ природним алгоритмом обробки  про-
дукц╕йно╖ бази знань, таку базу можна обробляти ╕ зворотним чином,
тобто зв'язувати правила не по типу "умови наступного правила = на-
сл╕дки поточного правила", а навпаки - "насл╕дки наступного  прави-
ла = умови поточного правила". В такому раз╕ поляга╓ться, що умови
╕ насл╕дки кожного правила м╕няються м╕сцями. Якщо на цьому зупини-
тись, то реал╕зац╕я такого алгоритма не буде в╕др╕знятись в╕д  реа-
л╕зац╕╖  прямого алгоритма. Так в приклад╕, наведеному  в  поперед-
ньому розд╕л╕, для цього необх╕дно лише по вс╕х функц╕ях  пом╕няти
м╕сцями параметри "начало" ╕ "к╕нець" та функц╕╕ car ╕ cdr. Але  в 
загальному випадку так робити не можна,тому що умови ╕ насл╕дки не 
завжди м╕няються м╕сцями. Наприклад, ма╓мо правило:  "ЯКЩО  настав 
ранок, ТО стало св╕тло ". Чи можемо ми тепер сказати: "ЯКЩО  стало 
св╕тло, ТО настав ранок"? Зв╕сно н╕,тому що св╕тло може бути ╕ в╕д  
штучного осв╕тлення. Але ми можемо покласти, що таке  правило може
бути г╕потезою ╕ задати запитання на п╕дтвердження тако╖ г╕потези:
"ЯКЩО стало св╕тло, ТО може тому, що настав ранок?".╤ якщо так, то
т╕льки тод╕ таке "зворотне" правило прийма╓мо за ╕стину.
    К необх╕дност╕ застосування алгоритма зворотного ланцюжка  м╕р-
кувань призводить, наприклад, задача, в як╕й користувач зна╓  ц╕ль,
але не зна╓, як ╖╖ досягти ╕ з чого  почати.  Взагал╕ в експертних
системах част╕ше застосовуються обидва алгоритма, як╕, як  правило,
не лише не заважають , але й доповнюють один одного,  що робить ма-
шину виводу б╕льш ефективною.

    10.2. Алгоритм зворотного ланцюжка м╕ркувань.

    З'ясу╓мо, чим зворотний алгоритм в╕др╕зня╓ться в╕д прямого  ал-
горитма. Основна схема пошуку залиша╓ться без зм╕н, але до не╖  не-
обх╕дно додати ще обов'язков╕ запитання до користувача, як╕ уточню-
ють ╕стину правила, яке розгляда╓ться як поточне.При цьому необх╕д-
но кожний раз перев╕ряти, може таке запитання вже було ╕ в╕дпов╕дь
на нього збер╕га╓ться в списку запит╕в. Якщо правило п╕дтверджу╓ть-
ся, то дал╕ алгоритм д╕╓ так, як  ╕  прямий  ( т╕льки в зворотному
напрямку ).
    Таким чином загальний алгоритм зворотного ланцюжка м╕ркувань
    буде такий (зам╕сть "стеку" тут також можна застосовувати
     ╕ "чергу"):

    1. Ввести або визначити к╕нцевий факт зм╕нних насл╕дку та запи-
       сати його в список факт╕в виводу.
    2. Вибрати ╕з БЗ та завантажити в стек можлив╕ правила  по зада-
       ним зм╕нним списка факт╕в виводу. Перев╕рити стек, якщо  в╕н
       пустий, то зак╕нчити роботу з  пов╕домленням  про  неспромож-
       н╕сть подальшого пошуку.
    3. Перев╕рити виконання умови першого правила стека  по  списку
       факт╕в виводу та за допомогою уточнюючих запит╕в.
    4. Якщо запити п╕дтверджуються, то записати ╖х в список  факт╕в
       виводу. Якщо правило повн╕стю  викону╓ться, то вигрузити його
       ╕з стека ╕ ╕ти до 2.
    5. Якщо правило не викону╓ться, то вигрузити це правило ╕з стека.
    6. Перев╕рити стек. Якщо в╕н вже пустий, то йти до 2, ╕накше йти
       до 3.

    Таким чином, ми створили зворотний алгоритм пошуку  у  випадку,
коли зада╓ться к╕нцевий факт. Але ╓ й ще така ситуац╕я, коли корис-
тувач не зна╓ к╕нцевого факту, але зна╓ ознаки, як╕ напевно  приве-
дуть до визначення к╕нцевого факту. При так╕й ситуац╕╖ иашина виво-
ду повинна визначити список можливих к╕нцевих факт╕в ( список г╕по-
тез) ╕ перев╕ряти ц╕ г╕потези по черз╕. Алгоритм буде дек╕лька в╕д-
р╕знятись в╕д приведеного, хоча схема зворотного пошуку залишиться:


    1. Ввести або визначити список г╕потез.
    1а.Перев╕рити список г╕потез. Якщо в╕н пустий, то зак╕нчити ро-
       боту з пов╕домленням про неспроможн╕сть  досягти  к╕нцевого 
       результата; якщо не пустий, то вибрати  першу  г╕потезу  ╕з 
       списка г╕потез.
    2. Вибрати ╕з БЗ та загрузити в стек можлив╕  правила  по зада-
       н╕й г╕потез╕. Перев╕рити стек, якщо  в╕н пустий,то вилучити
       першу гiпотезу ╕з списка ╕ йти до 1а.
    3. Перев╕рити виконання умов першого правила стека  по  списку
       факт╕в виводу та за допомогою уточнюючих запит╕в.  Для того,
       щоб не задавати один ╕ той же запит дек╕лька раз╕в, запам'я-
       товувати його в списку запит╕в ╕ перев╕ряти ╖х ╕снування пе-
       ред тим, як задавати запит.
    4. Якщо запити п╕дтверджуються, то записувати ╖х в список  фак-
       т╕в виводу . Якщо правило повн╕стю  викону╓ться, то зак╕нчи-
       ти роботу з к╕нцевим результатом у вигляд╕ доказано╖ г╕поте-
       зи.
    5. Якщо правило не викону╓ться,то вигрузити це правило ╕з стека.
       Перев╕рити стек, якщо в╕н пустий, то вилучити першу гiпотезу 
       ╕з списка г╕потез ╕ йти до 1а; якщо не пустий, то йти до 3.

    В зворотному алгоритм╕ також можна реал╕зовувати пошук"в-ширину",
"в-глибину" та "по-критер╕ю".

    10.3. Приклад експертно╖ системи з алгоритмом зворотного
          ланцюжка м╕ркувань.

    Наведемо приклад експертно╖ системи, яка визнача╓ по деяким оз-
накам назву тварини. Тут застосову╓ться зас╕б зворотного  ланцюжка
м╕ркувань по другому вар╕анту алгоритма,який описаний в попередньо-
му п╕дрозд╕л╕.
    Вс╕ основн╕ пояснення даються в текст╕ програм.
    
    10.3.1. База знань.
    База знань для зручност╕ створю╓ться спочатку у вигляд╕ множини 
окремих правил. Пот╕м перетворю╓ться в структурований список, який
опису╓ться як структура за допомогою функц╕╖ defstruct. З таким ст-
руктурованим списком зручн╕ше працювати за допомогою функц╕й make-*.
Можна було б визначити базу знань зразу у  вигляд╕  структурованого
списка, але це не так зручно.  

(terpri) (princ
" ЕХПЕРТНА СИСТЕМА, ЯКА ПОБУДОВАНА НА ПРОДУКЦiЙНiЙ БАЗi ЗНАНЬ ")
(terpri) (princ
"    ТА ЗАСТОСОВУЕ АЛГОРИТМ ЗВОРОТНОГО ЛАНЦЮЖКА МIРКУВАНЬ. ")
(terpri) (princ
"    ************ КЛАСИФIКАТОР ЗВIРIВ *******************  ")


;------- СТВОРЕННЯ ТА ПЕРЕТВОРЕННЯ ПРОДУКЦiЙНОI БАЗИ ЗНАНЬ-------
;****************************************************************

;************* Створення структури  "правило" *******************
(defstruct правило name умови наслiдки)

;********* Продукцiйна база знань *******************************
(setq ПРАВИЛО1
   '(ЯКЩО ТВАРИНА МАЕ ШЕРСТЬ
     ТО ТВАРИНА ССАВЕЦЬ))
(setq ПРАВИЛО2
   '(ЯКЩО ТВАРИНА ГОДУЕ ДIТЕЙ МОЛОКОМ
      ТО ТВАРИНА ССАВЕЦЬ))
(setq ПРАВИЛО3
    '(ЯКЩО ТВАРИНА МАЕ ПIР^Я
      ТО ТВАРИНА ПТИЦЯ))
(setq ПРАВИЛО4
     '(ЯКЩО ТВАРИНА МОЖЕ ЛIТАТИ
       I ТВАРИНА НЕСЕ ЯЙЦЯ
       ТО ТВАРИНА ПТИЦЯ))
(setq ПРАВИЛО5
     '(ЯКЩО ТВАРИНА IСТЬ М^ЯСО
       ТО ТВАРИНА ХИЖАК))
(setq ПРАВИЛО6
     '(ЯКЩО ТВАРИНА МАЕ ГОСТРI ЗУБИ
      I ОЧI  ПОСАДЖЕНI ПРЯМО
      ТО ТВАРИНА ХИЖАК))
(setq ПРАВИЛО7
     '(ЯКЩО ТВАРИНА ССАВЕЦЬ
       I ТВАРИНА МАЕ КОПИТА
	ТО ТВАРИНА ЖВАЧНА))
(setq ПРАВИЛО8
      '(ЯКЩО ТВАРИНА ССАВЕЦЬ
       I ТВАРИНА ЖУЕ ЖВАЧКУ
       ТО ТВАРИНА ЖВАЧНА))
(setq ПРАВИЛО9
      '(ЯКЩО ТВАРИНА ССАВЕЦЬ
	I ТВАРИНА ХИЖАК
	I ТВАРИНА ЖОВТО-КОРИЧНЕВА
	I ТВАРИНА МАЕ ТЕМНI ПЛЯМИ
	ТО ТВАРИНА ГЕПАРД))
(setq ПРАВИЛО10
       '(ЯКЩО ТВАРИНА ССАВЕЦЬ
	 I ТВАРИНА ХИЖАК
	 I ТВАРИНА ЖОВТО-КОРИЧНЕВА
	 I ТВАРИНА ПОЛОСАТА
	 ТО ТВАРИНА ТИГР))
(setq ПРАВИЛО11
       '(ЯКЩО ТВАРИНА ЖВАЧНА
	  I ТВАРИНА МАЕ ДОВГУ ШЕЮ
	  I ТВАРИНА МАЕ ДОВГI НОГИ
	  I ТВАРИНА МАЕ ТЕМНI ПЛЯМИ
	  ТО ТВАРИНА ЖИРАФ))
(setq ПРАВИЛО12
	'(ЯКЩО ТВАРИНА ЖВАЧНА
	  I ТВАРИНА ПОЛОСАТА
	  ТО ТВАРИНА ЗЕБРА))
(setq ПРАВИЛО13
	'(ЯКЩО ТВАРИНА ПТИЦЯ
	  I ТВАРИНА НЕ МОЖЕ ЛIТАТИ
	  I ТВАРИНА МАЕ ДОВГУ ШЕЮ
	  I ТВАРИНА МАЕ ДОВГI НОГИ
	  I ТВАРИНА ЧОРНО-БIЛА
	  ТО ТВАРИНА СТРАУС))
(setq ПРАВИЛО14
	  '(ЯКЩО ТВАРИНА НЕ МОЖЕ ЛIТАТИ
	  I ТВАРИНА ПЛАВАЕ
	  I ТВАРИНА ЧОРНО-БIЛА
	  ТО ТВАРИНА ПIНГВIН))
;*********** Список *база-знань* - це список iмен правил ********
(setq *база-знань*
      '(ПРАВИЛО1 ПРАВИЛО2 ПРАВИЛО3 ПРАВИЛО4 ПРАВИЛО5
	 ПРАВИЛО6 ПРАВИЛО7 ПРАВИЛО8 ПРАВИЛО9 ПРАВИЛО10
	  ПРАВИЛО11 ПРАВИЛО12 ПРАВИЛО13 ПРАВИЛО14))

;*********** Допомiжна функцiя об'сднання елементiв в список ****
(defun присднай (x y)
	(append  x (list y)))

;********** Функцiя створення структури об^сктiв ****************
(defun створи-структуру (правила)
       (mapcar 'створи-об^скт  правила))
(defun створи-об^скт  (name)
	(let ((правило (eval name)))
	     (make-правило :name name
		  :умови (умови правило)
		  :наслiдки  (наслiдки правило))))

;*********** Функцii виводу списку умов та списку наслiдкiв iз
;******** повного правила ***************************************  
(defun умови (повне-правило)
   (правило-i (cdr повне-правило) nil nil))
(defun наслiдки (повне-правило)
   (правило-i (cdr (member 'ТО повне-правило)) nil nil))
(defun правило-i (повне-правило частина результат)
  (cond
    ((null повне-правило)
	 (присднай результат частина))
    ((eq (car повне-правило) 'ТО)
        (присднай результат частина))
    ((eq (car повне-правило) 'I)
	(правило-i (cdr повне-правило)
			    nil
		  (присднай результат частина)))
    (t (правило-i (cdr повне-правило)
	(присднай частина
	       (car повне-правило))
		результат))))

;********* Перетворення бази знань в структурований список ******
;*********  *правила*, з яким буде працювати машина виводу ****** 
(setq *правила*   (створи-структуру *база-знань*))

;   10.3.2. Реал╕зац╕я алгоритма пошуку.
    
;-------------- М А Ш И Н А      В И В О Д У --------------------
;****************************************************************
;Основнi елементи машини виводу:                                *  
;     *факти* - список факт╕в виводу                            *
;     *запроси* - список запит╕в                                *
;     *гiпотези* - список г╕потез                               *  
;      правила  - список поточних можливих правил               *
;     (expert) - управляюча функц╕я                             *
;****************************************************************

;******** Функцiя перевiрки iснування в *факти* наслiдкiв правила 
(defun перевiр-правило (правило)
       (пiдмножина
	    (правило-умови правило) *факти*))
(defun пiдмножина
	(пiдмножина множина)
     (equal пiдмножина
       (intersection пiдмножина множина)))

;***** Функцiя додання наслiдкiв правила в *факти* ***************
(defun додай-наслiдки (правило)
    (do ((наслiдки (правило-наслiдки правило) (cdr наслiдки)))
	((null наслiдки) *факти*)
	(if (member (car наслiдки) *факти*)
	     nil
	    (progn (princ "Вiдповiдно правилу ")
                   (princ  (правило-name правило))
                   (princ ": ")
	 (виведи-елементи (car наслiдки)))
	 (push (car наслiдки) *факти*))))

;***** Функцiя друкування елементiв списку **********************
(defun виведи-елементи (список)
     (mapc '(lambda (елемент)
	      (princ елемент) (princ " "))
	     список)
           (terpri) t)

;************ Створення списку *гiпотези*  **********************
(setq *гiпотези*
    '((ТВАРИНА ПIНГВIН) (ТВАРИНА СТРАУС) (ТВАРИНА ЗЕБРА) (ТВАРИНА
     ЖИРАФ) (ТВАРИНА ТИГР) (ТВАРИНА ГЕПАРД)))

;********** Управляюча функцiя експертноi системи ***************
(defun EXPERT ()
              ;  пiдготовка
   (terpri)
   (princ "Я знаток наступних об^ектiв:") (terpri)
   (mapc '(lambda (x) (виведи-елементи (cdr x)))
         *гiпотези*)
   (princ "Вiдповiдайте на наступнi запитання:") (terpri)

              ; цикл  
   (do   ((ll 'Т))
          ((not (eq ll 'Т))
             (princ "КIНЕЦЬ. Для повторного визову: (expert)")
             (terpri))
          (setq *факти* nil *запити* nil)
                ; виклик головноi функцii
          (знаток-звiрiв *гiпотези*)
          (terpri)
                ; повторний процес
          (princ "Хочете ще щось узнати? <Т,Н>: ")
          (setq ll (read))))

;******** Головна функцiя машини виводу  *************************
(defun знаток-звiрiв (гiпотези)
   (cond
      ((null гiпотези) 
              (princ "Об^екту за Вашими ознаками не iснуе.")
                        (terpri))
          ;******** всi гiпотези вичерпанi *************
      ((докажи (car гiпотези))  (princ "Вiдповiдь: ")
                               (виведи-елементи (car гiпотези)))
          ;******** доказана перша гiпотеза ************
      (t  (знаток-звiрiв (cdr гiпотези)))))
          ;******** рекурсiя до "хвоста" ***************

;*********** Функцiя доказу заданоi гiпотези ********************* 
(defun докажи (гiпотеза)
  (let ((правила))
    (cond ((member гiпотеза *факти*) t);Якщо гiпотеза с в *факти*, 
                          ; то гiпотеза доказана - кiнець.
                          ; Якщо нi, то 
          ((setq правила (можливi гiпотеза)) 
                          ;  збирасмо правила, якi можуть доказати
                          ;  гiпотезу i якщо вони с, то 
             (if (перевiр-можливi гiпотеза правила) 
                          ; поповнемо *факти*,   
                 t
                          ;якщо немас, то шукасмо далi рекурсивно
                          ; в глибину бази знань.
                 (шукай-рекурсивно гiпотеза правила)))
            ; Якщо нiякi новi правила вже не можна знайти, то
          (t (cond
              ((member гiпотеза *запити*)  nil) 
                         ;якщо така гiпотеза вже с в *запити*,
                         ;то гiпотеза не доказана, якщо нi, то
                         ;то запитасмо, чи вiрна гiпотеза
                         ;i якщо вiрна, то занесемо ii в *запити*
                      ;i в *факти*,iнакше гiпотеза теж не доказана.   
              ((and
                  (princ "Це правда, що  ")
                  (виведи-елементи гiпотеза) 
                  (princ "<ТАК (Т),Н>?: ")
                  (progn (setq l (read)) 
                       (or (eq l 'Т ) (eq l 'ТАК))))
                  (setq *факти* (union (list гiпотеза) *факти*)) t)
                  (t  (push гiпотеза *запити*) nil))))))

; ********** Функцiя пошуку правил, вiдповiдних до заданоi гiпотези.
(defun можливi (гiпотеза)
    (mapcan '(lambda (x)
	(if  (member гiпотеза (правило-наслiдки x)
	     'equal)
	     (list x)))
	 *правила*))

;******** Функцiя перевiрки можливих правил i поповнення *факти* *
;******** тими умовами, що ще не iснували в *факти* **************  
(defun перевiр-можливi (гiпотеза можливi)
  (cond
    ((null можливi) nil)
    ((null *факти*) nil)
    ((перевiр-правило (car можливi))
	(додай-наслiдки (car можливi)))
    (t (перевiр-можливi гiпотеза (cdr можливi)))))

;********** Функцiя глибинного пошуку  правил, зв'язанних ********
;********** з можливими i рекурсивна спроба доказати гiпотезу ****  
(defun шукай-рекурсивно (гiпотеза можливi)
   (cond
     ((null можливi) nil)
     ((every 'докажи  (правило-умови (car можливi)))
       (додай-наслiдки (car можливi)))
     (t (шукай-рекурсивно гiпотеза (cdr можливi)))))
(expert)

           11. ПРОГРАМУВАННЯ, ЯКЕ УПРАВЛЯ╢ТЬСЯ ДАНИМИ
                       АБО ПОД╤ЯМИ.

    11.1. Принцип програмування, яке управля╓ться даними.

    Метод програмування, в якому дан╕ управляють виконанням програ-
ми або самi iнтерпретуються як програми, зветься методом  ПРОГРАМУ-
ВАННЯ, ЯКЕ УПРАВЛЯ╢ТЬСЯ ДАНИМИ (date driven). Програми в  цьому ме-
тодi зберiгаються разом з даними або з в╕дображеннями ╖х тип╕в. Та-
кий метод да╓ змогу конструювати основний алгоритм в самому загаль-
ному вигляд╕, а детал╕ його реал╕зац╕╖ виносити в дан╕, як╕,в свою
чергу, можливо безперервно доповнювати без переробки основно╖  про-
грами. Такий метод неможливо реал╕зувати в традиц╕йних мовах,в той
час як в мов╕ LISP ╓ для цього необх╕дн╕  механ╕зми.  Реал╕зу╓ться
в╕н за допомогою функц╕онал╕в (APPLY, FUNCALL та ╕нш╕),функц╕╖ EVAL 
та макровизначення DEFMACRO.
    За допомогою визначеного метода можна створювати динам╕чн╕ про-
грами, д╕╖ яких залежать в╕д даних, як╕ поступають на обробку.  Це
забезпечу╓ можлив╕сть створення ун╕версальних функц╕й.
    Програмування, яке управля╓ться даними  б╕льш н╕ж просте опера-
торне програмування п╕дходить для створення систем  штучного  ╕нте-
лекту, бо да╓ змогу конструювати б╕льш гнучк╕ алгоритми та неперер-
вно ╖х доповнювати ╕ модиф╕кувати.
    Особливо це п╕дходить тод╕,коли ╕сну╓ багато р╕зноман╕тних,але
аналог╕чних тип╕в даних, якi створюють  ╕╓рархiю типiв. Зокрема це
стосу╓ться програм обробки  людсько╖ мови, розп╕знання зображень ╕
таке ╕нше.
    На програмуванн╕, яке управля╓ться даними  базуються деяк╕ спе-
ц╕альн╕ методи,так╕ як мови ATN (augmented transition network gram-
mar)- обробка мереж перех╕дних становищ, як╕ описуються у  вигляд╕
спец╕альних  граматик  та метод  класиф╕кац╕йних мереж (discrimina-
tion net).Метод класиф╕кац╕йних мереж -це метод класиф╕кац╕╖ та ви-
бору,в якому дан╕ у в╕дпов╕дност╕ до описання мереж╕ анал╕зуються ╕
залежно  в╕д результат╕в анал╕зу оброблюються. Класиф╕кац╕йн╕ мере-
ж╕, наприклад, застосовуються при формуванн╕ речення на основ╕ гра-
матичних та семантичних правил.

    11.2. Програмування, яке управля╓ться под╕ями.

    Програмування, яке управля╓ться  под╕ями (even/action driven) - 
- це такий стиль програмування, коли д╕╖ актив╕зуються т╕льки  при 
виникненн╕ конкретних ситуац╕й, наприклад, при визначенн╕  задано╖ 
зм╕нно╖ або виклик конкретно╖ функц╕╖ ╕ таке ╕нше. Функц╕я або д╕я,
яка при цьому виклика╓ться, зветься ДЕМОНОМ  (daemon). Така  назва 
виникла тому, що  демон як би чека╓, коли зд╕йсниться те, що дасть
йому змогу д╕яти. 
    Принцип реал╕зац╕╖ такого методу може з невеликою модиф╕кац╕╓ю
грунтуватися на принцип╕ програмування, яке управля╓ться под╕ями.
  

    11.3. Реал╕зац╕я  програмування, яке управля╓ться даними.

    Реал╕зац╕я метода створю╓ться за такою схемою.

    1. Створю╓ться функц╕я або макровизначення привласнення  даним
(символу) значення або властивост╕  у  вигляд╕ lambda-функц╕╖ (або
╕мен╕ заздалег╕дь розроблено╖ функц╕╖).
    Наприклад, розробимо макровизначення, яке заданому символу при-
власню╓ властив╕сть (назва-д╕╖ . (lambda аргументи т╕ло)):

    (defmacro ╕м'я-макро  (символ аргументи т╕ло)
       (list  'put символ (quote  назва-д╕╖)
            (list  'quote (list 'lambda аргументи тiло))))

    2. Створю╓ться управляюча функц╕я, яка за допомогою  функц╕она-
лу (APPLY, FUNCALL) або EVAL зд╕йсню╓ виконання функц╕╖, яка визна-
чена в значенн╕ або властивост╕ символу.
    Наприклад:

    (defun управляюча (список-символ╕в фактичн╕-аргументи )
        ..........................
        (funcall (get  (car список-символ╕в) 'назва-д╕╖)
                                             фактичн╕-аргументи)
        (управляюча (cdr (список-символ╕в))  фактичн╕-аргументи) )

    3. За допомогою  виклику функц╕╖ або макровизначення,  що було
створено в 1, визнача╓мо ряд символ╕в з  заданими  значеннями  або
властивостями у вигляд╕ списку вираз╕в, як╕ виконують д╕╖,або у ви-
гляд╕ ╕мен╕ заздалег╕дь розроблено╖ функц╕╖.
    Наприклад:

    (╕м'я-макро символ1 аргументи1 т╕ло1)
    (╕м'я-макро символ2 аргументи2 т╕ло2)
    (╕м'я-макро символ3 аргументи3 т╕ло3)
    ......................................

    11.4. Реал╕зац╕я  програмування, яке управля╓ться под╕ями.

    Один ╕з можливих алгоритм╕в реал╕зац╕╖ цього метода визнача╓ть-
ся за допомогою вище приведено╖ схеми, т╕льки в управляюч╕й програ-
м╕ перед функц╕╓ю FUNCALL дода╓ться анал╕з на ╕снування конкретного
значення  або властивост╕ символа.

    11.5. Приклади розробки функц╕╖ диференц╕ювання виразу. 

    Ма╓мо вираз за такою схемою: (+ y (*  x (+ 25 (* x ...)))). Ро-
зробити функц╕ю диференц╕ювання можна на основ╕ посл╕довного анал╕-
зу виникаючих функц╕й + та *. 
    Приклад реал╕зац╕╖:

;ФУНКЦiЯ ДИФЕРЕНЦiЮВАННЯ ЗА ДОПОМОГОЮ РОЗГАЛУЖЕННЯ АЛГОРИТМУ:
(defun похiдна (l x)
  (cond
    ((atom l) (if (eq l x) 1 0))
    ((eq (car l) '+) (list '+
                       (похiдна (cadr l) x)
                       (похiдна (caddr l) x)))
    ((eq (car  l) '*) (list '+
                        (list '*
                          (похiдна (cadr l) x)
                          (caddr l))
                         (list '*
                           (cadr l)
                           (похiдна (caddr l) x))))
    (t l)))

(пох╕дна '(+ x (* 2 x)) x)
Результат:
(+ 1 (+ (* 0 x) (* 2 1)))

    Тут ми застосували принцип розгалуження алгоритму. Якщо ми  по-
бажа╓мо доповнити ╕ншими можливостями, то потр╕бно буде переробити
основну програму. 
    Тепер застосу╓мо функц╕онал (тут символи  + та * в  первинному 
вираз╕ зм╕нимо на #+ та #*, тому що для символ╕в + та * не во вс╕х 
д╕алектах можна визначати значення):
     
;ФУНКЦiЯ ДИФЕРЕНЦiЮВАННЯ ЗА ДОПОМОГОЮ ЗАСТОСУВАННЯ ФУНКЦiОНАЛУ:
(defun похiдна1 (l x)
   (cond ((atom l) (if (eq l x) 1 0))
         (t (funcall  (eval (car l)) (cdr l) x))))

(setq #+ 'похiдна+ #* 'похiдна*)

(defun похiдна+ (l x)
   (list '+ (похiдна1 (car l) x) (похiдна1 (cadr l) x)))

(defun похiдна* (l x)
   (list '+
     (list '* (похiдна1 (car l) x) (cadr l))
     (list '* (car l) (похiдна1 (cadr l) x))))

(пох╕дна1 '(#+ x (#* 2 x)) x)
Результат:
(+ 1 (+ (* 0 x) (* 2 1)))

    В наведеному приклад╕ застосований метод програмування,  що ке-
ру╓ться даними у вигляд╕ ╕мен функц╕й, заданих значеннями символ╕в 
#+ та #*. Для доповнення ╕ншими можливостями необх╕дно лише  розро-
бити нов╕ функц╕╖ "пох╕днаY".
    Наступний приклад реал╕зац╕╖ за допомогою макровизначення  в╕д-
р╕зня╓ться б╕льшою витончен╕стю стилю (тут + та * зм╕нен╕ на &+ та
&*):   

;ФУНКЦiЯ ДИФЕРЕНЦiЮВАННЯ ЗА ДОПОМОГОЮ ЗАСТОСУВАННЯ МАКРОВИЗНАЧЕННЯ:
(defun похiдна2 (l x)
   (cond ((atom l) (if (eq l x) 1 0))
       (t (funcall (get (car l) 'похiдна) (cdr l) x))))

(defmacro defпохiдна (дiя аргументи тiло)
      (list  'put дiя (quote похiдна)
                       (list  'quote (list 'lambda аргументи тiло))))

(defпохiдна &+ (l x)
         (list '+ (похiдна2 (car l) x)
                   (похiдна2 (cadr l) x)))

(defпохiдна &* (l x)
        (list '+
            (list '*
                (похiдна2 (car l) x)
                (cadr l))
            (list '*
                (car l)
                (похiдна2 (cadr l) x))))

    В останньому випадку, по сут╕, створена  нова вбудована (embed-
ded) в LISP об'╓ктно-ор╕╓нтована мова. 

                12. МЕТОД З╤СТАВЛЕННЯ ╤З ЗРАЗКОМ.

    12.1. Загальн╕ поняття.

    В реал╕зац╕╖ систем Ш╤ велику роль в╕д╕грають област╕, як╕  по-
в'язан╕ з розп╕знанням образ╕в (pattern recognition). Методи розп╕-
знання образ╕в застосовуються в системах штучного зору, ╕дентиф╕ка-
ц╕╖ людсько╖ мови, текстового сп╕лкування людини з машиною на мов╕,
наближено╖ до мови людини, перекладу з одн╕╓╖ мови на ╕ншу ╕  таке
╕нше. Метод з╕ставлення ╕з зразком (pattern matching) ╓ лише одним
╕з багатьох засоб╕в розп╕знання образ╕в, але застосову╓ться в╕н до-
статньо широко в р╕зноман╕тних системах, в тому числ╕  в  системах
анал╕зу та розп╕знання тексту в системах Ш╤, в продукц╕йних та  ло-
г╕чних системах програмування для створення ЕС ╕ ╕нших.
    З╕ставлення ╕з зразком - це процедура, при  як╕й  зд╕йсню╓ться
з╕ставлення (пор╕вняння) деякого зразка  задано╖ структури  з  кон-
кретним образом з метою виявлення ╖х в╕дпов╕дност╕ (в  англ╕йськ╕й
мов╕ зразок ╕ образ позначаються одним ╕ тим же словом pattern, що
╕нод╕ в переклад╕ призводить до помилкового розум╕ння).
    В даному розд╕л╕ ми розглянемо розп╕знання  списочних  образ╕в,
що ма╓ багато сп╕льного з розп╕знанням образ╕в, як╕ представлен╕ в
╕ншому вигляд╕. Кр╕м того, в мов╕ LISP ╕сну╓ достатньо засоб╕в для
перетворення р╕зноман╕тних структур даних в списочну структуру  та
навпаки.

    12.2. Умови з╕ставлення списк╕в.

     До з╕ставлення ╓лемент╕в списка можна  ставити  р╕зн╕  вимоги.
Насамперед, можна поставити вимогу розп╕знання однакових елемент╕в.
Для б╕льшо╖ гнучкост╕ будемо застосовувати символи-зам╕нювач╕. Мож-
ливо в╕др╕зняти наступн╕ основн╕ випадки:

     ? - дов╕льний непустий елемент образа,
     _ - дов╕льний елемент, який може бути пустим,
     & - непуста дов╕льна посл╕довн╕сть елемент╕в,
     ! - дов╕льна посл╕довн╕сть, яка може бути пустою.

     Формат функц╕╖ З╤СТАВ:
    
     (з╕став   зразок  образ)

     Приклади:
     (з╕став '(? ? к ?) '(ф а к т))
     T
     (з╕став '(& т и) '(ф а к т и))
     T
     (з╕став '(! с т у ! н т) '(с т у д е н т))
     T
     (з╕став '(? с т & ╕ в !) '((б а г а т о) с т у д е н т ╕ в))
     T

     12.3. Реал╕зац╕я з╕ставлення списк╕в.
  
;МЕТОД ЗIСТАВЛЕННЯ IЗ ЗРАЗКОМ.
(defun зiстав (m h)
  (cond 
      ((null m) (null h))
      ((null h) nil)
      ((equal (car m) (car h))     ;Якщо перш╕ елементи зб╕гаються,
         (зiстав (cdr m) (cdr h))) ;то переходимо до "хвост╕в",
                                   ;якщо н╕, то перев╕ря╓мо, чи ╓
                                   ;у символа зразка властивост╕. 
      ((and (atom (car m)) (get (car m) 'зiставник))
                                   ;Якщо ╓, то викону╓мо властивост╕ 
                                   ;функц╕оналом FUNCALL.  
          (funcall (get (car m) 'зiставник) m h))
      (t nil)))                    ;Якщо нема, то поверта╓мо NIL.  

;Макровизначення DEFЗ╤СТАВНИК:
(defmacro defзiставник (символ параметр тiло)
   (list 'put символ (quote зiставник)
          (list 'quote (list 'lambda параметр тiло))))

;Зiставник довiльних символiв - ?:
(defзiставник ? (m h)
    (зiстав (cdr m) (cdr h)))

;Зiставник непустих послiдовностей символiв - &:
(defзiставник & (m h)
    (or (зiстав (cdr m) (cdr h))
        (зiстав m (cdr h))))

;Зiставник послiдовностей, як╕ можуть бути пуст╕ -!:
(defзiставник ! (m h)
     (or (зiстав (cdr m) (cdr h))
         (зiстав (cdr m) h)
         (зiстав m (cdr h))))

;Зiставник дов╕льних символ╕в, як╕ можуть бути пуст╕ - _:
(defзiставник _ (m h)
      (or (зiстав (cdr m) (cdr h))
          (зiстав (cdr m) h)))

    Приведена реал╕зац╕я  працю╓ лише  ╕з  верхн╕м  р╕внем  списку,
але нема╓ н╕яких обмежень зробити ╖х ун╕версальними "в глибину"спи-
ска.

    12.4. Застосування зм╕нних в зразку.

    З╕ставлення можна зробити б╕льш ун╕версальним  в  застосуванн╕,
якщо реал╕зувати можлив╕сть збер╕гати та повертати т╕ елементи,як╕ 
зам╕няються символами-зам╕нювачами. Наприклад:

    (з╕став1 '((?> x) або (&> y)) '(до або п╕сля цього))
    Результат:
    ((X . до) (Y п╕сля цього))
    
    (з╕став1 '(? або &) '(до або п╕сля цього))
    Результат:
    T  

    Будемо застосовувати нов╕  символи-зам╕нювач╕, як╕  позначають
не т╕льки зам╕ну, але й збер╕гання в╕дпов╕дно╖ частини образа у ви-
гляд╕ списку пар ((зм╕нна1 частина1) (зм╕нна2 частина2)...):

    (?> зм╕нна) - в╕дпов╕дно ? (дал╕ зам╕нимо на ??),
    (&> зм╕нна) - в╕дпов╕дно & (дал╕ зам╕нимо на &&),
    (!> зм╕нна) - в╕дпов╕дно ! (дал╕ зам╕нимо на !!).
                 
    12.5. Реал╕зац╕я застосування зм╕нних в зразку.

;ЗАСТОСУВАННЯ ЗМiННИХ В ЗРАЗКУ.
(defun зiстав1 (m h пари )
  (cond
   ((null m) (if (null h)  (if пари пари t) nil))
   ((null h) nil)
   ((equal (car m) (car h))
       (зiстав1 (cdr m) (cdr h) пари))
   ((atom (car m))
       (if (get (car m) 'зiставник)
         (funcall (get (car m) 'зiставник) m h пари)
          nil))
   (t (funcall (get (car (car m)) 'зiставник) m h (cadr (car m))
           пари))))

;Зiставник довiльних символiв - ??:
(defзiставник ?? (m h пари)
    (зiстав1 (cdr m) (cdr h) пари))

;Зiставник непустих послiдовностей символiв - &&:
(defзiставник && (m h пари)
    (or (зiстав1 (cdr m) (cdr h) пари)
        (зiстав1 m (cdr h) пари)))

;Зiставник  послiдовностей, як╕ можуть бути пуст╕ - !!:
(defзiставник !! (m h пари)
     (or (зiстав1 (cdr m) (cdr h) пари)
         (зiстав1 (cdr m) h пари)
         (зiстав1 m (cdr h) пари)))

;Зiставник довiльних символiв  з повертанням пар - ?>:
(defзiставник ?> (m h v пари)
  (зiстав1 (cdr m) (cdr h)
          (acons v (car h) пари)))

;Зiставник  непустих послiдовностей символiв
; з повертанням пар - &>:
(defзiставник &> (m h v пари)
     (or (зiстав1 (cdr m) (cdr h)
             (додай v (car h) пари))
         (зiстав1 m (cdr h)
             (додай v (car h) пари))))

;Зiставник  послiдовностей, як╕ можуть бути пустими,
; з повертанням пар - !>:
(defзiставник !> (m h v пари)
     (or (зiстав1 (cdr m) (cdr h)
             (додай v (car h) пари))
         (зiстав1 m (cdr h)
             (додай v (car h) пари))
         (зiстав1 (cdr m)  h пари)))

;Функцiя конструювання пар:
(defun додай (iмя значення пари)
  (cond
    ((null пари) (acons iмя значення nil))
    ((eql iмя (caar пари))
       (if (atom (cdar пари))
          (acons iмя
            (list (cdar пари) значення)
            (cdr пари))
          (acons iмя
            (append (cdar пари)
                    (list значення))
            (cdr пари))))
   (t (cons (car пари) (додай iмя значення (cdr пари))))))

   12.6. Реал╕зац╕я ╕нших вар╕ант╕в з╕ставлення.  

;Функцiя зiставлення таким чином, що вирази, якi повторюються,
;зiставляються з тим виразом, з яким зiставлення вже здiйснилось,
;наприклад, (з╕став1 '(? (?> x) те (!> y) (< x))
;                    '(ми МА╢МО те що ми МА╢МО)) 
; Результат: ((X . МА╢МО) (Y що ми)) 
(defзiставник < (m h v пари)
   (зiстав1 (cons (значення v пари)
               (cdr m)) h пари))
(defun значення (iмя пари)
      (cdr (assoc iмя пари)))

;Функцiя зiставлення з включенням предiкатного зразка,
;який вимага╓ перев╕рити умови в╕дпов╕дност╕,
; наприклад: (з╕став1 '(? (p> numberp) &) '(a 5 d c))
; Результат: T  
(defзiставник p? (m h предiкат пари)
  (if (funcall предiкат (car h))
      (зiстав1 (cdr m) (cdr h) пари) nil))

    12.7. Приклад реал╕зац╕╖ програми, яка веде "розумну"
          бес╕ду з пац╕╓нтом.

    Застосу╓мо розроблену функц╕ю "з╕став1"  для  розробки  деяко╖
програми, яка начебто веде психолог╕чну "бес╕ду" з пац╕╓нтом.Автор
ц╕╓╖  програми Вайзенбаум (1965р.). Хоча вона ╕ не розум╕╓, про що
ведеться мова, але проявля╓ проблески "розуму", тому що застосову╓
метод розп╕знання образ╕в.   

;ПСИХIАТР "ЕЛIЗА" (Програма Вайзенбаума /1965/):
(defun eliza ()
  (terpri)
  (print '(Я психолог ЕЛIЗА.))
  (print '(Давайте поговоримо про Вашi проблеми.))
  (print '(Будь ласка вiдповiдайте по шаблонам:))
                                   ; Вивiд шаблонiв для вiдповiдей:
  (keys *rules*)
  (print '(все)) (terpri)
  (print '(де: !! (&> x) - це рiзнi можливi слова.))
  (terpri)
  (print '(Що Вас турбуе?:))
                                  ; Цикл дiалогу:
  (do*
    ((clause  (read)   (read)))
                                  ; Якщо вiдповiдь (все),то кiнець:
    ((equal clause '(все))
        '(До побачення! Звертайтесь ще!))
                                  ; Цикл аналiзу вiдповiдi:
    (do*
      ((rules *rules* (cdr rules))
       ( rule (car rules) (car rules)))
     ((cond
                                  ; Якщо правила вичерпанi, то
                                  ; допомiжне запитання:
         ((null rules) (print (help-question))
           (terpri) t)
                                  ; Якщо зiставлення успiшне, то
                                  ; вiдповiдне запитання:
         ((setq bindings
           (зiстав1 (car rule) clause))
           (print (answer (cadr rule)  bindings))
           (terpri) t))))))
                                  ; Допомiжнi запитання:
(setq *help-question*
  '((Що трапилось?)
    (Ну так що?)
    (Може ми поговоримо о Ваших проблемах?)
    (Не може цього бути!)
    (Може ми змiнимо тему?)
    (Не вигадуйте нiсенiтниць!)
    (Це як сказати!)
    (Чому Ви так думаете?)
    ;................
  ))
                                 ; Функцiя виводу допомiжного
                                 ; запитання:
(defun help-question ()
   (nth (random (length *help-question*)) *help-question*))
                                 ; Правила ((зразок)(запитання)..)
(setq *rules*
  ' (((!! я не можу (&> x)) (Чому Ви не можете (< x)?))
    ((нi) (Будь ласка розкажiть бiльше))
    ((!! так !!) (Я розумiю але чому Ви так в цьому впевненi?))
    ((!! я маю (&> x)) (Розкажiть менi про (< x)))
    ((!! ви (&> x)) (Чому Ви думаете що я (< x)?))
    ((!! ти (&> x)) (Чому Ви думаете що я (< x)?))
    ((!! батько !!) (Якi вiдносини у Вас в сiм^i?))
    ;............................................
))
                                 ; Функцiя виводу вiдповiдного
                                 ; запитання:
(defun answer (model pairs)
  (cond
    ((null model) nil)
    ((atom (car model))
      (cons (car model)
            (answer (cdr model) pairs)))
    ((eq (caar model) '<)
           (cons (значення (cadar model) pairs)
                 (answer (cdr model) pairs)))
    (t (cons (car model)
           (answer (cdr model) pairs)))))
                                ; Функцiя виводу шаблонiв для
                                ; вiдповiдi:
(defun keys (rules)
   (cond ((null rules) t)
         ((print (caar rules)) (keys (cdr rules)))))

(eliza)

    Приведемо вар╕ант прикладу тако╖ бес╕ди:

    (Я психолог ЕЛ╤ЗА)
     ...................
    (Що Вас турбу╓?)
    (Я не можу вивчити штучний ╕нтелект)
    (Чому Ви не можете вивчити штучний ╕нтелект?)
    (Тому що це дуже складно)
    (Чому Ви так дума╓те?)
    (Тому що так ╓)
    (Я розум╕ю але чому Ви так в цьому впевнен╕?)
    (Тому що я маю таку думку)
    (Розкаж╕ть мен╕ про таку думку!)
    (Яка ви нерозумна)
    (Чому Ви дума╓те що я нерозумна?)
    ..................................