fork download
copy 
  1. domains
  2.  
  3. conditions = integer *
  4.  
  5. history = integer *
  6.  
  7. database
  8.  
  9. /* Предикаты базы данных */
  10.  
  11. rule(integer, symbol,symbol, conditions)
  12.  
  13. cond(integer, symbol)
  14.  
  15. yes(integer)
  16.  
  17. no(integer)
  18.  
  19. predicates
  20.  
  21. /* Предикаты системы пользовательского интерфейса */
  22.  
  23. do_expert_job
  24.  
  25. do_consulting
  26.  
  27. goes(symbol)
  28.  
  29. clear
  30.  
  31. /* Предикаты механизма вывода */
  32.  
  33. go(history, symbol)
  34.  
  35. check(integer, history, conditions)
  36.  
  37. Inpo(history, integer, integer, symbol)
  38.  
  39. do_answer(history, integer, symbol,integer, integer)
  40.  
  41. goal
  42.  
  43. do_expert_job.
  44.  
  45. clauses
  46.  
  47. /* База знаний (БЗ) */
  48.  
  49. rule(1, "Собака", "Короткошерстная собака", [1]).
  50.  
  51. rule(2, "Собака", "Длинношерстная собака ", [2]).
  52.  
  53. rule(3, "Короткошерстная собака","Английский бульдог",[3,5,7]).
  54.  
  55. rule(4, "Короткошерстная собака","Гончая", [3,6,7]).
  56.  
  57. rule(5, "Короткошерстная собака","Немецкий Дог", [5,6,7,8]).
  58.  
  59. rule(6, "Короткошерстная собака","Американский фоксхаунд",
  60.  
  61. [4,6,7]).
  62.  
  63. rule(7, "Длинношерстная собака ", "Кокер спаниель", [3,5,6,7]).
  64.  
  65. rule(8, "Длинношерстная собака ", "Ирландский Сеттер", [4,6]).
  66.  
  67. rule(9, "Длинношерстная собака ", "Колли", [4,5,7]).
  68.  
  69. rule(10, "Длинношерстная собака ", "Сенбернар", [5,7,8]).
  70.  
  71. cond(1,"Короткошерстная").
  72.  
  73. cond(2,"Длинношерстная").
  74.  
  75. cond(3,"Высота в холке не более 57 см").
  76.  
  77. cond(4,"Высота в холке не более 77 см ").
  78.  
  79. cond(5,"Низко посаженный хвост").
  80.  
  81. cond(6, "Длинные уши").
  82.  
  83. cond(7, "Дружелюбный характер").
  84.  
  85. cond(8, "Вес более 45 кг").
  86.  
  87. /* Система пользовательского интерфейса */
  88.  
  89. do_expert_job :-
  90.  
  91. makewindow(1,7,7,"ЭКСПЕРТ ПО ПОРОДАМ СОБАК", 0, 0, 25, 80),
  92.  
  93. do_consulting, nl, nl, nl, nl, write("Нажмите любую клавишу"),
  94.  
  95. readchar(_), exit.
  96.  
  97. do_consulting :-goes(Mygoal),go([],Mygoal),!.
  98.  
  99. do_consulting :-nl, write("Извините, я не смогу Вам помочь") ,clear.
  100.  
  101. do_consulting.
  102.  
  103. goes(Mygoal) :- clear,clearwindow, nl, nl,nl,nl,
  104.  
  105. write("ДОБРО ПОЖАЛОВАТЬ"),nl, nl, nl,
  106.  
  107. write("Проводится идентификация породы"),nl,
  108.  
  109. write("Для того, чтобы начать процесс идентификации,"),nl,
  110.  
  111. write("введите слово 'Собака'. "), nl, nl, readln(Mygoal),!.
  112.  
  113. inpo(HISTORY,RNO,BNO,TEXT) :-write("?:- ",TEXT," ? "),
  114.  
  115. makewindow(2,7,7,"Для ответа на вопрос",10,54,7,35),
  116.  
  117. write("введите 1, если Ваш ответ 'да' ,"),
  118.  
  119. write("введите 2, если Ваш ответ 'нет' ,"),
  120.  
  121. write("введите 0, для выхода из системы"),nl,
  122.  
  123. readint(RESPONSE),
  124.  
  125. clearwindow,shiftwindow(1),
  126.  
  127. do_answer(HISTORY,RNO,TEXT,BNO,RESPONSE).
  128.  
  129. /* Механизм вывода */
  130.  
  131. go(HISTORY, Mygoal) :-rule(RNO,Mygoal,NY,COND),
  132.  
  133. check(RNO,HISTORY,COND),!,
  134.  
  135. go([RNO|HISTORY],NY).
  136.  
  137. go(_,Mygoal) :-not(rule(_,Mygoal,_,_)),!,
  138.  
  139. nl,write("Вероятно Ваша собака - ",Mygoal,"."), nl, nl, nl.
  140.  
  141. check(RNO,HISTORY,[BNO|REST]) :-
  142.  
  143. yes(BNO),!,check(RNO,HISTORY,REST).
  144.  
  145. check(_,_,[BNO|_]) :- no(BNO),!,fail.
  146.  
  147. check(RNO,HISTORY,[BNO|REST]) :-cond(BNO,TEXT),
  148.  
  149. inpo(HISTORY,RNO,BNO,TEXT),
  150.  
  151. check(RNO,HISTORY,REST).
  152.  
  153. check(_,_,[]).
  154.  
  155. do_answer(_,_,_,_,0):- exit.
  156.  
  157. do_answer(_,_,_,BNO,1) :-assert(yes(BNO)),write(yes),nl.
  158.  
  159. do_answer(_,_,_,BNO,2) :-assert(no(BNO)),write(no),nl,fail.
  160.  
  161. clear :- retract(yes(_)),retract(no(_)),fail,!.
  162.  
  163. clear.
Success #stdin #stdout #stderr 0.02s 7008KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
ERROR: /home/o0QYMi/prog:2:0: Syntax error: Operator expected
ERROR: /home/o0QYMi/prog:48:0: Syntax error: Operator expected
ERROR: '$runtoplevel'/0: Undefined procedure: program/0
   Exception: (3) program ? EOF: exit
https://ideone.com/ceV8US
language:
Prolog (swi 7.6.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!