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