------------------------------------------------------------------------
--                Пример визуальной экспертной системы.               --
--               Программа написана на Акторном Прологе.              --
--              (c) Алексей А. Морозов. 19 марта 1999 г.              -
------------------------------------------------------------------------
-- Это моя самая любимая программа. Она помогает варить варенье из    --
-- черной рябины, яблок и земляники. На самом деле, когда я писал эту --
-- программу, мне хотелось потренироваться в проведении интервью по   --
-- правилам SADT методологии. Для этого я не придумал ничего лучше,   --
-- как попросить мою собственную матушку рассказать мне, как надо     --
-- варить варенье. Поскольку я старался нарисовать модель как можно   --
-- более подробно, интервью затянулось на два дня. Результат оказался --
-- неожиданным для нас обоих. Матушка была очень удивлена, когда я    --
-- показал ей полный перечень посуды и инструментов, которые ей       --
-- приходится использовать во время приготовления обычного варенья.   --
-- Заодно я немного научился готовить. Матушка, спасибо за помощь!    --
------------------------------------------------------------------------
-- Логическое описание блоков SADT модели.                            --
------------------------------------------------------------------------
-- Этот класс просто заглушка, вызывающая диалоговое окно             --
-- выбора ягод и фруктов.                                             --
------------------------------------------------------------------------
class 'Выбрать_ягоды_и_фрукты' specializing 'DIALOG':
value_o1;
identifier= "ChooseFruits";
[
]
------------------------------------------------------------------------
-- Далее следуют классы, соответствующие блокам SADT модели.          --
-- Основное предназначение этих классов - хранить перечень посуды и   --
-- инструментов, соответствующих различным блокам SADT модели.        --
-- В дополнение к этому некоторые блоки:                              --
-- 1) Передают на выход значения (наименования выбранных ягод и       --
--    фруктов), полученные на входе.                                  --
-- 2) Проверяют, соответствуют ли выбранные ягоды и фрукты данному    --
--    блоку. Если не соответствуют, исполнение актора goal            --
--    заканчивается неудачей, процесс переходит в состояние           --
--    "неудачный", и соответствующий блок на экране краснеет.         --
-- 3) Вычисляют рекомендуемое время нагрева сахарной смеси для        --
--    выбранных ягод и фруктов.                                       --
-- Классы, соответствующие составным блокам, являются потомками       --
-- класса 'Compound_Block', назначение которого будет рассмотрено     --
-- ниже, когда мы будем обсуждать устройство блока "Анализ модели".   --
------------------------------------------------------------------------
class 'Вымыть_банки_и_крышки' specializing 'Simple_Block':
[
]
------------------------------------------------------------------------
class 'Вскипятить_воду_в_чайнике' specializing 'Simple_Block':
[
instrument()= "Чайник".
]
------------------------------------------------------------------------
class 'Обработать_крышки_кипятком' specializing 'Simple_Block':
[
instrument()= "Кастрюля для кипячения воды".
]
------------------------------------------------------------------------
class 'Обработать_банки_кипятком' specializing 'Simple_Block':
[
instrument()= "Чайник".
]
------------------------------------------------------------------------
class 'Просушить_банки_и_крышки' specializing 'Simple_Block':
[
]
------------------------------------------------------------------------
class 'Вымыть_ягоды_и_фрукты' specializing 'Simple_Block':
value_i1;
protecting: value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Дуршлаг".
]
------------------------------------------------------------------------
class 'Подготовить_смесь_из_твердых_ягод_и_сахара'
specializing 'Compound_Block':
value_i1;
[
goal:-!,
        check_fruits(value_i1).
--
check_fruits("Черная рябина").
]
------------------------------------------------------------------------
class 'Подготовить_смесь_из_крупных_фруктов_и_сахара'
specializing 'Compound_Block':
value_i1;
[
goal:-!,
        check_fruits(value_i1).
--
check_fruits("Яблоки \"Антоновка\"").
]
------------------------------------------------------------------------
class 'Подготовить_смесь_из_мягких_ягод_и_сахара'
specializing 'Compound_Block':
value_i1;
[
goal:-!,
        check_fruits(value_i1).
--
check_fruits("Земляника").
]
------------------------------------------------------------------------
class 'Вскипятить_воду_в_кастрюле' specializing 'Simple_Block':
[
instrument()= "Кастрюля для кипячения воды".
]
------------------------------------------------------------------------
class 'Приготовить_сироп' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Кастрюля или медная миска".
instrument()= "Деревянная ложка".
]
------------------------------------------------------------------------
class 'Бланшировать_ягоды' specializing 'Simple_Block':
value_i2;
value_o1;
[
goal:-!,
        value_o1 == value_i2.
--
instrument()= "Дуршлаг".
instrument()= "Кастрюля для кипячения воды".
]
------------------------------------------------------------------------
class 'Положить_ягоды_в_сироп' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Порезать_на_дольки' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Нож из нержавеющей стали".
]
------------------------------------------------------------------------
class 'Пересыпать_сахаром' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Выстаивать_6-8_часов' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Добавить_в_смесь_воду' specializing 'Simple_Block':
value_i1;
value_o1;
[
goal:-!,
        value_o1 == value_i1.
--
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Цикл_варки_твердых_ягод_и_фруктов'
specializing 'Compound_Block':
value_i1;
[
goal:-!,
        check_fruits(value_i1).
--
check_fruits("Черная рябина").
check_fruits("Яблоки \"Антоновка\"").
]
------------------------------------------------------------------------
class 'Цикл_варки_мягких_ягод_и_фруктов'
specializing 'Compound_Block':
value_i1;
[
goal:-!,
        check_fruits(value_i1).
--
check_fruits("Земляника").
]
------------------------------------------------------------------------
class 'Нагреть_смесь' specializing 'DIALOG':
value_i2;
time;
identifier      = "HeatUpMixture";
fruits          = value_i2;
[
goal:-!,
        set_time(value_i2,time).
--
set_time(#,"3-5"):-!.
set_time("Черная рябина","3"):-!.
set_time("Яблоки \"Антоновка\"",5):-!.
set_time("Земляника","---"):-!.
set_time(_,"3-5"):-!.
--
instrument()= "Кастрюля или медная миска".
instrument()= "Деревянная ложка".
]
------------------------------------------------------------------------
class 'Выстаивание' specializing 'Simple_Block':
[
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Проверить_готовность_варенья' specializing 'Simple_Block':
[
instrument()= "Деревянная ложка".
instrument()= "Блюдце".
]
------------------------------------------------------------------------
class 'Основной_этап_варки' specializing 'DIALOG':
value_i1;
time;
identifier      = "HeatUpMixture";
fruits          = value_i1;
[
goal:-!,
        set_time(value_i1,time).
--
set_time(#,"---"):-!.
set_time("Земляника","10"):-!.
set_time(_,"---"):-!.
--
instrument()= "Кастрюля или медная миска".
instrument()= "Деревянная ложка".
]
------------------------------------------------------------------------
class 'Дополнительный_этап_варки' specializing 'Simple_Block':
[
instrument()= "Кастрюля или медная миска".
instrument()= "Деревянная ложка".
]
------------------------------------------------------------------------
class 'Охладить_варенье' specializing 'Simple_Block':
[
instrument()= "Кастрюля или медная миска".
]
------------------------------------------------------------------------
class 'Разлить_варенье_в_банки' specializing 'Simple_Block':
[
instrument()= "Деревянная ложка".
instrument()= "Машинка для закатки".
]
------------------------------------------------------------------------
class 'Проверить_готовность_варенья_(твердые_ягоды_и_фрукты)'
specializing 'Simple_Block':
[
instrument()= "Блюдце".
]
------------------------------------------------------------------------
class 'Проверить_готовность_варенья_(мягкие_ягоды)'
specializing 'Simple_Block':
[
instrument()= "Блюдце".
]
------------------------------------------------------------------------
class 'Simple_Block':
[
goal.
--
show(_).
]
------------------------------------------------------------------------
-- Этот блок строит и выводит на экран полный перечень посуды и       --
-- инструментов, необходимых для приготовления варенья из выбранных   --
-- ягод и фруктов. Принцип работы блока состоит в следующем:          --
-- 1) Слот container, автоматически создаваемый во время трансляции   --
--    SADT диаграмм, содержит процесс, соответствующий блоку,         --
--    объемлющему данный, то есть блоку "Приготовление варенья".      --
--    С помощью специального резидента в этом блоке доказывается      --
--    предикат instrument.                                            --
-- 2) Блок "Приготовление варенья", а также все остальные составные   --
--    блоки в ходе трансляции модели реализуются с помощью классов.   --
--    Все эти классы являются потомками класса 'Compound_Block'.      --
-- 3) Класс 'Compound_Block' определен в тексте программы. При этом   --
--    в классе 'Compound_Block' определена функция instrument, таким  --
--    образом что ее значением является значение функции component.   --
-- 4) Функция component является недетерминированной и определяется   --
--    автоматически в ходе трансляции всех составных блоков.          --
--    В качестве значения эта функция возвращает процессы,            --
--    соответствующие блокам, входящим в состав рассматриваемого      --
--    составного блока.                                               --
-- 5) Таким образом, с помощью резидента блок "Анализ модели"         --
--    получает список процессов, соответствующих соседним блокам.     --
-- 6) Полученный список передается другому резиденту в рекурсивном    --
--    определении процесса 'Instruments', который доказывает в этих   --
--    мирах тот же самый предикат instrument.                         --
-- 7) Если предикат instrument доказывается в простом блоке,          --
--    соответствующий процесс возвращает наименования посуды и        --
--    инструментов, относящихся к данному блоку. Если предикат        --
--    доказывается в составном блоке, исполнение предиката происходит --
--    так же как в блоке "Приготовление варенья", рассмотренном       --
--    выше. Таким образом, резидент вычисляет список, в состав        --
--    которого могут входить как списки посуды и инструментов, так и  --
--    процессы, соответствующие некоторым блокам.                     --
-- 8) Полученный список передается на следующий виток рекурсии и      --
--    обрабатывается следующим резидентом. Такая рекурсивная          --
--    обработка списка продолжается до тех пор, пока на очередном     --
--    витке список не окажется равным списку, поступившему на         --
--    предыдущий уровень рекурсии. Если список окажется равным, это   --
--    означает, что просмотр дерева блоков достиг всех его вершин, и  --
--    в составе списка больше нет процессов.                          --
-- 9) Вычисленный таким образом список посуды и инструментов          --
--    сортируется с удалением повторов и выводится на экран с помощью --
--    диалогового окна.                                               --
------------------------------------------------------------------------
class 'Анализ_модели:_Какие_необходимы_посуда_и_инструменты?'
specializing 'DIALOG':
--
identifier= "ListOfInstruments";
--
title;
name;
number;
model;
x;
y;
text_color;
container;
con;
--
result;
instruments;
--
agent   = (('FindInstruments',
                        container,
                        protecting: result));
[
goal:-
        refine_list(result,[],instruments),!.
goal:-!,
        [result].
--
refine_list([],List,List):-!.
refine_list([#|Rest],List1,List2):-!,
        refine_list(Rest,List1,List2).
refine_list([Item|Rest],List1,List3):-
        is_list(Item),!,
        refine_list(Item,List1,List2),
        refine_list(Rest,List2,List3).
refine_list([Item|Rest],List1,List2):-
        is_not_element(Item,List1),!,
        refine_list(Rest,[Item|List1],List2).
refine_list([_|Rest],List1,List2):-!,
        refine_list(Rest,List1,List2).
refine_list(_,List,List).
--
is_list([]):-!.
is_list([_|_]).
--
is_not_element(_,[]):-!.
is_not_element(Item,[Item|_]):-!,
        fail.
is_not_element(Item,[_|List]):-
        is_not_element(Item,List).
--
show(_):-
        show.
]
------------------------------------------------------------------------
class 'FindInstruments' specializing 'ALPHA':
container;
result;
agent   = (('Instruments',
                suspending: source_list= [],
                target_list= container,
                protecting: result
                ));
[
goal:-!.
]
------------------------------------------------------------------------
class 'Instruments' specializing 'Alpha':
source_list;
target_list;
result;
--
tail_list;
tail_result;
tail    = (('Instruments',
                suspending: source_list=tail_list,
                target_list=target_list ?? instrument(),
                protecting: result=tail_result
                ));
con     = ('Console');
[
goal:-
        source_list == target_list,!,
        result == target_list.
goal:-
        tail_list== target_list,
        result== tail_result.
]
------------------------------------------------------------------------
class 'Compound_Block' specializing 'Alpha':
c = ('Console');
[
instrument()= Block
        :-!,
        component(Block).
]
------------------------------------------------------------------------