Экспертная система на Prolog — виды спорта

В этой теме 0 ответов, 1 участник, последнее обновление  Васильев Владимир Сергеевич 8 мес. назад.

  • Автор
    Сообщения
  • #4868
    @admin

    Разработать и реализовать с использованием Visual Prolog экспертную систему для определения видов спорта. Учесть возможность пополнения системы фактами пользователей.

    Экспертная система – это программное средство, использующее экспертные знания для обеспечения высокоэффективного решения неформализованных задач в узкой предметной области. Основу ЭС составляет база знаний (БЗ) о предметной области, которая накапливается в процессе построения и эксплуатации ЭС. Накопление и организация знаний — важнейшее свойство всех ЭС.

    В связи с тем, что планируется пополнять базу знаний системы, по окончании работы будем сохранять ее в файл, а при начале работы считывать информацию из файла в оперативную память. Для этого будем использовать внутренние (динамические) базы данных.

    Определим два предиката базы данных, которые позволят сохранить информацию о виде спорта: первый – свойства, второй – его словесное описание.

    Например, набор свойств может выглядеть так:

    cond(1,"Относится к художественным видам спорта")
    cond(2,"Проводится на воде")
    cond(3,"Участвует группа(команда) людей")
    cond(4,"Участвует один человек или пара")
    cond(5,"Проводится на льду")
    cond(6,"Вид танца")

    Второй предикат будет хранить описание вида спорта. Первый его аргумент – название, второй – список свойств, присущих данному спорту:

    rule("синхронное плавание",[3,2,1])
    rule("прыжки в воду",[4,2,1])
    rule("фигурное катание",[5,1,4])
    rule("спортивные бальные танцы",[7,6,1,3])
    rule("художественная гимнастика",[8,1,7,4,3])
    rule("армреслинг",[10,9,7,4])
    rule("тяжёлая атлетика",[11,9,4])

    Таким образом, в виде фактов записаны правила. Например, правило: «если этим видом спорта занимаются летом, и он является циклическим и индивидуальным, то – это бег», записано в виде rule(«бег»,[18,12,4]).

    Вторую базу используем для хранения ответов человека в следующем виде:

    cond_is(N,'1') /* если вид спорта имеет свойство с номером N */
    cond_is(N,'2') /* если вид спорта не имеет свойства с номером N */

    Первую базу назовем knowledge, а вторую – dialog.

    Работа системы происходит следующим образом:

    Пользователь отвечает на вопросы системы «да» либо «нет», исходя из ответа на определенный вопрос, задается очередной вопрос. После прохождения теста, ответов на вопросы система определяет вид спорта. Если не удается определить вид спорта, производится пополнение базы.

    SportExpert:-
            rule(X,L),
            check(L),
            nl,write("Может это ",X),
            nl,write("Верно? (1 - Да, 2 - Нет)"),
            read_true_char(C),C='1',!.
    SportExpert:-
            nl,write("Не удалось определить"),nl, 
            nl,write("Давайте обновим информацию в базе знаний."),nl,
            update.

    Чтобы конкретизировать вид спорта система должна сначала уточнить: к какой группе видов спорта относится искомы1. Основные группы представлены ниже:

    1. Спортивные игры
    2. Спортивные единоборства
    3. Силовые виды спорта
    4. Циклические виды спорта
    5. Худжественные виды спорта

    Далее одним из основных критериев является количество человек принимающих участие за одну команду: групповые (командные) и индивидуальные (парные) виды спорта.

    После этого использутся различные критерии и происходит определение вида спорта. Например, используется критерии:

    • сезонности:
      1. Летние виды спорта
      2. Зимние вида спорта
      3. Круглогодичные (вопрос не задаётся)
    • используемого оборудования:
      1. Байдарки
      2. Велосипеды
      3. Мячи
      4. Шайбы
      5. Клюшки, биты, ракетки
      6. Оружие (фехтование)
      7. Коньки
      8. Лыжи
      9. Сани
      10. Шахматные фигуры
    • места проведения:
      1. На воде
      2. На льду
      3. На специальной площадке
      4. На столе (настольные игры)

    Пример работы программы:

    Пример пополнения базы фактами, когда не удалось определить вид спорта:

    База данных:

    cond(1,"Относится к художественным видам спорта")
    cond(2,"Проводится на воде")
    cond(3,"Участвует группа(команда) людей")
    cond(4,"Участвует один человек или пара")
    cond(5,"Проводится на льду")
    cond(6,"Вид танца")
    cond(7,"Проводится на специальнй площадке")
    cond(8,"Вид гимнастики")
    cond(9,"Силовой вид спорта")
    cond(10,"Присутствует борьба")
    cond(11,"Основан на поднятии тяжёлых предметов")
    cond(12,"Циклический вид спорта")
    cond(13,"Зимний вид спорта")
    cond(14,"Используются лыжи")
    cond(15,"Используется винтовка")
    cond(16,"Используются сани")
    cond(17,"Используются коньки")
    cond(18,"Летний вид спорта")
    cond(19,"Используется велосипед")
    cond(20,"Относится к спортивным единоборствам")
    cond(21,"Не используется оружие")
    cond(22,"Используются удары")
    cond(23,"Используются удары кулаками")
    cond(24,"Используются удары ногами")
    cond(25,"Используются сцеплния")
    cond(26,"Используется традиционное оружие")
    cond(28,"Используется современное оружие")
    cond(29,"Относится к спортивным играм")
    cond(30,"Относится к играм с мячом/шаром")
    cond(31,"Относится к играм с шайбой")
    cond(32,"Относится к настольным играм")
    cond(33,"Используется ракетка")
    cond(34,"Используется волан")
    cond(35,"Используется клюшка")
    cond(36,"Используется бита")
    cond(37,"Используются лошади")
    cond(38,"Разрешено играть руками")
    cond(39,"Играет 30 человек")
    cond(40,"Играет 12 человек")
    cond(41,"Играет 14 человек")
    cond(42,"Используются ворота")
    cond(43,"Используется натянутая сетка")
    cond(27,"Играет 30 человек")
    cond(44,"Испольуется игральная доска")
    cond(45,"Используется специальный стол")
    cond(46,"Используются шахматные фигуры")
    rule("синхронное плавание",[3,2,1])
    rule("прыжки в воду",[4,2,1])
    rule("фигурное катание",[5,1,4])
    rule("спортивные бальные танцы",[7,6,1,3])
    rule("художественная гимнастика",[8,1,7,4,3])
    rule("армреслинг",[10,9,7,4])
    rule("тяжёлая атлетика",[11,9,4])
    rule("биатлон",[15,14,13,12,3])
    rule("лыжные гонки",[14,13,12,3])
    rule("санный спорт",[16,13,12,3])
    rule("конькобежный спорт",[17,13,12,3])
    rule("гребля на байдарках",[18,12,4,3,2])
    rule("плавание",[18,12,4,2])
    rule("велоспорт",[19,18,12,4])
    rule("бег",[18,12,4])
    rule("бокс",[23,22,21,20,10,7,4])
    rule("кикбоксинг",[24,22,21,20,7,4])
    rule("дзюдо",[25,21,20,7,4])
    rule("фехтование",[26,20,7,4])
    rule("кэндо",[27,20,7,4])
    rule("боевое самбо",[25,24,23,22,21,20,10,7,4])
    rule("рэгби",[38,29,27,10,7,3])
    rule("баскетбол",[40,38,30,29,7,3])
    rule("волейбол",[43,41,38,30,29,7,3])
    rule("гандбол",[42,41,38,30,29,7,3])
    rule("хоккей",[35,31,29,17,5,3])
    rule("хоккей на траве",[30,29,42,35,7,3])
    rule("футбол",[42,30,29,7,3])
    rule("поло",[37,42,35,30,29,7,3])
    rule("бейсбол",[36,30,29,7,3])
    rule("гольф",[35,30,29,7,4])
    rule("теннис",[33,43,30,29,7,4])
    rule("бадминтон",[34,43,33,29,7,4])
    rule("шахматы",[46,44,32,38,29,4])
    rule("шашки",[44,32,38,29,4])
    rule("бильярд",[45,32,38,30,29,4])
    

    Листинг программы:

    DOMAINS
    i=integer
    s=string
    c=char
    li=i* /* список целых чисел */
    FACTS - knowledge
    cond(i,s) /* свойства */
    rule(s,li) /* описания */
    FACTS - dialog
    cond_is(i,c) /* номер условия; '1' - есть, '2' - нету	места у загаданного */
    PREDICATES
    start
    nondeterm SportExpert /* решение */
    nondeterm check(li) /* добавляет в базу информацию о новом элементе */
    nondeterm test_cond(i) /* проверяет, имеется ли заданное свойство с данным номером */
    nondeterm update /* добавляет в базу информацию о новом элементе */
    nondeterm add_cond(li) /* возвращает список свойств, имеющихся у нового элемента */
    nondeterm print_cond(i,li,li) /* добавляет в список номера свойств, относительно которых уже были даны утвердительные ответы */
    read_cond(c,li,li) /* добавляет в список номера свойств, о которых еще не спрашивалось */
    nondeterm ex_cond(i,li,li,i) /* добавляет в список номера имеющихся в базе свойств*/
    nondeterm wr_cond(c,i,li,li)
    new_cond(i,li,li) /* добавляет в список номера новых свойств и описания новых свойств в базу знаний */
    read_true_char(c) /* с помощью предиката test читает символ с клавиатуры, пока он не окажется равен '1' или '2'*/
    test(c,c) /* проверка символа '1' или '2' */
    CLAUSES
    start:-
           consult("SportExpert.dba",knowledge), /*  загружаем информацию из базы знаний */
           write("Пробуем определить' "),nl,
           SportExpert, /* попытка определить */
           retractall(_,dialog), /* очищаем текущую информацию */
           retractall(_,knowledge), /* очищаем информацию об известных элементах и свойствах */
           nl,nl,write("Попробуем ещё раз? (1 - Да, 2 - Нет)"),
           read_true_char(C),
           C='1',!,start. 
    start:-
           nl,nl,write("Спасибо за внимание!"),
           readchar(_).
    SportExpert:-
            rule(X,L),
            check(L),
            nl,write("Может это ",X),
            nl,write("Верно? (1 - Да, 2 - Нет)"),
            read_true_char(C),C='1',!.
    SportExpert:-
            nl,write("Не удалось определить"),nl, 
            nl,write("Давайте обновим информацию в базе знаний."),nl,
            update.
    update:-
            nl,write("Введите название вида спорта:"),
            readln(S),
            add_cond(L), /* указываем свойства */
            assert(rule(S,L),knowledge), /* добавляем информацию в базу знаний*/
            save("SportExpert.dba",knowledge) /* сохраняем базу знаний в файл */.
    add_cond(L):-
                 cond_is(_,'1'),!, /* имеется информация о свойствах */
                 nl,write("Известно, что это: "),
                 print_cond(1,[],L1), 
             /* вывод имеющейся информации */
                 nl,write("Известно ли ещё что-то? (1 - Да, 2 - Нет)"),
                 read_true_char(C),
                 read_cond(C,L1,L).
    add_cond(L):-
                 read_cond('1',[],L).
    print_cond(H,L,L):-
            not(cond(H,_)),!.
    print_cond(H,L,L1):-
             cond_is(H,'1'),!,
             cond(H,T),
             H1=H+1,
             nl,write(T),
             print_cond(H1,[H|L],L1).
    print_cond(H,L,L1):-
             H1=H+1,
             print_cond(H1,L,L1).
    read_cond('1',L,L2):-
              ex_cond(1,L,L1,N),
              new_cond(N,L1,L2),!. 
    read_cond(_,L,L):-!.
    ex_cond(N,L,L,N):-
           not(cond(N,_)),!.
    ex_cond(N,L,L1,N2):-
             cond_is(N,_),!,
             N1=N+1,
             ex_cond(N1,L,L1,N2).
    ex_cond(N,L,L1,N2):-
             cond(N,S),
             nl,write("Это ",S,"? (1 - Да, 2 - Нет)"),
             read_true_char(A),
             wr_cond(A,N,L,L2),
             N1=N+1,
             ex_cond(N1,L2,L1,N2).
    wr_cond('1',N,L,[N|L]):-!.
    wr_cond('2',_,L,L):-!.
    new_cond(N,L,L1):-
           nl,write("Есть ещё свойства? (1 - Да, 2- Нет)"),
           read_true_char(A),
           A='1',!,
           nl,write("Напишите новое свойство"),
           nl,write("в виде 'свойство <описание нового свойства>'"), readln(S),
           assertz(cond(N,S)), /* добавление нового свойства в базу знаний */
           N1=N+1,
           new_cond(N1,[N|L],L1).
    new_cond(_,L,L).
    check([H|T]):-
                  test_cond(H), 
                  check(T).
    check([]).
    test_cond(H):-
                  cond_is(H,'1'),!. /* в базе имеется информация о наличии свойства
    */
    test_cond(H):-
                  cond_is(H,'2'),!,
                  fail. /* в базе имеется информация об отсутствии свойства */
    test_cond(H):- /* в базе нет никакой информации о данном свойстве, получаем ее у человека */
                  cond(H,S),
                  nl,write(" ",S,"? (1 - Да, 2 - Нет)"),
                  read_true_char(A),
                  assert(cond_is(H,A)),
                  test_cond(H).
    read_true_char(C):-
            readchar(C1),
            test(C1,C).
    test(C,C):-
               '1'<=C,C<='2',!.
    test(_,C):-
               write("Ошибка ввода! Нажмите 1или 2!"),nl,
               readchar(C1),
               test(C1,C). 
    GOAL
    start.

Для ответа в этой теме необходимо авторизоваться.