home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l217 / 2.ddi / PROGRAMS / GENI.PRO < prev    next >
Encoding:
Text File  |  1990-03-26  |  10.1 KB  |  407 lines
  1. /*
  2.   Copyright (c) 1986, 90 by Prolog Development Center
  3. */
  4.  
  5. code = 2000
  6. /*
  7.   This is a small example of how to create a
  8.   classification expert-system in PDC Prolog.
  9.  
  10.   Animals are classified in different
  11.   categories which are then broken up into
  12.   smaller categories. One can move from one
  13.   category to another if a number of
  14.   conditions are fulfilled.
  15.  
  16.   In this system the conditions are added
  17.   together. The first thing that is needed is
  18.   'or' and 'not'.
  19.  
  20.   Please understand this is a simple example
  21.   not a finished expert-system development
  22.   tool.
  23. */
  24.  
  25. DOMAINS
  26.   CONDITIONS = BNO*
  27.   HISTORY = RNO*
  28.   RNO, BNO, FNO = INTEGER
  29.   CATEGORY = STRING
  30.   data_file = string
  31.   file = save_file
  32.   slist = string*
  33.  
  34. DATABASE
  35.   rule(RNO,CATEGORY,CATEGORY,CONDITIONS)
  36.   cond(BNO,STRING)
  37.   data_file(data_file)
  38.   yes(BNO)
  39.   no(BNO)
  40.   fact(FNO,CATEGORY,CATEGORY)
  41.   topic(string)
  42.  
  43. include "tdoms.pro"
  44. include "tpreds.pro"
  45. include "menu2.pro"
  46.  
  47. PREDICATES
  48.  
  49. /*Commands*/
  50.   title_go
  51.   update
  52.   edit_kb
  53.   list
  54.   llist(HISTORY,string)
  55.   load_know
  56.   save_know
  57.   pick_dba(data_file)
  58.   erase
  59.   clear
  60.   proces(integer)
  61.   endd(integer)
  62.   listopt
  63.   evalans(char)
  64.   info(CATEGORY)
  65.   goes(CATEGORY)
  66.   run
  67.   reverse(CONDITIONS,CONDITIONS)
  68.   reverse1(CONDITIONS,CONDITIONS,CONDITIONS)
  69.   
  70.  
  71. /*Inferences mechanisms*/
  72.   go(HISTORY,CATEGORY)
  73.   check(RNO,HISTORY,CONDITIONS)
  74.   notest(BNO)
  75.   inpq(HISTORY,RNO,BNO,STRING)
  76.   do_answer(HISTORY,RNO,STRING,BNO,INTEGER)
  77.  
  78. /*Explanations*/
  79.   sub_cat(CATEGORY,CATEGORY,CATEGORY)
  80.   show_conditions(CONDITIONS,string)
  81.   show_rule(RNO,string)
  82.   show_cond(BNO,string)
  83.   report(HISTORY,string)
  84.   quest(CATEGORY,integer,integer,CATEGORY)
  85.  
  86. /*Update the knowledge*/
  87.   topict(string)
  88.   getrnr(RNO,RNO)
  89.   getbnr(BNO,BNO)
  90.   readcondl( CONDITIONS )
  91.   help
  92.   getcond(BNO,STRING)
  93.   save_y(char,string,data_file)
  94.  
  95. GOAL
  96.   makewindow(1,49,72,"",4,0,20,80),
  97.   makewindow(2,3,7,"",14,0,10,80),
  98.   makewindow(5,7,0,"",0,0,4,80),
  99.   makewindow(8,23,0,"",24,0,1,80),
  100.   makewindow(9,7,0,"",0,0,25,80),
  101.   run.
  102. clauses
  103.  run :-
  104.   repeat,
  105.   shiftwindow(8),
  106.   clearwindow,
  107.   write("  select option with arrow key  "),
  108.   shiftwindow(1),
  109.   menu(6,55,7,7,
  110.     ["Consultation",
  111.     "Load knowledge",
  112.     "Save knowledge",
  113.     "List knowledge",
  114.     "Update knowledge",
  115.     "Erase knowledge",
  116.     "Edit Knowledge",
  117.     "Help Information",
  118.     "DOS Shell",
  119.     "Exit Geni"],"menu",2,
  120.     CHOICE),
  121.     proces(CHOICE),
  122. endd(CHOICE),!.
  123.  
  124. /*Process Choice*/
  125.  
  126.  proces(0):-exit.
  127.  proces(1):-title_go.
  128.  proces(2):-load_know.
  129.  proces(3):-save_know.
  130.  proces(4):-list.
  131.  proces(5):-update.
  132.  proces(6):-erase.
  133.  proces(7):-edit_kb.
  134.  proces(8):-help.
  135.  proces(9):-write("PDC ",'\3','\2'," you"),system("").
  136.  proces(10).
  137.  
  138.  endd(0).
  139.  endd(10):- clearwindow,
  140.     write("Are you sure? (y or n) "),
  141.     readchar(C),write(C),
  142.     C='y',exit.
  143.  
  144. /*Inference mechanism*/
  145.  
  146.   title_go:-
  147.     goes(Mygoal),
  148.     nl,nl,go([],Mygoal),!.
  149.   title_go:- nl,
  150.     write("Sorry that one I did not know"),nl,update.
  151.  
  152.   goes(Mygoal):-
  153.     clear,clearwindow,
  154.     topict(Topic),
  155.     repeat,
  156.     write("You may select a general category( e.g. ",Topic,") \nor '?' for other options in the ",Topic,
  157.     " domain.\n Enter Goal "),
  158.     readln(Mygoal),
  159.     info(Mygoal),!.
  160.  
  161.   topict(Topic) :- topic(Topic).
  162.   topict(Topic) :- write("Enter a name that represents \nthis knowledge domain\n  : "),
  163.     readln(Topic),assert(topic(Topic)).
  164.  
  165.   go( _, Mygoal ):-                     /* My best guess  */
  166.     not(rule(_,Mygoal,_,_)),!,nl,
  167.     write("I think it is a(n): ",Mygoal),nl,nl,
  168.     write("I was right, wasn't I? (enter y or n)"),
  169.     readchar(Ans),
  170.     evalans(Ans).
  171.  
  172.   go( HISTORY, Mygoal ):-
  173.     rule(RNO,Mygoal,NY,COND),
  174.     check(RNO,HISTORY, COND),
  175.     go([RNO|HISTORY],NY).
  176.  
  177.   check( RNO, HISTORY, [BNO|REST] ):- yes(BNO), !,
  178.     check(RNO, HISTORY, REST).
  179.   check( _, _, [BNO|_] ):- no(BNO), !,fail.
  180.   check( RNO, HISTORY, [BNO|REST] ):- cond(BNO,NCOND),
  181.     fronttoken(NCOND,"not",_COND),
  182.     frontchar(_COND,_,COND),
  183.     cond(BNO1,COND),
  184.     notest(BNO1), !,
  185.     check(RNO, HISTORY, REST).
  186.   check(_,_, [BNO|_] ):- cond(BNO,NCOND),
  187.     fronttoken(NCOND,"not",_COND),
  188.     frontchar(_COND,_,COND),
  189.     cond(BNO1,COND),
  190.     yes(BNO1), !,fail.
  191.   check( RNO, HISTORY, [BNO|REST] ):-
  192.     cond(BNO,TEXT),
  193.     inpq(HISTORY,RNO,BNO,TEXT),
  194.     check(RNO, HISTORY, REST).
  195.     check( _, _, [] ).
  196.  
  197.   notest(BNO):-no(BNO),!.
  198.   notest(BNO):-not(yes(BNO)),!.
  199.  
  200.   inpq(HISTORY,RNO,BNO,TEXT):-
  201.     write("Is it true that ",TEXT,": "),
  202.     ROW = 14,
  203.     COL = 60,
  204.     menu(ROW,COL,7,7,[yes,no,why],"",1,CHOICE),
  205.     do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
  206.  
  207.   do_answer(_,_,_,_,0):-exit.
  208.   do_answer(_,_,_,BNO,1):-assert(yes(BNO)),
  209.     shiftwindow(1),write(yes),nl.
  210.   do_answer(_,_,_,BNO,2):-assert(no(BNO)),
  211.     shiftwindow(1),write(no),nl,fail.
  212.   do_answer(HISTORY,RNO,TEXT,BNO,3):- !,
  213.     shiftwindow(2),
  214.     rule( RNO, Mygoal1, Mygoal2, _ ),
  215.     sub_cat(Mygoal1,Mygoal2,Lstr),
  216.     concat("I try to show that: ",Lstr,Lstr1),
  217.     concat(Lstr1,"\nBy using rule number ",Ls1),
  218.     str_int(Str_num,RNO),
  219.     concat(Ls1,Str_num,Ans),
  220.     show_rule(RNO,Lls1),
  221.     concat(Ans,Lls1,Ans1),
  222.     report(HISTORY,Sng),
  223.     concat(Ans1,Sng,Answ),
  224.     display(Answ),
  225.     shiftwindow(8),
  226.     clearwindow,
  227.     write("   Use Arrow Keys To Select Option  "),
  228.     shiftwindow(1),
  229.     ROW = 14,COL = 60,
  230.     menu(ROW,COL,7,7,[yes,no,why],"",1,CHOICE),
  231.     do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
  232.  
  233. /* List Rules / Explanation Mechanism */
  234.  
  235.   list :- findall(RNO,rule(RNO,_,_,_),LIST),
  236.     llist(List,Str),!,display(Str),!.
  237.  
  238.   llist([],"") :-!.
  239.   llist([RNO|List],Str):-
  240.     llist(List,Oldstr),
  241.     show_rule(RNO,RNO_Str),
  242.     concat(RNO_Str,Oldstr,Str).
  243.  
  244.   show_rule(RNO,Strg):-
  245.     rule( RNO, Mygoal1, Mygoal2, CONDINGELSER),
  246.     str_int(RNO_str,RNO),
  247.     concat("\n Rule ",RNO_str,Ans),
  248.     concat(Ans,": ",Ans1),
  249.     sub_cat(Mygoal1,Mygoal2,Lstr),
  250.     concat(Ans1,Lstr,Ans2),
  251.     concat(Ans2,"\n     if ",Ans3),
  252.     reverse(CONDINGELSER,CONILS),
  253.     show_conditions(CONILS,Con),
  254.     concat(Ans3,Con,Strg).
  255.  
  256.   show_conditions([],"").
  257.   show_conditions([COND],Ans):-
  258.     show_cond(COND,Ans),!.
  259.   show_conditions([COND|REST],Ans):-
  260.     show_cond(COND,Text),
  261.     concat("\n    and ",Text,Nstr),
  262.     show_conditions(REST,Next_ans),
  263.     concat(Next_ans,Nstr,Ans).
  264.  
  265.   show_cond(COND,TEXT):-cond(COND,TEXT).
  266.  
  267.   sub_cat(Mygoal1,Mygoal2,Lstr):-
  268.     concat(Mygoal1," is a ",Str),
  269.     concat(Str,Mygoal2,Lstr).
  270.  
  271.   report([],"").
  272.   report([RNO|REST],Strg) :-
  273.     rule( RNO, Mygoal1, Mygoal2, _),
  274.     sub_cat(Mygoal1,Mygoal2,Lstr),
  275.     concat("\nI have shown that: ",Lstr,L1),
  276.     concat(L1,"\nBy using rule number ",L2),
  277.     str_int(Str_RNO,RNO),
  278.     concat(L2,Str_RNO,L3),
  279.     concat(L3,":\n ",L4),
  280.     show_rule(RNO,Str),
  281.     concat(L4,Str,L5),
  282.     report(REST,Next_strg),
  283.     concat(L5,Next_strg,Strg).
  284.  
  285. /*Update the knowledge base*/
  286.  
  287.   getrnr(N,N):-not(rule(N,_,_,_)),!.
  288.   getrnr(N,N1):-H=N+1,getrnr(H,N1).
  289.  
  290.   getbnr(N,N):-not(cond(N,_)),!.
  291.   getbnr(N,N1):-H=N+1,getbnr(H,N1).
  292.  
  293.   readcondl( [BNO|R] ):-
  294.     write("condition: "),readln(COND),
  295.     COND><"",!,
  296.     getcond(BNO,COND),
  297.     readcondl( R ).
  298.   readcondl( [] ).
  299.  
  300.   getcond(BNO,COND):-cond(BNO,COND),!.
  301.   getcond(BNO,COND):-getbnr(1,BNO), assert( cond(BNO,COND) ).
  302.  
  303. /*EDIT KNOWLEDGE*/
  304.  
  305.   edit_kb :-
  306.     pick_dba(Filename),
  307.     file_str(Filename,Data),
  308.     edit(Data,NewData),clearwindow,
  309.     write("Save Knowledge Base (enter y or n) "),
  310.     readchar(Ans),save_y(Ans,NewData,Filename).
  311.  
  312.   save_y('y',D,Filename):-
  313.     openwrite(save_file,Filename),
  314.     writedevice(save_file),
  315.     write(D),
  316.     closefile(save_file).
  317.   save_y('n',_,_).
  318.  
  319. /*HELP !!!*/
  320.  
  321.    help :- file_str("geni.hlp",Help),
  322.     display(Help).
  323.  
  324.  
  325. /*User commands*/
  326.  
  327.   load_know:-pick_dba(Data), consult(Data).
  328.  
  329.   save_know :- data_file(Data), bound(Data),!,
  330.     save(Data),clearwindow,
  331.     writef(" Your % Knowledge base has been saved",Data).
  332.   save_know :- makewindow(11,10,9,"Name of the file",10,40,4,35),
  333.     write("Enter Knowledge\nBase Name: "),
  334.     readln(Data),
  335.     assert(data_file(Data)),
  336.     removewindow,
  337.     save(Data),clearwindow,
  338.     writef(" Your % Knowledge base has been saved",Data).
  339.  
  340.   pick_dba(Data) :- makewindow(10,7,7,"PICK A DATA FILE",10,10,10,60),
  341.     dir("","*.gni",Data),removewindow.
  342.  
  343.   erase:-retract(_),fail.
  344.   erase.
  345.  
  346.   clear:-retract(yes(_)),retract(no(_)),fail,!.
  347.   clear.
  348.  
  349.   update:-
  350.     shiftwindow(5),
  351.     clearwindow,
  352.     write("\n\tUpdate knowledge\n\t****************\n"),
  353.     cursor(1,30),
  354.     write("Name of category: "),
  355.     cursor(3,30),
  356.     write("Name of subcategory: "),
  357.     cursor(1,50),
  358.     readln(KAT1),KAT1><"",
  359.     quest(KAT1,1,50,KAT),
  360.     cursor(3,50),
  361.     readln(SUB1),SUB1><"",
  362.     quest(SUB1,3,50,SUB),
  363.     readcondl(CONDL),
  364.     getrnr(1,RNO),
  365.     assert( rule(RNO,KAT,SUB,CONDL) ),update.
  366.  
  367.   quest(Q,X,Y,Q2):- Q = "?",
  368.     shiftwindow(2),clearwindow,
  369.     write("The categories and subcategories are objects. For example:\n"),nl,
  370.     write("subcategory|-----| category|-----|[condition1  |------|  condition2]\n"),
  371.     write("___________|_____|_______________|_____________|______|____________"),nl,
  372.     write("mammal     |is an| animal  |if it| has hair    |and it|  gives milk\n"),
  373.     write("bird       |is an| animal  |if it| has feathers|and it|  lays eggs\n"),
  374.     shiftwindow(5),
  375.     cursor(X,Y),
  376.     readln(Q2).
  377.   quest(Q,_,_,Q).
  378.  
  379.   info("?") :-
  380.     shiftwindow(2), clearwindow,
  381.     write("Enter the type of thing you are trying to classify."),
  382.     listopt,nl,nl, write(" press any key "),
  383.     readchar(_),
  384.     shiftwindow(1),clearwindow,fail.
  385.  
  386.   info(X) :- X>< "?".
  387.  
  388.   listopt :-
  389.     write(" The options are:\n\n"),
  390.     rule(_,Ans,_,_),
  391.     write(Ans,"  "),
  392.     fail.
  393.   listopt.
  394.  
  395.   evalans('y'):-
  396.     write("\nOf course, I am always right!").
  397.   evalans(_):-
  398.     write(" you're the boss \n  Update my Knowledge Base!"),!,run.
  399.  
  400.  /*system commands*/
  401.  
  402.   reverse(X,Y):-
  403.      reverse1([],X,Y).
  404.   reverse1(Y,[],Y).
  405.   reverse1(X1,[U|X2],Y):-reverse1([U|X1],X2,Y).
  406.   
  407.