clam.pro

来自「prolog开发工具」· PRO 代码 · 共 643 行 · 第 1/2 页

combine(CF1,CF2,CF) :-
	(CF1 < 0; CF2 < 0),
	(CF1 > 0; CF2 > 0),
	abs_minimum(CF1,CF2,MCF),
	X is 100 * (CF1 + CF2) / (100 - MCF),
	int_round(X,CF).

abs_minimum(A,B,X) :-
	absolute(A, AA),
	absolute(B, BB),
	minimum(AA,BB,X).

absolute(X, X) :- X >= 0.
absolute(X, Y) :- X < 0, Y is -X.

%minimum(A,B,A) :- A =< B.
%minimum(A,B,B) :- B > A.

%min([],X,X).
%min([H|T],Z,X) :-
%	H < Z,
%	min(T,H,X).
%min([H|T],Z,X) :-
%	H >= Z,
%	min(T,Z,X).

minimum(X,Y,X) :- X =< Y,!.
minimum(X,Y,Y) :- Y =< X.

int_round(X,I) :-
	X >= 0,
	I is integer(X + 0.5).
int_round(X,I) :-
	X < 0,
	I is integer(X - 0.5).

set_trace(off) :-
	ruletrace,
	retract( ruletrace ).
set_trace(on) :-
	not ruletrace,
	asserta( ruletrace ).
set_trace(_).

single_valued(A) :-multivalued(A),!,fail.
single_valued(A) :-true.

list_facts :-
	fact(X,Y,_),
	write(fact(X,Y)),nl,
	fail.
list_facts :-true.

do_over :-
	abolish(asked,1),
	abolish(fact,3).

clear :-
	abolish(asked,1),
	abolish(fact,3),
	abolish(rule,1),
	abolish(multivalued,1),
	abolish(askable,1),
	abolish(ghoul,1).
	
blank_lines(0).
blank_lines(N) :-
	nl,
	NN is N - 1,
	blank_lines(NN).

bugdisp(L) :-
	ruletrace,
	write_line(L), !.
bugdisp(_).

write_line(L) :-
	flatten(L,LF),
	write_lin(LF).
	
write_lin([]) :- nl.
write_lin([H|T]) :-
	write(H), tab(1),
	write_lin(T).

flatten([],[]) :- !.
flatten([[]|T],T2) :-
	flatten(T,T2), !.
flatten([[X|Y]|T], L) :-
	flatten([X|[Y|T]],L), !.
flatten([H|T],[H|T2]) :-
	flatten(T,T2).                   

member(X,[X|Y]).
member(X,[Y|Z]) :- member(X,Z).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% LDRULS - this module reads a rule file and translates it to internal
%          Prolog format for the Clam shell

load_rules :-
	write('Enter file name in single quotes (ex. ''car.ckb''.): '),
	read(F),
	load_rules(F).

load_rules(F) :-
	clear_db,
	see(F),
	lod_ruls,
	write('rules loaded'),nl,
	seen, !.

lod_ruls :-
	repeat,
	read_sentence(L),
%	bug(L),
	process(L),
	L == ['!EOF'].

process(['!EOF']) :- !.
process(L) :-
	trans(R,L,[]),
	bug(R),
	assertz(R), !.
process(L) :-
	write('trans error on:'),nl,
	write(L),nl.

clear_db :-
	abolish(cf_model,1),
	abolish(ghoul,1),
	abolish(askable,4),
	abolish(output,3),
	abolish(rule,3).

bug(cf_model(X)) :- write(cf_model(X)),nl,!.
bug(ghoul(X)):- write(ghoul(X)),nl,!.
bug(askable(A,_,_,_)):- write('askable '),write(A),nl,!.
bug(output(A,V,PL)):- write('output '),write(V),nl,!.
bug(rule(N,_,_)):- write('rule '),write(N),nl,!.
bug(X) :- write(X),nl.

% trans - translates a list of atoms in external rule form to internal
%         rule form

trans(cf_model(X)) --> [cf,model,X].
trans(cf_model(X)) --> [cf,model,is,X].
trans(cf_model(X)) --> [cf,X].
trans(ghoul(X)) --> [goal,is,X].
trans(ghoul(X)) --> [goal,X].
trans(askable(A,M,E,P)) --> 
	[ask,A],menux(M),editchk(E),prompt(A,P).
trans(output(A,V,PL)) --> 
	[output],phraz(av(A,V)),plist(PL). 
trans(rule(N,lhs(IF),rhs(THEN,CF))) --> id(N),if(IF),then(THEN,CF).
trans(multivalued(X)) --> [multivalued,X].
trans('Parsing error'-L,L,_).

% default(D) -->  [default,D].
% default(none) -->  [].

menux(M) -->  [menu,'('], menuxlist(M).

menuxlist([Item]) -->  [Item,')'].
menuxlist([Item|T]) -->  [Item],menuxlist(T).

editchk(E) -->  [edit,E].
editchk(none) -->  [].

prompt(_,P) -->  [prompt,P].
prompt(P,P) -->  [].

id(N) --> [rule,N].

if(IF) --> [if],iflist(IF).

iflist([IF]) --> phraz(IF),[then].
iflist([Hif|Tif]) --> phraz(Hif),[and],iflist(Tif).
iflist([Hif|Tif]) --> phraz(Hif),[','],iflist(Tif).

then(THEN,CF) --> phraz(THEN),[cf],[CF].
then(THEN,100) --> phraz(THEN).

phraz(not av(Attr,yes)) --> [not,Attr].
phraz(not av(Attr,yes)) --> [not,a,Attr].
phraz(not av(Attr,yes)) --> [not,an,Attr].
phraz(not av(Attr,Val)) --> [not,Attr,is,Val].
phraz(not av(Attr,Val)) --> [not,Attr,are,Val].
phraz(av(Attr,Val)) --> [Attr,is,Val].
phraz(av(Attr,Val)) --> [Attr,are,Val].
phraz(av(Attr,yes)) --> [Attr].

plist([Text]) --> [Text].
plist([Htext|Ttext]) --> [Htext],plist(Ttext).

%%
%% end LDRULS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                                                                                

read_line(L) :- read_word_list([13,10], L), !.

read_sentence(S) :- read_word_list([`.], S), !.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% From the Cogent Prolog Toolbox
%% 
%% rwl.pro - read word list, based on Clocksin & Mellish
%%
%% Read word list reads in a list of chars (terminated with a !, . or ?)
%% and converts it to a list of atomic entries (including numbers).
%% Uppercase is converted to lower case.
%% A 'word' is one item in our generated list

%% This version has been modified for CLAM by allowing an additional
%% argument, Xs, that is a list of the ending characters.  This allows the
%% code to be used for both command input, terminated by the Enter key, and
%% reading the knowledge base files, terminated after multiple lines by
%% a period.

%% It has further been modified to skip everything between a % and the
%% end of line, allowing for Prolog style comments.

read_word_list(LW,[W|Ws]) :-
        get0(C),
        readword(C, W, C1),        % Read word starting with C, C1 is first new
        restsent(LW, C1, Ws).      % character - use it to get rest of sentence

restsent(_, '!EOF', []).
restsent(LW,C,[]) :-				     % Nothing left if hit last-word marker
        member(C,LW), !.
restsent(LW,C,[W1|Ws]) :-
        readword(C,W1,C1),         % Else read next word and rest of sentence
        restsent(LW,C1,Ws).

readword('!EOF','!EOF','!EOF').
readword(`%,W,C2) :-               % allow Prolog style comments
        !,
        skip(13),
        get0(C1),
        readword(C1,W,C2).
readword(`',W,C2) :-
        !,
        get0(C1),
        to_next_quote(C1,Cs),
        name(W, [`'|Cs]),
        get0(C2).        
readword(C,W,C1) :-                % Some words are single characters
        single_char(C),            % i.e. punctuation
        !, 
        name(W, [C]),              % get as an atom
        get0(C1).
readword(C, W, C1) :-
        is_num(C),                 % if we have a number --
        !,
        number_word(C, W, C1, _).  % convert it to a genuine number
readword(C,W,C2) :-                % otherwise if charcter does not
        in_word(C, NewC),          % delineate end of word - keep
        get0(C1),                  % accumulating them until 
        restword(C1,Cs,C2),        % we have all the words
        name(W, [NewC|Cs]).        % then make it an atom
readword(C,W,C2) :-                % otherwise
        get0(C1),       
        readword(C1,W,C2).         % start a new word

restword(C, [NewC|Cs], C2) :-
        in_word(C, NewC),
        get0(C1),
        restword(C1, Cs, C2).
restword(C, [], C).

to_next_quote(`', [`']).
to_next_quote(C,[C|Rest]) :-
        get0(C1),
        to_next_quote(C1,Rest).

single_char(`,).
single_char(`;).
single_char(`:).
single_char(`?).
single_char(`!).
single_char(`.).
single_char(`().
single_char(`)).


in_word(C, C) :- C >= `a, C =< `z.
in_word(C, C) :- C >= `A, C =< `Z.
in_word(`-, `-).
in_word(`_, `_).

% Have character C (known integer) - keep reading integers and build
% up the number until we hit a non-integer. Return this in C1,
% and return the computed number in W.

number_word(C, W, C1, Pow10) :- 
        is_num(C),
        !,
        get0(C2),
        number_word(C2, W1, C1, P10),
        Pow10 is P10 * 10,
        W is integer(((C - `0) * Pow10) + W1).
number_word(C, 0, C, 0.1).


is_num(C) :-
        C =< `9,
        C >= `0.

% These symbols delineate end of sentence

%lastword(`.).
%lastword(`!).
%lastword(`?).
%lastword(13).		% carriage return
%lastword(10).		% line feed

%%
%% end RWL.PRO from Cogent Prolog Toolbox
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%