This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/cplint/slipcover/test.pl

470 lines
9.4 KiB
Perl
Raw Normal View History

2013-09-17 12:04:22 +01:00
:-multifile setting/2.
:-source.
:-use_module(library('cplint/slipcover')).
setting(neg_ex,cw).
/* allowed values: given, cw */
main(TrainP,TestSets):-
system('rm -f areas.csv'),
system('rm -f curve_roc.m'),
system('rm -f curve_pr.m'),
open('cll1.pl',write,S),
open('areas.csv',append,SA),
format(SA,"Fold;\tCLL;\t AUCROC;\t AUCPR~n",[]),
close(SA),
test(TrainP,TestSets,S,[],LG,0,Pos,0,Neg,0,CLL),
keysort(LG,LG1),
format(S,"cll(all,post,~d,~d,[",[Pos,Neg]),
writes(LG1,S),
reverse(LG1,LGR1),
compute_areas(LGR1,Pos,Neg,AUCROC,AUCPR),
open('areas.csv',append,SA1),
format(SA1,"~a;\t ~f;\t ~f;\t ~f~n",[all,CLL,AUCROC,AUCPR]),
close(SA1),
close(S).
test([],[],_S,LG,LG,Pos,Pos,Neg,Neg,CLL,CLL).
test([HP|TP],[HT|TT],S,LG0,LG,Pos0,Pos,Neg0,Neg,CLL0,CLL):-
test_fold(HP,HT,S,LG1,Pos1,Neg1,CLL1),
append(LG0,LG1,LG2),
Pos2 is Pos0+Pos1,
Neg2 is Neg0+Neg1,
CLL2 is CLL0+CLL1,
test(TP,TT,S,LG2,LG,Pos2,Pos,Neg2,Neg,CLL2,CLL).
test_fold(P,F,S,LGOrd,Pos,Neg,CLL1):-
atom_concat([P,'.rules'],PR),
atom_concat([P,'.bg'],PBG),
atom_concat([P,'.l'],FL),
atom_concat([F,'.kb'],TKB),
reconsult(FL),
(file_exists(PBG)->
set(compiling,on),
load(PBG,_ThBG,RBG),
set(compiling,off),
generate_clauses(RBG,_RBG1,0,[],ThBG),
assert_all(ThBG)
;
true
),
format("~a~n",[TKB]),
load_models(TKB,DB),
set(compiling,on),
load(PR,Th1,R1),
set(compiling,off),
assert_all(Th1),
assert_all(R1),
find_ex(DB,LG,Pos,Neg),
compute_CLL_atoms(LG,0,0,CLL1,LG1),
(file_exists(PBG)->
retract_all(ThBG)
;
true
),
retract_all(Th1),
retract_all(R1),
keysort(LG1,LGOrd),
reverse(LGOrd,LGROrd),
compute_areas(LGROrd,Pos,Neg,AUCROC,AUCPR),
format(S,"cll(~a,post,~d,~d,[",[F,Pos,Neg]),
writes(LGOrd,S),
open('areas.csv',append,SA),
format(SA,"~a;\t ~f;\t ~f;\t ~f~n",[F,CLL1,AUCROC,AUCPR]),
close(SA).
compute_areas(LG,Pos,Neg,AUCROC,AUCPR):-
compute_pointsroc(LG,+inf,0,0,Pos,Neg,[],ROC),
hull(ROC,0,0,0,AUCROC),
open('curve_roc.m',append,SC),
write_p(ROC,SC),
close(SC),
compute_aucpr(LG,Pos,Neg,AUCPR,PR),
open('curve_pr.m',append,SPR),
write_ppr(PR,SPR),
close(SPR).
compute_pointsroc([],_P0,_TP,_FP,_FN,_TN,P0,P1):-!,
append(P0,[1.0-1.0],P1).
compute_pointsroc([P- (\+ _)|T],P0,TP,FP,FN,TN,Po0,Po1):-!,
(P<P0->
FPR is FP/(FP+TN),
TPR is TP/(TP+FN),
append(Po0,[(FPR-TPR)],Po2),
P1=P
;
Po2=Po0,
P1=P0
),
FP1 is FP+1,
TN1 is TN-1,
compute_pointsroc(T,P1,TP,FP1,FN,TN1,Po2,Po1).
compute_pointsroc([P- _|T],P0,TP,FP,FN,TN,Po0,Po1):-!,
(P<P0->
FPR is FP/(FP+TN),
TPR is TP/(TP+FN),
append(Po0,[FPR-TPR],Po2),
P1=P
;
Po2=Po0,
P1=P0
),
TP1 is TP+1,
FN1 is FN-1,
compute_pointsroc(T,P1,TP1,FP,FN1,TN,Po2,Po1).
hull([],FPR,TPR,AUC0,AUC1):-
AUC1 is AUC0+(1-FPR)*(1+TPR)/2.
hull([FPR1-TPR1|T],FPR,TPR,AUC0,AUC1):-
AUC2 is AUC0+(FPR1-FPR)*(TPR1+TPR)/2,
hull(T,FPR1,TPR1,AUC2,AUC1).
compute_aucpr(L,Pos,Neg,A,PR):-
L=[P_0-E|TL],
(E= (\+ _ )->
FP=1,
TP=0,
FN=Pos,
TN is Neg -1
;
FP=0,
TP=1,
FN is Pos -1,
TN=Neg
),
compute_curve_points(TL,P_0,TP,FP,FN,TN,Points),
Points=[R0-P0|_TPoints],
(R0=:=0,P0=:=0->
Flag=true
;
Flag=false
),
area(Points,Flag,Pos,0,0,0,A,[],PR).
compute_curve_points([],_P0,TP,FP,_FN,_TN,[1.0-Prec]):-!,
Prec is TP/(TP+FP).
compute_curve_points([P- (\+ _)|T],P0,TP,FP,FN,TN,Pr):-!,
(P<P0->
Prec is TP/(TP+FP),
Rec is TP/(TP+FN),
Pr=[Rec-Prec|Pr1],
P1=P
;
Pr=Pr1,
P1=P0
),
FP1 is FP+1,
TN1 is TN-1,
compute_curve_points(T,P1,TP,FP1,FN,TN1,Pr1).
compute_curve_points([P- _|T],P0,TP,FP,FN,TN,Pr):-!,
(P<P0->
Prec is TP/(TP+FP),
Rec is TP/(TP+FN),
Pr=[Rec-Prec|Pr1],
P1=P
;
Pr=Pr1,
P1=P0
),
TP1 is TP+1,
FN1 is FN-1,
compute_curve_points(T,P1,TP1,FP,FN1,TN,Pr1).
area([],_Flag,_Pos,_TPA,_FPA,A,A,PR,PR).
area([R0-P0|T],Flag,Pos,TPA,FPA,A0,A,PR0,PR):-
TPB is R0*Pos,
(TPB=:=0->
A1=A0,
FPB=0,
PR2=PR0,
PR=[R0-P0|PR3]
;
R_1 is TPA/Pos,
(TPA=:=0->
(Flag=false->
P_1=P0,
PR=[0.0-P0|PR3]
;
P_1=0.0,
PR=[0.0-0.0|PR3]
)
;
P_1 is TPA/(TPA+FPA),
PR=PR3
),
FPB is TPB*(1-P0)/P0,
N is TPB-TPA+0.5,
(N<1.0->
append(PR0,[R0-P0],PR2),
A1=A0
;
interpolate(1,N,Pos,R_1,P_1,TPA,FPA,TPB,FPB,A0,A1,[],PR1),
append(PR0,PR1,PR2)
)
),
area(T,Flag,Pos,TPB,FPB,A1,A,PR2,PR3).
interpolate(I,N,_Pos,_R0,_P0,_TPA,_FPA,_TPB,_FPB,A,A,PR,PR):-I>N,!.
interpolate(I,N,Pos,R0,P0,TPA,FPA,TPB,FPB,A0,A,PR0,[R-P|PR]):-
R is (TPA+I)/Pos,
P is (TPA+I)/(TPA+I+FPA+(FPB-FPA)/(TPB-TPA)*I),
A1 is A0+(R-R0)*(P+P0)/2,
I1 is I+1,
interpolate(I1,N,Pos,R,P,TPA,FPA,TPB,FPB,A1,A,PR0,PR).
find_ex(DB,LG,Pos,Neg):-
findall(P/A,output(P/A),LP),
setting(neg_ex,given),!,
find_ex_pred(LP,DB,[],LG,0,Pos,0,Neg).
find_ex(DB,LG,Pos,Neg):-
findall(P/A,output(P/A),LP),
setting(neg_ex,cw),
find_ex_pred_cw(LP,DB,[],LG,0,Pos,0,Neg).
find_ex_pred([],_DB,LG,LG,Pos,Pos,Neg,Neg).
find_ex_pred([P/A|T],DB,LG0,LG,Pos0,Pos,Neg0,Neg):-
functor(At,P,A),
find_ex_db(DB,At,LG0,LG1,Pos0,Pos1,Neg0,Neg1),
find_ex_pred(T,DB,LG1,LG,Pos1,Pos,Neg1,Neg).
find_ex_db([],_At,LG,LG,Pos,Pos,Neg,Neg).
find_ex_db([H|T],At,LG0,LG,Pos0,Pos,Neg0,Neg):-
At=..[P|L],
At1=..[P,H|L],
findall(At1,At1,LP),
findall(\+ At1,neg(At1),LN),
length(LP,NP),
length(LN,NN),
append([LG0,LP,LN],LG1),
Pos1 is Pos0+NP,
Neg1 is Neg0+NN,
find_ex_db(T,At,LG1,LG,Pos1,Pos,Neg1,Neg).
find_ex_pred_cw([],_DB,LG,LG,Pos,Pos,Neg,Neg).
find_ex_pred_cw([P/A|T],DB,LG0,LG,Pos0,Pos,Neg0,Neg):-
functor(At,P,A),
get_types(At,Types),
remove_duplicates(Types,Types1),
find_ex_db_cw(DB,At,Types1,LG0,LG1,Pos0,Pos1,Neg0,Neg1),
find_ex_pred_cw(T,DB,LG1,LG,Pos1,Pos,Neg1,Neg).
get_types(At,Types):-
modeh(_,At),
At=..[_|Args],
get_args(Args,Types).
get_args([],[]).
get_args([+H|T],[H|T1]):-!,
get_args(T,T1).
get_args([-H|T],[H|T1]):-!,
get_args(T,T1).
get_args([#H|T],[H|T1]):-!,
get_args(T,T1).
get_args([-#H|T],[H|T1]):-!,
get_args(T,T1).
get_args([H|T],[H|T1]):-
get_args(T,T1).
get_constants([],_M,[]).
get_constants([Type|T],M,[(Type,Co)|C]):-
find_pred_using_type(Type,LP),
find_constants(LP,M,[],Co),
get_constants(T,M,C).
find_pred_using_type(T,L):-
setof((P,Ar,A),pred_type(T,P,Ar,A),L).
pred_type(T,P,Ar,A):-
modeh(_,S),
S=..[P|Args],
length(Args,Ar),
scan_args(Args,T,1,A).
pred_type(T,P,Ar,A):-
modeb(_,S),
S=..[P|Args],
length(Args,Ar),
scan_args(Args,T,1,A).
scan_args([+T|_],T,A,A):-!.
scan_args([-T|_],T,A,A):-!.
scan_args([#T|_],T,A,A):-!.
scan_args([-#T|_],T,A,A):-!.
scan_args([_|Tail],T,A0,A):-
A1 is A0+1,
scan_args(Tail,T,A1,A).
find_constants([],_M,C,C).
find_constants([(P,Ar,A)|T],M,C0,C):-
gen_goal(1,Ar,A,Args,ArgsNoV,V),
G=..[P,M|Args],
setof(V,ArgsNoV^G,LC),
append(C0,LC,C1),
remove_duplicates(C1,C2),
find_constants(T,M,C2,C).
gen_goal(Arg,Ar,_A,[],[],_):-
Arg =:= Ar+1,!.
gen_goal(A,Ar,A,[V|Args],ArgsNoV,V):-!,
Arg1 is A+1,
gen_goal(Arg1,Ar,A,Args,ArgsNoV,V).
gen_goal(Arg,Ar,A,[ArgV|Args],[ArgV|ArgsNoV],V):-
Arg1 is Arg+1,
gen_goal(Arg1,Ar,A,Args,ArgsNoV,V).
find_ex_db_cw([],_At,_Ty,LG,LG,Pos,Pos,Neg,Neg).
find_ex_db_cw([H|T],At,Types,LG0,LG,Pos0,Pos,Neg0,Neg):-
get_constants(Types,H,C),
At=..[P|L],
get_types(At,TypesA),
length(L,N),
length(LN,N),
At1=..[P,H|LN],
findall(At1,At1,LP),
setof(\+ At1,neg_ex(LN,TypesA,At1,C),LNeg),
length(LP,NP),
length(LNeg,NN),
append([LG0,LP,LNeg],LG1),
Pos1 is Pos0+NP,
Neg1 is Neg0+NN,
find_ex_db_cw(T,At,Types,LG1,LG,Pos1,Pos,Neg1,Neg).
neg_ex([],[],At1,_C):-
\+ At1.
neg_ex([H|T],[HT|TT],At1,C):-
member((HT,Co),C),
member(H,Co),
neg_ex(T,TT,At1,C).
compute_CLL_atoms([],_N,CLL,CLL,[]):-!.
compute_CLL_atoms([\+ H|T],N,CLL0,CLL1,[PG- (\+ H)|T1]):-!,
rule_n(NR),
init_test(NR),
% write(\+ H),
get_node(H,BDD),!,
ret_prob(BDD,PG),
% write(PG),nl,
end_test,!,
PG1 is 1-PG,
(PG1=:=0.0->
CLL2 is CLL0-10
;
CLL2 is CLL0+ log(PG1)
),
N1 is N+1,
compute_CLL_atoms(T,N1,CLL2,CLL1,T1).
compute_CLL_atoms([H|T],N,CLL0,CLL1,[PG-H|T1]):-
rule_n(NR),
init_test(NR),
% write(H),
get_node(H,BDD),!,
ret_prob(BDD,PG),
% write(PG),nl,
end_test,!,
(PG=:=0.0->
CLL2 is CLL0-10
;
CLL2 is CLL0+ log(PG)
),
N1 is N+1,
compute_CLL_atoms(T,N1,CLL2,CLL1,T1).
writes([H-H1],S):-
format(S,"~f - (~p)]).~n~n",[H,H1]).
writes([H-H1|T],S):-
format(S,"~f - (~p),~n",[H,H1]),
writes(T,S).
write_p(P,S):-
get_xy(P,PX,PY),
format(S,"x=[",[]),
writesf(PX,S),
format(S,"y=[",[]),
writesf(PY,S),
format(S,"
figure('Name','roc','NumberTitle','off')
set(gca,'XLim',[0.0 1.0])
set(gca,'YLim',[0.0 1.0])
x=[x 1.0]
y=[y 0.0]
k=convhull(x,y)
plot(x(k),y(k),'r-',x,y,'--b+')
A = polyarea(x,y)~n~n
save area_roc.csv A -ascii -append
",
[]).
get_xy([],[],[]).
get_xy([X-Y|T],[X|TX],[Y|TY]):-
get_xy(T,TX,TY).
writesf([H],S):-
format(S,"~f]~n",[H]).
writesf([H|T],S):-
format(S,"~f ",[H]),
writesf(T,S).
write_ppr(P,S):-
get_xy(P,PX,PY),
format(S,"rec=[",[A]),
writesf(PX,S),
format(S,"prec=[",[A]),
writesf(PY,S),
format(S,"
figure('Name','pr','NumberTitle','off')
set(gca,'XLim',[0.0 1.0])
set(gca,'YLim',[0.0 1.0])
rec=[0.0 rec 1.0];
prec=[0.0 prec 0.0];
plot(rec,prec,'--*k')
A=polyarea(rec,prec)
save area_pr.csv A -ascii -append
~n~n",
[]).