---

/*        Primer ekspertnoy sistemy              */
/*        baziruyushcheysya na pravilah          */
/*        Ekspert po zhivotnym                   */

domains
database
  d_da(symbol, symbol)
  d_net(symbol, symbol)

predicates
  zapusk
  konsultaciya
  sprosit(symbol, symbol)
  zhivotnoe(symbol)
  kategoriya(symbol)
  da(symbol, symbol)
  net(symbol, symbol)
  zapomnit(symbol, symbol, symbol)
  ochistit
  vyvod_bd

goal
  zapusk.

clauses
/* Sistema polzovatelskogo interfeysa */
zapusk:-
  makewindow(1,7,7, "Ekspertnaya sistema",1,16,22,58),
  nl,write("***************************************************"),
  nl,nl,
  write(" Dobro pozhalovat v ZHIVOTNUYU ekspertnuyu sistemu!"),
  nl,nl,write(" Eta sistema legko opredelit nazvanie zhivotnogo po "),
  nl,write(" ego priznakam. Zashchita ot beliberdy VKLYUCHENA.  "),
  nl,write(" Otvechayte na voprosy : 'y'(Da) ili 'n'(Net).     "),
  nl,write("***************************************************"),
  nl,nl,
  konsultaciya,
  nl,nl,
  write("--- Soderzhimoe bazy dannyh ---"), nl,
  vyvod_bd,
  ochistit,
  write("Nazhmite probel."),nl,
  readchar(_),
  removewindow,
  exit.

konsultaciya:-
  zhivotnoe(X),!,nl,
  write("Rezyume: ", X, ".").
konsultaciya:-
  nl, write("Izvinite, no ya nichem ne mogu vam pomoch."), nl,
  write("I voobshche, gde vy videli takoe zhivotnoe ?..").

sprosit(X,Y):- 
  write(" Vopros: ",X,"  ",Y," ? "),
  readln(Reply),
  zapomnit(X,Y,Reply).

/*        Mehanizm vyvoda        */
da(X,Y):-d_da(X,Y),!.
da(X,Y):-not(net(X,Y)),!, sprosit(X,Y).

net(X,Y):-d_net(X,Y),!.

zapomnit(X,Y,y):-asserta(d_da(X,Y)).
zapomnit(X,Y,n):-asserta(d_net(X,Y)), fail.

vyvod_bd:- d_da(P,Q), write("d_da(",P,", ",Q,")"), nl, fail.
vyvod_bd:- d_net(P,Q), write("d_net(",P,", ",Q,")"), nl, fail.
vyvod_bd. 

ochistit:-retract(d_da(_,_)), fail.
ochistit:-retract(d_net(_,_)), fail.
ochistit. 

/* === BLOK ZASHCHITY OT BELIBERDY === */
zhivotnoe("Eto beliberda! Mlekopitayushchee ne mozhet byt pticey") :-
  kategoriya("mlekopitayushchee"),
  kategoriya("ptica"), !.

zhivotnoe("Eto beliberda! Parnokopytnye iz bazy ne edyat myaso") :-
  kategoriya("parnokopytnoe"),
  kategoriya("hishchnik"), !.

zhivotnoe("Eto beliberda! Ptica ne mozhet imet kopyta") :-
  kategoriya("ptica"),
  kategoriya("parnokopytnoe"), !.


/* === Pravila iz Prilozheniya 2 === */
zhivotnoe("Gepard") :-
  kategoriya("mlekopitayushchee"),
  kategoriya("hishchnik"),
  da(imeet, "zhelto-korichnevyy cvet"),
  da(imeet, "temnye pyatna"),!.

zhivotnoe("Tigr") :-
  kategoriya("mlekopitayushchee"),
  kategoriya("hishchnik"),
  da(imeet, "zhelto-korichnevyy cvet"),
  da(imeet, "temnye polosy"),!.

zhivotnoe("Zhiraf") :-
  kategoriya("parnokopytnoe"),
  da(imeet, "dlinnuyu sheyu"),
  da(imeet, "dlinnye nogi"),
  da(imeet, "chernye pyatna"),!.

zhivotnoe("Zebra") :-
  kategoriya("parnokopytnoe"),
  da(imeet, "chernye polosy"),!.

zhivotnoe("Straus") :-
  kategoriya("ptica"),
  da(mozhet, "ne letat"),
  da(imeet, "dlinnuyu sheyu"),
  da(imeet, "dlinnye nogi"),
  da(imeet, "cherno-beluyu okrasku"),!.

zhivotnoe("Pingvin") :-
  kategoriya("ptica"),
  da(mozhet, "ne letat"),
  da(mozhet, "plavat"),
  da(imeet, "cherno-beluyu okrasku"),!.

zhivotnoe("Albatros") :-
  kategoriya("ptica"),
  da(mozhet, "horosho letat"),!.

kategoriya("mlekopitayushchee") :-
  da(imeet, "volosyanoj pokrov"),!.
kategoriya("mlekopitayushchee") :-
  da(delaet, "daet moloko"),!.

kategoriya("ptica") :-
  da(imeet, "perya"),!.
kategoriya("ptica") :-
  da(mozhet, "letat"),
  da(delaet, "otkladyvaet yayca"),!.

kategoriya("hishchnik") :-
  da(est, "myaso"),!.
kategoriya("hishchnik") :-
  da(imeet, "ostrye zuby"),
  da(imeet, "kogti"),
  da(imeet, "glaza smotryat vpered"),!.

kategoriya("parnokopytnoe") :-
  kategoriya("mlekopitayushchee"),
  da(imeet, "kopyta"),!.
kategoriya("parnokopytnoe") :-
  kategoriya("mlekopitayushchee"),
  da(delaet, "zhuet zhvachku"),!.

/*      konec programmy          */