📄 gni91220.pro
字号:
/*Copyright (c) 1986, 88 by Borland International, Inc.
*/
code = 4000
/*This is a small example of how to create a
classification expert-system in TURBO-
Prolog.
Animals are classified in different
categories which are then broken up into
smaller categories. One can move from one
category to another if a number of
conditions are fulfilled.
In this system the conditions are added
together. The first thing that is needed is
'or' and 'not'.
Please understand this is a simple example
not a finished expert-system development
tool. */
DOMAINS
CONDITIONS = BNO* HISTORY = RNO*
RNO, BNO, FNO = INTEGER CATEGORY = STRING
data_file = string file = save_file
slist = string*
DATABASE
rule(RNO,CATEGORY,CATEGORY,CONDITIONS)
cond(BNO,STRING) data_file(data_file)
yes(BNO) unknow(BNO) no(BNO)
fact(FNO,CATEGORY,CATEGORY) topic(string)
reason(RNO,CONDITIONS) maximum(string,integer)
include "tdoms.pro"
include "tpreds.pro"
include "menu2.pro"
PREDICATES
/*****************************************COMMANDS*****************************/
title_go update
edit_kb list
llist(HISTORY,string) load_know
save_know pick_dba(data_file)
erase clear
proces(integer) endd(integer)
listopt evalans(char)
info(CATEGORY) goes(CATEGORY)
run reverse(CONDITIONS,CONDITIONS)
reverse1(CONDITIONS,CONDITIONS,CONDITIONS)
/****************************INFERENCES MECHANISMS*****************************/
go(HISTORY,CATEGORY) check(RNO,HISTORY,CONDITIONS)
inpq(HISTORY,RNO,BNO,STRING) do_answer(HISTORY,RNO,STRING,BNO,INTEGER)
count(CONDITIONS,integer) terminal_goal(RNO,CATEGORY)
make_reason(RNO,BNO) file_name(string)
find_max(string,integer) store_max(string,integer)
store_max(string,integer) head_is_a_not(BNO,string)
remove_not(string,string)
/*************************************EXPLANATIONS*****************************/
sub_cat(CATEGORY,CATEGORY,CATEGORY)
show_conditions(CONDITIONS,string)
show_rule(RNO,string) show_cond(BNO,string)
report(HISTORY,string) quest(CATEGORY,integer,integer,CATEGORY)
/*****************************UPDATA THE KNOWLEDGE*****************************/
topict(string) getrnr(RNO,RNO)
getbnr(BNO,BNO) readcondl(CONDITIONS)
help getcond(BNO,STRING)
save_y(char,string,data_file)
/******************************************************************************/
GOAL
makewindow(1,49,72,"",4,0,20,80),
makewindow(2,3,7,"",14,0,10,80),
makewindow(5,7,0,"",0,0,4,80),
makewindow(8,23,0,"",24,0,1,80),
makewindow(9,7,0,"",0,0,25,80),
run.
CLAUSES
run :-
repeat,
shiftwindow(8),clearwindow,
write(" select option with arrow key "),
shiftwindow(1),
menu(6,55,7,7,["Consultation","Load knowledge",
"Save knowledge","List knowledge",
"Update knowledge","Erase knowledge",
"Edit Knowledge","Help Information",
"DOS Shell","Exit Geni"],"menu",2,CHOICE),
proces(CHOICE),
endd(CHOICE),!.
/***********************************PROCESS CHOICE*****************************/
proces(0):-exit.
proces(1):-title_go. proces(2):-load_know.
proces(3):-save_know. proces(4):-list.
proces(5):-update. proces(6):-erase.
proces(7):-edit_kb. proces(8):-help.
proces(9):-write("Borland ",'\3','\2'," you"),system("").
proces(10).
endd(0).
endd(10):- clearwindow,
write("Are you sure? (y or n) "),
readchar(C),write(C),C='y',exit.
/******************************INFERENCE MECHANISM*****************************/
title_go:-
goes(Mygoal),nl,nl,
go([],Mygoal),!.
title_go:-
nl,write("Sorry that one I did not know"),nl,update.
goes(Mygoal):-
clear,clearwindow,
topict(Topic),
repeat,
write("You may select a general category( e.g. ",Topic,") \nor '?' for other options in the ",Topic,
" domain.\n Enter Goal "),
readln(Mygoal),
info(Mygoal),!.
topict(Topic) :- topic(Topic).
topict(Topic) :- write("Enter a name that represents \nthis knowledge domain\n : "),
readln(Topic),assert(topic(Topic)).
go( _, Mygoal ):- /**** My best guess ****/
/*not(rule(_,Mygoal,_,_)),!,nl,*/
terminal_goal(_,Mygoal),
nl,write("I think it is a(n): ",Mygoal),nl,nl,
write("I was right, wasn't I? (enter y or n)"),
readchar(Ans),evalans(Ans).
go( HISTORY, Mygoal ):-
rule(RNO,Mygoal,NY,COND),asserta(reason(RNO,[])),
check(RNO,HISTORY, COND),
go([RNO|HISTORY],NY).
go( [RNO|_],Mygoal ):-
reason(RNO,COND), count(COND,True),
rule(RNO,_,_,COND),count(COND,Total),
Certainty=True/Total*100,
nl,write(" I think it is a(n): ",Mygoal," with ",Certainty,"% Certainty"),nl,
!,assert(maximum("",0)), find_max(Ny,Ct),
write(" I think it may be a(n): ",Ny," with ",Ct,"% Certainty"),nl.
find_max(Ny,Ct):-
reason(RNO,COND),terminal_goal(RNO,_),count(COND,True),
rule(RNO,_,Ny,COND1),count(COND1,Total),
Ct=True/Total*100,store_max(Ny,Ct),fail.
find_max(Ny,Ct):- maximum(Ny,Ct).
store_max( _,Ct):- maximum( _,Ct1), Ct1>=Ct, !.
store_max(Ny,Ct):- maximum(Ny1,Ct1), Ct1< Ct,
assert(maximum(Ny,Ct)), retract(maximum(Ny1,Ct1)), !.
check( RNO, HISTORY, [BNO|REST] ):- yes(BNO), !,
make_reason(RNO,BNO),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):- no(BNO), !,
terminal_goal(RNO,_),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):- unknow(BNO), !,
terminal_goal(RNO,_),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):-
head_is_a_not(BNO,COND),cond(BNO1,COND),no(BNO1), !,
make_reason(RNO,BNO),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):-
head_is_a_not(BNO,COND),cond(BNO1,COND),yes(BNO1), !,
terminal_goal(RNO,_),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):-
head_is_a_not(BNO,COND),cond(BNO1,COND),unknow(BNO1),!,
terminal_goal(RNO,_),
!, check(RNO,HISTORY,REST).
check( RNO, HISTORY, [BNO|REST] ):-
cond(BNO,TEXT),
inpq(HISTORY,RNO,BNO,TEXT),
!, check(RNO,HISTORY,REST).
check( RNO, _, [] ):-
reason(RNO,COND),reverse(COND,COND1),
rule(RNO,_,_,COND1), !.
check( RNO, _, [] ):- not(terminal_goal(RNO,_)), !.
count([],0).
count([_|Tail],N):- count(Tail,N1),N=N1+1.
make_reason(RNO,BNO):-
reason(RNO,BNOlist),
asserta(reason(RNO,[BNO|BNOlist])),
retract(reason(RNO,BNOlist)), !.
make_reason(RNO,BNO):-
assert(reason(RNO,[BNO])).
terminal_goal(RNO,N):-
rule(RNO,_,N,_),not(rule(_,N,_,_)).
inpq(HISTORY,RNO,BNO,TEXT):-remove_not(TEXT,TEXT1),
write("Is it true that ",TEXT1,": "),
ROW = 14,COL = 60,
menu(ROW,COL,7,7,[yes,unknow,no,why],"",1,CHOICE),
do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
do_answer(_,_,_,_,0):-exit.
do_answer(_,_,_,BNO,1):- head_is_a_not(BNO,COND),
cond(BNO1,COND),assert(yes(BNO1)),
shiftwindow(1),write(yes),nl,fail.
do_answer(_,RNO,_,BNO,1):- not(head_is_a_not(BNO,_)),assert(yes(BNO)),
make_reason(RNO,BNO),
shiftwindow(1),write(yes),nl.
do_answer(_,_,_,BNO,2):- assert(unknow(BNO)),
shiftwindow(1),write(unknow),nl,fail.
do_answer(_,_,_,BNO,3):- head_is_a_not(BNO,COND),
cond(BNO1,COND),assert(no(BNO1)),
shiftwindow(1),write(no),nl.
do_answer(_,_,_,BNO,3):- not(head_is_a_not(BNO,_)),assert(no(BNO)),
shiftwindow(1),write(no),nl,fail.
do_answer(HISTORY,RNO,TEXT,BNO,4):- !,
shiftwindow(2),
rule( RNO, Mygoal1, Mygoal2, _ ),
sub_cat(Mygoal1,Mygoal2,Lstr),
concat("I try to show that: ",Lstr,Lstr1),
concat(Lstr1,"\nBy using rule number ",Ls1),
str_int(Str_num,RNO), concat(Ls1,Str_num,Ans),
show_rule(RNO,Lls1),
concat(Ans,Lls1,Ans1),
report(HISTORY,Sng),
concat(Ans1,Sng,Answ),
display(Answ),
shiftwindow(8), clearwindow,
write(" Use Arrow Keys To Select Option "),
shiftwindow(1),
ROW = 14,COL = 60,
menu(ROW,COL,7,7,[yes,unknow,no,why],"",1,CHOICE),
do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
head_is_a_not(BNO,COND):-cond(BNO,NCOND),
fronttoken(NCOND,"not",_COND),
frontchar(_COND,_,COND).
remove_not(TEXT,TEXT1):-
fronttoken(TEXT,"not",_TEXT),frontchar(_TEXT,_,TEXT1), !.
remove_not(TEXT,TEXT1):- TEXT1=TEXT.
/************* LIST RULES / EXPLANATION MECHANISM *****************************/
list :- findall(RNO,rule(RNO,_,_,_),LIST),
llist(List,Str),!,display(Str),!.
llist([],"") :-!.
llist([RNO|List],Str):-
llist(List,Oldstr),
show_rule(RNO,RNO_Str),
concat(RNO_Str,Oldstr,Str).
show_rule(RNO,Strg):-
rule( RNO, Mygoal1, Mygoal2, CONDINGELSER),
str_int(RNO_str,RNO),
concat("\n Rule ",RNO_str,Ans),
concat(Ans,": ",Ans1),
sub_cat(Mygoal1,Mygoal2,Lstr),
concat(Ans1,Lstr,Ans2),
concat(Ans2,"\n if ",Ans3),
reverse(CONDINGELSER,CONILS),
show_conditions(CONILS,Con),
concat(Ans3,Con,Strg).
show_conditions([],"").
show_conditions([COND],Ans):-
show_cond(COND,Ans),!.
show_conditions([COND|REST],Ans):-
show_cond(COND,Text),
concat("\n and ",Text,Nstr),
show_conditions(REST,Next_ans),
concat(Next_ans,Nstr,Ans).
show_cond(COND,TEXT):-cond(COND,TEXT).
sub_cat(Mygoal1,Mygoal2,Lstr):-
concat(Mygoal1," is a ",Str),
concat(Str,Mygoal2,Lstr).
report([],"").
report([RNO|REST],Strg) :-
rule( RNO, Mygoal1, Mygoal2, _),
sub_cat(Mygoal1,Mygoal2,Lstr),
concat("\nI have shown that: ",Lstr,L1),
concat(L1,"\nBy using rule number ",L2),
str_int(Str_RNO,RNO),
concat(L2,Str_RNO,L3),
concat(L3,":\n ",L4),
show_rule(RNO,Str),
concat(L4,Str,L5),
report(REST,Next_strg),
concat(L5,Next_strg,Strg).
/************************UPDATE THE KNOWLEDGE BASE*****************************/
getrnr(N,N):-not(rule(N,_,_,_)),!.
getrnr(N,N1):-H=N+1,getrnr(H,N1).
getbnr(N,N):-not(cond(N,_)),!.
getbnr(N,N1):-H=N+1,getbnr(H,N1).
readcondl( [BNO|R] ):-
write("condition: "), readln(COND), COND><"",!,
getcond(BNO,COND), readcondl( R ).
readcondl( [] ).
getcond(BNO,COND):-cond(BNO,COND),!.
getcond(BNO,COND):-getbnr(1,BNO), assert( cond(BNO,COND) ).
/***********************************EDIT KNOWLEDGE*****************************/
edit_kb :-
pick_dba(Filename), file_str(Filename,Data),
edit(Data,NewData), clearwindow,
write("Save Knowledge Base (enter y or n) "),
readchar(Ans), save_y(Ans,NewData,Filename).
save_y('y',D,Filename):-
openwrite(save_file,Filename),
writedevice(save_file), write(D),
closefile(save_file).
save_y('n',_,_).
/*****************************************HELP !!!*****************************/
help :- file_str("geni.hlp",Help),
display(Help).
/************************************User commands*****************************/
load_know:-erase,pick_dba(Data), consult(Data).
/*save_know :- data_file(Data), bound(Data),!,
save(Data),clearwindow,
writef(" Your % Knowledge base has been saved",Data).*/
save_know :- makewindow(11,10,9,"Name of the file",10,40,4,35),
write("Enter Knowledge\nBase Name: "),
readln(Data), file_name(Data),
removewindow, save(Data), clearwindow,
writef(" Your % Knowledge base has been saved",Data).
file_name(Data):- data_file(Data),!.
file_name(Data):- assert(data_file(Data)).
pick_dba(Data):- makewindow(10,7,7,"PICK A DATA FILE",10,10,10,60),
dir("","*.gni",Data),removewindow.
erase:-retract(_),fail.
erase.
clear:-retract(yes(_)),fail.
clear:-retract(no(_)),fail.
clear:-retract(unknow(_)),fail.
clear:-retract(reason(_,_)),fail.
clear:-retract(maximum(_,_)),fail.
clear.
update:-
shiftwindow(5), clearwindow,
write("\n\tUpdate knowledge\n\t****************\n"),
cursor(1,30), write("Name of category: "),
cursor(3,30), write("Name of subcategory: "),
cursor(1,50), readln(KAT1),
KAT1><"", quest(KAT1,1,50,KAT),
cursor(3,50), readln(SUB1),
SUB1><"", quest(SUB1,3,50,SUB),
readcondl(CONDL),
getrnr(1,RNO),
assert( rule(RNO,KAT,SUB,CONDL) ),update.
quest(Q,X,Y,Q2):- Q = "?",
shiftwindow(2),clearwindow,
write("The categories and subcategories are objects. For example:\n"),nl,
write("subcategory|-----| category|-----|[condition1 |------| condition2]\n"),
write("___________|_____|_______________|_____________|______|____________"),nl,
write("mammal |is an| animal |if it| has hair |and it| gives milk\n"),
write("bird |is an| animal |if it| has feathers|and it| lays eggs\n"),
shiftwindow(5), cursor(X,Y), readln(Q2).
quest(Q,_,_,Q).
info("?") :-
shiftwindow(2), clearwindow,
write("Enter the type of thing you are trying to classify."),
listopt,nl,nl, write(" press any key "),
readchar(_), shiftwindow(1), clearwindow, fail.
info(X) :- X>< "?".
listopt :-
write(" The options are:\n\n"),
rule(_,Ans,_,_), write(Ans," "), fail.
listopt.
evalans('y'):-
write("\nOf course, I am always right!").
evalans(_):-
write(" you're the boss \n Update my Knowledge Base!"),!,run.
/**********************************SYSTEM COMMANDS*****************************/
reverse(X,Y):-
reverse1([],X,Y).
reverse1(Y,[],Y).
reverse1(X1,[U|X2],Y):-reverse1([U|X1],X2,Y).
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -