%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Learning Engine for Proposing Hypotheses % % % % A L E P H % % Version 5 (last modified: Sun Mar 11 03:25:37 UTC 2007) % % % % This is the source for Aleph written and maintained % % by Ashwin Srinivasan (ashwin@comlab.ox.ac.uk) % % % % % % It was originally written to run with the Yap Prolog Compiler % % Yap can be found at: http://sourceforge.net/projects/yap/ % % Yap must be compiled with -DDEPTH_LIMIT=1 % % % % It should also run with SWI Prolog, although performance may be % % sub-optimal. % % % % If you obtain this version of Aleph and have not already done so % % please subscribe to the Aleph mailing list. You can do this by % % mailing majordomo@comlab.ox.ac.uk with the following command in the % % body of the mail message: subscribe aleph % % % % Aleph is freely available for academic purposes. % % If you intend to use it for commercial purposes then % % please contact Ashwin Srinivasan first. % % % % A simple on-line manual is available on the Web at % % www.comlab.ox.ac.uk/oucl/research/areas/machlearn/Aleph/index.html % % % % % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % C O M P I L E R S P E C I F I C prolog_type(swi):-!. /* prolog_type(yap):- predicate_property(yap_flag(_,_),built_in), !. prolog_type(swi). */ init(_):-!. init(yap):- source, system_predicate(nil,nil), hide(nil), style_check(single_var), % yap_flag(profiling,on), assert_static((aleph_random(X):- X is random)), (predicate_property(alarm(_,_,_),built_in) -> assert_static((remove_alarm(X):- alarm(0,_,_))); assert_static(alarm(_,_,_)), assert_static(remove_alarm(_))), assert_static((aleph_consult(F):- consult(F))), assert_static((aleph_reconsult(F):- reconsult(F))), (predicate_property(thread_local(_),built_in) -> true; assert_static(thread_local(_))), assert_static(broadcast(_)), assert_static((aleph_background_predicate(Lit):- predicate_property(Lit,P), ((P = static); (P = dynamic); (P = built_in)), !)), (predicate_property(delete_file(_),built_in) -> true; assert_static(delete_file(_))). % :- redefine_system_predicate(nil/0). :- style_check(+singleton). :- style_check(-discontiguous). :- use_module(library(arithmetic)). :- arithmetic_function(inf/0). :- dynamic(nil/0), dynamic(example/3), assert((aleph_random(X):- I = 1000000, X is float(random(I-1))/float(I))), assert(inf(1e10)), assert((gc:- garbage_collect)), assert((depth_bound_call(G,L):- call_with_depth_limit(G,L,R), R \= depth_limit_exceeded)), (predicate_property(numbervars(_,_,_),built_in) -> true; assert((numbervars(A,B,C):- numbervars(A,'$VAR',B,C)))), assert((assert_static(X):- assert(X))), assert((system(X):- shell(X))), assert((exists(X):- exists_file(X))), assert((aleph_reconsult(F):- consult(F))), assert((aleph_consult(X):- aleph_open(X,read,S), repeat, read(S,F), (F = end_of_file -> close(S), !; assertz(F),fail))), use_module(library(broadcast)), use_module(library(time)), (predicate_property(time:alarm(_,_,_),_) -> use_module(library(time)); (redefine_system_predicate(time:alarm/3), abolish(time:alarm/3), assert(alarm(_,_,_)), redefine_system_predicate(time:remove_alarm/1), abolish(time:remove_alarm/1), assert(remove_alarm(_)))), (predicate_property(thread_local(_),built_in) -> true; assert(thread_local(_))), assert((aleph_background_predicate(Lit):- predicate_property(Lit,P), ((P=interpreted);(P=built_in)), ! )), (predicate_property(delete_file(_),built_in) -> true; assert_static(delete_file(_))). :- prolog_type(Type), init(Type). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A L E P H aleph_version(5). aleph_version_date('Sun Mar 11 03:25:37 UTC 2007'). aleph_manual('http://www.comlab.ox.ac.uk/oucl/groups/machlearn/Aleph/index.html'). :- op(500,fy,#). :- op(500,fy,*). :- op(900,xfy,because). :- dynamic '$aleph_feature'/2. :- dynamic '$aleph_global'/2. :- dynamic '$aleph_good'/3. :- dynamic '$aleph_local'/2. :- dynamic '$aleph_sat'/2. :- dynamic '$aleph_sat_atom'/2. :- dynamic '$aleph_sat_ovars'/2. :- dynamic '$aleph_sat_ivars'/2. :- dynamic '$aleph_sat_varsequiv'/2. :- dynamic '$aleph_sat_varscopy'/3. :- dynamic '$aleph_sat_terms'/4. :- dynamic '$aleph_sat_vars'/4. :- dynamic '$aleph_sat_litinfo'/6. :- dynamic '$aleph_search_cache'/1. :- dynamic '$aleph_search_prunecache'/1. :- dynamic '$aleph_search'/2. :- dynamic '$aleph_search_seen'/2. :- dynamic '$aleph_search_expansion'/4. :- dynamic '$aleph_search_gain'/4. :- dynamic '$aleph_search_node'/8. :- dynamic '$aleph_link_vars'/2. :- dynamic '$aleph_has_vars'/3. :- dynamic '$aleph_has_ovar'/4. :- dynamic '$aleph_has_ivar'/4. :- dynamic '$aleph_determination'/2. :- thread_local('$aleph_search_cache'/1). :- thread_local('$aleph_search_prunecache'/1). :- thread_local('$aleph_search'/2). :- thread_local('$aleph_search_seen'/2). :- thread_local('$aleph_search_expansion'/4). :- thread_local('$aleph_search_gain'/4). :- thread_local('$aleph_search_node'/8). :- multifile nil/0. :- multifile prune/1. :- multifile refine/2. :- multifile cost/3. :- multifile prove/2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % C O N S T R U C T B O T T O M % get_atoms(+Preds,+Depth,+MaxDepth,+Last,-LastLit) % layered generation of ground atoms to add to bottom clause % Preds is list of PName/Arity entries obtained from the determinations % Depth is current variable-chain depth % MaxDepth is maximum allowed variable chain depth (i setting) % Last is last atom number so far % Lastlit is atom number after all atoms to MaxDepth have been generated get_atoms([],_,_,Last,Last):- !. get_atoms(Preds,Depth,MaxDepth,Last,LastLit):- Depth =< MaxDepth, Depth0 is Depth - 1, '$aleph_sat_terms'(_,Depth0,_,_), % new terms generated ? !, get_atoms1(Preds,Depth,MaxDepth,Last,Last1), Depth1 is Depth + 1, get_atoms(Preds,Depth1,MaxDepth,Last1,LastLit). get_atoms(_,_,_,Last,Last). % auxiliary predicate used by get_atoms/5 get_atoms1([],_,_,Last,Last). get_atoms1([Pred|Preds],Depth,MaxDepth,Last,LastLit):- gen_layer(Pred,Depth), flatten(Depth,MaxDepth,Last,Last1), get_atoms1(Preds,Depth,MaxDepth,Last1,LastLit). % flatten(+Depth,+MaxDepth,+Last,-LastLit) % flatten a set of ground atoms by replacing all in/out terms with variables % constants are wrapped in a special term called aleph_const(...) % eg suppose p/3 had modes p(+char,+char,#int) % then p(a,a,3) becomes p(X,X,aleph_const(3)) % ground atoms to be flattened are assumed to be in the i.d.b atoms % vars and terms are actually integers which are stored in vars/terms databases % so eg above actually becomes p(1,1,aleph_const(3)). % where variable 1 stands for term 2 (say) which in turn stands for a % Depth is current variable-chain depth % MaxDepth is maximum allowed variable chain depth (i setting) % Last is last atom number so far % Lastlit is atom number after ground atoms here have been flattened % If permute_bottom is set to true, then the order of ground atoms is % shuffled. The empirical utility of doing this has been investigated by % P. Schorn in "Random Local Bottom Clause Permutations for Better Search Space % Exploration in Progol-like ILP Systems.", 16th International Conference on % ILP (ILP 2006). flatten(Depth,MaxDepth,Last,Last1):- retractall('$aleph_local'(flatten_num,_)), asserta('$aleph_local'(flatten_num,Last)), '$aleph_sat_atom'(_,_), !, (setting(permute_bottom,Permute) -> true; Permute = nil), flatten_atoms(Permute,Depth,MaxDepth,Last1). flatten(_,_,_,Last):- retract('$aleph_local'(flatten_num,Last)), !. flatten_atoms(true,Depth,MaxDepth,Last1):- findall(L-M,retract('$aleph_sat_atom'(L,M)),LitModes), aleph_rpermute(LitModes,PLitModes), aleph_member(Lit1-Mode,PLitModes), retract('$aleph_local'(flatten_num,LastSoFar)), (Lit1 = not(Lit) -> Negated = true; Lit = Lit1, Negated = nil), flatten_atom(Depth,MaxDepth,Lit,Negated,Mode,LastSoFar,Last1), asserta('$aleph_local'(flatten_num,Last1)), fail. flatten_atoms(nil,Depth,MaxDepth,Last1):- repeat, retract('$aleph_sat_atom'(Lit1,Mode)), retract('$aleph_local'(flatten_num,LastSoFar)), (Lit1 = not(Lit) -> Negated = true; Lit = Lit1, Negated = nil), flatten_atom(Depth,MaxDepth,Lit,Negated,Mode,LastSoFar,Last1), asserta('$aleph_local'(flatten_num,Last1)), ('$aleph_sat_atom'(_,_) -> fail; retract('$aleph_local'(flatten_num,Last1))), !. flatten_atoms(_,_,_,Last):- retract('$aleph_local'(flatten_num,Last)), !. % flatten_atom(+Depth,+Depth1,+Lit,+Negated,+Mode,+Last,-Last1) % update lits database by adding ``flattened atoms''. This involves: % replacing ground terms at +/- positions in Lit with variables % and wrapping # positions in Lit within a special term stucture % Mode contains actual mode and term-place numbers and types for +/-/# % Last is the last literal number in the lits database at present % Last1 is the last literal number after the update flatten_atom(Depth,Depth1,Lit,Negated,Mode,Last,Last1):- arg(3,Mode,O), arg(4,Mode,C), integrate_args(Depth,Lit,O), integrate_args(Depth,Lit,C), (Depth = Depth1 -> CheckOArgs = true; CheckOArgs = nil), flatten_lits(Lit,CheckOArgs,Depth,Negated,Mode,Last,Last1). % variabilise literals by replacing terms with variables % if var splitting is on then new equalities are introduced into bottom clause % if at final i-layer, then literals with o/p args that do not contain at least % one output var from head are discarded flatten_lits(Lit,CheckOArgs,Depth,Negated,Mode,Last,_):- functor(Lit,Name,Arity), asserta('$aleph_local'(flatten_lits,Last)), Depth1 is Depth - 1, functor(OldFAtom,Name,Arity), flatten_lit(Lit,Mode,OldFAtom,_,_), functor(FAtom,Name,Arity), apply_equivs(Depth1,Arity,OldFAtom,FAtom), retract('$aleph_local'(flatten_lits,OldLast)), (CheckOArgs = true -> arg(3,Mode,Out), get_vars(FAtom,Out,OVars), (in_path(OVars) -> add_new_lit(Depth,FAtom,Mode,OldLast,Negated,NewLast); NewLast = OldLast) ; add_new_lit(Depth,FAtom,Mode,OldLast,Negated,NewLast)), asserta('$aleph_local'(flatten_lits,NewLast)), fail. flatten_lits(_,_,_,_,_,_,Last1):- retract('$aleph_local'(flatten_lits,Last1)). % flatten_lit(+Lit,+Mode,+FAtom,-IVars,-OVars) % variabilise Lit as FAtom % Mode contains actual mode and % In, Out, Const positions as term-place numbers with types % replace ground terms with integers denoting variables % or special terms denoting constants % variable numbers arising from variable splits are disallowed % returns Input and Output variable numbers flatten_lit(Lit,mode(Mode,In,Out,Const),FAtom,IVars,OVars):- functor(Mode,_,Arity), once(copy_modeterms(Mode,FAtom,Arity)), flatten_vars(In,Lit,FAtom,IVars), flatten_vars(Out,Lit,FAtom,OVars), flatten_consts(Const,Lit,FAtom). % flatten_vars(+TPList,+Lit,+FAtom,-Vars):- % FAtom is Lit with terms-places in TPList replaced by variables flatten_vars([],_,_,[]). flatten_vars([Pos/Type|Rest],Lit,FAtom,[Var|Vars]):- tparg(Pos,Lit,Term), '$aleph_sat_terms'(TNo,_,Term,Type), '$aleph_sat_vars'(Var,TNo,_,_), \+('$aleph_sat_varscopy'(Var,_,_)), tparg(Pos,FAtom,Var), flatten_vars(Rest,Lit,FAtom,Vars). % replace a list of terms at places marked by # in the modes % with a special term structure denoting a constant flatten_consts([],_,_). flatten_consts([Pos/_|Rest],Lit,FAtom):- tparg(Pos,Lit,Term), tparg(Pos,FAtom,aleph_const(Term)), flatten_consts(Rest,Lit,FAtom). % in_path(+ListOfOutputVars) % check to avoid generating useless literals in the last i layer in_path(OVars):- '$aleph_sat'(hovars,Vars), !, (Vars=[];OVars=[];intersects(Vars,OVars)). in_path(_). % update_equivs(+VariableEquivalences,+IDepth) % update variable equivalences created at a particular i-depth % is non-empty only if variable splitting is allowed update_equivs([],_):- !. update_equivs(Equivs,Depth):- retract('$aleph_sat_varsequiv'(Depth,Eq1)), !, update_equiv_lists(Equivs,Eq1,Eq2), asserta('$aleph_sat_varsequiv'(Depth,Eq2)). update_equivs(Equivs,Depth):- Depth1 is Depth - 1, get_equivs(Depth1,Eq1), update_equiv_lists(Equivs,Eq1,Eq2), asserta('$aleph_sat_varsequiv'(Depth,Eq2)). update_equiv_lists([],E,E):- !. update_equiv_lists([Var/E1|Equivs],ESoFar,E):- aleph_delete(Var/E2,ESoFar,ELeft), !, update_list(E1,E2,E3), update_equiv_lists(Equivs,[Var/E3|ELeft],E). update_equiv_lists([Equiv|Equivs],ESoFar,E):- update_equiv_lists(Equivs,[Equiv|ESoFar],E). % get variable equivalences at a particular depth % recursively descend to greatest depth below this for which equivs exist % also returns the database reference of entry get_equivs(Depth,[]):- Depth < 0, !. get_equivs(Depth,Equivs):- '$aleph_sat_varsequiv'(Depth,Equivs), !. get_equivs(Depth,E):- Depth1 is Depth - 1, get_equivs(Depth1,E). % apply equivalences inherited from Depth to a flattened literal % if no variable splitting, then succeeds only once apply_equivs(Depth,Arity,Old,New):- get_equivs(Depth,Equivs), rename(Arity,Equivs,[],Old,New). % rename args using list of Var/Equivalences rename(_,[],_,L,L):- !. rename(0,_,_,_,_):- !. rename(Pos,Equivs,Subst0,Old,New):- arg(Pos,Old,OldVar), aleph_member(OldVar/Equiv,Equivs), !, aleph_member(NewVar,Equiv), arg(Pos,New,NewVar), Pos1 is Pos - 1, rename(Pos1,Equivs,[OldVar/NewVar|Subst0],Old,New). rename(Pos,Equivs,Subst0,Old,New):- arg(Pos,Old,OldVar), (aleph_member(OldVar/NewVar,Subst0) -> arg(Pos,New,NewVar); arg(Pos,New,OldVar)), Pos1 is Pos - 1, rename(Pos1,Equivs,Subst0,Old,New). % add a new literal to lits database % performs variable splitting if splitvars is set to true add_new_lit(Depth,FAtom,Mode,OldLast,Negated,NewLast):- arg(1,Mode,M), functor(FAtom,Name,Arity), functor(SplitAtom,Name,Arity), once(copy_modeterms(M,SplitAtom,Arity)), arg(2,Mode,In), arg(3,Mode,Out), arg(4,Mode,Const), split_vars(Depth,FAtom,In,Out,Const,SplitAtom,IVars,OVars,Equivs), update_equivs(Equivs,Depth), add_lit(OldLast,Negated,SplitAtom,In,Out,IVars,OVars,LitNum), insert_eqs(Equivs,Depth,LitNum,NewLast), !. % modify the literal database: check if performing lazy evaluation % of bottom clause, and update input and output terms in literal add_lit(Last,Negated,FAtom,I,O,_,_,Last):- setting(construct_bottom,CBot), (CBot = nil ; CBot = reduction), (Negated = true -> Lit = not(FAtom); Lit = FAtom), '$aleph_sat_litinfo'(_,0,Lit,I,O,_), !. add_lit(Last,Negated,FAtom,In,Out,IVars,OVars,LitNum):- LitNum is Last + 1, update_iterms(LitNum,IVars), update_oterms(LitNum,OVars,[],Dependents), add_litinfo(LitNum,Negated,FAtom,In,Out,Dependents), assertz('$aleph_sat_ivars'(LitNum,IVars)), assertz('$aleph_sat_ovars'(LitNum,OVars)), !. % update lits database after checking that the atom does not exist % used during updates of lit database by lazy evaluation update_lit(LitNum,true,FAtom,I,O,D):- '$aleph_sat_litinfo'(LitNum,0,not(FAtom),I,O,D), !. update_lit(LitNum,nil,FAtom,I,O,D):- '$aleph_sat_litinfo'(LitNum,0,FAtom,I,O,D), !. update_lit(LitNum,Negated,FAtom,I,O,D):- gen_nlitnum(LitNum), add_litinfo(LitNum,Negated,FAtom,I,O,D), get_vars(FAtom,I,IVars), get_vars(FAtom,O,OVars), assertz('$aleph_sat_ivars'(LitNum,K,IVars)), assertz('$aleph_sat_ovars'(LitNum,K,OVars)), !. % add a literal to lits database without checking add_litinfo(LitNum,true,FAtom,I,O,D):- !, assertz('$aleph_sat_litinfo'(LitNum,0,not(FAtom),I,O,D)). add_litinfo(LitNum,_,FAtom,I,O,D):- assertz('$aleph_sat_litinfo'(LitNum,0,FAtom,I,O,D)). % update database with input terms of literal update_iterms(_,[]). update_iterms(LitNum,[VarNum|Vars]):- retract('$aleph_sat_vars'(VarNum,TNo,I,O)), update(I,LitNum,NewI), asserta('$aleph_sat_vars'(VarNum,TNo,NewI,O)), update_dependents(LitNum,O), update_iterms(LitNum,Vars). % update database with output terms of literal % return list of dependent literals update_oterms(_,[],Dependents,Dependents). update_oterms(LitNum,[VarNum|Vars],DSoFar,Dependents):- retract('$aleph_sat_vars'(VarNum,TNo,I,O)), update(O,LitNum,NewO), asserta('$aleph_sat_vars'(VarNum,TNo,I,NewO)), update_list(I,DSoFar,D1), update_oterms(LitNum,Vars,D1,Dependents). % update Dependent list of literals with LitNum update_dependents(_,[]). update_dependents(LitNum,[Lit|Lits]):- retract('$aleph_sat_litinfo'(Lit,Depth,Atom,ITerms,OTerms,Dependents)), update(Dependents,LitNum,NewD), asserta('$aleph_sat_litinfo'(Lit,Depth,Atom,ITerms,OTerms,NewD)), update_dependents(LitNum,Lits). % update dependents of head with literals that are simply generators % that is, literals that require no input args update_generators:- findall(L,('$aleph_sat_litinfo'(L,_,_,[],_,_),L>1),GList), GList \= [], !, retract('$aleph_sat_litinfo'(1,Depth,Lit,I,O,D)), aleph_append(D,GList,D1), asserta('$aleph_sat_litinfo'(1,Depth,Lit,I,O,D1)). update_generators. % mark literals mark_lits(Lits):- aleph_member(Lit,Lits), asserta('$aleph_local'(marked,Lit/0)), fail. mark_lits(_). % recursively mark literals with minimum depth to bind output vars in head mark_lits([],_,_). mark_lits(Lits,OldVars,Depth):- mark_lits(Lits,Depth,true,[],Predecessors,OldVars,NewVars), aleph_delete_list(Lits,Predecessors,P1), Depth1 is Depth + 1, mark_lits(P1,NewVars,Depth1). mark_lits([],_,_,P,P,V,V). mark_lits([Lit|Lits],Depth,GetPreds,PSoFar,P,VSoFar,V):- retract('$aleph_local'(marked,Lit/Depth0)), !, (Depth < Depth0 -> mark_lit(Lit,Depth,GetPreds,VSoFar,P1,V2), update_list(P1,PSoFar,P2), mark_lits(Lits,Depth,GetPreds,P2,P,V2,V); asserta('$aleph_local'(marked,Lit/Depth0)), mark_lits(Lits,Depth,GetPreds,PSoFar,P,VSoFar,V)). mark_lits([Lit|Lits],Depth,GetPreds,PSoFar,P,VSoFar,V):- mark_lit(Lit,Depth,GetPreds,VSoFar,P1,V2), !, update_list(P1,PSoFar,P2), mark_lits(Lits,Depth,GetPreds,P2,P,V2,V). mark_lits([_|Lits],Depth,GetPreds,PSoFar,P,VSoFar,V):- mark_lits(Lits,Depth,GetPreds,PSoFar,P,VSoFar,V). mark_lit(Lit,Depth,GetPreds,VSoFar,P1,V1):- retract('$aleph_sat_litinfo'(Lit,_,Atom,I,O,D)), asserta('$aleph_local'(marked,Lit/Depth)), asserta('$aleph_sat_litinfo'(Lit,Depth,Atom,I,O,D)), (GetPreds = nil -> P1 = [], V1 = VSoFar; get_vars(Atom,O,OVars), update_list(OVars,VSoFar,V1), get_predicates(D,V1,D1), mark_lits(D1,Depth,nil,[],_,VSoFar,_), get_vars(Atom,I,IVars), get_predecessors(IVars,[],P1)). % mark lits that produce outputs that are not used by any other literal mark_floating_lits(Lit,Last):- Lit > Last, !. mark_floating_lits(Lit,Last):- '$aleph_sat_litinfo'(Lit,_,_,_,O,D), O \= [], (D = []; D = [Lit]), !, asserta('$aleph_local'(marked,Lit/0)), Lit1 is Lit + 1, mark_floating_lits(Lit1,Last). mark_floating_lits(Lit,Last):- Lit1 is Lit + 1, mark_floating_lits(Lit1,Last). % mark lits in bottom clause that are specified redundant by user % requires definition of redundant/2 that have distinguished first arg ``bottom'' mark_redundant_lits(Lit,Last):- Lit > Last, !. mark_redundant_lits(Lit,Last):- get_pclause([Lit],[],Atom,_,_,_), redundant(bottom,Atom), !, asserta('$aleph_local'(marked,Lit/0)), Lit1 is Lit + 1, mark_redundant_lits(Lit1,Last). mark_redundant_lits(Lit,Last):- Lit1 is Lit + 1, mark_redundant_lits(Lit1,Last). % get literals that are linked and do not link to any others (ie predicates) get_predicates([],_,[]). get_predicates([Lit|Lits],Vars,[Lit|T]):- '$aleph_sat_litinfo'(Lit,_,Atom,I,_,[]), get_vars(Atom,I,IVars), aleph_subset1(IVars,Vars), !, get_predicates(Lits,Vars,T). get_predicates([_|Lits],Vars,T):- get_predicates(Lits,Vars,T). % get all predecessors in the bottom clause of a set of literals get_predecessors([],[]). get_predecessors([Lit|Lits],P):- (Lit = 1 -> Pred = []; get_ivars1(nil,Lit,IVars), get_predecessors(IVars,[],Pred)), get_predecessors(Pred,PPred), update_list(Pred,PPred,P1), get_predecessors(Lits,P2), update_list(P2,P1,P). % get list of literals in the bottom clause that produce a set of vars get_predecessors([],P,P). get_predecessors([Var|Vars],PSoFar,P):- '$aleph_sat_vars'(Var,_,_,O), update_list(O,PSoFar,P1), get_predecessors(Vars,P1,P). % removal of literals in bottom clause by negative-based reduction. % A greedy strategy is employed, as implemented within the ILP system % Golem (see Muggleton and Feng, "Efficient induction % of logic programs", Inductive Logic Programming, S. Muggleton (ed.), % AFP Press). In this, given a clause H:- B1, B2,...Bn, let Bi be the % first literal s.t. H:-B1,...,Bi covers no more than the allowable number % of negatives. The clause H:- Bi,B1,...,Bi-1 is then reduced. The % process continues until there is no change in the length of a clause % within an iteration. The algorithm is O(n^2). rm_nreduce(Last,N):- setting(nreduce_bottom,true), !, get_litnums(1,Last,BottomLits), '$aleph_global'(atoms,atoms(neg,Neg)), setting(depth,Depth), setting(prooftime,Time), setting(proof_strategy,Proof), setting(noise,Noise), neg_reduce(BottomLits,Neg,Last,Depth/Time/Proof,Noise), get_marked(1,Last,Lits), length(Lits,N), p1_message('negative-based removal'), p_message(N/Last). rm_nreduce(_,0). neg_reduce([Head|Body],Neg,Last,DepthTime,Noise):- get_pclause([Head],[],Clause,TV,_,_), neg_reduce(Body,Clause,TV,2,Neg,DepthTime,Noise,NewLast), NewLast \= Last, !, NewLast1 is NewLast - 1, aleph_remove_n(NewLast1,[Head|Body],Prefix,[LastLit|Rest]), mark_lits(Rest), insert_lastlit(LastLit,Prefix,Lits1), neg_reduce(Lits1,Neg,NewLast,DepthTime,Noise). neg_reduce(_,_,_,_,_). neg_reduce([],_,_,N,_,_,_,N). neg_reduce([L1|Lits],C,TV,N,Neg,ProofFlags,Noise,LastLit):- get_pclause([L1],TV,Lit1,TV1,_,_), extend_clause(C,Lit1,Clause), prove(ProofFlags,neg,Clause,Neg,NegCover,Count), Count > Noise, !, N1 is N + 1, neg_reduce(Lits,Clause,TV1,N1,NegCover,ProofFlags,Noise,LastLit). neg_reduce(_,_,_,N,_,_,_,N). % insert_lastlit(LastLit,[1|Lits],Lits1):- % find_last_ancestor(Lits,LastLit,1,2,Last), % aleph_remove_n(Last,[1|Lits],Prefix,Suffix), % aleph_append([LastLit|Suffix],Prefix,Lits1). insert_lastlit(LastLit,Lits,Lits1):- get_predecessors([LastLit],Prefix), aleph_delete_list(Prefix,Lits,Suffix), aleph_append([LastLit|Suffix],Prefix,Lits1). find_last_ancestor([],_,Last,_,Last):- !. find_last_ancestor([Lit|Lits],L,_,LitNum,Last):- '$aleph_sat_litinfo'(Lit,_,_,_,_,D), aleph_member1(L,D), !, NextLit is LitNum + 1, find_last_ancestor(Lits,L,LitNum,NextLit,Last). find_last_ancestor([_|Lits],L,Last0,LitNum,Last):- NextLit is LitNum + 1, find_last_ancestor(Lits,L,Last0,NextLit,Last). % removal of literals that are repeated because of mode differences rm_moderepeats(_,_):- '$aleph_sat_litinfo'(Lit1,_,Pred1,_,_,_), '$aleph_sat_litinfo'(Lit2,_,Pred1,_,_,_), Lit1 >= 1, Lit2 > Lit1, retract('$aleph_sat_litinfo'(Lit2,_,Pred1,_,_,_)), asserta('$aleph_local'(marked,Lit2/0)), fail. rm_moderepeats(Last,N):- '$aleph_local'(marked,_), !, get_marked(1,Last,Lits), length(Lits,N), p1_message('repeated literals'), p_message(N/Last), remove_lits(Lits). rm_moderepeats(_,0). % removal of symmetric literals rm_symmetric(_,_):- '$aleph_global'(symmetric,_), '$aleph_sat_litinfo'(Lit1,_,Pred1,[I1|T1],_,_), is_symmetric(Pred1,Name,Arity), get_vars(Pred1,[I1|T1],S1), '$aleph_sat_litinfo'(Lit2,_,Pred2,[I2|T2],_,_), Lit1 \= Lit2, is_symmetric(Pred2,Name,Arity), Pred1 =.. [_|Args1], Pred2 =.. [_|Args2], symmetric_match(Args1,Args2), get_vars(Pred2,[I2|T2],S2), equal_set(S1,S2), asserta('$aleph_local'(marked,Lit2/0)), retract('$aleph_sat_litinfo'(Lit2,_,Pred2,[I2|T2],_,_)), fail. rm_symmetric(Last,N):- '$aleph_local'(marked,_), !, get_marked(1,Last,Lits), length(Lits,N), p1_message('symmetric literals'), p_message(N/Last), remove_lits(Lits). rm_symmetric(_,0). is_symmetric(not(Pred),not(Name),Arity):- !, functor(Pred,Name,Arity), '$aleph_global'(symmetric,symmetric(Name/Arity)). is_symmetric(Pred,Name,Arity):- functor(Pred,Name,Arity), '$aleph_global'(symmetric,symmetric(Name/Arity)). symmetric_match([],[]). symmetric_match([aleph_const(Term)|Terms1],[aleph_const(Term)|Terms2]):- !, symmetric_match(Terms1,Terms2). symmetric_match([Term1|Terms1],[Term2|Terms2]):- integer(Term1), integer(Term2), symmetric_match(Terms1,Terms2). % removal of literals that are repeated because of commutativity rm_commutative(_,_):- '$aleph_global'(commutative,commutative(Name/Arity)), p1_message('checking commutative literals'), p_message(Name/Arity), functor(Pred,Name,Arity), functor(Pred1,Name,Arity), '$aleph_sat_litinfo'(Lit1,_,Pred,[I1|T1],O1,_), % check for marked literals % (SWI-Prolog specific: suggested by Vasili Vrubleuski) \+('$aleph_local'(marked,Lit1/0)), get_vars(Pred,[I1|T1],S1), '$aleph_sat_litinfo'(Lit2,_,Pred1,[I2|T2],O2,_), Lit1 \= Lit2 , O1 = O2, get_vars(Pred1,[I2|T2],S2), equal_set(S1,S2), asserta('$aleph_local'(marked,Lit2/0)), retract('$aleph_sat_litinfo'(Lit2,_,Pred1,[I2|T2],_,_)), fail. rm_commutative(Last,N):- '$aleph_local'(marked,_), !, get_marked(1,Last,Lits), length(Lits,N), p1_message('commutative literals'), p_message(N/Last), remove_lits(Lits). rm_commutative(_,0). % recursive marking of literals that do not contribute to establishing % variable chains to output vars in the head % or produce outputs that are not used by any literal % controlled by setting flag check_useless rm_uselesslits(_,0):- setting(check_useless,nil), !. rm_uselesslits(Last,N):- '$aleph_sat'(hovars,OVars), OVars \= [], !, get_predecessors(OVars,[],P), '$aleph_sat'(hivars,IVars), mark_lits(P,IVars,0), get_unmarked(1,Last,Lits), length(Lits,N), p1_message('useless literals'), p_message(N/Last), remove_lits(Lits). rm_uselesslits(_,0). % call user-defined predicate redundant/2 to remove redundant % literals from bottom clause. Redundancy checking only done on request rm_redundant(_,0):- setting(check_redundant,nil), !. rm_redundant(Last,N):- mark_redundant_lits(1,Last), get_marked(1,Last,Lits), length(Lits,N), p1_message('redundant literals'), p_message(N/Last), remove_lits(Lits). % get a list of unmarked literals get_unmarked(Lit,Last,[]):- Lit > Last, !. get_unmarked(Lit,Last,Lits):- retract('$aleph_local'(marked,Lit/_)), !, Next is Lit + 1, get_unmarked(Next,Last,Lits). get_unmarked(Lit,Last,[Lit|Lits]):- retract('$aleph_sat_litinfo'(Lit,_,_,_,_,_)), !, Next is Lit + 1, get_unmarked(Next,Last,Lits). get_unmarked(Lit,Last,Lits):- Next is Lit + 1, get_unmarked(Next,Last,Lits). % get a list of marked literals get_marked(Lit,Last,[]):- Lit > Last, !. get_marked(Lit,Last,[Lit|Lits]):- retract('$aleph_local'(marked,Lit/_)), !, (retract('$aleph_sat_litinfo'(Lit,_,_,_,_,_)) -> true; true), Next is Lit + 1, get_marked(Next,Last,Lits). get_marked(Lit,Last,Lits):- Next is Lit + 1, get_marked(Next,Last,Lits). % update descendent lists of literals by removing useless literals remove_lits(L):- retract('$aleph_sat_litinfo'(Lit,Depth,A,I,O,D)), aleph_delete_list(L,D,D1), asserta('$aleph_sat_litinfo'(Lit,Depth,A,I,O,D1)), fail. remove_lits(_). % generate a new literal at depth Depth: forced backtracking will give all lits gen_layer(Name/Arity,Depth):- (Name/Arity = (not)/1 -> '$aleph_global'(modeb,modeb(NSucc,not(Mode))), functor(Mode,Name1,Arity1), functor(Lit1,Name1,Arity1), once(copy_modeterms(Mode,Lit1,Arity1)), Lit = not(Lit1); functor(Mode,Name,Arity), functor(Lit,Name,Arity), '$aleph_global'(modeb,modeb(NSucc,Mode)), once(copy_modeterms(Mode,Lit,Arity))), split_args(Mode,Mode,Input,Output,Constants), (Input = [] -> Call1 = true, Call2 = true; aleph_delete(Arg/Type,Input,OtherInputs), Depth1 is Depth - 1, construct_incall(Lit,Depth1,[Arg/Type],Call1), construct_call(Lit,Depth,OtherInputs,Call2)), Call1, Call2, aleph_background_predicate(Lit), get_successes(Lit,NSucc,mode(Mode,Input,Output,Constants)), fail. gen_layer(_,_). get_successes(Literal,1,M):- depth_bound_call(Literal), update_atoms(Literal,M), !. get_successes(Literal,*,M):- depth_bound_call(Literal), update_atoms(Literal,M). get_successes(Literal,N,M):- integer(N), N > 1, reset_succ, get_nsuccesses(Literal,N,M). % get at most N matches for a literal get_nsuccesses(Literal,N,M):- depth_bound_call(Literal), retract('$aleph_local'(last_success,Succ0)), Succ0 < N, Succ1 is Succ0 + 1, update_atoms(Literal,M), asserta('$aleph_local'(last_success,Succ1)), (Succ1 >= N -> !; true). update_atoms(Atom,M):- '$aleph_sat_atom'(Atom,M), !. update_atoms(Atom,M):- assertz('$aleph_sat_atom'(Atom,M)). % call with input term that is an ouput of a previous literal construct_incall(_,_,[],true):- !. construct_incall(not(Lit),Depth,Args,Call):- !, construct_incall(Lit,Depth,Args,Call). construct_incall(Lit,Depth,[Pos/Type],Call):- !, Call = legal_term(exact,Depth,Type,Term), tparg(Pos,Lit,Term). construct_incall(Lit,Depth,[Pos/Type|Args],(Call,Calls)):- tparg(Pos,Lit,Term), Call = legal_term(exact,Depth,Type,Term), (var(Depth)-> construct_incall(Lit,_,Args,Calls); construct_incall(Lit,Depth,Args,Calls)). construct_call(_,_,[],true):- !. construct_call(not(Lit),Depth,Args,Call):- !, construct_call(Lit,Depth,Args,Call). construct_call(Lit,Depth,[Pos/Type],Call):- !, Call = legal_term(upper,Depth,Type,Term), tparg(Pos,Lit,Term). construct_call(Lit,Depth,[Pos/Type|Args],(Call,Calls)):- tparg(Pos,Lit,Term), Call = legal_term(upper,Depth,Type,Term), construct_call(Lit,Depth,Args,Calls). % generator of legal terms seen so far legal_term(exact,Depth,Type,Term):- '$aleph_sat_terms'(TNo,Depth,Term,Type), once('$aleph_sat_vars'(_,TNo,_,[_|_])). % legal_term(exact,Depth,Type,Term):- % '$aleph_sat_varscopy'(NewVar,OldVar,Depth), % once('$aleph_sat_vars'(NewVar,TNo,_,_)), % '$aleph_sat_terms'(TNo,_,Term,Type),_). legal_term(upper,Depth,Type,Term):- '$aleph_sat_terms'(TNo,Depth1,Term,Type), Depth1 \= unknown, Depth1 < Depth, once('$aleph_sat_vars'(_,TNo,_,[_|_])). % legal_term(upper,Depth,Type,Term):- % '$aleph_sat_varscopy'(NewVar,OldVar,Depth), % once('$aleph_sat_vars'(NewVar,TNo,_,_)), % '$aleph_sat_terms'(TNo,Depth1,Term,Type), % Depth1 \= unknown. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % V A R I A B L E -- S P L I T T I N G split_vars(Depth,FAtom,I,O,C,SplitAtom,IVars,OVars,Equivs):- setting(splitvars,true), !, get_args(FAtom,I,[],IVarList), get_args(FAtom,O,[],OVarList), get_var_equivs(Depth,IVarList,OVarList,IVars,OVars0,Equivs0), (Equivs0 = [] -> OVars = OVars0, SplitAtom = FAtom, Equivs = Equivs0; functor(FAtom,Name,Arity), functor(SplitAtom,Name,Arity), copy_args(FAtom,SplitAtom,I), copy_args(FAtom,SplitAtom,C), rename_ovars(O,Depth,FAtom,SplitAtom,Equivs0,Equivs), get_argterms(SplitAtom,O,[],OVars)). % write('splitting: '), write(FAtom), write(' to: '), write(SplitAtom), nl. split_vars(_,FAtom,I,O,_,FAtom,IVars,OVars,[]):- get_vars(FAtom,I,IVars), get_vars(FAtom,O,OVars). % get equivalent classes of variables from co-references get_var_equivs(Depth,IVarList,OVarList,IVars,OVars,Equivs):- sort(IVarList,IVars), sort(OVarList,OVars), (Depth = 0 -> intersect1(IVars,OVarList,IOCoRefs,_), get_repeats(IVarList,IOCoRefs,ICoRefs); intersect1(IVars,OVarList,ICoRefs,_)), get_repeats(OVarList,ICoRefs,CoRefs), add_equivalences(CoRefs,Depth,Equivs). add_equivalences([],_,[]). add_equivalences([Var|Vars],Depth,[Var/E|Rest]):- % (Depth = 0 -> E = []; E = [Var]), E = [Var], add_equivalences(Vars,Depth,Rest). get_repeats([],L,L). get_repeats([Var|Vars],Ref1,L):- aleph_member1(Var,Vars), !, update(Ref1,Var,Ref2), get_repeats(Vars,Ref2,L). get_repeats([_|Vars],Ref,L):- get_repeats(Vars,Ref,L). % rename all output vars that are co-references % updates vars database and return equivalent class of variables rename_ovars([],_,_,_,L,L). rename_ovars([ArgNo|Args],Depth,Old,New,CoRefs,Equivalences):- (ArgNo = Pos/_ -> true; Pos = ArgNo), tparg(Pos,Old,OldVar), aleph_delete(OldVar/Equiv,CoRefs,Rest), !, copy_var(OldVar,NewVar,Depth), tparg(Pos,New,NewVar), rename_ovars(Args,Depth,Old,New,[OldVar/[NewVar|Equiv]|Rest],Equivalences). rename_ovars([ArgNo|Args],Depth,Old,New,CoRefs,Equivalences):- (ArgNo = Pos/_ -> true; Pos = ArgNo), tparg(Pos,Old,OldVar), tparg(Pos,New,OldVar), rename_ovars(Args,Depth,Old,New,CoRefs,Equivalences). % create new equalities to allow co-references to re-appear in search insert_eqs([],_,L,L). insert_eqs([OldVar/Equivs|Rest],Depth,Last,NewLast):- '$aleph_sat_vars'(OldVar,TNo,_,_), '$aleph_sat_terms'(TNo,_,_,Type), add_eqs(Equivs,Depth,Type,Last,Last1), insert_eqs(Rest,Depth,Last1,NewLast). add_eqs([],_,_,L,L). add_eqs([V1|Rest],Depth,Type,Last,NewLast):- add_eqs(Rest,Depth,V1,Type,Last,Last1), add_eqs(Rest,Depth,Type,Last1,NewLast). add_eqs([],_,_,_,L,L). add_eqs([Var2|Rest],Depth,Var1,Type,Last,NewLast):- (Depth = 0 -> add_lit(Last,nil,(Var1=Var2),[1/Type],[2/Type],[Var1],[Var2],Last1); add_lit(Last,nil,(Var1=Var2),[1/Type,2/Type],[],[Var1,Var2],[],Last1)), add_eqs(Rest,Depth,Var1,Type,Last1,NewLast). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % utilities for updating mappings between terms and variables % integrate terms specified by a list of arguments % integrating a term means: % updating 2 databases: terms and vars % terms contains the term along with a term-id % vars contains a var-id <-> term-id mapping % var and term-ids are integers integrate_args(_,_,[]). integrate_args(Depth,Literal,[Pos/Type|T]):- tparg(Pos,Literal,Term), integrate_term(Depth,Term/Type), (retract('$aleph_sat_terms'(TNo,Depth,Term,unknown)) -> asserta('$aleph_sat_terms'(TNo,Depth,Term,Type)); true), integrate_args(Depth,Literal,T). % integrate a term integrate_term(Depth,Term/Type):- '$aleph_sat_terms'(TNo,Depth,Term,Type), '$aleph_sat_vars'(_,TNo,_,[_|_]), !. integrate_term(Depth,Term/Type):- '$aleph_sat_terms'(TNo,Depth1,Term,Type), (Type = unknown ; '$aleph_sat_vars'(_,TNo,_,[])), !, (Depth1 = unknown -> retract('$aleph_sat_terms'(TNo,Depth1,Term,Type)), asserta('$aleph_sat_terms'(TNo,Depth,Term,Type)); true). integrate_term(_,Term/Type):- '$aleph_sat_terms'(_,_,Term,Type), Type \= unknown, !. integrate_term(Depth,Term/Type):- retract('$aleph_sat'(lastterm,Num)), retract('$aleph_sat'(lastvar,Var0)), TNo is Num + 1, Var is Var0 + 1, asserta('$aleph_sat'(lastterm,TNo)), asserta('$aleph_sat'(lastvar,Var)), asserta('$aleph_sat_vars'(Var,TNo,[],[])), asserta('$aleph_sat_terms'(TNo,Depth,Term,Type)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % split_args(+Lit,?Mode,-Input,-Output,-Constants) % return term-places and types of +,-, and # args in Lit % by finding a matching mode declaration if Mode is given % otherwise first mode that matches is used split_args(Lit,Mode,Input,Output,Constants):- functor(Lit,Psym,Arity), find_mode(mode,Psym/Arity,Mode), functor(Template,Psym,Arity), copy_modeterms(Mode,Template,Arity), Template = Lit, tp(Mode,TPList), split_tp(TPList,Input,Output,Constants). % split_tp(+TPList,-Input,-Output,-Constants) % split term-place/type list into +,-,# split_tp([],[],[],[]). split_tp([(+Type)/Place|TP],[Place/Type|Input],Output,Constants):- !, split_tp(TP,Input,Output,Constants). split_tp([(-Type)/Place|TP],Input,[Place/Type|Output],Constants):- !, split_tp(TP,Input,Output,Constants). split_tp([(#Type)/Place|TP],Input,Output,[Place/Type|Constants]):- !, split_tp(TP,Input,Output,Constants). split_tp([_|TP],Input,Output,Constants):- split_tp(TP,Input,Output,Constants). % tp(+Literal,-TPList) % return terms and places in Literal tp(Literal,TPList):- functor(Literal,_,Arity), tp_list(Literal,Arity,[],[],TPList). tp_list(_,0,_,L,L):- !. tp_list(Term,Pos,PlaceList,TpSoFar,TpList):- arg(Pos,Term,Arg), aleph_append([Pos],PlaceList,Places), unwrap_term(Arg,Places,[Arg/Places|TpSoFar],L1), Pos1 is Pos - 1, tp_list(Term,Pos1,PlaceList,L1,TpList). unwrap_term(Term,_,L,L):- var(Term), !. unwrap_term(Term,Place,TpSoFar,TpList):- functor(Term,_,Arity), tp_list(Term,Arity,Place,TpSoFar,TpList). get_determs(PSym/Arity,L):- findall(Pred,'$aleph_global'(determination,determination(PSym/Arity,Pred)),L). get_modes(PSym/Arity,L):- functor(Lit,PSym,Arity), findall(Lit,'$aleph_global'(mode,mode(_,Lit)),L). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % S E A R C H % basic search engine for single clause search search(S,Nodes):- arg(36,S,Time), Inf is inf, Time =\= Inf, SearchTime is integer(Time), SearchTime > 0, !, catch(time_bound_call(SearchTime,searchlimit,graphsearch(S,_)), searchlimit,p_message('Time limit reached')), '$aleph_search'(current,current(_,Nodes,_)). search(S,Nodes):- graphsearch(S,Nodes). % basic search engine for theory-based search tsearch(S,Nodes):- arg(36,S,Time), Inf is inf, Time =\= Inf, SearchTime is integer(Time), SearchTime > 0, !, alarm(SearchTime,throw(searchlimit),Id), catch(theorysearch(S,Nodes),searchlimit,p_message('Time limit reached')), remove_alarm(Id). tsearch(S,Nodes):- theorysearch(S,Nodes). graphsearch(S,Nodes):- next_node(_), !, arg(3,S,RefineOp), arg(23,S,LazyPreds), repeat, next_node(NodeRef), once(retract('$aleph_search'(current,current(LastE,Last,BestSoFar)))), expand(RefineOp,S,NodeRef,Node,Path,MinLength,Succ,PosCover,NegCover,OVars, PrefixClause,PrefixTV,PrefixLength), ((LazyPreds = []; RefineOp \= nil) -> Succ1 = Succ; lazy_evaluate(Succ,LazyPreds,Path,PosCover,NegCover,Succ1)), NextE is LastE + 1, get_gains(S,Last,BestSoFar,Path,PrefixClause,PrefixTV,PrefixLength, MinLength,Succ1,PosCover,NegCover,OVars,NextE,Last0,NextBest0), (RefineOp = nil -> get_sibgains(S,Node,Last0,NextBest0,Path,PrefixClause, PrefixTV,PrefixLength,MinLength,PosCover,NegCover, OVars,NextE,Last1,NextBest); Last1 = Last0, NextBest = NextBest0), asserta('$aleph_search'(current,current(NextE,Last1,NextBest))), NextL is Last + 1, asserta('$aleph_search_expansion'(NextE,Node,NextL,Last1)), (discontinue_search(S,NextBest,Last1) -> '$aleph_search'(current,current(_,Nodes,_)); prune_open(S,BestSoFar,NextBest), get_nextbest(S,Next), Next = none, '$aleph_search'(current,current(_,Nodes,_))), !. graphsearch(_,Nodes):- '$aleph_search'(current,current(_,Nodes,_)). theorysearch(S,Nodes):- next_node(_), !, '$aleph_global'(atoms,atoms(pos,Pos)), '$aleph_global'(atoms,atoms(neg,Neg)), interval_count(Pos,P), interval_count(Neg,N), repeat, next_node(NodeRef), '$aleph_search_node'(NodeRef,Theory,_,_,_,_,_,_), once(retract('$aleph_search'(current,current(_,Last,BestSoFar)))), get_theory_gain(S,Last,BestSoFar,Theory,Pos,Neg,P,N,NextBest,Last1), asserta('$aleph_search'(current,current(0,Last1,NextBest))), (discontinue_search(S,NextBest,Last1) -> '$aleph_search'(current,current(_,Nodes,_)); prune_open(S,BestSoFar,NextBest), get_nextbest(S,Next), Next = none, '$aleph_search'(current,current(_,Nodes,_))), !. theorysearch(_,Nodes):- '$aleph_search'(current,current(_,Nodes,_)). next_node(NodeRef):- once('$aleph_search'(nextnode,NodeRef)), !. get_search_settings(S):- functor(S,set,47), setting(nodes,MaxNodes), arg(1,S,MaxNodes), setting(explore,Explore), arg(2,S,Explore), setting(refineop,RefineOp), arg(3,S,RefineOp), setting(searchstrat,SearchStrat), setting(evalfn,EvalFn), arg(4,S,SearchStrat/EvalFn), (setting(greedy,Greedy)-> arg(5,S,Greedy); arg(5,S,nil)), setting(verbosity,Verbose), arg(6,S,Verbose), setting(clauselength,CLength), arg(7,S,CLength), setting(caching,Cache), arg(8,S,Cache), (setting(prune_defs,Prune)-> arg(9,S,Prune); arg(9,S,nil)), setting(lazy_on_cost,LCost), arg(10,S,LCost), setting(lazy_on_contradiction,LContra), arg(11,S,LContra), setting(lazy_negs,LNegs), arg(12,S,LNegs), setting(minpos,MinPos), arg(13,S,MinPos), setting(depth,Depth), arg(14,S,Depth), setting(cache_clauselength,CCLim), arg(15,S,CCLim), ('$aleph_global'(size,size(pos,PSize))-> arg(16,S,PSize); arg(16,S,0)), setting(noise,Noise), arg(17,S,Noise), setting(minacc,MinAcc), arg(18,S,MinAcc), setting(minscore,MinScore), arg(19,S,MinScore), ('$aleph_global'(size,size(rand,RSize))-> arg(20,S,RSize); arg(20,S,0)), setting(mingain,MinGain), arg(21,S,MinGain), setting(search,Search), arg(22,S,Search), findall(PN/PA,'$aleph_global'(lazy_evaluate,lazy_evaluate(PN/PA)),LazyPreds), arg(23,S,LazyPreds), ('$aleph_global'(size,size(neg,NSize))-> arg(24,S,NSize); arg(24,S,0)), setting(openlist,OSize), arg(25,S,OSize), setting(check_redundant,RCheck), arg(26,S,RCheck), ('$aleph_sat'(eq,Eq) -> arg(27,S,Eq); arg(27,S,nil)), ('$aleph_sat'(hovars,HOVars) -> arg(28,S,HOVars); arg(28,S,HOVars)), setting(prooftime,PTime), arg(29,S,PTime), setting(construct_bottom,CBott), arg(30,S,CBott), (get_ovars1(nil,1,HIVars) -> arg(31,S,HIVars); arg(31,S,[])), setting(language,Lang), arg(32,S,Lang), setting(splitvars,Split), arg(33,S,Split), setting(proof_strategy,Proof), arg(34,S,Proof), setting(portray_search,VSearch), arg(35,S,VSearch), setting(searchtime,Time), arg(36,S,Time), setting(optimise_clauses,Optim), arg(37,S,Optim), setting(newvars,NewV), arg(38,S,NewV), (setting(rls_type,RlsType) -> arg(39,S,RlsType);arg(39,S,nil)), setting(minposfrac,MinPosFrac), arg(40,S,MinPosFrac), (setting(recursion,Recursion) -> true; Recursion = nil), prolog_type(Prolog), arg(41,S,Prolog), setting(interactive,Interactive), arg(42,S,Interactive), setting(lookahead,LookAhead), arg(43,S,LookAhead), (setting(construct_features,Features)-> arg(44,S,Features); arg(44,S,nil)), setting(max_features,FMax), arg(45,S,FMax), setting(subsample,SS), arg(46,S,SS), setting(subsamplesize,SSize), arg(47,S,SSize). % stop search from proceeding if certain % conditions are reached. These are: % . minacc and minpos values reached in rrr search % . best hypothesis has accuracy 1.0 if evalfn=accuracy % . best hypothesis covers all positive examples discontinue_search(S,[P,_,_,F|_]/_,_):- arg(39,S,RlsType), RlsType = rrr, arg(13,S,MinPos), P >= MinPos, arg(19,S,MinScore), F >= MinScore, !. discontinue_search(S,_,Nodes):- arg(1,S,MaxNodes), Nodes >= MaxNodes, !, p_message('node limit reached'). discontinue_search(S,_,_):- arg(44,S,Features), Features = true, arg(45,S,FMax), '$aleph_search'(last_good,LastGood), LastGood >= FMax, !, p_message('feature limit reached'). discontinue_search(S,[_,_,_,F|_]/_,_):- arg(4,S,_/Evalfn), Evalfn = accuracy, F = 1.0, !. discontinue_search(S,Best,_):- arg(2,S,Explore), Explore = nil, arg(4,S,_/Evalfn), Evalfn \= user, Evalfn \= posonly, arg(22,S,Search), Search \= ic, Best = [P|_]/_, arg(16,S,P). update_max_head_count(N,0):- retractall('$aleph_local'(max_head_count,_)), asserta('$aleph_local'(max_head_count,N)), !. update_max_head_count(Count,Last):- '$aleph_search_node'(Last,LitNum,_,_,PosCover,_,_,_), !, asserta('$aleph_local'(head_lit,LitNum)), interval_count(PosCover,N), Next is Last - 1, (N > Count -> update_max_head_count(N,Next); update_max_head_count(Count,Next)). update_max_head_count(Count,Last):- Next is Last - 1, update_max_head_count(Count,Next). expand(nil,S,NodeRef,NodeRef,Path1,Length,Descendents,PosCover,NegCover,OVars,C,TV,CL):- !, '$aleph_search_node'(NodeRef,LitNum,Path,Length/_,PCover,NCover,OVars,_), arg(46,S,SSample), (SSample = nil -> PosCover = PCover, NegCover = NCover; get_sample_cover(S,PosCover,NegCover)), aleph_append([LitNum],Path,Path1), get_pclause(Path1,[],C,TV,CL,_), '$aleph_sat_litinfo'(LitNum,_,_,_,_,Dependents), intersect1(Dependents,Path1,_,Succ), check_parents(Succ,OVars,Descendents,_). expand(_,S,NodeRef,NodeRef,Path1,Length,[_],PosCover,NegCover,OVars,_,_,_):- retract('$aleph_search_node'(NodeRef,_,Path1,Length/_,_,_,OVars,_)), get_sample_cover(S,PosCover,NegCover). get_sample_cover(S,PosCover,NegCover):- arg(5,S,Greedy), (Greedy = true -> '$aleph_global'(atoms_left,atoms_left(pos,PCover)); arg(16,S,PSize), PCover = [1-PSize]), arg(4,S,_/Evalfn), (Evalfn = posonly -> '$aleph_global'(atoms_left,atoms_left(rand,NCover)); arg(24,S,NSize), NCover = [1-NSize]), arg(46,S,SSample), (SSample = nil -> PosCover = PCover, NegCover = NCover; arg(47,S,SampleSize), interval_sample(SampleSize,PCover,PosCover), interval_sample(SampleSize,NCover,NegCover)). get_ovars([],_,V,V). get_ovars([LitNum|Lits],K,VarsSoFar,Vars):- get_ovars1(K,LitNum,OVars), aleph_append(VarsSoFar,OVars,Vars1), get_ovars(Lits,K,Vars1,Vars). get_ovars1(nil,LitNum,OVars):- '$aleph_sat_ovars'(LitNum,OVars), !. get_ovars1(nil,LitNum,OVars):- !, '$aleph_sat_litinfo'(LitNum,_,Atom,_,O,_), get_vars(Atom,O,OVars). get_ovars1(K,LitNum,OVars):- '$aleph_sat_ovars'(LitNum,K,OVars), !. get_ovars1(K,LitNum,OVars):- '$aleph_sat_litinfo'(LitNum,K,_,Atom,_,O,_), get_vars(Atom,O,OVars). % get set of vars at term-places specified get_vars(not(Literal),Args,Vars):- !, get_vars(Literal,Args,Vars). get_vars(_,[],[]). get_vars(Literal,[ArgNo|Args],Vars):- (ArgNo = Pos/_ -> true; Pos = ArgNo), tparg(Pos,Literal,Term), get_vars_in_term([Term],TV1), get_vars(Literal,Args,TV2), update_list(TV2,TV1,Vars). get_vars_in_term([],[]). get_vars_in_term([Var|Terms],[Var|TVars]):- integer(Var), !, get_vars_in_term(Terms,TVars). get_vars_in_term([Term|Terms],TVars):- Term =.. [_|Terms1], get_vars_in_term(Terms1,TV1), get_vars_in_term(Terms,TV2), update_list(TV2,TV1,TVars). % get terms at term-places specified % need not be variables get_argterms(not(Literal),Args,TermsSoFar,Terms):- !, get_argterms(Literal,Args,TermsSoFar,Terms). get_argterms(_,[],Terms,Terms). get_argterms(Literal,[ArgNo|Args],TermsSoFar,Terms):- (ArgNo = Pos/_ -> true; Pos = ArgNo), tparg(Pos,Literal,Term), update(TermsSoFar,Term,T1), get_argterms(Literal,Args,T1,Terms). % get list of terms at arg positions specified get_args(not(Literal),Args,TermsSoFar,Terms):- !, get_args(Literal,Args,TermsSoFar,Terms). get_args(_,[],Terms,Terms). get_args(Literal,[ArgNo|Args],TermsSoFar,Terms):- (ArgNo = Pos/_ -> true; Pos = ArgNo), tparg(Pos,Literal,Term), get_args(Literal,Args,[Term|TermsSoFar],Terms). get_ivars([],_,V,V). get_ivars([LitNum|Lits],K,VarsSoFar,Vars):- get_ivars1(K,LitNum,IVars), aleph_append(VarsSoFar,IVars,Vars1), get_ivars(Lits,K,Vars1,Vars). get_ivars1(nil,LitNum,IVars):- '$aleph_sat_ivars'(LitNum,IVars), !. get_ivars1(nil,LitNum,IVars):- !, '$aleph_sat_litinfo'(LitNum,_,Atom,I,_,_), get_vars(Atom,I,IVars). get_ivars1(K,LitNum,IVars):- '$aleph_sat_ivars'(LitNum,K,IVars), !. get_ivars1(K,LitNum,IVars):- '$aleph_sat_litinfo'(LitNum,K,_,Atom,I,_,_), get_vars(Atom,I,IVars). check_parents([],_,[],[]). check_parents([LitNum|Lits],OutputVars,[LitNum|DLits],Rest):- get_ivars1(nil,LitNum,IVars), aleph_subset1(IVars,OutputVars), !, check_parents(Lits,OutputVars,DLits,Rest). check_parents([LitNum|Lits],OutputVars,DLits,[LitNum|Rest]):- check_parents(Lits,OutputVars,DLits,Rest), !. get_gains(S,Last,Best,_,_,_,_,_,_,_,_,_,_,Last,Best):- discontinue_search(S,Best,Last), !. get_gains(_,Last,Best,_,_,_,_,_,[],_,_,_,_,Last,Best):- !. get_gains(S,Last,Best,Path,C,TV,L,Min,[L1|Succ],Pos,Neg,OVars,E,Last1,NextBest):- get_gain(S,upper,Last,Best,Path,C,TV,L,Min,L1,Pos,Neg,OVars,E,Best1,Node1), !, get_gains(S,Node1,Best1,Path,C,TV,L,Min,Succ,Pos,Neg,OVars,E,Last1,NextBest). get_gains(S,Last,BestSoFar,Path,C,TV,L,Min,[_|Succ],Pos,Neg,OVars,E,Last1,NextBest):- get_gains(S,Last,BestSoFar,Path,C,TV,L,Min,Succ,Pos,Neg,OVars,E,Last1,NextBest), !. get_sibgains(S,Node,Last,Best,Path,C,TV,L,Min,Pos,Neg,OVars,E,Last1,NextBest):- '$aleph_search_node'(Node,LitNum,_,_,_,_,_,OldE), '$aleph_search_expansion'(OldE,_,_,LastSib), '$aleph_sat_litinfo'(LitNum,_,_,_,_,Desc), Node1 is Node + 1, arg(31,S,HIVars), aleph_delete_list(HIVars,OVars,LVars), get_sibgain(S,LVars,LitNum,Desc,Node1,LastSib,Last, Best,Path,C,TV,L,Min,Pos,Neg,OVars,E,NextBest,Last1), !. get_sibgain(S,_,_,_,Node,Node1,Last,Best,_,_,_,_,_,_,_,_,_,Best,Last):- (Node > Node1; discontinue_search(S,Best,Last)), !. get_sibgain(S,LVars,LitNum,Desc,Node,LastSib,Last,Best,Path,C,TV,L,Min,Pos,Neg,OVars,E,LBest,LNode):- arg(23,S,Lazy), get_sibpncover(Lazy,Node,Desc,Pos,Neg,Sib1,PC,NC), lazy_evaluate([Sib1],Lazy,Path,PC,NC,[Sib]), get_ivars1(nil,Sib,SibIVars), (intersects(SibIVars,LVars) -> Flag = upper; get_ovars1(nil,Sib,SibOVars), (intersects(SibOVars,LVars) -> Flag = upper; Flag = exact)), get_gain(S,Flag,Last,Best,Path,C,TV,L,Min,Sib,PC,NC,OVars,E,Best1,Node1), !, NextNode is Node + 1, get_sibgain(S,LVars,LitNum,Desc,NextNode,LastSib,Node1,Best1,Path,C,TV,L, Min,Pos,Neg,OVars,E,LBest,LNode), !. get_sibgain(S,LVars,LitNum,Desc,Node,LastSib,Last,Best,Path,C,TV,L,Min,Pos,Neg,OVars,E,Best1,Node1):- NextNode is Node + 1, get_sibgain(S,LVars,LitNum,Desc,NextNode,LastSib,Last,Best,Path,C,TV,L, Min,Pos,Neg,OVars,E,Best1,Node1), !. get_sibgain(S,LVars,LitNum,Node,LastSib,Last,Best,Path,C,TV,L,Min,Pos,Neg,OVars,E,Best1,Node1):- NextNode is Node + 1, get_sibgain(S,LVars,LitNum,NextNode,LastSib,Last,Best,Path,C,TV,L,Min,Pos,Neg, OVars,E,Best1,Node1), !. get_sibpncover(Lazy,NodeNum,Desc,Pos,Neg,Sib,PC,NC):- '$aleph_search_node'(NodeNum,Sib,_,_,Pos1,Neg1,_,_), '$aleph_sat_litinfo'(Sib,_,Atom,_,_,_), \+(aleph_member1(Sib,Desc)), functor(Atom,Name,Arity), (aleph_member1(Name/Arity,Lazy) -> PC = Pos, NC = Neg; calc_intersection(Pos,Pos1,PC), calc_intersection(Neg,Neg1,NC)). % in some cases, it is possible to simply use the intersection of % covers cached. The conditions under which this is possible was developed % in discussions with James Cussens calc_intersection(A1/[B1-L1],A2/[B2-L2],A/[B-L]):- !, intervals_intersection(A1,A2,A), B3 is max(B1,B2), (intervals_intersects(A1,[B2-L2],X3-_) -> true; X3 = B3), (intervals_intersects(A2,[B1-L1],X4-_) -> true; X4 = B3), B4 is min(X3,B3), B is min(X4,B4), L is max(L1,L2). calc_intersection(A1/_,A2,A):- !, intervals_intersection(A1,A2,A). calc_intersection(A1,A2/_,A):- !, intervals_intersection(A1,A2,A). calc_intersection(A1,A2,A):- intervals_intersection(A1,A2,A). get_gain(S,_,Last,Best,Path,_,_,_,MinLength,_,Pos,Neg,OVars,E,Best1,NewLast):- arg(3,S,RefineOp), RefineOp \= nil , !, get_refine_gain(S,Last,Best,Path,MinLength,Pos,Neg,OVars,E,Best1,NewLast). get_gain(S,Flag,Last,Best/Node,Path,C,TV,Len1,MinLen,L1,Pos,Neg,OVars,E,Best1,Last1):- arg(26,S,RCheck), arg(33,S,SplitVars), retractall('$aleph_search'(covers,_)), retractall('$aleph_search'(coversn,_)), get_pclause([L1],TV,Lit1,_,Len2,LastD), split_ok(SplitVars,C,Lit1), !, extend_clause(C,Lit1,Clause), (RCheck = true -> (redundant(Clause,Lit1) -> fail; true); true), CLen is Len1 + Len2, length_ok(S,MinLen,CLen,LastD,EMin,ELength), % arg(41,S,Prolog), split_clause(Clause,Head,Body), % (Prolog = yap -> % assertz('$aleph_search'(pclause,pclause(Head,Body)),DbRef); % assertz('$aleph_search'(pclause,pclause(Head,Body)))), assertz('$aleph_search'(pclause,pclause(Head,Body))), arg(6,S,Verbosity), (Verbosity >= 1 -> pp_dclause(Clause); true), get_gain1(S,Flag,Clause,CLen,EMin/ELength,Last,Best/Node, Path,L1,Pos,Neg,OVars,E,Best1), % (Prolog = yap -> % erase(DbRef); % retractall('$aleph_search'(pclause,_))), retractall('$aleph_search'(pclause,_)), Last1 is Last + 1. get_gain(_,_,Last,Best,_,_,_,_,_,_,_,_,_,_,Best,Last). get_refine_gain(S,Last,Best/Node,Path,MinLength,Pos,Neg,OVars,E,Best1,NewLast):- arg(3,S,RefineOp), RefineOp = rls, refine_prelims(Best/Node,Last), rls_refine(clauses,Path,Path1), get_refine_gain1(S,Path1,MinLength,Pos,Neg,OVars,E,Best1,NewLast), !. get_refine_gain(S,Last,Best/Node,Path,MinLength,Pos,Neg,OVars,E,Best1,NewLast):- arg(3,S,RefineOp), RefineOp \= rls, refine_prelims(Best/Node,Last), Path = CL-[Example,Type,_,Clause], arg(30,S,ConstructBottom), arg(43,S,LookAhead), get_user_refinement(RefineOp,LookAhead,Clause,R,_), match_bot(ConstructBottom,R,R1,LitNums), Path1 = CL-[Example,Type,LitNums,R1], get_refine_gain1(S,Path1,MinLength,Pos,Neg,OVars,E,Best1,NewLast), !. get_refine_gain(_,_,_,_,_,_,_,_,_,Best,Last):- retract('$aleph_search'(best_refinement,best_refinement(Best))), retract('$aleph_search'(last_refinement,last_refinement(Last))). get_theory_gain(S,Last,BestSoFar,T0,Pos,Neg,P,N,Best1,NewLast):- refine_prelims(BestSoFar,Last), arg(3,S,RefineOp), (RefineOp = rls -> rls_refine(theories,T0,T1); fail), arg(23,S,LazyPreds), (LazyPreds = [] -> Theory = T1; lazy_evaluate_theory(T1,LazyPreds,Pos,Neg,Theory)), retract('$aleph_search'(best_refinement,best_refinement(OldBest))), retract('$aleph_search'(last_refinement,last_refinement(OldLast))), arg(6,S,Verbosity), (Verbosity >= 1 -> p_message('new refinement'), pp_dclauses(Theory); true), record_pclauses(Theory), get_theory_gain1(S,Theory,OldLast,OldBest,Pos,Neg,P,N,Best1), retractall('$aleph_search'(pclause,_)), NewLast is OldLast + 1, asserta('$aleph_search'(last_refinement,last_refinement(NewLast))), asserta('$aleph_search'(best_refinement,best_refinement(Best1))), (discontinue_search(S,Best1,NewLast) -> retract('$aleph_search'(last_refinement,last_refinement(_))), retract('$aleph_search'(best_refinement,best_refinement(_))); fail), !. get_theory_gain(_,_,_,_,_,_,_,_,Best,Last):- '$aleph_search'(best_refinement,best_refinement(Best)), '$aleph_search'(last_refinement,last_refinement(Last)). refine_prelims(Best,Last):- retractall('$aleph_search'(last_refinement,_)), retractall('$aleph_search'(best_refinement,_)), asserta('$aleph_search'(best_refinement,best_refinement(Best))), asserta('$aleph_search'(last_refinement,last_refinement(Last))). get_refine_gain1(S,Path,MinLength,Pos,Neg,OVars,E,Best1,NewLast):- arg(23,S,LazyPreds), Path = CL-[Example,Type,Ids,Refine], (LazyPreds = [] -> Ids1 = Ids, Clause = Refine; lazy_evaluate_refinement(Ids,Refine,LazyPreds,Pos,Neg,Ids1,Clause)), retractall('$aleph_search'(covers,_)), retractall('$aleph_search'(coversn,_)), Path1 = CL-[Example,Type,Ids1,Clause], split_clause(Clause,Head,Body), nlits(Body,CLength0), CLength is CLength0 + 1, length_ok(S,MinLength,CLength,0,EMin,ELength), arg(41,S,Prolog), split_clause(Clause,Head,Body), (Prolog = yap -> assertz('$aleph_search'(pclause,pclause(Head,Body)),DbRef); assertz('$aleph_search'(pclause,pclause(Head,Body)))), retract('$aleph_search'(best_refinement,best_refinement(OldBest))), retract('$aleph_search'(last_refinement,last_refinement(OldLast))), arg(6,S,Verbosity), (Verbosity >= 1 -> p_message('new refinement'), pp_dclause(Clause); true), once(get_gain1(S,upper,Clause,CLength,EMin/ELength,OldLast,OldBest, Path1,[],Pos,Neg,OVars,E,Best1)), (Prolog = yap -> erase(DbRef); retractall('$aleph_search'(pclause,_))), NewLast is OldLast + 1, asserta('$aleph_search'(last_refinement,last_refinement(NewLast))), asserta('$aleph_search'(best_refinement,best_refinement(Best1))), (discontinue_search(S,Best1,NewLast) -> retract('$aleph_search'(last_refinement,last_refinement(_))), retract('$aleph_search'(best_refinement,best_refinement(_))); fail), !. get_theory_gain1(S,Theory,Last,Best,Pos,Neg,P,N,Best1):- (nil -> p_message('constraint violated'), Contradiction = true; Contradiction = nil), Contradiction = nil, Node1 is Last + 1, arg(32,S,Lang), theory_lang_ok(Theory,Lang), arg(38,S,NewVars), theory_newvars_ok(Theory,NewVars), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(Depth/Time/Proof,pos,(X:-X),Pos,PCvr,TP), prove(Depth/Time/Proof,neg,(X:-X),Neg,NCvr,FP), arg(4,S,_/Evalfn), Correct is TP + (N - FP), Incorrect is FP + (P - TP), length(Theory,L), Label = [Correct,Incorrect,L], complete_label(Evalfn,Theory,Label,Label1), get_search_keys(heuristic,Label1,SearchKeys), arg(6,S,Verbosity), (Verbosity >= 1 -> p_message(Correct/Incorrect); true), asserta('$aleph_search_node'(Node1,Theory,[],0,PCvr,NCvr,[],0)), update_open_list(SearchKeys,Node1,Label1), update_best_theory(S,Theory,PCvr,NCvr,Best,Label1/Node1,Best1), !. get_theory_gain1(_,_,_,Best,_,_,_,_,Best). get_gain1(S,_,C,CL,_,Last,Best,Path,_,Pos,Neg,_,E,Best):- abandon_branch(S,C), !, Node1 is Last + 1, arg(3,S,RefineOp), arg(7,S,ClauseLength), arg(35,S,VSearch), (ClauseLength = CL -> true; (RefineOp = nil -> asserta('$aleph_search_node'(Node1,0,Path,0,Pos,Neg,[],E)); true)), (VSearch = true -> asserta('$aleph_search'(bad,Node1)), asserta('$aleph_search_node'(Node1,C)); true). get_gain1(S,_,Clause,_,_,_,Best,_,_,_,_,_,_,Best):- arg(8,S,Caching), Caching = true, skolemize(Clause,SHead,SBody,0,_), '$aleph_search_prunecache'([SHead|SBody]), !, arg(6,S,Verbosity), (Verbosity >= 1 -> p_message('in prune cache'); true). get_gain1(S,Flag,C,CL,EMin/EL,Last,Best/Node,Path,L1,Pos,Neg,OVars,E,Best1):- split_clause(C,Head,Body), arg(22,S,Search), ((Search \== ic, nil) -> p_message('constraint violated'), Contradiction = true; Contradiction = nil), Node1 is Last + 1, arg(8,S,Caching), (Caching = true -> arg(15,S,CCLim), get_cache_entry(CCLim,C,Entry); Entry = nil), arg(35,S,VSearch), (VSearch = true -> asserta('$aleph_search_node'(Node1,C)); true), arg(3,S,RefineOp), refinement_ok(RefineOp,Entry), arg(32,S,Lang), lang_ok((Head:-Body),Lang), arg(38,S,NewVars), newvars_ok((Head:-Body),NewVars), arg(34,S,Proof), arg(37,S,Optim), rewrite_clause(Proof,Optim,(Head:-Body),(Head1:-Body1)), (Search = ic -> PCvr = [], Label = [_,_,CL], ccheck(S,(Head1:-Body1),NCvr,Label); prove_examples(S,Flag,Contradiction,Entry,Best,CL,EL, (Head1:-Body1),Pos,Neg,PCvr,NCvr,Label) ), arg(4,S,SearchStrat/Evalfn), arg(40,S,MinPosFrac), ((MinPosFrac > 0.0 ; Evalfn = wracc) -> reset_clause_prior(S,Head1); true ), arg(46,S,SSample), (SSample = true -> arg(47,S,SampleSize), estimate_label(SampleSize,Label,Label0); Label0 = Label), complete_label(Evalfn,C,Label0,Label1), compression_ok(Evalfn,Label1), get_search_keys(SearchStrat,Label1,SearchKeys), arg(6,S,Verbosity), arg(10,S,LCost), arg(11,S,LContra), ((Verbosity >= 1, LContra = nil, LCost = nil) -> Label = [A,B|_], p_message(A/B); true), arg(7,S,ClauseLength), (RefineOp = nil -> get_ovars1(nil,L1,OVars1), aleph_append(OVars1,OVars,OVars2); true), ((ClauseLength=CL, RefineOp = nil) -> true; (RefineOp = nil -> asserta('$aleph_search_node'(Node1,L1,Path,EMin/EL,PCvr, NCvr,OVars2,E)); asserta('$aleph_search_node'(Node1,0,Path,EMin/EL,PCvr, NCvr,[],E))), update_open_list(SearchKeys,Node1,Label1)), (VSearch = true -> asserta('$aleph_search'(label,label(Node1,Label))); true), (((RefineOp \= nil,Contradiction=nil); (arg(28,S,HOVars),clause_ok(Contradiction,HOVars,OVars2))) -> update_best(S,C,PCvr,NCvr,Best/Node,Label1/Node1,Best1); Best1=Best/Node), !. get_gain1(_,_,_,_,_,_,Best,_,_,_,_,_,_,Best). abandon_branch(S,C):- arg(9,S,PruneDefined), PruneDefined = true, prune(C), !, arg(6,S,Verbosity), (Verbosity >= 1 -> p_message(pruned); true). clause_ok(nil,V1,V2):- aleph_subset1(V1,V2). % check to see if a clause is acceptable % unacceptable if it fails noise, minacc, or minpos settings % unacceptable if it fails search or language constraints clause_ok(_,_):- nil, !, fail. clause_ok(_,Label):- extract_pos(Label,P), extract_neg(Label,N), Acc is P/(P+N), setting(noise,Noise), setting(minacc,MinAcc), setting(minpos,MinPos), (N > Noise; Acc < MinAcc; P < MinPos), !, fail. clause_ok(Clause,_):- prune(Clause), !, fail. clause_ok(Clause,_):- setting(language,Lang), \+ lang_ok(Clause,Lang), !, fail. clause_ok(Clause,_):- setting(newvars,NewVars), \+ newvars_ok(Clause,NewVars), !, fail. clause_ok(_,_). % check to see if refinement has been produced before refinement_ok(nil,_):- !. refinement_ok(rls,_):- !. refinement_ok(_,nil):- !. refinement_ok(_,Entry):- (check_cache(Entry,pos,_); check_cache(Entry,neg,_)), !, p_message('redundant refinement'), fail. refinement_ok(_,_). % specialised redundancy check with equality theory % used only to check if equalities introduced by splitting vars make % literal to be added redundant split_ok(nil,_,_):- !. split_ok(_,Clause,Lit):- functor(Lit,Name,_), Name \= '=', copy_term(Clause/Lit,Clause1/Lit1), lit_redun(Lit1,Clause1), !, p_message('redundant literal'), nl, fail. split_ok(_,_,_). lit_redun(Lit,(Head:-Body)):- !, lit_redun(Lit,(Head,Body)). lit_redun(Lit,(L1,_)):- Lit == L1, !. lit_redun(Lit,(L1,L2)):- !, execute_equality(L1), lit_redun(Lit,L2). lit_redun(Lit,L):- Lit == L. execute_equality(Lit):- functor(Lit,'=',2), !, Lit. execute_equality(_). theory_lang_ok([],_). theory_lang_ok([_-[_,_,_,Clause]|T],Lang):- lang_ok(Lang,Clause), theory_lang_ok(Lang,T). theory_newvars_ok([],_). theory_newvars_ok([_-[_,_,_,Clause]|T],NewV):- newvars_ok(NewV,Clause), theory_newvars_ok(T,NewV). lang_ok((Head:-Body),N):- !, (lang_ok(N,Head,Body) -> true; p_message('outside language bound'), fail). lang_ok(N,_,_):- N is inf, !. lang_ok(N,Head,Body):- get_psyms((Head,Body),PSymList), lang_ok1(PSymList,N). newvars_ok((Head:-Body),N):- !, (newvars_ok(N,Head,Body) -> true; p_message('outside newvars bound'), fail). newvars_ok(N,_,_):- N is inf, !. newvars_ok(N,Head,Body):- vars_in_term([Head],[],HVars), goals_to_list(Body,BodyL), vars_in_term(BodyL,[],BVars), aleph_ord_subtract(BVars,HVars,NewVars), length(NewVars,N1), N1 =< N. get_psyms((L,B),[N/A|Syms]):- !, functor(L,N,A), get_psyms(B,Syms). get_psyms(true,[]):- !. get_psyms(L,[N/A]):- functor(L,N,A). lang_ok1([],_). lang_ok1([Pred|Preds],N):- length(Preds,N0), aleph_delete_all(Pred,Preds,Preds1), length(Preds1,N1), PredOccurs is N0 - N1 + 1, PredOccurs =< N, lang_ok1(Preds1,N). rewrite_clause(sld,_,_,(X:-X)):- !. rewrite_clause(restricted_sld,true,(Head:-Body),(Head1:-Body1)):- !, optimise((Head:-Body),(Head1:-Body1)). rewrite_clause(_,_,Clause,Clause). record_pclauses([]). record_pclauses([_-[_,_,_,Clause]|T]):- split_clause(Clause,Head,Body), assertz('$aleph_search'(pclause,pclause(Head,Body))), record_pclauses(T). % get pos/neg distribution of clause head reset_clause_prior(S,Head):- arg(3,S,Refine), Refine = nil, !, ('$aleph_search'(clauseprior,_) -> true; get_clause_prior(S,Head,Prior), assertz('$aleph_search'(clauseprior,Prior)) ). reset_clause_prior(S,Head):- copy_term(Head,Head1), numbervars(Head1,0,_), ('$aleph_local'(clauseprior,prior(Head1,Prior)) -> true; get_clause_prior(S,Head,Prior), assertz('$aleph_local'(clauseprior,prior(Head1,Prior))) ), retractall('$aleph_search'(clauseprior,_)), assertz('$aleph_search'(clauseprior,Prior)). get_clause_prior(S,Head,Total-[P-pos,N-neg]):- arg(5,S,Greedy), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), (Greedy = true -> '$aleph_global'(atoms_left,atoms_left(pos,Pos)); '$aleph_global'(atoms,atoms(pos,Pos)) ), '$aleph_global'(atoms_left,atoms_left(neg,Neg)), prove(Depth/Time/Proof,pos,(Head:-true),Pos,_,P), prove(Depth/Time/Proof,neg,(Head:-true),Neg,_,N), Total is P + N. get_user_refinement(auto,L,Clause,Template,0):- auto_refine(L,Clause,Template). get_user_refinement(user,_,Clause,Template,0):- refine(Clause,Template). match_bot(nil,Clause,Clause,[]). match_bot(reduction,Clause,Clause1,Lits):- match_lazy_bottom(Clause,Lits), get_pclause(Lits,[],Clause1,_,_,_). match_bot(saturation,Clause,Clause1,Lits):- once(get_aleph_clause(Clause,AlephClause)), match_bot_lits(AlephClause,[],Lits), get_pclause(Lits,[],Clause1,_,_,_). match_bot_lits((Lit,Lits),SoFar,[LitNum|LitNums]):- !, match_bot_lit(Lit,LitNum), \+(aleph_member(LitNum,SoFar)), match_bot_lits(Lits,[LitNum|SoFar],LitNums). match_bot_lits(Lit,SoFar,[LitNum]):- match_bot_lit(Lit,LitNum), \+(aleph_member(LitNum,SoFar)). match_bot_lit(Lit,LitNum):- '$aleph_sat'(botsize,Last), '$aleph_sat_litinfo'(LitNum,_,Lit,_,_,_), LitNum >= 0, LitNum =< Last. match_lazy_bottom(Clause,Lits):- once(get_aleph_clause(Clause,AlephClause)), copy_term(Clause,CClause), split_clause(CClause,CHead,CBody), example_saturated(CHead), store(stage), set(stage,saturation), match_lazy_bottom1(CBody), reinstate(stage), match_bot_lits(AlephClause,[],Lits). match_lazy_bottom1(Body):- Body, match_body_modes(Body), fail. match_lazy_bottom1(_):- flatten_matched_atoms(body). match_body_modes((CLit,CLits)):- !, match_mode(body,CLit), match_body_modes(CLits). match_body_modes(CLit):- match_mode(body,CLit). match_mode(_,true):- !. match_mode(Loc,CLit):- functor(CLit,Name,Arity), functor(Mode,Name,Arity), (Loc=head -> '$aleph_global'(modeh,modeh(_,Mode)); '$aleph_global'(modeb,modeb(_,Mode))), split_args(Mode,Mode,I,O,C), (Loc = head -> update_atoms(CLit,mode(Mode,O,I,C)); update_atoms(CLit,mode(Mode,I,O,C))), fail. match_mode(_,_). flatten_matched_atoms(Loc):- setting(i,IVal), (retract('$aleph_sat'(botsize,BSize))-> true; BSize = 0), (retract('$aleph_sat'(lastlit,Last))-> true ; Last = 0), (Loc = head -> flatten(0,IVal,BSize,BSize1); flatten(0,IVal,Last,BSize1)), asserta('$aleph_sat'(botsize,BSize1)), (Last < BSize1 -> asserta('$aleph_sat'(lastlit,BSize1)); asserta('$aleph_sat'(lastlit,Last))), !. flatten_matched_atoms(_). % integrate head literal into lits database % used during lazy evaluation of bottom clause integrate_head_lit(HeadOVars):- example_saturated(Example), split_args(Example,_,_,Output,_), integrate_args(unknown,Example,Output), match_mode(head,Example), flatten_matched_atoms(head), get_ivars1(nil,1,HeadOVars), !. integrate_head_lit([]). get_aleph_clause((Lit:-true),PLit):- !, get_aleph_lit(Lit,PLit). get_aleph_clause((Lit:-Lits),(PLit,PLits)):- !, get_aleph_lit(Lit,PLit), get_aleph_lits(Lits,PLits). get_aleph_clause(Lit,PLit):- get_aleph_lit(Lit,PLit). get_aleph_lits((Lit,Lits),(PLit,PLits)):- !, get_aleph_lit(Lit,PLit), get_aleph_lits(Lits,PLits). get_aleph_lits(Lit,PLit):- get_aleph_lit(Lit,PLit). get_aleph_lit(Lit,PLit):- functor(Lit,Name,Arity), functor(PLit,Name,Arity), get_aleph_lit(Lit,PLit,Arity). get_aleph_lit(_,_,0):- !. get_aleph_lit(Lit,PLit,Arg):- arg(Arg,Lit,Term), (var(Term) -> arg(Arg,PLit,Term);arg(Arg,PLit,aleph_const(Term))), NextArg is Arg - 1, get_aleph_lit(Lit,PLit,NextArg), !. % Claudien-style consistency checking as described by De Raedt and Dehaspe, 1996 % currently does not retain actual substitutions that result in inconsistencies % also, only checks for constraints of the form nil:- ... % this simplifies the check of Body,not(Head) to just Body ccheck(S,(nil:-Body),[],[0,N|_]):- (Body = true -> N is inf; arg(11,S,LContra), (LContra = nil -> arg(14,S,Depth), arg(29,S,Time), findall(X,(resource_bound_call(Time,Depth,Body),X=1),XL), length(XL,N); lazy_ccheck(S,Body,N) ) ). lazy_ccheck(S,Body,N):- arg(14,S,Depth), arg(17,S,Noise), arg(29,S,Time), retractall('$aleph_local'(subst_count,_)), asserta('$aleph_local'(subst_count,0)), resource_bound_call(Time,Depth,Body), retract('$aleph_local'(subst_count,N0)), N is N0 + 1, N > Noise, !. lazy_ccheck(_,_,N):- retract('$aleph_local'(subst_count,N)). % posonly formula as described by Muggleton, ILP-96 prove_examples(S,Flag,Contradiction,Entry,Best,CL,L2,Clause,Pos,Rand,PCover,RCover,[P,B,CL,I,G]):- arg(4,S,_/Evalfn), Evalfn = posonly, !, arg(11,S,LazyOnContra), ((LazyOnContra = true, Contradiction = true) -> prove_lazy_cached(S,Entry,Pos,Rand,PCover,RCover), interval_count(PCover,PC), interval_count(RCover,RC); prove_pos(S,Flag,Entry,Best,[PC,L2],Clause,Pos,PCover,PC), prove_rand(S,Flag,Entry,Clause,Rand,RCover,RC)), find_posgain(PCover,P), arg(16,S,M), arg(20,S,N), GC is (RC+1.0)/(N+2.0), % Laplace correction for small numbers A is log(P), B is log(GC), G is GC*M/P, C is CL/P, % Sz is CL*M/P, % D is M*G, % I is M - D - Sz, I is A - B - C. prove_examples(S,_,_,Entry,_,CL,_,_,Pos,Neg,Pos,Neg,[PC,NC,CL]):- arg(10,S,LazyOnCost), LazyOnCost = true, !, prove_lazy_cached(S,Entry,Pos,Neg,Pos1,Neg1), interval_count(Pos1,PC), interval_count(Neg1,NC). prove_examples(S,_,true,Entry,_,CL,_,_,Pos,Neg,Pos,Neg,[PC,NC,CL]):- arg(11,S,LazyOnContra), LazyOnContra = true, !, prove_lazy_cached(S,Entry,Pos,Neg,Pos1,Neg1), interval_count(Pos1,PC), interval_count(Neg1,NC). prove_examples(S,Flag,_,Ent,Best,CL,L2,Clause,Pos,Neg,PCover,NCover,[PC,NC,CL]):- arg(3,S,RefineOp), (RefineOp = nil; RefineOp = auto), arg(7,S,ClauseLength), ClauseLength = CL, !, interval_count(Pos,MaxPCount), prove_neg(S,Flag,Ent,Best,[MaxPCount,CL],Clause,Neg,NCover,NC), arg(17,S,Noise), arg(18,S,MinAcc), maxlength_neg_ok(Noise/MinAcc,Ent,MaxPCount,NC), prove_pos(S,Flag,Ent,Best,[PC,L2],Clause,Pos,PCover,PC), maxlength_neg_ok(Noise/MinAcc,Ent,PC,NC), !. prove_examples(S,Flag,_,Ent,Best,CL,L2,Clause,Pos,Neg,PCover,NCover,[PC,NC,CL]):- prove_pos(S,Flag,Ent,Best,[PC,L2],Clause,Pos,PCover,PC), prove_neg(S,Flag,Ent,Best,[PC,CL],Clause,Neg,NCover,NC), !. prove_lazy_cached(S,Entry,Pos,Neg,Pos1,Neg1):- arg(8,S,Caching), Caching = true, !, (check_cache(Entry,pos,Pos1)-> true; add_cache(Entry,pos,Pos), Pos1 = Pos), (check_cache(Entry,neg,Neg1)-> true; add_cache(Entry,neg,Neg), Neg1 = Neg). prove_lazy_cached(_,_,Pos,Neg,Pos,Neg). complete_label(posonly,_,L,L):- !. complete_label(user,Clause,[P,N,L],[P,N,L,Val]):- cost(Clause,[P,N,L],Cost), !, Val is -Cost. complete_label(entropy,_,[P,N,L],[P,N,L,Val]):- evalfn(entropy,[P,N,L],Entropy), Val is -Entropy, !. complete_label(gini,_,[P,N,L],[P,N,L,Val]):- evalfn(gini,[P,N,L],Gini), Val is -Gini, !. complete_label(EvalFn,_,[P,N,L],[P,N,L,Val]):- evalfn(EvalFn,[P,N,L],Val), !. complete_label(_,_,_,_):- p_message1('error'), p_message('incorrect evaluation/cost function'), fail. % estimate label based on subsampling estimate_label(Sample,[P,N|Rest],[P1,N1|Rest]):- '$aleph_global'(atoms_left,atoms_left(pos,Pos)), '$aleph_global'(atoms_left,atoms_left(neg,Neg)), interval_count(Pos,PC), interval_count(Neg,NC), PFrac is P/Sample, NFrac is N/Sample, P1 is integer(PFrac*PC), N1 is integer(NFrac*NC). % get primary and secondary search keys for search % use [Primary|Secondary] notation as it is the most compact get_search_keys(bf,[_,_,L,F|_],[L1|F]):- !, L1 is -1*L. get_search_keys(df,[_,_,L,F|_],[L|F]):- !. get_search_keys(_,[_,_,L,F|_],[F|L1]):- L1 is -1*L. prove_pos(_,_,_,_,_,_,[],[],0):- !. prove_pos(S,_,Entry,BestSoFar,PosSoFar,Clause,_,PCover,PCount):- '$aleph_search'(covers,covers(PCover,PCount)), !, pos_ok(S,Entry,BestSoFar,PosSoFar,Clause,PCover). prove_pos(S,Flag,Entry,BestSoFar,PosSoFar,Clause,Pos,PCover,PCount):- prove_cache(Flag,S,pos,Entry,Clause,Pos,PCover,PCount), pos_ok(S,Entry,BestSoFar,PosSoFar,Clause,PCover), !. prove_neg(S,_,Entry,_,_,_,[],[],0):- arg(8,S,Caching), (Caching = true -> add_cache(Entry,neg,[]); true), !. prove_neg(S,Flag,Entry,_,_,Clause,Neg,NCover,NCount):- arg(3,S,RefineOp), RefineOp = rls, !, prove_cache(Flag,S,neg,Entry,Clause,Neg,NCover,NCount). prove_neg(_,_,_,_,_,_,_,NCover,NCount):- '$aleph_search'(coversn,coversn(NCover,NCount)), !. prove_neg(S,Flag,Entry,BestSoFar,PosSoFar,Clause,Neg,NCover,NCount):- arg(12,S,LazyNegs), LazyNegs = true, !, lazy_prove_neg(S,Flag,Entry,BestSoFar,PosSoFar,Clause,Neg,NCover,NCount). prove_neg(S,Flag,Entry,[P,0,L1|_],[P,L2],Clause,Neg,[],0):- arg(4,S,bf/coverage), L2 is L1 - 1, !, prove_cache(Flag,S,neg,Entry,Clause,Neg,0,[],0), !. prove_neg(S,Flag,Entry,[P,N|_],[P,L1],Clause,Neg,NCover,NCount):- arg(4,S,bf/coverage), !, arg(7,S,ClauseLength), (ClauseLength = L1 -> arg(2,S,Explore), (Explore = true -> MaxNegs is N; MaxNegs is N - 1), MaxNegs >= 0, prove_cache(Flag,S,neg,Entry,Clause,Neg,MaxNegs,NCover,NCount), NCount =< MaxNegs; prove_cache(Flag,S,neg,Entry,Clause,Neg,NCover,NCount)), !. prove_neg(S,Flag,Entry,_,[P1,L1],Clause,Neg,NCover,NCount):- arg(7,S,ClauseLength), ClauseLength = L1, !, arg(17,S,Noise), arg(18,S,MinAcc), get_max_negs(Noise/MinAcc,P1,N1), prove_cache(Flag,S,neg,Entry,Clause,Neg,N1,NCover,NCount), NCount =< N1, !. prove_neg(S,Flag,Entry,_,_,Clause,Neg,NCover,NCount):- prove_cache(Flag,S,neg,Entry,Clause,Neg,NCover,NCount), !. prove_rand(S,Flag,Entry,Clause,Rand,RCover,RCount):- prove_cache(Flag,S,rand,Entry,Clause,Rand,RCover,RCount), !. lazy_prove_neg(S,Flag,Entry,[P,N|_],[P,_],Clause,Neg,NCover,NCount):- arg(4,S,bf/coverage), !, MaxNegs is N + 1, prove_cache(Flag,S,neg,Entry,Clause,Neg,MaxNegs,NCover,NCount), !. lazy_prove_neg(S,Flag,Entry,_,[P1,_],Clause,Neg,NCover,NCount):- arg(17,S,Noise), arg(18,S,MinAcc), get_max_negs(Noise/MinAcc,P1,N1), MaxNegs is N1 + 1, prove_cache(Flag,S,neg,Entry,Clause,Neg,MaxNegs,NCover,NCount), !. % Bug reported by Daniel Fredouille % For MiAcc =:= 0, Negs was being set to P1 + 1. Unclear why. % This definition is as it was up to Aleph 2. get_max_negs(Noise/MinAcc,P1,N):- number(P1), (MinAcc =:= 0.0 -> N is Noise; (N1 is integer((1-MinAcc)*P1/MinAcc), (Noise < N1 -> N is Noise; N is N1)) ), !. get_max_negs(Noise/_,_,Noise). % update_open_list(+SearchKeys,+NodeRef,+Label) % insert SearchKeys into openlist update_open_list([K1|K2],NodeRef,Label):- assertz('$aleph_search_gain'(K1,K2,NodeRef,Label)), retract('$aleph_search'(openlist,OpenList)), uniq_insert(descending,[K1|K2],OpenList,List1), asserta('$aleph_search'(openlist,List1)). pos_ok(S,_,_,_,_,_):- arg(3,S,RefineOp), (RefineOp = rls; RefineOp = user), !. pos_ok(S,Entry,_,[P,_],_,_):- arg(13,S,MinPos), P < MinPos, !, arg(8,S,Caching), (Caching = true -> add_prune_cache(Entry); true), fail. pos_ok(S,Entry,_,[P,_],_,_):- arg(40,S,MinPosFrac), MinPosFrac > 0.0, '$aleph_search'(clauseprior,_-[P1-pos,_]), P/P1 < MinPosFrac, !, arg(8,S,Caching), (Caching = true -> add_prune_cache(Entry); true), fail. pos_ok(S,_,[_,_,_,C1|_],[P,L],_,_):- arg(4,S,_/Evalfn), arg(2,S,Explore), ((Evalfn = user; Explore = true) -> true; evalfn(Evalfn,[P,0,L],C2), best_value(Evalfn,S,[P,0,L,C2],Max), Max > C1), !. maxlength_neg_ok(Noise/MinAcc,Entry,P,N):- ((N > Noise); (P/(P+N) < MinAcc)), !, add_prune_cache(Entry), fail. maxlength_neg_ok(_,_,_,_). compression_ok(compression,[P,_,L|_]):- !, P - L + 1 > 0. compression_ok(_,_). length_ok(S,MinLen,ClauseLen,LastD,ExpectedMin,ExpectedCLen):- arg(3,S,RefineOp), (RefineOp = nil -> L1 = LastD; L1 = 0), (L1 < MinLen->ExpectedMin = L1;ExpectedMin = MinLen), ExpectedCLen is ClauseLen + ExpectedMin, arg(7,S,CLength), ExpectedCLen =< CLength, !. update_best(S,_,_,_,Best,[P,_,_,F|_]/_,Best):- arg(13,S,MinPos), arg(19,S,MinScore), (P < MinPos; F is -inf; F < MinScore), !. update_best(S,_,_,_,Best,[P|_]/_,Best):- arg(40,S,MinPosFrac), MinPosFrac > 0.0, '$aleph_search'(clauseprior,_-[P1-pos,_]), P/P1 < MinPosFrac, !. update_best(S,_,_,_,Best,[P,N,_,_|_]/_,Best):- arg(4,S,_/Evalfn), Evalfn \= posonly, % Evalfn \= user, arg(17,S,Noise), arg(18,S,MinAcc), arg(22,S,Search), Total is P + N, ((N > Noise);(Search \= ic, Total > 0, P/Total < MinAcc)), !. update_best(S,Clause,PCover,NCover,Label/_,Label1/Node1,Label1/Node1):- Label = [_,_,_,Gain|_], Label1 = [_,_,_,Gain1|_], % (Gain1 = inf; Gain = -inf; Gain1 > Gain), !, Gain1 > Gain, !, retractall('$aleph_search'(selected,_)), asserta('$aleph_search'(selected,selected(Label1,Clause,PCover,NCover))), arg(35,S,VSearch), (VSearch = true -> retractall('$aleph_search'(best,_)), asserta('$aleph_search'(best,Node1)), asserta('$aleph_search'(good,Node1)); true), update_good(Label1,Clause), show_clause(newbest,Label1,Clause,Node1), record_clause(newbest,Label1,Clause,Node1), record_clause(good,Label1,Clause,Node1). update_best(S,Clause,_,_,Label/Node,Label1/Node1,Label/Node):- arg(35,S,VSearch), (VSearch = true -> asserta('$aleph_search'(good,Node1)); true), update_good(Label1,Clause), show_clause(good,Label1,Clause,Node1), record_clause(good,Label1,Clause,Node1). update_good(Label,Clause):- setting(good,true), !, Label = [_,_,L|_], setting(check_good,Flag), update_good(Flag,L,Label,Clause). update_good(_,_). update_good(_,_,_,_):- setting(goodfile,_), !. update_good(true,L,Label,Clause):- '$aleph_good'(L,Label,Clause), !. update_good(_,L,Label,Clause):- assertz('$aleph_good'(L,Label,Clause)), (retract('$aleph_search'(last_good,Good)) -> Good1 is Good + 1; Good1 is 1), assertz('$aleph_search'(last_good,Good1)). update_best_theory(S,_,_,_,Best,[P,N,_,F|_]/_,Best):- arg(17,S,Noise), arg(18,S,MinAcc), arg(19,S,MinScore), (N > Noise; P/(P+N) < MinAcc; F < MinScore), !. update_best_theory(_,Theory,PCover,NCover,Label/_,Label1/Node1,Label1/Node1):- Label = [_,_,_,Gain|_], Label1 = [_,_,_,Gain1|_], Gain1 > Gain, !, retractall('$aleph_search'(selected,_)), asserta('$aleph_search'(selected,selected(Label1,Theory,PCover,NCover))), show_theory(newbest,Label1,Theory,Node1), record_theory(newbest,Label1,Theory,Node1), record_theory(good,Label1,Theory,Node1). update_best_theory(_,Theory,_,_,Best,Label1/_,Best):- show_theory(good,Label1,Theory,Node1), record_theory(good,Label1,Theory,Node1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % P R U N I N G C L A U S E S get_node([[K1|K2]|_],[K1|K2],Node):- '$aleph_search_gain'(K1,K2,Node,_). get_node([_|Gains],Gain,Node):- get_node(Gains,Gain,Node). prune_open(S,_,_):- arg(25,S,OSize), Inf is inf, OSize =\= Inf, retractall('$aleph_local'(in_beam,_)), asserta('$aleph_local'(in_beam,0)), '$aleph_search'(openlist,Gains), get_node(Gains,[K1|K2],NodeNum), '$aleph_local'(in_beam,N), (N < OSize-> retract('$aleph_local'(in_beam,N)), N1 is N + 1, asserta('$aleph_local'(in_beam,N1)); retract('$aleph_search_gain'(K1,K2,NodeNum,_)), arg(6,S,Verbose), (Verbose < 1 -> true; p1_message('non-admissible removal'), p_message(NodeNum))), fail. prune_open(S,_,_):- arg(2,S,Explore), arg(3,S,RefineOp), (Explore = true; RefineOp = rls; RefineOp = user), !. prune_open(_,_/N,_/N):- !. prune_open(S,_,[_,_,_,Best|_]/_):- arg(4,S,_/Evalfn), built_in_prune(Evalfn), '$aleph_search_gain'(_,_,_,Label), best_value(Evalfn,S,Label,Best1), Best1 =< Best, retract('$aleph_search_gain'(_,_,_,Label)), fail. prune_open(_,_,_). built_in_prune(coverage). built_in_prune(compression). built_in_prune(posonly). built_in_prune(laplace). built_in_prune(wracc). built_in_prune(mestimate). built_in_prune(auto_m). % pruning for posonly, laplace and m-estimates devised in % discussion with James Cussens % pruning for weighted relative accuracy devised in % discussion with Steve Moyle % corrections to best_value/4 after discussion with % Mark Reid and James Cussens best_value(gini,_,_,0.0):- !. best_value(entropy,_,_,0.0):- !. best_value(posonly,S,[P,_,L|_],Best):- arg(20,S,RSize), Best is log(P) + log(RSize+2.0) - (L+1)/P, !. best_value(wracc,_,[P|_],Best):- ('$aleph_search'(clauseprior,Total-[P1-pos,_]) -> Best is P*(Total - P1)/(Total^2); Best is 0.25), !. best_value(Evalfn,_,[P,_,L|Rest],Best):- L1 is L + 1, % need at least 1 extra literal to achieve best value evalfn(Evalfn,[P,0,L1|Rest],Best). get_nextbest(S,NodeRef):- arg(22,S,Search), select_nextbest(Search,NodeRef). % Select the next best node % Incorporates the changes made by Filip Zelezny to % achieve the `randomised rapid restart' (or rrr) technique % within randomised local search select_nextbest(rls,NodeRef):- retractall('$aleph_search'(nextnode,_)), setting(rls_type,Type), (retract('$aleph_search'(rls_parentstats,stats(PStats,_,_))) -> true; true), (rls_nextbest(Type,PStats,NodeRef,Label) -> asserta('$aleph_search'(rls_parentstats,stats(Label,[],[]))), setting(rls_type,RlsType), (RlsType = rrr -> true; assertz('$aleph_search'(nextnode,NodeRef))); NodeRef = none), !. select_nextbest(_,NodeRef):- retractall('$aleph_search'(nextnode,_)), get_nextbest(NodeRef), !. select_nextbest(_,none). get_nextbest(NodeRef):- '$aleph_search'(openlist,[H|_]), H = [K1|K2], retract('$aleph_search_gain'(K1,K2,NodeRef,_)), assertz('$aleph_search'(nextnode,NodeRef)). get_nextbest(NodeRef):- retract('$aleph_search'(openlist,[_|T])), asserta('$aleph_search'(openlist,T)), get_nextbest(NodeRef), !. get_nextbest(none). rls_nextbest(rrr,_,NodeRef,_):- get_nextbest(NodeRef). rls_nextbest(gsat,_,NodeRef,Label):- retract('$aleph_search'(openlist,[H|_])), H = [K1|K2], asserta('$aleph_search'(openlist,[])), findall(N-L,'$aleph_search_gain'(K1,K2,N,L),Choices), length(Choices,Last), get_random(Last,N), aleph_remove_nth(N,Choices,NodeRef-Label,_), retractall('$aleph_search_gain'(_,_,_,_)). rls_nextbest(wsat,PStats,NodeRef,Label):- setting(walk,WProb), aleph_random(P), P >= WProb, !, rls_nextbest(gsat,PStats,NodeRef,Label). rls_nextbest(wsat,PStats,NodeRef,Label):- p_message('random walk'), retract('$aleph_search'(openlist,_)), asserta('$aleph_search'(openlist,[])), findall(N-L,'$aleph_search_gain'(_,_,N,L),AllNodes), potentially_good(AllNodes,PStats,Choices), length(Choices,Last), get_random(Last,N), aleph_remove_nth(N,Choices,NodeRef-Label,_), retractall('$aleph_search_gain'(_,_,_,_)). rls_nextbest(anneal,[P,N|_],NodeRef,Label):- setting(temperature,Temp), retract('$aleph_search'(openlist,_)), asserta('$aleph_search'(openlist,[])), findall(N-L,'$aleph_search_gain'(_,_,N,L),AllNodes), length(AllNodes,Last), get_random(Last,S), aleph_remove_nth(S,AllNodes,NodeRef-Label,_), Label = [P1,N1|_], Gain is (P1 - N1) - (P - N), ((P = 1); (Gain >= 0);(aleph_random(R), R < exp(Gain/Temp))). potentially_good([],_,[]). potentially_good([H|T],Label,[H|T1]):- H = _-Label1, potentially_good(Label,Label1), !, potentially_good(T,Label,T1). potentially_good([_|T],Label,T1):- potentially_good(T,Label,T1). potentially_good([1|_],[P1|_]):- !, P1 > 1. potentially_good([P,_,L|_],[P1,_,L1|_]):- L1 =< L, !, P1 > P. potentially_good([_,N|_],[_,N1|_]):- N1 < N. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % P R O V E % prove with caching % if entry exists in cache, then return it % otherwise find and cache cover % if ``exact'' flag is set then only check proof for examples % in the part left over due to lazy theorem-proving % ideas in caching developed in discussions with James Cussens prove_cache(exact,S,Type,Entry,Clause,Intervals,IList,Count):- !, (Intervals = Exact/Left -> arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(Depth/Time/Proof,Type,Clause,Left,IList1,Count1), aleph_append(IList1,Exact,IList), interval_count(Exact,Count0), Count is Count0 + Count1; IList = Intervals, interval_count(IList,Count)), arg(8,S,Caching), (Caching = true -> add_cache(Entry,Type,IList); true). prove_cache(upper,S,Type,Entry,Clause,Intervals,IList,Count):- arg(8,S,Caching), Caching = true, !, arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), (check_cache(Entry,Type,Cached)-> prove_cached(S,Type,Entry,Cached,Clause,Intervals,IList,Count); prove_intervals(Depth/Time/Proof,Type,Clause,Intervals,IList,Count), add_cache(Entry,Type,IList)). prove_cache(upper,S,Type,_,Clause,Intervals,IList,Count):- arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), (Intervals = Exact/Left -> aleph_append(Left,Exact,IList1), prove(Depth/Time/Proof,Type,Clause,IList1,IList,Count); prove(Depth/Time/Proof,Type,Clause,Intervals,IList,Count)). prove_intervals(DepthTime,Type,Clause,I1/Left,IList,Count):- !, aleph_append(Left,I1,Intervals), prove(DepthTime,Type,Clause,Intervals,IList,Count). prove_intervals(DepthTime,Type,Clause,Intervals,IList,Count):- prove(DepthTime,Type,Clause,Intervals,IList,Count). prove_cached(S,Type,Entry,I1/Left,Clause,Intervals,IList,Count):- !, arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(Depth/Time/Proof,Type,Clause,Left,I2,_), aleph_append(I2,I1,I), (Type = pos -> arg(5,S,Greedy), (Greedy = true -> intervals_intersection(I,Intervals,IList); IList = I); IList = I), interval_count(IList,Count), update_cache(Entry,Type,IList). prove_cached(S,Type,Entry,I1,_,Intervals,IList,Count):- (Type = pos -> arg(5,S,Greedy), (Greedy = true -> intervals_intersection(I1,Intervals,IList); IList = I1); IList = I1), interval_count(IList,Count), update_cache(Entry,Type,IList). % prove at most Max atoms prove_cache(exact,S,Type,Entry,Clause,Intervals,Max,IList,Count):- !, (Intervals = Exact/Left -> interval_count(Exact,Count0), Max1 is Max - Count0, arg(12,S,LNegs), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(LNegs/nil,Depth/Time/Proof,Type,Clause,Left,Max1,IList1,Count1), aleph_append(IList1,Exact,Exact1), find_lazy_left(S,Type,Exact1,Left1), IList = Exact1/Left1, Count is Count0 + Count1; IList = Intervals, interval_count(Intervals,Count)), arg(8,S,Caching), (Caching = true -> add_cache(Entry,Type,IList); true). prove_cache(upper,S,Type,Entry,Clause,Intervals,Max,IList,Count):- arg(8,S,Caching), Caching = true, !, (check_cache(Entry,Type,Cached)-> prove_cached(S,Type,Entry,Cached,Clause,Intervals,Max,IList,Count); (prove_intervals(S,Type,Clause,Intervals,Max,IList1,Count)-> find_lazy_left(S,Type,IList1,Left1), add_cache(Entry,Type,IList1/Left1), IList = IList1/Left1, retractall('$aleph_local'(example_cache,_)); collect_example_cache(IList), add_cache(Entry,Type,IList), fail)). prove_cache(upper,S,Type,_,Clause,Intervals,Max,IList/Left1,Count):- arg(8,S,Caching), arg(12,S,LNegs), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), (Intervals = Exact/Left -> aleph_append(Left,Exact,IList1), prove(LNegs/Caching,Depth/Time/Proof,Type,Clause,IList1,Max,IList,Count); prove(LNegs/Caching,Depth/Time/Proof,Type,Clause,Intervals,Max,IList,Count)), find_lazy_left(S,Type,IList,Left1). prove_intervals(S,Type,Clause,I1/Left,Max,IList,Count):- !, arg(8,S,Caching), arg(12,S,LNegs), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), aleph_append(Left,I1,Intervals), prove(LNegs/Caching,Depth/Time/Proof,Type,Clause,Intervals,Max,IList,Count). prove_intervals(S,Type,Clause,Intervals,Max,IList,Count):- arg(8,S,Caching), arg(12,S,LNegs), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(LNegs/Caching,Depth/Time/Proof,Type,Clause,Intervals,Max,IList,Count). prove_cached(S,Type,Entry, I1/Left,Clause,_,Max,IList/Left1,Count):- !, arg(8,S,Caching), arg(12,S,LNegs), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), interval_count(I1,C1), Max1 is Max - C1, Max1 >= 0, (prove(LNegs/Caching,Depth/Time/Proof,Type,Clause,Left,Max1,I2,C2)-> aleph_append(I2,I1,IList), Count is C2 + C1, find_lazy_left(S,Type,IList,Left1), update_cache(Entry,Type,IList/Left1), retractall('$aleph_local'(example_cache,_)); collect_example_cache(I2/Left1), aleph_append(I2,I1,IList), update_cache(Entry,Type,IList/Left1), fail). prove_cached(_,neg,_, I1/L1,_,_,_,I1/L1,C1):- !, interval_count(I1,C1). prove_cached(S,_,_,I1,_,_,Max,I1,C1):- interval_count(I1,C1), arg(12,S,LNegs), (LNegs = true ->true; C1 =< Max). collect_example_cache(Intervals/Left):- retract('$aleph_local'(example_cache,[Last|Rest])), aleph_reverse([Last|Rest],IList), list_to_intervals1(IList,Intervals), Next is Last + 1, '$aleph_global'(size,size(neg,LastN)), (Next > LastN -> Left = []; Left = [Next-LastN]). find_lazy_left(S,_,_,[]):- arg(12,S,LazyNegs), LazyNegs = nil, !. find_lazy_left(_,_,[],[]). find_lazy_left(S,Type,[_-F],Left):- !, F1 is F + 1, (Type = pos -> arg(16,S,Last); (Type = neg -> arg(24,S,Last); (Type = rand -> arg(20,S,Last); Last = F))), (F1 > Last -> Left = []; Left = [F1-Last]). find_lazy_left(S,Type,[_|T1],Left):- find_lazy_left(S,Type,T1,Left). % prove atoms specified by Type and index set using Clause. % dependent on data structure used for index set: % currently index set is a list of intervals % return atoms proved and their count % if tail-recursive version is needed see below prove(_,_,_,[],[],0). prove(Flags,Type,Clause,[Interval|Intervals],IList,Count):- index_prove(Flags,Type,Clause,Interval,I1,C1), prove(Flags,Type,Clause,Intervals,I2,C2), aleph_append(I2,I1,IList), Count is C1 + C2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % T A I L - R E C U R S I V E P R O V E/6 % use this rather than the prove/6 above for tail recursion % written by James Cussens % prove(DepthTime,Type,Clause,Intervals,IList,Count):- % prove2(Intervals,DepthTime,Type,Clause,0,IList,Count). % code for tail recursive cover testing % starts here % when we know that Sofar is a variable. prove2([],_,_,_,Count,[],Count). prove2([Current-Finish|Intervals],Depth/Time/Proof,Type,(Head:-Body),InCount,Sofar,OutCount) :- example(Current,Type,Example), \+ prove1(Proof,Depth/Time,Example,(Head:-Body)), %uncovered !, (Current>=Finish -> prove2(Intervals,Depth/Time/Proof,Type,(Head:-Body),InCount,Sofar,OutCount); Next is Current+1,!, prove2([Next-Finish|Intervals],Depth/Time/Proof,Type,(Head:-Body),InCount,Sofar,OutCount) ). prove2([Current-Finish|Intervals],ProofFlags,Type,Clause,InCount,Sofar,OutCount) :- (Current>=Finish -> Sofar=[Current-Current|Rest], MidCount is InCount+1,!, prove2(Intervals,ProofFlags,Type,Clause,MidCount,Rest,OutCount); Next is Current+1, Sofar=[Current-_Last|_Rest],!, prove3([Next-Finish|Intervals],ProofFlags,Type,Clause,InCount,Sofar,OutCount) ). %when Sofar is not a variable prove3([Current-Finish|Intervals],Depth/Time/Proof,Type,(Head:-Body),InCount,Sofar,OutCount) :- example(Current,Type,Example), \+ prove1(Proof,Depth/Time,Example,(Head:-Body)), %uncovered !, Last is Current-1, %found some previously Sofar=[Start-Last|Rest], %complete found interval MidCount is InCount+Current-Start, (Current>=Finish -> prove2(Intervals,Depth/Time/Proof,Type,(Head:-Body),MidCount,Rest,OutCount); Next is Current+1,!, prove2([Next-Finish|Intervals],Depth/Time/Proof,Type,(Head:-Body),MidCount,Rest,OutCount) ). prove3([Current-Finish|Intervals],ProofFlags,Type,Clause,InCount,Sofar,OutCount) :- (Current>=Finish -> Sofar=[Start-Finish|Rest], MidCount is InCount+Finish-Start+1,!, prove2(Intervals,ProofFlags,Type,Clause,MidCount,Rest,OutCount); Next is Current+1,!, prove3([Next-Finish|Intervals],ProofFlags,Type,Clause,InCount,Sofar,OutCount) ). % code for tail recursive cover testing % ends here index_prove(_,_,_,Start-Finish,[],0):- Start > Finish, !. index_prove(ProofFlags,Type,Clause,Start-Finish,IList,Count):- index_prove1(ProofFlags,Type,Clause,Start,Finish,Last), Last0 is Last - 1 , Last1 is Last + 1, (Last0 >= Start-> index_prove(ProofFlags,Type,Clause,Last1-Finish,Rest,Count1), IList = [Start-Last0|Rest], Count is Last - Start + Count1; index_prove(ProofFlags,Type,Clause,Last1-Finish,IList,Count)). prove1(G):- depth_bound_call(G), !. prove1(user,_,Example,Clause):- prove(Clause,Example), !. prove1(restricted_sld,Depth/Time,Example,(Head:-Body)):- \+((\+(((Example = Head),resource_bound_call(Time,Depth,Body))))), !. prove1(sld,Depth/Time,Example,_):- \+(\+(resource_bound_call(Time,Depth,Example))), !. index_prove1(_,_,_,Num,Last,Num):- Num > Last, !. index_prove1(Depth/Time/Proof,Type,Clause,Num,Finish,Last):- example(Num,Type,Example), prove1(Proof,Depth/Time,Example,Clause), !, Num1 is Num + 1, index_prove1(Depth/Time/Proof,Type,Clause,Num1,Finish,Last). index_prove1(_,_,_,Last,_,Last). % proves at most Max atoms using Clause. prove(_,_,_,_,[],_,[],0). prove(Flags,ProofFlags,Type,Clause,[Interval|Intervals],Max,IList,Count):- index_prove(Flags,ProofFlags,Type,Clause,Interval,Max,I1,C1), !, Max1 is Max - C1, prove(Flags,ProofFlags,Type,Clause,Intervals,Max1,I2,C2), aleph_append(I2,I1,IList), Count is C1 + C2. index_prove(_,_,_,_,Start-Finish,_,[],0):- Start > Finish, !. index_prove(Flags,ProofFlags,Type,Clause,Start-Finish,Max,IList,Count):- index_prove1(Flags,ProofFlags,Type,Clause,Start,Finish,0,Max,Last), Last0 is Last - 1 , Last1 is Last + 1, (Last0 >= Start-> Max1 is Max - Last + Start, ((Max1 = 0, Flags = true/_) -> Rest = [], Count1 = 0; index_prove(Flags,ProofFlags,Type,Clause,Last1-Finish, Max1,Rest,Count1)), IList = [Start-Last0|Rest], Count is Last - Start + Count1; index_prove(Flags,ProofFlags,Type,Clause,Last1-Finish,Max,IList,Count)). index_prove1(nil/_,_,_,_,_,_,Proved,Allowed,_):- Proved > Allowed, !, fail. index_prove1(_,_,_,_,Num,Last,_,_,Num):- Num > Last, !. index_prove1(true/_,_,_,_,Num,_,Allowed,Allowed,Num):- !. index_prove1(LNegs/Caching,Depth/Time/Proof,Type,Clause,Num,Finish,Proved,Allowed,Last):- example(Num,Type,Example), prove1(Proof,Depth/Time,Example,Clause), !, Num1 is Num + 1, Proved1 is Proved + 1, (Caching = true -> (retract('$aleph_local'(example_cache,L)) -> asserta('$aleph_local'(example_cache,[Num|L])); asserta('$aleph_local'(example_cache,[Num]))); true), index_prove1(LNegs/Caching,Depth/Time/Proof,Type,Clause,Num1,Finish,Proved1,Allowed,Last). index_prove1(_,_,_,_,Last,_,_,_,Last). % resource_bound_call(Time,Depth,Goals) % attempt to prove Goals using depth bounded theorem-prover % in at most Time secs resource_bound_call(T,Depth,Goals):- Inf is inf, T =:= Inf, !, depth_bound_call(Goals,Depth). resource_bound_call(T,Depth,Goals):- catch(time_bound_call(T,prooflimit,depth_bound_call(Goals,Depth)), prooflimit,fail). time_bound_call(T,Exception,Goal):- alarm(T,throw(Exception),X), (Goal -> remove_alarm(X); remove_alarm(X), fail). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % C A C H I N G clear_cache:- retractall('$aleph_search_cache'(_)), retractall('$aleph_search_prunecache'(_)). check_cache(Entry,Type,I):- Entry \= nil, '$aleph_search_cache'(Entry), !, functor(Entry,_,Arity), (Type = pos -> Arg is Arity - 1; Arg is Arity), arg(Arg,Entry,I), nonvar(I). add_cache(nil,_,_):- !. add_cache(Entry,Type,I):- (retract('$aleph_search_cache'(Entry))-> true ; true), functor(Entry,_,Arity), (Type = pos -> Arg is Arity - 1; Arg is Arity), (arg(Arg,Entry,I)-> asserta('$aleph_search_cache'(Entry)); true), !. update_cache(Entry,Type,I):- Entry \= nil, functor(Entry,Name,Arity), (Type = pos -> Arg is Arity - 1; Arg is Arity), arg(Arg,Entry,OldI), OldI = _/_, retract('$aleph_search_cache'(Entry)), functor(NewEntry,Name,Arity), Arg0 is Arg - 1, copy_args(Entry,NewEntry,1,Arg0), arg(Arg,NewEntry,I), Arg1 is Arg + 1, copy_args(Entry,NewEntry,Arg1,Arity), asserta('$aleph_search_cache'(NewEntry)), !. update_cache(_,_,_). add_prune_cache(nil):- !. add_prune_cache(Entry):- ('$aleph_global'(caching,set(caching,true))-> functor(Entry,_,Arity), A1 is Arity - 2, arg(A1,Entry,Clause), asserta('$aleph_search_prunecache'(Clause)); true). get_cache_entry(Max,Clause,Entry):- skolemize(Clause,Head,Body,0,_), length(Body,L1), Max >= L1 + 1, aleph_hash_term([Head|Body],Entry), !. get_cache_entry(_,_,nil). % upto 3-argument indexing using predicate names in a clause aleph_hash_term([L0,L1,L2,L3,L4|T],Entry):- !, functor(L1,P1,_), functor(L2,P2,_), functor(L3,P3,_), functor(L4,P4,_), functor(Entry,P4,6), arg(1,Entry,P2), arg(2,Entry,P3), arg(3,Entry,P1), arg(4,Entry,[L0,L1,L2,L3,L4|T]). aleph_hash_term([L0,L1,L2,L3],Entry):- !, functor(L1,P1,_), functor(L2,P2,_), functor(L3,P3,_), functor(Entry,P3,5), arg(1,Entry,P2), arg(2,Entry,P1), arg(3,Entry,[L0,L1,L2,L3]). aleph_hash_term([L0,L1,L2],Entry):- !, functor(L1,P1,_), functor(L2,P2,_), functor(Entry,P2,4), arg(1,Entry,P1), arg(2,Entry,[L0,L1,L2]). aleph_hash_term([L0,L1],Entry):- !, functor(L1,P1,_), functor(Entry,P1,3), arg(1,Entry,[L0,L1]). aleph_hash_term([L0],Entry):- functor(L0,P0,_), functor(Entry,P0,3), arg(1,Entry,[L0]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % T R E E S construct_tree(Type):- setting(searchtime,Time), Inf is inf, Time =\= Inf, SearchTime is integer(Time), SearchTime > 0, !, catch(time_bound_call(SearchTime,searchlimit,find_tree(Type)), searchlimit,p_message('Time limit reached')). construct_tree(Type):- find_tree(Type). % find_tree(Type) where Type is one of % classification, regression, class_probability find_tree(Type):- retractall('$aleph_search'(tree,_)), retractall('$aleph_search'(tree_besterror,_)), retractall('$aleph_search'(tree_gain,_)), retractall('$aleph_search'(tree_lastleaf,_)), retractall('$aleph_search'(tree_leaf,_)), retractall('$aleph_search'(tree_newleaf,_)), retractall('$aleph_search'(tree_startdistribution,_)), get_start_distribution(Type,Distribution), asserta('$aleph_search'(tree_startdistribution,d(Type,Distribution))), '$aleph_global'(atoms_left,atoms_left(pos,Pos)), setting(dependent,Argno), p_message('constructing tree'), stopwatch(StartClock), get_search_settings(S), auto_refine(nil,Head), gen_leaf(Leaf), eval_treenode(S,Type,(Head:-true),[Argno],Pos,Examples,N,Cost), asserta('$aleph_search'(tree_leaf,l(Leaf,Leaf,[Head,Cost,N],Examples))), find_tree1([Leaf],S,Type,[Argno]), prune_rules(S,Type,[Argno]), stopwatch(StopClock), add_tree(S,Type,[Argno]), Time is StopClock - StartClock, p1_message('construction timeit'), p_message(Time). get_start_distribution(regression,0-[0,0]):- !. get_start_distribution(model,0-[0,0]):- setting(evalfn,mse), !. get_start_distribution(model,0-Distribution):- setting(evalfn,accuracy), !, (setting(classes,Classes) -> true; !, p_message('missing setting for classes'), fail), initialise_distribution(Classes,Distribution), !. get_start_distribution(Tree,0-Distribution):- (Tree = classification; Tree = class_probability), (setting(classes,Classes) -> true; !, p_message('missing setting for classes'), fail), initialise_distribution(Classes,Distribution), !. get_start_distribution(_,_):- p_message('incorrect/missing setting for tree_type or evalfn'), fail. initialise_distribution([],[]). initialise_distribution([Class|Classes],[0-Class|T]):- initialise_distribution(Classes,T). laplace_correct([],[]). laplace_correct([N-Class|Classes],[N1-Class|T]):- N1 is N + 1, laplace_correct(Classes,T). find_tree1([],_,_,_). find_tree1([Leaf|Leaves],S,Type,Predict):- can_split(S,Type,Predict,Leaf,Left,Right), !, split_leaf(Leaf,Left,Right,NewLeaves), aleph_append(NewLeaves,Leaves,LeavesLeft), find_tree1(LeavesLeft,S,Type,Predict). find_tree1([_|LeavesLeft],S,Type,Predict):- find_tree1(LeavesLeft,S,Type,Predict). prune_rules(S,Tree,Predict):- setting(prune_tree,true), prune_rules1(Tree,S,Predict), !. prune_rules(_,_,_). % pessimistic pruning by employing corrections to observed errors prune_rules1(class_probability,_,_):- p_message('no pruning for class probability trees'), !. prune_rules1(model,_,_):- p_message('no pruning for model trees'), !. prune_rules1(Tree,S,Predict):- p_message('pruning clauses'), '$aleph_search'(tree_leaf,l(Leaf,Parent,Clause,Examples)), prune_rule(Tree,S,Predict,Clause,Examples,NewClause,NewExamples), retract('$aleph_search'(tree_leaf,l(Leaf,Parent,Clause,Examples))), asserta('$aleph_search'(tree_newleaf,l(Leaf,Parent,NewClause,NewExamples))), fail. prune_rules1(_,_,_):- retract('$aleph_search'(tree_newleaf,l(Leaf,Parent,NewClause,NewExamples))), asserta('$aleph_search'(tree_leaf,l(Leaf,Parent,NewClause,NewExamples))), fail. prune_rules1(_,_,_). prune_rule(Tree,S,PredictArg,[Clause,_,N],Examples,[PrunedClause,E1,NCov],NewEx):- node_stats(Tree,Examples,PredictArg,Total-Distribution), leaf_prediction(Tree,Total-Distribution,_,Incorrect), estimate_error(Tree,Incorrect,Total,Upper), split_clause(Clause,Head,Body), goals_to_list(Body,BodyL), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), greedy_prune_rule(Tree,Depth/Time/Proof,PredictArg,[Head|BodyL],Upper,C1L,E1), list_to_clause(C1L,PrunedClause), % p1_message('pruned clause'), p_message(Clause), % p_message('to'), % p_message(PrunedClause), (E1 < Upper -> '$aleph_global'(atoms_left,atoms_left(pos,Pos)), prove(Depth/Time/Proof,pos,PrunedClause,Pos,NewEx,NCov); NewEx = Examples, NCov = N). % estimate error using binomial distribution as done in C4.5 estimate_error(classification,Incorrect,Total,Error):- setting(confidence,Conf), estimate_error(1.0/0.0,0.0/1.0,Conf,Total,Incorrect,Error). % estimate upper bound on sample std deviation by % assuming the n values in a leaf are normally distributed. % In this case, a (1-alpha)x100 confidence interval for the % variance is (n-1)s^2/X^2(alpha/2) =< var =< (n-1)s^2/X^2(1-alpha/2) estimate_error(regression,Sd,1,Sd):- !. estimate_error(regression,Sd,N,Upper):- (setting(confidence,Conf) -> true; Conf = 0.95), Alpha is 1.0 - Conf, DF is N - 1, Prob is 1 - Alpha/2, chi_square(DF,Prob,ChiSq), Upper is Sd*sqrt((N-1)/ChiSq). bound_error(classification,Error,Total,Lower,Upper):- (setting(confidence,Alpha) -> true; Alpha = 0.95), approx_z(Alpha,Z), Lower is Error - Z*sqrt(Error*(1-Error)/Total), Upper is Error + Z*sqrt(Error*(1-Error)/Total). approx_z(P,2.58):- P >= 0.99, !. approx_z(P,Z):- P >= 0.98, !, Z is 2.33 + (P-0.98)*(2.58-2.33)/(0.99-0.98). approx_z(P,Z):- P >= 0.95, !, Z is 1.96 + (P-0.95)*(2.33-1.96)/(0.98-0.95). approx_z(P,Z):- P >= 0.90, !, Z is 1.64 + (P-0.90)*(1.96-1.64)/(0.95-0.90). approx_z(P,Z):- P >= 0.80, !, Z is 1.28 + (P-0.80)*(1.64-1.28)/(0.90-0.80). approx_z(P,Z):- P >= 0.68, !, Z is 1.00 + (P-0.68)*(1.28-1.00)/(0.80-0.68). approx_z(P,Z):- P >= 0.50, !, Z is 0.67 + (P-0.50)*(1.00-0.67)/(0.68-0.50). approx_z(_,0.67). greedy_prune_rule(Tree,Flags,PredictArg,Clause,Err0,NewClause,BestErr):- greedy_prune_rule1(Tree,Flags,PredictArg,Clause,Err0,Clause1,Err1), Clause \= Clause1, !, greedy_prune_rule(Tree,Flags,PredictArg,Clause1,Err1,NewClause,BestErr). greedy_prune_rule(_,_,_,C,E,C,E). greedy_prune_rule1(Tree,Flags,PredictArg,[Head|Body],Err0,_,_):- retractall('$aleph_search'(tree_besterror,_)), asserta('$aleph_search'(tree_besterror,besterror([Head|Body],Err0))), '$aleph_global'(atoms_left,atoms_left(pos,Pos)), aleph_delete(_,Body,Left), strip_negs(Left,Body1), aleph_mode_linked([Head|Body1]), list_to_clause([Head|Left],Clause), prove(Flags,pos,Clause,Pos,Ex1,_), node_stats(Tree,Ex1,PredictArg,Total-Distribution), leaf_prediction(Tree,Total-Distribution,_,Incorrect), estimate_error(Tree,Incorrect,Total,Upper), '$aleph_search'(tree_besterror,besterror(_,BestError)), Upper =< BestError, retract('$aleph_search'(tree_besterror,besterror(_,BestError))), asserta('$aleph_search'(tree_besterror,besterror([Head|Left],Upper))), fail. greedy_prune_rule1(_,_,_,_,_,Clause1,Err1):- retract('$aleph_search'(tree_besterror,besterror(Clause1,Err1))). strip_negs([],[]). strip_negs([not(L)|T],[L|T1]):- !, strip_negs(T,T1). strip_negs([L|T],[L|T1]):- strip_negs(T,T1). add_tree(_,Tree,Predict):- retract('$aleph_search'(tree_leaf,l(_,_,Leaf,Examples))), Leaf = [Clause,Cost,P], add_prediction(Tree,Clause,Predict,Examples,Clause1), p_message('best clause'), pp_dclause(Clause1), nlits(Clause,L), Gain is -Cost, asserta('$aleph_global'(hypothesis,hypothesis([P,0,L,Gain],Clause1,Examples,[]))), addhyp, fail. add_tree(_,_,_). add_prediction(Tree,Clause,PredictArg,Examples,Clause1):- split_clause(Clause,Head,_), (Tree = model -> setting(evalfn,Evalfn), add_model(Evalfn,Clause,PredictArg,Examples,Clause1,_,_); node_stats(Tree,Examples,PredictArg,Distribution), leaf_prediction(Tree,Distribution,Prediction,Error), tparg(PredictArg,Head,Var), add_prediction(Tree,Clause,Var,Prediction,Error,Clause1)). add_prediction(classification,Clause,Var,Prediction,_,Clause1):- extend_clause(Clause,(Var = Prediction),Clause1). add_prediction(class_probability,Clause,Var,Prediction,_,Clause1):- extend_clause(Clause,(random(Var,Prediction)),Clause1). add_prediction(regression,Clause,Var,Mean,Sd,Clause1):- extend_clause(Clause,(random(Var,normal(Mean,Sd))),Clause1). add_model(Evalfn,Clause,PredictArg,Examples,_,_,_):- retractall('$aleph_local'(tree_model,_,_,_)), Best is inf, split_clause(Clause,Head,_), tparg(PredictArg,Head,Var), asserta('$aleph_local'(tree_model,nil,0,Best)), '$aleph_global'(model,model(Name/Arity)), functor(Model,Name,Arity), auto_extend(Clause,Model,C), leaf_predicts(Arity,Model,Var), lazy_evaluate_refinement([],C,[Name/Arity],Examples,[],[],C1), find_model_error(Evalfn,Examples,C1,PredictArg,Total,Error), '$aleph_local'(tree_model,_,_,BestSoFar), (Error < BestSoFar -> retract('$aleph_local'(tree_model,_,_,_)), asserta('$aleph_local'(tree_model,C1,Total,Error)); true), fail. add_model(_,_,_,_,Clause,Total,Error):- retract('$aleph_local'(tree_model,Clause,Total,Error)). find_model_error(Evalfn,Examples,(Head:-Body),[PredictArg],T,E):- functor(Head,_,Arity), findall(Actual-Pred, (aleph_member(Interval,Examples), aleph_member3(N,Interval), example(N,pos,Example), copy_iargs(Arity,Example,Head,PredictArg), once(Body), arg(PredictArg,Head,Pred), arg(PredictArg,Example,Actual) ), L), sum_model_errors(L,Evalfn,0,0.0,T,E), !. sum_model_errors([],_,N,E,N,E). sum_model_errors([Act-Pred|T],Evalfn,NSoFar,ESoFar,N,E):- get_model_error(Evalfn,Act,Pred,E1), E1SoFar is ESoFar + E1, N1SoFar is NSoFar + 1, sum_model_errors(T,Evalfn,N1SoFar,E1SoFar,N,E). get_model_error(mse,Act,Pred,E):- E is (Act-Pred)^2. get_model_error(accuracy,Act,Pred,E):- (Act = Pred -> E is 0.0; E is 1.0). leaf_predicts(0,_,_):- !, fail. leaf_predicts(Arg,Model,Var):- arg(Arg,Model,Var1), var(Var1), Var1 == Var, !. leaf_predicts(Arg,Model,Var):- Arg1 is Arg - 1, leaf_predicts(Arg1,Model,Var). leaf_prediction(classification,Total-Distribution,Class,Incorrect):- find_maj_class(Distribution,N-Class), Incorrect is Total - N. leaf_prediction(class_probability,T1-D1,NDistr,0):- length(D1,NClasses), laplace_correct(D1,LaplaceD1), LaplaceTotal is T1 + NClasses, normalise_distribution(LaplaceD1,LaplaceTotal,NDistr). leaf_prediction(regression,_-[Mean,Sd],Mean,Sd). find_maj_class([X],X):- !. find_maj_class([N-Class|Rest],MajClass):- find_maj_class(Rest,N1-C1), (N > N1 -> MajClass = N-Class; MajClass = N1-C1). can_split(S,Type,Predict,Leaf,Left,Right):- arg(21,S,MinGain), '$aleph_search'(tree_leaf,l(Leaf,_,[Clause,Cost,N],Examples)), Cost >= MinGain, get_best_subtree(S,Type,Predict,[Clause,Cost,N],Examples,Gain,Left,Right), Gain >= MinGain, p_message('found clauses'), Left = [ClF,CostF|_], Right = [ClS,CostS|_], arg(4,S,_/Evalfn), pp_dclause(ClS), print_eval(Evalfn,CostS), pp_dclause(ClF), print_eval(Evalfn,CostF), p1_message('expected cost reduction'), p_message(Gain). get_best_subtree(S,Type,Predict,[Clause,Cost,N],Examples,Gain,Left,Right):- arg(42,S,Interactive), arg(43,S,LookAhead), retractall('$aleph_search'(tree_gain,_)), MInf is -inf, (Interactive = nil -> asserta('$aleph_search'(tree_gain,tree_gain(MInf,[],[]))); true), split_clause(Clause,Head,Body), arg(4,S,_/Evalfn), arg(13,S,MinPos), auto_refine(LookAhead,Clause,ClS), tree_refine_ok(Type,ClS), eval_treenode(S,Type,ClS,Predict,Examples,ExS,NS,CostS), NS >= MinPos, rm_intervals(ExS,Examples,ExF), split_clause(ClS,Head,Body1), get_goaldiffs(Body,Body1,Diff), extend_clause(Clause,not(Diff),ClF), eval_treenode(S,Type,ClF,Predict,ExF,NF,CostF), NF >= MinPos, AvLeafCost is (NS*CostS + NF*CostF)/N, CostReduction is Cost - AvLeafCost, (Interactive = nil -> pp_dclause(ClS), print_eval(Evalfn,CostS), pp_dclause(ClF), print_eval(Evalfn,CostF), p1_message('expected cost reduction'), p_message(CostReduction), '$aleph_search'(tree_gain,tree_gain(BestSoFar,_,_)), CostReduction > BestSoFar, retract('$aleph_search'(tree_gain,tree_gain(BestSoFar,_,_))), asserta('$aleph_search'(tree_gain,tree_gain(CostReduction, [ClF,CostF,NF,ExF], [ClS,CostS,NS,ExS]))); asserta('$aleph_search'(tree_gain,tree_gain(CostReduction, [ClF,CostF,NF,ExF], [ClS,CostS,NS,ExS])))), AvLeafCost =< 0.0, !, get_best_subtree(Interactive,Clause,Gain,Left,Right). get_best_subtree(S,_,_,[Clause|_],_,Gain,Left,Right):- arg(42,S,Interactive), get_best_subtree(Interactive,Clause,Gain,Left,Right). get_best_subtree(nil,_,Gain,Left,Right):- retract('$aleph_search'(tree_gain,tree_gain(Gain,Left,Right))), !. get_best_subtree(true,Clause,Gain,Left,Right):- nl, write('Extending path: '), nl, write('---------------'), nl, pp_dclause(Clause), findall(MCR-[Left,Right], ('$aleph_search'(tree_gain,tree_gain(CostReduction,Left,Right)), MCR is -1*CostReduction), SplitsList), keysort(SplitsList,Sorted), get_best_split(Clause,Sorted,Gain,Left,Right), retractall('$aleph_search'(tree_gain,_)). get_best_split(Clause,Splits,Gain,Left,Right):- show_split_list(Clause,Splits), ask_best_split(Splits,Gain,Left,Right). show_split_list(Clause,Splits):- tab(4), write('Split Information'), nl, tab(4), write('-----------------'), nl, nl, tab(4), write('No.'), tab(4), write('Split'), nl, tab(4), write('---'), tab(4), write('-----'), nl, show_split_list(Splits,1,Clause). show_split_list([],_,_). show_split_list([MCR-[[_,_,NF,_],[CLS,_,NS,_]]|Rest],SplitNum,Clause):- copy_term(Clause,ClauseCopy), split_clause(ClauseCopy,Head,Body), copy_term(CLS,CLSCopy), numbervars(CLSCopy,0,_), split_clause(CLSCopy,Head,Body1), get_goaldiffs(Body,Body1,Diff), Gain is -1*MCR, tab(4), write(SplitNum), tab(4), write(Diff), nl, tab(12), write('Succeeded (Right Branch): '), write(NS), nl, tab(12), write('Failed (Left Branch) : '), write(NF), nl, tab(12), write('Cost Reduction : '), write(Gain), nl, nl, NextSplit is SplitNum + 1, show_split_list(Rest,NextSplit,Clause). ask_best_split(Splits,Gain,Left,Right):- repeat, tab(4), write('-> '), write('Select Split Number (or "none.")'), nl, read(Answer), (Answer = none -> Gain is -inf, Left = [], Right = []; SplitNum is integer(Answer), aleph_remove_nth(SplitNum,Splits,MCR-[Left,Right],_), Gain is -1*MCR ), !. tree_refine_ok(model,Clause):- '$aleph_global'(model,model(Name/Arity)), functor(Model,Name,Arity), in(Clause,Model), !, fail. tree_refine_ok(_,_). eval_treenode(S,Tree,Clause,PredictArg,PCov,N,Cost):- arg(4,S,_/Evalfn), treenode_cost(Tree,Evalfn,Clause,PCov,PredictArg,N,Cost). eval_treenode(S,Tree,Clause,PredictArg,Pos,PCov,N,Cost):- arg(4,S,_/Evalfn), arg(13,S,MinPos), arg(14,S,Depth), arg(29,S,Time), arg(34,S,Proof), prove(Depth/Time/Proof,pos,Clause,Pos,PCov,PCount), PCount >= MinPos, treenode_cost(Tree,Evalfn,Clause,PCov,PredictArg,N,Cost). treenode_cost(model,Evalfn,Clause,Covered,PredictArg,Total,Cost):- !, add_model(Evalfn,Clause,PredictArg,Covered,_,Total,Cost). treenode_cost(Tree,Evalfn,_,Covered,PredictArg,Total,Cost):- node_stats(Tree,Covered,PredictArg,Total-Distribution), Total > 0, impurity(Tree,Evalfn,Total-Distribution,Cost). node_stats(Tree,Covered,PredictArg,D):- '$aleph_search'(tree_startdistribution,d(Tree,D0)), (Tree = regression -> cont_distribution(Covered,PredictArg,D0,D); discr_distribution(Covered,PredictArg,D0,D)). discr_distribution([],_,D,D). discr_distribution([S-F|Intervals],PredictArg,T0-D0,D):- discr_distribution(S,F,PredictArg,T0-D0,T1-D1), discr_distribution(Intervals,PredictArg,T1-D1,D). discr_distribution(N,F,_,D,D):- N > F, !. discr_distribution(N,F,PredictArg,T0-D0,D):- example(N,pos,Example), tparg(PredictArg,Example,Actual), N1 is N + 1, T1 is T0 + 1, (aleph_delete(C0-Actual,D0,D1) -> C1 is C0 + 1, discr_distribution(N1,F,PredictArg,T1-[C1-Actual|D1],D); discr_distribution(N1,F,PredictArg,T1-[1-Actual|D0],D)). cont_distribution([],_,T-[S,SS],T-[Mean,Sd]):- (T = 0 -> Mean = 0, Sd = 0; Mean is S/T, Sd is sqrt(SS/T - Mean*Mean)). cont_distribution([S-F|Intervals],PredictArg,T0-D0,D):- cont_distribution(S,F,PredictArg,T0-D0,T1-D1), cont_distribution(Intervals,PredictArg,T1-D1,D). cont_distribution(N,F,_,D,D):- N > F, !. cont_distribution(N,F,PredictArg,T0-[S0,SS0],D):- example(N,pos,Example), tparg(PredictArg,Example,Actual), N1 is N + 1, T1 is T0 + 1, S1 is S0 + Actual, SS1 is SS0 + Actual*Actual, cont_distribution(N1,F,PredictArg,T1-[S1,SS1],D). impurity(regression,sd,_-[_,Sd],Sd):- !. impurity(classification,entropy,Total-Distribution,Cost):- sum_entropy(Distribution,Total,S), Cost is -S/(Total*log(2)), !. impurity(classification,gini,Total-Distribution,Cost):- sum_gini(Distribution,Total,Cost), !. impurity(class_probability,entropy,Total-Distribution,Cost):- sum_entropy(Distribution,Total,S), Cost is -S/(Total*log(2)), !. impurity(class_probability,gini,Total-Distribution,Cost):- sum_gini(Distribution,Total,Cost), !. impurity(_,_,_,_):- err_message('inappropriate settings for tree_type and/or evalfn'), fail. sum_gini([],_,0). sum_gini([N-_|Rest],Total,Sum):- N > 0, !, sum_gini(Rest,Total,C0), P is N/Total, Sum is P*(1-P) + C0. sum_gini([_|Rest],Total,Sum):- sum_gini(Rest,Total,Sum). sum_entropy([],_,0). sum_entropy([N-_|Rest],Total,Sum):- N > 0, !, sum_entropy(Rest,Total,C0), Sum is N*log(N/Total) + C0. sum_entropy([_|Rest],Total,Sum):- sum_entropy(Rest,Total,Sum). % only binary splits % left = condition at node fails % right = condition at node succeeds split_leaf(Leaf,LeftTree,RightTree,[Left,Right]):- retract('$aleph_search'(tree_leaf,l(Leaf,Parent, [Clause,Cost,N],Examples))), gen_leaf(Left), gen_leaf(Right), LeftTree = [ClF,CostF,NF,ExF], RightTree = [ClS,CostS,NS,ExS], asserta('$aleph_search'(tree,t(Leaf,Parent,[Clause,Cost,N], Examples,Left,Right))), asserta('$aleph_search'(tree_leaf,l(Left,Leaf,[ClF,CostF,NF],ExF))), asserta('$aleph_search'(tree_leaf,l(Right,Leaf,[ClS,CostS,NS],ExS))). gen_leaf(Leaf1):- retract('$aleph_search'(tree_lastleaf,Leaf0)), !, Leaf1 is Leaf0 + 1, asserta('$aleph_search'(tree_lastleaf,Leaf1)). gen_leaf(0):- asserta('$aleph_search'(tree_lastleaf,0)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % G C W S % examine list of clauses to be specialised % generate an exception theory for each clause that covers negative examples gcws:- setting(evalfn,EvalFn), repeat, retract('$aleph_search'(sphyp,hypothesis([P,N,L|T],Clause,PCover,NCover))), (PCover = _/_ -> label_create(pos,Clause,Label1), extract_pos(Label1,PCover1), interval_count(PCover1,P1); PCover1 = PCover, P1 = P), (NCover = _/_ -> label_create(neg,Clause,Label2), extract_neg(Label2,NCover1), interval_count(NCover1,N1); NCover1 = NCover, N1 = N), (N1 = 0 -> NewClause = Clause, NewLabel = [P1,N1,L|T]; MinAcc is P1/(2*P1 - 1), set(minacc,MinAcc), set(noise,N1), gcws(Clause,PCover1,NCover1,NewClause), L1 is L + 1, complete_label(EvalFn,NewClause,[P,0,L1],NewLabel)), assertz('$aleph_search'(gcwshyp,hypothesis(NewLabel,NewClause,PCover1,[]))), \+('$aleph_search'(sphyp,hypothesis(_,_,_,_))), !. % gcws(+Clause,+PCvr,+NCvr,-Clause1) % specialise Clause that covers pos examples PCvr and neg examples NCvr % result is is Clause extended with a single negated literal % clauses in exception theory are added to list for specialisation gcws(Clause,PCover,NCover,Clause1):- gen_absym(AbName), split_clause(Clause,Head,Body), functor(Head,_,Arity), add_determinations(AbName/Arity,true), add_modes(AbName/Arity), gen_ab_examples(AbName/Arity,PCover,NCover), cwinduce, Head =.. [_|Args], AbLit =.. [AbName|Args], (Body = true -> Body1 = not(AbLit) ; app_lit(not(AbLit),Body,Body1)), Clause1 = (Head:-Body1). % greedy set-cover based construction of abnormality theory % starts with the first exceptional example % each clause obtained is added to list of clauses to be specialised cwinduce:- store(greedy), set(greedy,true), '$aleph_global'(atoms_left,atoms_left(pos,PosSet)), PosSet \= [], repeat, '$aleph_global'(atoms_left,atoms_left(pos,[Num-X|Y])), sat(Num), reduce, retract('$aleph_global'(hypothesis,hypothesis(Label,H,PCover,NCover))), asserta('$aleph_search'(sphyp,hypothesis(Label,H,PCover,NCover))), rm_seeds1(PCover,[Num-X|Y],NewPosLeft), retract('$aleph_global'(atoms_left,atoms_left(pos,[Num-X|Y]))), asserta('$aleph_global'(atoms_left,atoms_left(pos,NewPosLeft))), NewPosLeft = [], retract('$aleph_global'(atoms_left,atoms_left(pos,NewPosLeft))), reinstate(greedy), !. cwinduce. % gen_ab_examples(+Ab,+PCover,+NCover) % obtain examples for abnormality predicate Ab by % pos examples are copies of neg examples in NCover % neg examples are copies of pos examples in PCover % writes new examples to temporary ".f" and ".n" files % to ensure example/3 remains a static predicate % alters search parameters accordingly gen_ab_examples(Ab/_,PCover,NCover):- PosFile = '.alephtmp.f', NegFile = '.alephtmp.n', create_examples(PosFile,Ab,neg,NCover,pos,PCover1), create_examples(NegFile,Ab,pos,PCover,neg,NCover1), aleph_consult(PosFile), aleph_consult(NegFile), retractall('$aleph_global'(atoms_left,_)), retractall('$aleph_global'(size,_)), asserta('$aleph_global'(atoms_left,atoms_left(pos,PCover1))), asserta('$aleph_global'(atoms_left,atoms_left(neg,NCover1))), interval_count(PCover1,PSize), interval_count(NCover1,NSize), asserta('$aleph_global'(size,size(pos,PSize))), asserta('$aleph_global'(size,size(neg,NSize))), delete_file(PosFile), delete_file(NegFile). % create_examples(+File,+OldType,+OldE,+NewType,-NewE) % copy OldE examples of OldType to give NewE examples of NewType % copy stored in File create_examples(File,Ab,OldT,OldE,NewT,[Next-Last]):- '$aleph_global'(last_example,last_example(NewT,OldLast)), aleph_open(File,write,Stream), set_output(Stream), create_copy(OldE,OldT,NewT,Ab,OldLast,Last), close(Stream), set_output(user_output), Last > OldLast, !, retract('$aleph_global'(last_example,last_example(NewT,OldLast))), Next is OldLast + 1, asserta('$aleph_global'(last_example,last_example(NewT,Last))). create_examples(_,_,_,_,_,[]). create_copy([],_,_,_,L,L). create_copy([X-Y|T],OldT,NewT,Ab,Num,Last):- create_copy(X,Y,OldT,NewT,Ab,Num,Num1), create_copy(T,OldT,NewT,Ab,Num1,Last). create_copy(X,Y,_,_,_,L,L):- X > Y, !. create_copy(X,Y,OldT,NewT,Ab,Num,Last):- example(X,OldT,Example), Example =.. [_|Args], NewExample =.. [Ab|Args], Num1 is Num + 1, aleph_writeq(example(Num1,NewT,NewExample)), write('.'), nl, X1 is X + 1, create_copy(X1,Y,OldT,NewT,Ab,Num1,Last). % gen_absym(-Name) % generate new abnormality predicate symbol gen_absym(Name):- (retract('$aleph_global'(last_ab,last_ab(N))) -> N1 is N + 1; N1 is 0), asserta('$aleph_global'(last_ab,last_ab(N1))), concat([ab,N1],Name). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % C L A U S E O P T I M I S A T I O N S optimise(Clause,Clause1):- remove_redundant(Clause,Clause0), reorder_clause(Clause0,Clause1). remove_redundant((Head:-Body),(Head1:-Body1)):- goals_to_list((Head,Body),ClauseL), remove_subsumed(ClauseL,[Head1|Body1L]), (Body1L = [] -> Body1 = true; list_to_goals(Body1L,Body1)). reorder_clause((Head:-Body), Clause) :- % term_variables(Head,LHead), vars_in_term([Head],[],LHead), number_goals_and_get_vars(Body,LHead,1,_,[],Conj), calculate_independent_sets(Conj,[],BSets), compile_clause(BSets,Head,Clause). number_goals_and_get_vars((G,Body),LHead,I0,IF,L0,[g(I0,LVF,NG)|LGs]) :- !, I is I0+1, get_goal_vars(G,LHead,LVF,NG), number_goals_and_get_vars(Body,LHead,I,IF,L0,LGs). number_goals_and_get_vars(G,LHead,I,I,L0,[g(I,LVF,NG)|L0]) :- get_goal_vars(G,LHead,LVF,NG). get_goal_vars(G,LHead,LVF,G) :- % term_variables(G,LV0), vars_in_term([G],[],LVI), aleph_ord_subtract(LVI,LHead,LVF). calculate_independent_sets([],BSets,BSets). calculate_independent_sets([G|Ls],BSets0,BSetsF) :- add_goal_to_set(G,BSets0,BSetsI), calculate_independent_sets(Ls,BSetsI,BSetsF). add_goal_to_set(g(I,LV,G),Sets0,SetsF) :- add_to_sets(Sets0,LV,[g(I,LV,G)],SetsF). add_to_sets([],LV,Gs,[[LV|Gs]]). add_to_sets([[LV|Gs]|Sets0],LVC,GsC,[[LV|Gs]|SetsF]) :- aleph_ord_disjoint(LV,LVC), !, add_to_sets(Sets0,LVC,GsC,SetsF). add_to_sets([[LV|Gs]|Sets0],LVC,GsC,SetsF) :- aleph_ord_union(LV,LVC,LVN), join_goals(Gs,GsC,GsN), add_to_sets(Sets0,LVN,GsN,SetsF). join_goals([],L,L):- !. join_goals(L,[],L):- !. join_goals([g(I1,VL1,G1)|T],[g(I2,VL2,G2)|T2],Z) :- I1 < I2, !, Z = [g(I1,VL1,G1)|TN], join_goals(T,[g(I2,VL2,G2)|T2],TN). join_goals([H|T],[g(I2,VL2,G2)|T2],Z) :- Z = [g(I2,VL2,G2)|TN], join_goals(T,[H|T2],TN). compile_clause(Goals,Head,(Head:-Body)):- compile_clause2(Goals,Body). compile_clause2([[_|B]], B1):- !, glist_to_goals(B,B1). compile_clause2([[_|B]|Bs],(B1,!,NB)):- glist_to_goals(B,B1), compile_clause2(Bs,NB). glist_to_goals([g(_,_,Goal)],Goal):- !. glist_to_goals([g(_,_,Goal)|Goals],(Goal,Goals1)):- glist_to_goals(Goals,Goals1). % remove literals subsumed in the body of a clause remove_subsumed([Head|Lits],Lits1):- delete(Lit,Lits,Left), \+(\+(redundant(Lit,[Head|Lits],[Head|Left]))), !, remove_subsumed([Head|Left],Lits1). remove_subsumed(L,L). % determine if Lit is subsumed by a body literal redundant(Lit,Lits,[Head|Body]):- copy_term([Head|Body],Rest1), member(Lit1,Body), Lit = Lit1, aleph_subsumes(Lits,Rest1). aleph_subsumes(Lits,Lits1):- \+(\+((numbervars(Lits,0,_),numbervars(Lits1,0,_),aleph_subset1(Lits,Lits1)))). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % S A T / R E D U C E sat(Num):- integer(Num), example(Num,pos,_), sat(pos,Num), !. sat(Example):- record_example(check,uspec,Example,Num), sat(uspec,Num), !. sat(Type,Num):- setting(construct_bottom,nil), !, sat_prelims, example(Num,Type,Example), broadcast(start(sat(Num))), p1_message('sat'), p_message(Num), p_message(Example), record_sat_example(Num), asserta('$aleph_sat'(example,example(Num,Type))), asserta('$aleph_sat'(hovars,[])), broadcast(end(sat(Num, 0, 0.0))). sat(Type,Num):- setting(construct_bottom,reduction), !, sat_prelims, example(Num,Type,Example), broadcast(start(sat(Num))), p1_message('sat'), p_message(Num), p_message(Example), record_sat_example(Num), asserta('$aleph_sat'(example,example(Num,Type))), integrate_head_lit(HeadOVars), asserta('$aleph_sat'(hovars,HeadOVars)), broadcast(end(sat(Num, 0, 0.0))). sat(Type,Num):- set(stage,saturation), sat_prelims, example(Num,Type,Example), broadcast(start(sat(Num))), p1_message('sat'), p_message(Num), p_message(Example), record_sat_example(Num), asserta('$aleph_sat'(example,example(Num,Type))), split_args(Example,Mode,Input,Output,Constants), integrate_args(unknown,Example,Output), stopwatch(StartClock), assertz('$aleph_sat_atom'(Example,mode(Mode,Output,Input,Constants))), '$aleph_global'(i,set(i,Ival)), flatten(0,Ival,0,Last1), '$aleph_sat_litinfo'(1,_,Atom,_,_,_), get_vars(Atom,Output,HeadOVars), asserta('$aleph_sat'(hovars,HeadOVars)), get_vars(Atom,Input,HeadIVars), asserta('$aleph_sat'(hivars,HeadIVars)), functor(Example,Name,Arity), get_determs(Name/Arity,L), ('$aleph_global'(determination,determination(Name/Arity,'='/2))-> asserta('$aleph_sat'(eq,true)); asserta('$aleph_sat'(eq,nil))), get_atoms(L,1,Ival,Last1,Last), stopwatch(StopClock), Time is StopClock - StartClock, asserta('$aleph_sat'(lastlit,Last)), asserta('$aleph_sat'(botsize,Last)), update_generators, rm_moderepeats(Last,Repeats), rm_commutative(Last,Commutative), rm_symmetric(Last,Symmetric), rm_redundant(Last,Redundant), rm_uselesslits(Last,NotConnected), rm_nreduce(Last,NegReduced), TotalLiterals is Last-Repeats-NotConnected-Commutative-Symmetric-Redundant-NegReduced, show(bottom), p1_message('literals'), p_message(TotalLiterals), p1_message('saturation timeit'), p_message(Time), broadcast(end(sat(Num, TotalLiterals, Time))), store(bottom), noset(stage). sat(_,_):- noset(stage). reduce:- setting(search,Search), catch(reduce(Search),abort,reinstate_values), !. % no search: add bottom clause as hypothesis reduce(nil):- !, add_bottom. % iterative beam search as described by Ross Quinlan+MikeCameron-Jones,IJCAI-95 reduce(ibs):- !, retractall('$aleph_search'(ibs_rval,_)), retractall('$aleph_search'(ibs_nodes,_)), retractall('$aleph_search'(ibs_selected,_)), store_values([openlist,caching,explore]), set(openlist,1), set(caching,true), set(explore,true), asserta('$aleph_search'(ibs_rval,1.0)), asserta('$aleph_search'(ibs_nodes,0)), setting(evalfn,Evalfn), get_start_label(Evalfn,Label), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(ibs_selected,selected(Label,(Example:-true), [Num-Num],[]))); asserta('$aleph_search'(ibs_selected,selected(Label,(nil:-true), [],[])))), stopwatch(Start), repeat, setting(openlist,OldOpen), p1_message('ibs beam width'), p_message(OldOpen), find_clause(bf), '$aleph_search'(current,current(_,Nodes0,[PC,NC|_]/_)), N is NC + PC, estimate_error_rate(Nodes0,0.5,N,NC,NewR), p1_message('ibs estimated error'), p_message(NewR), retract('$aleph_search'(ibs_rval,OldR)), retract('$aleph_search'(ibs_nodes,Nodes1)), '$aleph_search'(selected,selected(BL,RCl,PCov,NCov)), NewOpen is 2*OldOpen, Nodes2 is Nodes0 + Nodes1, set(openlist,NewOpen), asserta('$aleph_search'(ibs_rval,NewR)), asserta('$aleph_search'(ibs_nodes,Nodes2)), ((NewR >= OldR; NewOpen > 512) -> true; retract('$aleph_search'(ibs_selected,selected(_,_,_,_))), asserta('$aleph_search'(ibs_selected,selected(BL,RCl,PCov,NCov))), fail), !, stopwatch(Stop), Time is Stop - Start, retractall('$aleph_search'(ibs_rval,_)), retract('$aleph_search'(ibs_nodes,Nodes)), retract('$aleph_search'(ibs_selected,selected(BestLabel,RClause,PCover,NCover))), add_hyp(BestLabel,RClause,PCover,NCover), p1_message('ibs clauses constructed'), p_message(Nodes), p1_message('ibs search timeit'), p_message(Time), p_message('ibs best clause'), pp_dclause(RClause), show_stats(Evalfn,BestLabel), record_search_stats(RClause,Nodes,Time), reinstate_values([openlist,caching,explore]). % iterative deepening search reduce(id):- !, retractall('$aleph_search'(id_nodes,_)), retractall('$aleph_search'(id_selected,_)), store_values([caching,clauselength]), setting(clauselength,MaxCLen), set(clauselength,1), set(caching,true), asserta('$aleph_search'(id_nodes,0)), setting(evalfn,Evalfn), get_start_label(Evalfn,Label), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(id_selected,selected(Label,(Example:-true), [Num-Num],[]))); asserta('$aleph_search'(id_selected,selected(Label,(nil:-true), [],[])))), stopwatch(Start), repeat, setting(clauselength,OldCLen), p1_message('id clauselength setting'), p_message(OldCLen), find_clause(df), '$aleph_search'(current,current(_,Nodes0,_)), retract('$aleph_search'(id_nodes,Nodes1)), '$aleph_search'(selected,selected([P,N,L,F|T],RCl,PCov,NCov)), '$aleph_search'(id_selected,selected([_,_,_,F1|_],_,_,_)), NewCLen is OldCLen + 1, Nodes2 is Nodes0 + Nodes1, set(clauselength,NewCLen), '$aleph_search'(id_nodes,Nodes2), (F1 >= F -> true; retract('$aleph_search'(id_selected,selected([_,_,_,F1|_],_,_,_))), asserta('$aleph_search'(id_selected,selected([P,N,L,F|T],RCl,PCov,NCov))), set(best,[P,N,L,F|T])), NewCLen > MaxCLen, !, stopwatch(Stop), Time is Stop - Start, retract('$aleph_search'(id_nodes,Nodes)), retract('$aleph_search'(id_selected,selected(BestLabel,RClause,PCover,NCover))), add_hyp(BestLabel,RClause,PCover,NCover), p1_message('id clauses constructed'), p_message(Nodes), p1_message('id search timeit'), p_message(Time), p_message('id best clause'), pp_dclause(RClause), show_stats(Evalfn,BestLabel), record_search_stats(RClause,Nodes,Time), noset(best), reinstate_values([caching,clauselength]). % iterative language search as described by Rui Camacho, 1996 reduce(ils):- !, retractall('$aleph_search'(ils_nodes,_)), retractall('$aleph_search'(ils_selected,_)), store_values([caching,language]), set(searchstrat,bf), set(language,1), set(caching,true), asserta('$aleph_search'(ils_nodes,0)), setting(evalfn,Evalfn), get_start_label(Evalfn,Label), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(ils_selected,selected(Label,(Example:-true), [Num-Num],[]))); asserta('$aleph_search'(ils_selected,selected(Label,(nil:-true), [],[])))), stopwatch(Start), repeat, setting(language,OldLang), p1_message('ils language setting'), p_message(OldLang), find_clause(bf), '$aleph_search'(current,current(_,Nodes0,_)), retract('$aleph_search'(ils_nodes,Nodes1)), '$aleph_search'(selected,selected([P,N,L,F|T],RCl,PCov,NCov)), '$aleph_search'(ils_selected,selected([_,_,_,F1|_],_,_,_)), NewLang is OldLang + 1, Nodes2 is Nodes0 + Nodes1, set(language,NewLang), asserta('$aleph_search'(ils_nodes,Nodes2)), (F1 >= F -> true; retract('$aleph_search'(ils_selected,selected([_,_,_,F1|_],_,_,_))), asserta('$aleph_search'(ils_selected,selected([P,N,L,F|T],RCl,PCov,NCov))), set(best,[P,N,L,F|T]), fail), !, stopwatch(Stop), Time is Stop - Start, retract('$aleph_search'(ils_nodes,Nodes)), retract('$aleph_search'(ils_selected,selected(BestLabel,RClause,PCover,NCover))), add_hyp(BestLabel,RClause,PCover,NCover), p1_message('ils clauses constructed'), p_message(Nodes), p1_message('ils search timeit'), p_message(Time), p_message('ils best clause'), pp_dclause(RClause), show_stats(Evalfn,BestLabel), record_search_stats(RClause,Nodes,Time), noset(best), reinstate_values([caching,language]). % implementation of a randomised local search for clauses % currently, this can use either: simulated annealing with a fixed temp % or a GSAT-like algorithm % the choice of these is specified by the parameter: rls_type % both annealing and GSAT employ random multiple restarts % and a limit on the number of moves % the number of restarts is specified by set(tries,...) % the number of moves is specified by set(moves,...) % annealing currently restricted to using a fixed temperature % the temperature is specified by set(temperature,...) % the use of a fixed temp. makes it equivalent to the Metropolis alg. % GSAT if given a ``random-walk probability'' performs Selman et als walksat % the walk probability is specified by set(walk,...) % a walk probability of 0 is equivalent to doing standard GSAT reduce(rls):- !, setting(tries,MaxTries), MaxTries >= 1, store_values([caching,refine,refineop]), set(searchstrat,heuristic), set(caching,true), setting(refine,Refine), (Refine \= nil -> true; set(refineop,rls)), setting(threads,Threads), rls_search(Threads, MaxTries, Time, Nodes, selected(BestLabel, RBest,PCover,NCover)), add_hyp(BestLabel,RBest,PCover,NCover), p1_message('rls nodes constructed'), p_message(Nodes), p1_message('rls search timeit'), p_message(Time), p_message('rls best result'), pp_dclause(RBest), setting(evalfn,Evalfn), show_stats(Evalfn,BestLabel), record_search_stats(RBest,Nodes,Time), noset(best), reinstate_values([caching,refine,refineop]). % stochastic clause selection based on ordinal optimisation % see papers by Y.C. Ho and colleagues for more details reduce(scs):- !, store_values([tries,moves,rls_type,clauselength_distribution]), stopwatch(Start), (setting(scs_sample,SampleSize) -> true; setting(scs_percentile,K), K > 0.0, setting(scs_prob,P), P < 1.0, SampleSize is integer(log(1-P)/log(1-K/100) + 1)), (setting(scs_type,informed)-> (setting(clauselength_distribution,D) -> true; setting(clauselength,CL), estimate_clauselength_distribution(CL,100,K,D), % max_in_list(D,Prob-Length), % p1_message('using clauselength distribution'), % p_message([Prob-Length]), % set(clauselength_distribution,[Prob-Length])); p1_message('using clauselength distribution'), p_message(D), set(clauselength_distribution,D)); true), set(tries,SampleSize), set(moves,0), set(rls_type,gsat), reduce(rls), stopwatch(Stop), Time is Stop - Start, '$aleph_search'(rls_nodes,Nodes), '$aleph_search'(rls_selected,selected(BestLabel,RBest,_,_)), p1_message('scs nodes constructed'), p_message(Nodes), p1_message('scs search timeit'), p_message(Time), p_message('scs best result'), pp_dclause(RBest), setting(evalfn,Evalfn), show_stats(Evalfn,BestLabel), record_search_stats(RBest,Nodes,Time), p1_message('scs search timeit'), p_message(Time), reinstate_values([tries,moves,rls_type,clauselength_distribution]). % simple association rule search % For a much more sophisticated approach see: L. Dehaspe, PhD Thesis, 1998 % Here, simply find all rules within search that cover at least % a pre-specificed fraction of the positive examples reduce(ar):- !, clear_cache, (setting(pos_fraction,PFrac) -> true; p_message('value required for pos_fraction parameter'), fail), '$aleph_global'(atoms_left,atoms_left(pos,Pos)), retract('$aleph_global'(atoms_left,atoms_left(neg,Neg))), interval_count(Pos,P), MinPos is PFrac*P, store_values([minpos,evalfn,explore,caching,minacc,good]), set(searchstrat,bf), set(minpos,MinPos), set(evalfn,coverage), set(explore,true), set(caching,true), set(minacc,0.0), set(good,true), asserta('$aleph_global'(atoms_left,atoms_left(neg,[]))), find_clause(bf), show(good), retract('$aleph_global'(atoms_left,atoms_left(neg,[]))), asserta('$aleph_global'(atoms_left,atoms_left(neg,Neg))), reinstate_values([minpos,evalfn,explore,caching,minacc,good]). % search for integrity constraints % modelled on the work by L. De Raedt and L. Dehaspe, 1996 reduce(ic):- !, store_values([minpos,minscore,evalfn,explore,refineop]), setting(refineop,RefineOp), (RefineOp = nil -> set(refineop,auto); true), set(minpos,0), set(searchstrat,bf), set(evalfn,coverage), set(explore,true), setting(noise,N), MinScore is -N, set(minscore,MinScore), find_clause(bf), reinstate_values([minpos,minscore,evalfn,explore,refineop]). reduce(bf):- !, find_clause(bf). reduce(df):- !, find_clause(df). reduce(heuristic):- !, find_clause(heuristic). % find_clause(Search) where Search is one of bf, df, heuristic find_clause(Search):- set(stage,reduction), set(searchstrat,Search), p_message('reduce'), reduce_prelims(L,P,N), asserta('$aleph_search'(openlist,[])), get_search_settings(S), arg(4,S,_/Evalfn), get_start_label(Evalfn,Label), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(selected,selected(Label,(Example:-true), [Num-Num],[]))); asserta('$aleph_search'(selected,selected(Label,(nil:-true),[],[])))), arg(13,S,MinPos), interval_count(P,PosLeft), PosLeft >= MinPos, '$aleph_search'(selected,selected(L0,C0,P0,N0)), add_hyp(L0,C0,P0,N0), ('$aleph_global'(max_set,max_set(Type,Num,Label1,ClauseNum))-> BestSoFar = Label1/ClauseNum; ('$aleph_global'(best,set(best,Label2))-> BestSoFar = Label2/0; BestSoFar = Label/0)), asserta('$aleph_search'(best_label,BestSoFar)), p1_message('best label so far'), p_message(BestSoFar), arg(3,S,RefineOp), stopwatch(StartClock), (RefineOp = nil -> get_gains(S,0,BestSoFar,[],nil,[],0,L,[1],P,N,[],1,Last,NextBest), update_max_head_count(0,Last); clear_cache, interval_count(P,MaxPC), asserta('$aleph_local'(max_head_count,MaxPC)), StartClause = 0-[Num,Type,[],nil], get_gains(S,0,BestSoFar,StartClause,_,_,_,L,[StartClause], P,N,[],1,Last,NextBest)), asserta('$aleph_search_expansion'(1,0,1,Last)), get_nextbest(S,_), asserta('$aleph_search'(current,current(1,Last,NextBest))), search(S,Nodes), stopwatch(StopClock), Time is StopClock - StartClock, '$aleph_search'(selected,selected(BestLabel,RClause,PCover,NCover)), retract('$aleph_search'(openlist,_)), add_hyp(BestLabel,RClause,PCover,NCover), p1_message('clauses constructed'), p_message(Nodes), p1_message('search timeit'), p_message(Time), p_message('best clause'), pp_dclause(RClause), show_stats(Evalfn,BestLabel), update_search_stats(Nodes,Time), record_search_stats(RClause,Nodes,Time), noset(stage), !. find_clause(_):- '$aleph_search'(selected,selected(BestLabel,RClause,PCover,NCover)), retract('$aleph_search'(openlist,_)), add_hyp(BestLabel,RClause,PCover,NCover), p_message('best clause'), pp_dclause(RClause), (setting(evalfn,Evalfn) -> true; Evalfn = coverage), show_stats(Evalfn,BestLabel), noset(stage), !. % find_theory(Search) where Search is rls only at present find_theory(rls):- !, retractall('$aleph_search'(rls_move,_)), retractall('$aleph_search'(rls_nodes,_)), retractall('$aleph_search'(rls_parentstats,_)), retractall('$aleph_search'(rls_selected,_)), setting(tries,MaxTries), MaxTries >= 1, store_values([caching,store_bottom]), set(caching,nil), set(store_bottom,true), '$aleph_global'(atoms,atoms(pos,PosSet)), '$aleph_global'(atoms,atoms(neg,NegSet)), interval_count(PosSet,P0), interval_count(NegSet,N0), setting(evalfn,Evalfn), complete_label(Evalfn,[0-[0,0,[],nil]],[P0,N0,1],Label), asserta('$aleph_search'(rls_selected,selected(Label,[0-[0,0,[],nil]], PosSet,NegSet))), asserta('$aleph_search'(rls_nodes,0)), asserta('$aleph_search'(rls_restart,1)), get_search_settings(S), set(best,Label), stopwatch(Start), repeat, retractall('$aleph_search'(rls_parentstats,_)), retractall('$aleph_search'(rls_move,_)), retractall('$aleph_search_seen'(_,_)), asserta('$aleph_search'(rls_move,1)), asserta('$aleph_search'(rls_parentstats,stats(Label,PosSet,NegSet))), '$aleph_search'(rls_restart,R), p1_message('restart'), p_message(R), find_theory1(rls), '$aleph_search'(current,current(_,Nodes0,_)), retract('$aleph_search'(rls_nodes,Nodes1)), '$aleph_search'(selected,selected([P,N,L,F|T],RCl,PCov,NCov)), '$aleph_search'(rls_selected,selected([_,_,_,F1|_],_,_,_)), retract('$aleph_search'(rls_restart,R)), R1 is R + 1, asserta('$aleph_search'(rls_restart,R1)), Nodes2 is Nodes0 + Nodes1, asserta('$aleph_search'(rls_nodes,Nodes2)), (F1 >= F -> true; retract('$aleph_search'(rls_selected,selected([_,_,_,F1|_],_,_,_))), asserta('$aleph_search'(rls_selected,selected([P,N,L,F|T],RCl,PCov,NCov))), set(best,[P,N,L,F|T])), setting(best,BestSoFar), (R1 > MaxTries;discontinue_search(S,BestSoFar/_,Nodes2)), !, stopwatch(Stop), Time is Stop - Start, '$aleph_search'(rls_nodes,Nodes), '$aleph_search'(rls_selected,selected(BestLabel,RBest,PCover,NCover)), add_hyp(BestLabel,RBest,PCover,NCover), p1_message('nodes constructed'), p_message(Nodes), p1_message('search timeit'), p_message(Time), p_message('best theory'), pp_dclauses(RBest), show_stats(Evalfn,BestLabel), record_search_stats(RBest,Nodes,Time), noset(best), reinstate_values([caching,refine,refineop,store_bottom]). find_theory1(_):- clean_up_reduce, '$aleph_global'(atoms,atoms(pos,Pos)), '$aleph_global'(atoms,atoms(neg,Neg)), asserta('$aleph_search'(openlist,[])), asserta('$aleph_search'(nextnode,none)), stopwatch(StartClock), get_search_settings(S), arg(4,S,_/Evalfn), interval_count(Pos,P), interval_count(Neg,N), complete_label(Evalfn,[0-[0,0,[],nil]],[P,N,1],Label), asserta('$aleph_search'(selected,selected(Label,[0-[0,0,[],nil]],Pos,Neg))), get_theory_gain(S,0,Label/0,[0-[0,0,[],nil]],Pos,Neg,P,N,NextBest,Last), asserta('$aleph_search'(current,current(0,Last,NextBest))), get_nextbest(S,_), tsearch(S,Nodes), stopwatch(StopClock), Time is StopClock - StartClock, '$aleph_search'(selected,selected(BestLabel,RTheory,PCover,NCover)), retract('$aleph_search'(openlist,_)), add_hyp(BestLabel,RTheory,PCover,NCover), p1_message('theories constructed'), p_message(Nodes), p1_message('search timeit'), p_message(Time), p_message('best theory'), pp_dclauses(RTheory), show_stats(Evalfn,BestLabel), update_search_stats(Nodes,Time), record_tsearch_stats(RTheory,Nodes,Time). estimate_error_rate(H,Del,N,E,R):- TargetProb is 1-exp(log(1-Del)/H), estimate_error(1.0/0.0,0.0/1.0,TargetProb,N,E,R). estimate_error(L/P1,U/P2,P,N,E,R):- M is (L+U)/2, binom_lte(N,M,E,P3), ADiff is abs(P - P3), (ADiff < 0.00001 -> R is M; (P3 > P -> estimate_error(L/P1,M/P3,P,N,E,R); estimate_error(M/P3,U/P2,P,N,E,R) ) ). zap_rest(Lits):- retract('$aleph_sat_litinfo'(LitNum,Depth,Atom,I,O,D)), (aleph_member1(LitNum,Lits) -> intersect1(Lits,D,D1,_), asserta('$aleph_sat_litinfo'(LitNum,Depth,Atom,I,O,D1)); true), fail. zap_rest(_). sat_prelims:- clean_up_sat, clean_up_hypothesis, reset_counts, set_up_builtins. reduce_prelims(L,P,N):- clean_up_reduce, check_posonly, check_auto_refine, ('$aleph_sat'(lastlit,L) -> true; L = 0, asserta('$aleph_sat'(lastlit,L))), ('$aleph_sat'(botsize,B) -> true; B = 0, asserta('$aleph_sat'(botsize,B))), (('$aleph_global'(lazy_evaluate,lazy_evaluate(_));setting(greedy,true))-> '$aleph_global'(atoms_left,atoms_left(pos,P)); '$aleph_global'(atoms,atoms(pos,P))), setting(evalfn,E), (E = posonly -> NType = rand; NType = neg), '$aleph_global'(atoms_left,atoms_left(NType,N)), asserta('$aleph_search'(nextnode,none)). set_up_builtins:- gen_nlitnum(Cut), asserta('$aleph_sat_litinfo'(Cut,0,'!',[],[],[])). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % T H R E A D S % multi-threaded randomised local search rls_search(1, MaxTries, Time, Nodes, Selected) :- !, retractall('$aleph_search'(rls_restart,_)), retractall('$aleph_search'(rls_nodes,_)), retractall('$aleph_search'(rls_selected,_)), asserta('$aleph_search'(rls_restart,1)), setting(evalfn,Evalfn), get_start_label(Evalfn,Label), set(best,Label), get_search_settings(S), arg(4,S,SearchStrat/_), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(rls_selected,selected(Label, (Example:-true),[Num-Num],[]))); asserta('$aleph_search'(rls_selected,selected(Label, (nil:-true),[],[]))) ), asserta('$aleph_search'(rls_nodes,0)), stopwatch(Start), estimate_numbers(_), repeat, retract('$aleph_search'(rls_restart,R)), R1 is R + 1, asserta('$aleph_search'(rls_restart,R1)), rls_thread(R, SearchStrat, Label, Nodes0, selected(Best,RCl,PCov,NCov)), Best = [_,_,_,F|_], '$aleph_search'(rls_selected,selected([_,_,_,F1|_],_,_,_)), (F1 >= F -> true; retract('$aleph_search'(rls_selected,selected([_,_,_,F1|_], _,_,_))), asserta('$aleph_search'(rls_selected,selected(Best,RCl, PCov,NCov))), set(best,Best) ), setting(best,BestSoFar), retract('$aleph_search'(rls_nodes,Nodes1)), Nodes2 is Nodes0 + Nodes1, asserta('$aleph_search'(rls_nodes,Nodes2)), (R1 > MaxTries; discontinue_search(S,BestSoFar/_,Nodes2)), !, stopwatch(Stop), Time is Stop - Start, retractall('$aleph_search'(rls_restart,_)), retract('$aleph_search'(rls_nodes,Nodes)), retract('$aleph_search'(rls_selected,Selected)). rls_search(N, MaxTries, Time, Nodes, Selected) :- retractall('$aleph_search'(rls_restart,_)), retractall('$aleph_search'(rls_nodes,_)), retractall('$aleph_search'(rls_selected,_)), setting(evalfn,Evalfn), get_start_label(Evalfn,Label), set(best,Label), get_search_settings(S), arg(4,S,SearchStrat/_), ('$aleph_sat'(example,example(Num,Type)) -> example(Num,Type,Example), asserta('$aleph_search'(rls_selected,selected(Label, (Example:-true),[Num-Num],[]))); asserta('$aleph_search'(rls_selected,selected(Label, (nil:-true),[],[]))) ), asserta('$aleph_search'(rls_nodes,0)), estimate_numbers(_), % so all threads can use same estimates thread_self(Master), message_queue_create(Queue), create_worker_pool(N, Master, Queue, WorkerIds), forall(between(1, MaxTries, R), thread_send_message(Queue, rls_restart(R, SearchStrat, Label))), collect_results(rls_restart,MaxTries,[0,S],[Time|_]), kill_worker_pool(Queue, WorkerIds), retractall('$aleph_search'(rls_restart,_)), retract('$aleph_search'(rls_nodes,Nodes)), retract('$aleph_search'(rls_selected,Selected)). rls_thread(R, SearchStrat, Label, Nodes0, selected(Best,RCl,PCov,NCov)) :- retractall('$aleph_search'(best_refinement,_)), retractall('$aleph_search'(last_refinement,_)), retractall('$aleph_search'(rls_move,_)), retractall('$aleph_search'(rls_parentstats,_)), retractall('$aleph_search_seen'(_,_)), asserta('$aleph_search'(rls_move,1)), asserta('$aleph_search'(rls_parentstats,stats(Label,[],[]))), p1_message('restart'), p_message(R), find_clause(SearchStrat), '$aleph_search'(current,current(_,Nodes0,_)), '$aleph_search'(selected,selected(Best,RCl,PCov,NCov)), retractall('$aleph_search'(best_refinement,_)), retractall('$aleph_search'(last_refinement,_)), retractall('$aleph_search'(rls_move,_)), retractall('$aleph_search'(rls_parentstats,_)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % T H R E A D S create_worker_pool(N, Master, Queue, WorkerIds) :- create_worker_pool(1, N, Master, Queue, WorkerIds). create_worker_pool(I, N, _, _, []) :- I > N, !. create_worker_pool(I, N, Master, Queue, [Id|T]) :- atom_concat(worker_, I, Alias), thread_create(worker(Queue, Master), Id, [alias(Alias)]), I2 is I + 1, create_worker_pool(I2, N, Master, Queue, T). kill_worker_pool(Queue, WorkerIds) :- p_message('Killing workers'), forall(aleph_member(Worker, WorkerIds), kill_worker(Queue, Worker)), p_message('Waiting for workers'), forall(aleph_member(Worker, WorkerIds), thread_join(Worker, _)), message_queue_destroy(Queue), p_message('Ok, all done'). kill_worker(Queue, Worker) :- thread_send_message(Queue, all_done), thread_signal(Worker, throw(surplus_to_requirements)). worker(Queue, Master) :- thread_get_message(Queue, Message), work(Message, Master), worker(Queue, Master). work(rls_restart(R, SearchStrat, Label), Master) :- statistics(cputime, CPU0), rls_thread(R, SearchStrat, Label, Nodes, Selected), statistics(cputime, CPU1), CPU is CPU1 - CPU0, thread_send_message(Master, done(CPU, Nodes, Selected)). work(all_done, _) :- thread_exit(done). collect_results(rls_restart,NResults,In,Out):- collect_results(0,NResults,rls_restart,In,Out). collect_results(R0,MaxR,Flag,In,Out):- thread_get_message(Message), collect(Flag,Message,In,Out1,Done), R1 is R0 + 1, ( (Done == nil, R1 < MaxR) -> collect_results(R1,MaxR,Flag,Out1,Out) ; Out = Out1 ). collect(rls_restart,done(CPU, Nodes, selected(Best,RCl,PCov,NCov)),[T0,S], [T1,S],Done) :- T1 is CPU + T0, Best = [_,_,_,F|_], '$aleph_search'(rls_selected,selected([_,_,_,F1|_],_,_,_)), (F1 >= F -> true; retract('$aleph_search'(rls_selected,selected( [_,_,_,F1|_],_,_,_))), asserta('$aleph_search'(rls_selected,selected(Best, RCl,PCov,NCov))), set(best,Best)), setting(best,BestSoFar), retract('$aleph_search'(rls_nodes,Nodes1)), Nodes2 is Nodes + Nodes1, asserta('$aleph_search'(rls_nodes,Nodes2)), ( discontinue_search(S,BestSoFar/_,Nodes2) -> Done = true ; Done = nil ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % C O N T R O L % induce_clauses/0: the basic theory construction predicate % constructs theories 1 clause at a timeit induce_clauses:- setting(interactive,true), !, induce_incremental. induce_clauses:- induce. % induce/0: non-interactive theory construction % constructs theories 1 clause at a timeit % does greedy cover removal after each clause found induce:- clean_up, set(greedy,true), retractall('$aleph_global'(search_stats,search_stats(_,_))), '$aleph_global'(atoms_left,atoms_left(pos,PosSet)), PosSet \= [], store(portray_search), set(portray_search,nil), setting(samplesize,S), setting(abduce,Abduce), record_settings, stopwatch(StartClock), repeat, gen_sample(pos,S), retractall('$aleph_global'(besthyp,besthyp(_,_,_,_,_))), asserta('$aleph_global'(besthyp,besthyp([-inf,0,1,-inf],0,(nil),[],[]))), get_besthyp(Abduce), (setting(gcws,true) -> sphyp, addgcws; addhyp), show_atoms_left, record_atoms_left, '$aleph_global'(atoms_left,atoms_left(pos,[])), stopwatch(StopClock), Time is StopClock - StartClock, show(theory), record_theory(Time), noset(greedy), reinstate(portray_search), p1_message('timeit taken'), p_message(Time), show_total_stats, record_total_stats, !. induce. % construct theories 1 clause at a timeit % does not perform greedy cover removal after each clause found % constructs unique ``maximum cover set'' solution % by obtaining the best clause covering each example % slow induce_max:- clean_up, retractall('$aleph_global'(search_stats,search_stats(_,_))), '$aleph_global'(atoms,atoms(pos,PosSet)), PosSet \= [], store(portray_search), set(portray_search,nil), record_settings, stopwatch(StartClock), set(maxcover,true), induce_max(PosSet), stopwatch(StopClock), Time is StopClock - StartClock, show(theory), record_theory(Time), noset(maxcover), reinstate(portray_search), reinstate(greedy), p1_message('timeit taken'), p_message(Time), show_total_stats, record_total_stats, !. induce_max. induce_max([]). induce_max([Start-Finish|Intervals]):- asserta('$aleph_local'(counter,Start)), induce_max1(Finish), induce_max(Intervals). induce_max1(Finish):- '$aleph_local'(counter,S), S =< Finish, !, (setting(resample,Resample) -> true; Resample = 1), repeat, retract('$aleph_local'(counter,Start)), gen_sample(Resample,pos,Start), get_besthyp(nil), update_coverset(pos,Start), Next is Start+1, assertz('$aleph_local'(counter,Next)), Next > Finish, !, retract('$aleph_local'(counter,Next)). induce_max1(_). % construct theories 1 clause at a timeit % does not perform greedy cover removal after each clause found induce_cover:- clean_up, retractall('$aleph_global'(search_stats,search_stats(_,_))), '$aleph_global'(atoms,atoms(pos,PosSet)), PosSet \= [], store(portray_search), set(portray_search,nil), setting(samplesize,S), setting(abduce,Abduce), record_settings, stopwatch(StartClock), repeat, gen_sample(pos,S), asserta('$aleph_global'(besthyp,besthyp([-inf,0,1,-inf],0, (nil),[],[]))), get_besthyp(Abduce), addhyp, '$aleph_global'(atoms_left,atoms_left(pos,[])), stopwatch(StopClock), Time is StopClock - StartClock, show(theory), record_theory(Time), reinstate(portray_search), reinstate(greedy), p1_message('timeit taken'), p_message(Time), show_total_stats, record_total_stats, !. induce_cover. % rudimentary version of an interactive, incremental rule learner % repeatedly does the following: % 1. ask the user for an example % default is to use a new positive example from previous search % if user responds with Ctrl-d (eof) then search stops % if user responds with "ok" then default is used % otherwise user has to provide an example % 2. construct bottom clause using that example % expects to have appropriate mode declarations % 3. search for the best clause C % 4. ask the user about C who can respond with % ok: clause added to theory % prune: statement added to prevent future % clauses that are subsumed by C % overgeneral: constraint added to prevent future % clauses that subsume C % overgeneral because not(E): E is added as a negative example % overspecific: C is added as new positive example % overspecific because E: E is added as a new positive example % X: where X is some aleph command like "covers" % Ctrl-d (eof): return to Step 1 induce_incremental:- clean_up, retractall('$aleph_global'(search_stats,search_stats(_,_))), store_values([interactive,portray_search,proof_strategy,mode]), set(portray_search,nil), set(proof_strategy,sld), set(interactive,true), record_settings, stopwatch(StartClock), repeat, ask_example(E), ((E = end_of_file; E = none) -> true; once(record_example(check,pos,E,N)), retractall('$aleph_global'(example_selected, example_selected(_,_))), asserta('$aleph_global'(example_selected, example_selected(pos,N))), once(sat(N)), once(reduce), once(process_hypothesis), fail), !, stopwatch(StopClock), Time is StopClock - StartClock, show(theory), show(pos), show(neg), show(nil/0), show(prune/1), record_theory(Time), reinstate_values([interactive,portray_search,proof_strategy,mode]), p1_message('timeit taken'), p_message(Time). % induce_theory/0: does theory-level search % currently only with search = rls; and evalfn = accuracy induce_theory:- setting(search,Search), induce_theory(Search). % induce entire theories from batch data % using a randomised local search % currently, this can use either: simulated annealing with a fixed temp, % GSAT, or a WSAT-like algorithm % the choice of these is specified by the parameter: rls_type % all methods employ random multiple restarts % and a limit on the number of moves % the number of restarts is specified by set(tries,...) % the number of moves is specified by set(moves,...) % annealing currently restricted to using a fixed temperature % the temperature is specified by set(temperature,...) % the fixed temp. makes it equivalent to the Metropolis alg. % WSAT requires a ``random-walk probability'' % the walk probability is specified by set(walk,...) % a walk probability of 0 is equivalent to doing standard GSAT % theory accuracy is the evaluation function induce_theory(rls):- clean_up, retractall('$aleph_global'(search_stats,search_stats(_,_))), store(evalfn), set(evalfn,accuracy), record_settings, find_theory(rls), reinstate(evalfn), show_total_stats, record_total_stats, !. induce_theory(_). % induce_constraints/0: search for logical constraints that % hold in the background knowledge % A constraint is a clause of the form nil:-... % This is modelled on the Claudien program developed by % L. De Raedt and his colleagues in Leuven % Constraints that are ``nearly true'' can be obtained % by altering the noise setting % All constraints found are stored as `good clauses'. induce_constraints:- clean_up, retractall('$aleph_global'(search_stats,search_stats(_,_))), store_values([portray_search,search,construct_bottom,good,goodfile]), noset(goodfile), set(portray_search,nil), set(construct_bottom,nil), set(search,ic), set(good,true), sat(uspec,0), reduce, show(constraints), reinstate_values([portray_search,search,construct_bottom,good,goodfile]), show_total_stats, record_total_stats, !. induce_constraints. % induce_modes/0: search for an acceptable set of mode declarations induce_modes:- clean_up, store_values([typeoverlap]), search_modes, reinstate_values([typeoverlap]), show(modes). % induce_features/0: search for interesting boolean features % each good clause found in a search constitutes a new boolean feature % the maximum number of features is controlled by set(max_features,F) % the features are constructed by doing the following: % while (number of features =< F) do: % (a) randomly select an example; % (b) search for good clauses using the example selected; % (c) construct new features using good clauses induce_features:- clean_up, store_values([good,check_good,updateback,construct_features,samplesize,greedy,explore,lazy_on_contradiction]), set(good,true), set(check_good,true), set(updateback,nil), set(construct_features,true), set(lazy_on_contradiction,true), (setting(feature_construction,exhaustive) -> set(explore,true); true), setting(max_features,FMax), record_settings, stopwatch(StartClock), '$aleph_global'(atoms_left,atoms_left(pos,AtomsLeft)), repeat, gen_sample(pos,0), retractall('$aleph_global'(besthyp,besthyp(_,_,_,_,_))), asserta('$aleph_global'(besthyp,besthyp([-inf,0,1,-inf],0,(nil),[],[]))), get_besthyp(nil), addhyp, show_atoms_left, record_atoms_left, (('$aleph_search'(last_good,LastGood), LastGood >= FMax); '$aleph_global'(atoms_left,atoms_left(pos,[]))), !, gen_features, stopwatch(StopClock), Time is StopClock - StartClock, show(features), record_features(Time), retract('$aleph_global'(atoms_left,atoms_left(pos,_))), assertz('$aleph_global'(atoms_left,atoms_left(pos,AtomsLeft))), reinstate_values([good,check_good,updateback,construct_features,samplesize,greedy,explore,lazy_on_contradiction]), !. induce_features. % induce_tree/0: construct a theory using recursive partitioning % rules are obtained by building a tree % the tree constructed can be one of 4 types % classification, regression, class_probability or model % the type is set by set(tree_type,...) % In addition, the following parameters are relevant % set(classes,ListofClasses): when tree_type is classification or % or class_probability % set(prune_tree,Flag): for pruning rules from a tree % set(confidence,C): for pruning of rules as described by % J R Quinlan in the C4.5 book % set(lookahead,L): lookahead for the refinement operator to avoid % local zero-gain literals % set(dependent,A): argument of the dependent variable in the examples % The basic procedure attempts to construct a tree to predict the dependent % variable in the examples. Note that the mode declarations must specify the % variable as an output argument. Paths from root to leaf constitute clauses. % Tree-construction is viewed as a refinement operation: any leaf can currently % be refined by extending the corresponding clause. The extension is done using % Aleph's automatic refinement operator that extends clauses within the mode % language. A lookahead option allows additions to include several literals. % Classification problems currently use entropy gain to measure worth of additions. % Regression and model trees use reduction in standard deviation to measure % worth of additions. This is not quite correct for the latter. % Pruning for classification is done on the final set of clauses from the tree. % The technique used here is the reduced-error pruning method. % For classification trees, this is identical to the one proposed by % Quinlan in C4.5: Programs for Machine Learning, Morgan Kauffmann. % For regression and model trees, this is done by using a pessimistic estimate % of the sample standard deviation. This assumes normality of observed values % in a leaf. This method and others have been studied by L. Torgo in % "A Comparative Study of Reliable Error Estimators for Pruning Regression % Trees" % Following work by F Provost and P Domingos, pruning is not employed % for class probability prediction. % Currently no pruning is performed for model trees. induce_tree:- clean_up, setting(tree_type,Type), store_values([refine]), set(refine,auto), setting(mingain,MinGain), (MinGain =< 0.0 -> err_message('inappropriate setting for mingain'), fail; true ), record_settings, stopwatch(StartClock), construct_tree(Type), stopwatch(StopClock), Time is StopClock - StartClock, show(theory), record_theory(Time), reinstate_values([refine]), !. induce_tree. % utilities for the induce predicates % randomly pick a positive example and construct bottom clause % example is from those uncovered by current theory % and whose bottom clause has not been stored away previously % makes at most 100 attempts to find such an example rsat:- '$aleph_global'(atoms_left,atoms_left(pos,PosSet)), PosSet \= [], store(resample), set(resample,1), rsat(100), reinstate(resample). rsat(0):- !. rsat(N):- gen_sample(pos,1), '$aleph_global'(example_selected,example_selected(pos,Num)), (\+('$aleph_sat'(stored,stored(Num,pos,_))) -> !, retract('$aleph_global'(example_selected, example_selected(pos,Num))), sat(pos,Num); N1 is N - 1, rsat(N1)). get_besthyp(AbduceFlag):- retract('$aleph_global'(example_selected, example_selected(pos,Num))), reset_best_label, % set-up target to beat sat(Num), reduce, update_besthyp(Num), (AbduceFlag = true -> example(Num,pos,Atom), abgen(Atom,AbGen), once(retract('$aleph_global'(hypothesis, hypothesis(Label,_,PCover,NCover)))), assert('$aleph_global'(hypothesis, hypothesis(Label,AbGen,PCover,NCover))), update_besthyp(Num); true), fail. get_besthyp(_):- retract('$aleph_global'(besthyp,besthyp(L,Num,H,PC,NC))), H \= nil, !, ((setting(samplesize,S),S>1)-> setting(nodes,Nodes), show_clause(sample,L,H,Nodes), record_clause(sample,L,H,Nodes); true), add_hyp(L,H,PC,NC), asserta('$aleph_global'(example_selected, example_selected(pos,Num))), !. get_besthyp(_). reset_best_label:- '$aleph_global'(besthyp,besthyp(Label1,_,Clause,P,N)), '$aleph_search'(best_label,Label/_), Label = [_,_,L,Gain|_], Label1 = [_,_,L1,Gain1|_], % Gain1 > Gain, !, ((Gain1 > Gain);(Gain1 =:= Gain, L1 < L)), !, retract('$aleph_search'(best_label,Label/_)), asserta('$aleph_search'(best_label,Label1/0)), retractall('$aleph_search'(selected,_)), asserta('$aleph_search'(selected,selected(Label1,Clause,P,N))). reset_best_label. update_besthyp(Num):- '$aleph_global'(hypothesis,hypothesis(Label,H,PCover,NCover)), '$aleph_global'(besthyp,besthyp(Label1,_,_,_,_)), Label = [_,_,L,Gain|_], Label1 = [_,_,L1,Gain1|_], % Gain > Gain1, !, ((Gain > Gain1);(Gain =:= Gain1, L < L1)), !, retract('$aleph_global'(besthyp,besthyp(Label1,_,_,_,_))), assertz('$aleph_global'(besthyp,besthyp(Label,Num,H,PCover,NCover))). update_besthyp(_). % generate a new feature from a good clause gen_features:- aleph_abolish('$aleph_feature'/2), (setting(dependent,PredictArg) -> true; PredictArg is 0), (setting(minscore,FMin) -> true; FMin = -inf), '$aleph_good'(_,Label,Clause), Label = [_,_,_,F|_], F >= FMin, split_clause(Clause,Head,Body), Body \= true, functor(Head,Name,Arity), functor(Template,Name,Arity), copy_iargs(Arity,Head,Template,PredictArg), get_feature_class(PredictArg,Head,Body,Class), gen_feature((Template:-Body),Label,Class), fail. gen_features:- (setting(dependent,PredictArg) -> true; PredictArg is 0), setting(good,true), setting(goodfile,File), aleph_open(File,read,Stream), (setting(minscore,FMin) -> true; FMin = -inf), repeat, read(Stream,Fact), (Fact = '$aleph_good'(_,Label,Clause) -> Label = [_,_,_,F|_], F >= FMin, split_clause(Clause,Head,Body), Body \= true, functor(Head,Name,Arity), functor(Template,Name,Arity), copy_iargs(Arity,Head,Template,PredictArg), get_feature_class(PredictArg,Head,Body,Class), gen_feature((Template:-Body),Label,Class), fail; close(Stream), ! ). gen_features. get_feature_class(Argno,Head,Body,Class):- has_class(Argno,Head,Body,Class), !. get_feature_class(_,_,_,_). has_class(Argno,Head,_,Class):- arg(Argno,Head,Class), ground(Class), !. has_class(Argno,Head,Body,Class):- arg(Argno,Head,DepVar), in((DepVar=Class),Body), ground(Class), !. ask_example(E):- ('$aleph_global'(example_selected,example_selected(pos,N)) -> example(N,pos,E1); E1 = none), !, show_options(example_selection), tab(4), write('Response '), p1_message(default:E1), write('?'), nl, read(Response), (Response = ok -> E = E1; E = Response). process_hypothesis:- show(hypothesis), repeat, show_options(hypothesis_selection), tab(4), write('Response?'), nl, read(Response), process_hypothesis(Response), (Response = end_of_file; Response = none), !. process_hypothesis(end_of_file):- nl, nl, !. process_hypothesis(none):- nl, nl, !. process_hypothesis(ok):- !, update_theory(_), nl, p_message('added new clause'). process_hypothesis(prune):- !, retract('$aleph_global'(hypothesis,hypothesis(_,H,_,_))), Prune = ( hypothesis(Head,Body,_), goals_to_list(Body,BodyL), clause_to_list(H,HL), aleph_subsumes(HL,[Head|BodyL])), assertz((prune(H):- Prune)), nl, p_message('added new prune statement'). process_hypothesis(overgeneral):- !, retract('$aleph_global'(hypothesis,hypothesis(_,H,_,_))), Constraint = ( hypothesis(Head,Body,_), goals_to_list(Body,BodyL), clause_to_list(H,HL), aleph_subsumes([Head|BodyL],HL)), assertz((nil:- Constraint)), nl, p_message('added new constraint'). process_hypothesis(overgeneral because not(E)):- !, record_example(check,neg,E,_), nl, p_message('added new negative example'). process_hypothesis(overspecific):- !, retract('$aleph_global'(hypothesis,hypothesis(_,H,_,_))), (retract('$aleph_global'(example_selected,example_selected(_,_)))-> true; true), record_example(check,pos,H,N), asserta('$aleph_global'(example_selected,example_selected(pos,N))), nl, p_message('added new positive example'). process_hypothesis(overspecific because E):- !, retract('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), (retract('$aleph_global'(example_selected,example_selected(_,_)))-> true; true), record_example(check,pos,E,N), asserta('$aleph_global'(example_selected,example_selected(pos,N))), nl, p_message('added new positive example'). process_hypothesis(AlephCommand):- AlephCommand. show_options(example_selection):- nl, tab(4), write('Options:'), nl, tab(8), write('-> "ok." to accept default example'), nl, tab(8), write('-> Enter an example'), nl, tab(8), write('-> ctrl-D or "none." to end'), nl, nl. show_options(hypothesis_selection):- nl, tab(4), write('Options:'), nl, tab(8), write('-> "ok." to accept clause'), nl, tab(8), write('-> "prune." to prune clause and its refinements from the search'), nl, tab(8), write('-> "overgeneral." to add clause as a constraint'), nl, tab(8), write('-> "overgeneral because not(E)." to add E as a negative example'), nl, tab(8), write('-> "overspecific." to add clause as a positive example'), nl, tab(8), write('-> "overspecific because E." to add E as a positive example'), nl, tab(8), write('-> any Aleph command'), nl, tab(8), write('-> ctrl-D or "none." to end'), nl, nl. get_performance:- setting(evalfn,Evalfn), (Evalfn = sd; Evalfn = mse), !. get_performance:- (setting(train_pos,PFile) -> test(PFile,noshow,Tp,TotPos), Fn is TotPos - Tp; TotPos = 0, Tp = 0, Fn = 0), (setting(train_neg,NFile) -> test(NFile,noshow,Fp,TotNeg), Tn is TotNeg - Fp; TotNeg = 0, Tn = 0, Fp = 0), TotPos + TotNeg > 0, p_message('Training set performance'), write_cmatrix([Tp,Fp,Fn,Tn]), p1_message('Training set summary'), p_message([Tp,Fp,Fn,Tn]), fail. get_performance:- (setting(test_pos,PFile) -> test(PFile,noshow,Tp,TotPos), Fn is TotPos - Tp; TotPos = 0, Tp = 0, Fn = 0), (setting(test_neg,NFile) -> test(NFile,noshow,Fp,TotNeg), Tn is TotNeg - Fp; TotNeg = 0, Tn = 0, Fp = 0), TotPos + TotNeg > 0, p_message('Test set performance'), write_cmatrix([Tp,Fp,Fn,Tn]), p1_message('Test set summary'), p_message([Tp,Fp,Fn,Tn]), fail. get_performance. write_cmatrix([Tp,Fp,Fn,Tn]):- P is Tp + Fn, N is Fp + Tn, PP is Tp + Fp, PN is Fn + Tn, Total is PP + PN, (Total = 0 -> Accuracy is 0.5; Accuracy is (Tp + Tn)/Total), find_max_width([Tp,Fp,Fn,Tn,P,N,PP,PN,Total],0,W1), W is W1 + 2, tab(5), write(' '), tab(W), write('Actual'), nl, tab(5), write(' '), write_entry(W,'+'), tab(6), write_entry(W,'-'), nl, tab(5), write('+'), write_entry(W,Tp), tab(6), write_entry(W,Fp), tab(6), write_entry(W,PP), nl, write('Pred '), nl, tab(5), write('-'), write_entry(W,Fn), tab(6), write_entry(W,Tn), tab(6), write_entry(W,PN), nl, nl, tab(5), write(' '), write_entry(W,P), tab(6), write_entry(W,N), tab(6), write_entry(W,Total), nl, nl, write('Accuracy = '), write(Accuracy), nl. find_max_width([],W,W). find_max_width([V|T],W1,W):- name(V,VList), length(VList,VL), (VL > W1 -> find_max_width(T,VL,W); find_max_width(T,W1,W)). write_entry(W,V):- name(V,VList), length(VList,VL), Y is integer((W-VL)/2), tab(Y), write(V), tab(Y). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A B D U C T I O N % Generalisation of an abductive explanation for a fact. % The basic procedure is a simplified variant of S. Moyle's Alecto % program. Alecto is described in some detail in S. Moyle, % "Using Theory Completion to Learn a Navigation Control Program", % Proceedings of the Twelfth International Conference on ILP (ILP2002), % S. Matwin and C.A. Sammut (Eds), LNAI 2583, pp 182-197, % 2003. % Alecto does the following: for each positive example, an % abductive explanation is obtained. This explanation is set of % ground atoms. The union of abductive explanations from all % positive examples is formed (this is also a set of ground atoms). % These are then generalised to give the final theory. The % ground atoms in an abductive explanation are obtained using % Yamamoto's SOLD resolution or SOLDR (Skip Ordered Linear resolution for % Definite clauses). % One complication with abductive learning is this: for a given % positive example to be provable, we require all the ground atoms % in its abductive explanation to be true. Correctly therefore, % we would need to assert the abductive explanation before % checking the utility of any hypothesis. To avoid unnecessary % asserts and retracts, the "pclause" trick is used here (see % record_testclause/0). abgen(Fact):- abgen(Fact,_). abgen(Fact,AbGen):- retractall('$aleph_search'(abgenhyp,hypothesis(_,_,_,_))), Minf is -inf, asserta('$aleph_search'(abgenhyp, hypothesis([Minf,0,1,Minf],[nil],[],[]))), setting(max_abducibles,Max), abgen(Fact,Max,AbGen), '$aleph_global'(hypothesis,hypothesis(Label,_,PCover,NCover)), Label = [_,_,L,Gain|_], '$aleph_search'(abgenhyp,hypothesis(Label1,_,_,_)), Label1 = [_,_,L1,Gain1|_], once(((Gain > Gain1); (Gain =:= Gain1, L < L1))), once(retract('$aleph_search'(abgenhyp,hypothesis(_,_,_,_)))), asserta('$aleph_search'(abgenhyp, hypothesis(Label,AbGen,PCover,NCover))), fail. abgen(_,AbGen):- retractall('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), '$aleph_search'(abgenhyp,hypothesis(Label,AbGen,PCover,NCover)), asserta('$aleph_global'(hypothesis, hypothesis(Label,AbGen,PCover,NCover))). abgen(Fact,Max,AbGen):- sold_prove(Fact,AbAtoms), ground(AbAtoms), length(AbAtoms,N), N =< Max, prolog_type(Prolog), (Prolog = yap -> store_abduced_atoms(AbAtoms,AssertRefs); store_abduced_atoms(AbAtoms)), store(proof_strategy), set(proof_strategy,sld), gen_abduced_atoms(AbAtoms,AbGen), reinstate(proof_strategy), (Prolog = yap -> erase_refs(AssertRefs); remove_abduced_atoms(AbAtoms)). gen_abduced_atoms([],[]). gen_abduced_atoms([AbAtom|AbAtoms],[AbGen|AbGens]):- functor(AbAtom,Name,Arity), add_determinations(Name/Arity,true), sat(AbAtom), reduce, '$aleph_global'(hypothesis,hypothesis(_,AbGen,_,_)), remove_explained(AbAtoms,AbGen,AbAtoms1), gen_abduced_atoms(AbAtoms1,AbGens). remove_explained([],_,[]). remove_explained([AbAtom|AbAtoms],(Head:-Body),Rest):- \+((\+ ((AbAtom = Head), Body))), !, remove_explained(AbAtoms,(Head:-Body),Rest). remove_explained([AbAtom|AbAtoms],(Head:-Body),[AbAtom|Rest]):- remove_explained(AbAtoms,(Head:-Body),Rest). store_abduced_atoms([],[]). store_abduced_atoms([AbAtom|AbAtoms],[DbRef|DbRefs]):- assertz('$aleph_search'(abduced,pclause(AbAtom,true)),DbRef), store_abduced_atoms(AbAtoms,DbRefs). store_abduced_atoms([]). store_abduced_atoms([AbAtom|AbAtoms]):- assertz('$aleph_search'(abduced,pclause(AbAtom,true))), store_abduced_atoms(AbAtoms). remove_abduced_atoms([]). remove_abduced_atoms([AbAtom|AbAtoms]):- retract('$aleph_search'(abduced,pclause(AbAtom,true))), remove_abduced_atoms(AbAtoms). % sold_prove(+G,-A) % Where G is an input goal (comma separated conjunction of atoms) % and A is a list of atoms (containing the abductive explanation). % This procedure is due to S.Moyle sold_prove(Goal,SkippedGoals):- soldnf_solve(Goal,Skipped), sort(Skipped,SkippedGoals). soldnf_solve(Goal,Skipped):- soldnf_solve(Goal,true,[],Skipped). soldnf_solve((Goal,Goals),Status,SkippedSoFar,Skipped):- !, soldnf_solve(Goal,Status1,SkippedSoFar,Skipped1), soldnf_solve(Goals,Status2,Skipped1,Skipped), conj_status(Status1,Status2,Status). soldnf_solve(not(Goal),true,SkippedSoFar,Skipped):- soldnf_solve(Goal,nil,SkippedSoFar,Skipped). soldnf_solve(not(Goal),nil,SkippedSoFar,Skipped):- !, soldnf_solve(Goal,true,SkippedSoFar,Skipped). soldnf_solve(Goal,Status,SkippedSoFar,SkippedSoFar):- soldnf_builtin(Goal), !, soldnfcall(Goal,Status). soldnf_solve(Goal,Status,SkippedSoFar,Skipped):- soldnf_clause(Goal,Body), soldnf_solve(Body,Status,SkippedSoFar,Skipped). soldnf_solve(Goal,true,SkippedSoFar,[Goal|SkippedSoFar]):- skippable(Goal). soldnf_clause(Goal,_Body):-soldnf_builtin(Goal),!,fail. soldnf_clause(Goal,Body):- clause(Goal,Body). soldnf_builtin(not(_Goal)):-!,fail. soldnf_builtin(A):-predicate_property(A,built_in). soldnfcall(Goal,true):- Goal, !. soldnfcall(_,nil). conj_status(true,true,true):- !. conj_status(_,_,nil). skippable(Pred):- functor(Pred,Name,Arity), '$aleph_global'(abducible,abducible(Name/Arity)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % L A Z Y E V A L U A T I O N % lazy_evaluate_theory(+Clauses,+Lazy,+Pos,+Neg,-Theory) % evaluate lazy preds in a set of clauses % untested lazy_evaluate_theory([],_,_,_,[]). lazy_evaluate_theory([Refine|T],LazyPreds,Pos,Neg,[Refine1|T1]):- Refine = A-[B,C,D,Clause], lazy_evaluate_refinement(D,Clause,LazyPreds,Pos,Neg,D1,Clause1), Refine1 = A-[B,C,D1,Clause1], lazy_evaluate_theory(T,LazyPreds,Pos,Neg,T1). % lazy evaluation of literals in a refinement operation lazy_evaluate_refinement([],Refine,Lazy,Pos,Neg,[],NewRefine):- clause_to_list(Refine,Lits), lazy_evaluate_refinement(Lits,Lazy,[],Pos,Neg,Lits1), list_to_clause(Lits1,NewRefine), !. lazy_evaluate_refinement(Lits,_,Lazy,Pos,Neg,Lits1,NewRefine):- Lits \= [], lazy_evaluate_refinement(Lits,Lazy,[],Pos,Neg,Lits1), get_pclause(Lits1,[],NewRefine,_,_,_), !. lazy_evaluate_refinement(Lits,Refine,_,_,_,Lits,Refine). lazy_evaluate_refinement([],_,L,_,_,L):- !. lazy_evaluate_refinement([Lit|Lits],LazyPreds,Path,PosCover,NegCover,Refine):- lazy_evaluate([Lit],LazyPreds,Path,PosCover,NegCover,[Lit1]), aleph_append([Lit1],Path,Path1), !, lazy_evaluate_refinement(Lits,LazyPreds,Path1,PosCover,NegCover,Refine). % lazy evaluation of specified literals % all #'d arguments of these literals are evaluated at reduction-timeit % From Version 5 (dated Sat Nov 29 13:02:36 GMT 2003), collects both % input and output args (previously only collected input args) lazy_evaluate(Lits,[],_,_,_,Lits):- !. lazy_evaluate([],_,_,_,_,[]):- !. lazy_evaluate([LitNum|LitNums],LazyPreds,Path,PosCover,NegCover,Lits):- (integer(LitNum) -> BottomExists = true, '$aleph_sat_litinfo'(LitNum,Depth,Atom,I,O,D), functor(Atom,Name,Arity), aleph_member1(Name/Arity,LazyPreds), !, get_pclause([LitNum|Path],[],(Lit:-(Goals)),_,_,_); BottomExists = nil, Atom = LitNum, Depth = 0, functor(Atom,Name,Arity), aleph_member1(Name/Arity,LazyPreds), !, split_args(LitNum,_,I,O,C), D = [], list_to_clause([LitNum|Path],(Lit:-(Goals)))), goals_to_clause(Goals,Clause), lazy_prove(pos,Lit,Clause,PosCover), ('$aleph_global'(positive_only,positive_only(Name/Arity))-> true; lazy_prove_negs(Lit,Clause,NegCover)), functor(LazyLiteral,Name,Arity), collect_args(I,LazyLiteral), collect_args(O,LazyLiteral), lazy_evaluate1(BottomExists,Atom,Depth,I,O,C,D,LazyLiteral,NewLits), retractall('$aleph_local'(lazy_evaluate,_)), lazy_evaluate(LitNums,LazyPreds,Path,PosCover,NegCover,NewLits1), update_list(NewLits1,NewLits,Lits). lazy_evaluate([LitNum|LitNums],LazyPreds,Path,PosCover,NegCover,[LitNum|Lits]):- lazy_evaluate(LitNums,LazyPreds,Path,PosCover,NegCover,Lits). lazy_prove_negs(Lit,Clause,_):- '$aleph_global'(lazy_negs,set(lazy_negs,true)), !, '$aleph_global'(atoms,atoms(neg,NegCover)), lazy_prove(neg,Lit,Clause,NegCover). lazy_prove_negs(Lit,Clause,NegCover):- lazy_prove(neg,Lit,Clause,NegCover). collect_args([],_). collect_args([Argno/_|Args],Literal):- findall(Term, ('$aleph_local'(lazy_evaluate,eval(pos,Lit)), tparg(Argno,Lit,Term)), PTerms), findall(Term, ('$aleph_local'(lazy_evaluate,eval(neg,Lit)), tparg(Argno,Lit,Term)), NTerms), tparg(Argno,Literal,[PTerms,NTerms]), collect_args(Args,Literal). % when construct_bottom = nil % currently do not check if user's definition of lazily evaluated % literal corresponds to recall number in the modes lazy_evaluate1(nil,Atom,_,I,O,C,_,Lit,NewLits):- functor(Atom,Name,Arity), p1_message('lazy evaluation'), p_message(Name), functor(NewLit,Name,Arity), findall(NewLit,(Lit,copy_args(Lit,NewLit,C)),NewLits), copy_io_args(NewLits,Atom,I,O). lazy_evaluate1(true,Atom,Depth,I,O,_,D,Lit,NewLits):- % '$aleph_sat'(lastlit,_), call_library_pred(Atom,Depth,Lit,I,O,D), findall(LitNum,(retract('$aleph_local'(lazy_evaluated,LitNum))),NewLits). call_library_pred(OldLit,Depth,Lit,I,O,D):- functor(OldLit,Name,Arity), '$aleph_global'(lazy_recall,lazy_recall(Name/Arity,Recall)), asserta('$aleph_local'(callno,1)), p1_message('lazy evaluation'), p_message(Name), repeat, evaluate(OldLit,Depth,Lit,I,O,D), retract('$aleph_local'(callno,CallNo)), NextCall is CallNo + 1, asserta('$aleph_local'(callno,NextCall)), NextCall > Recall, !, p_message('completed'), retract('$aleph_local'(callno,NextCall)). evaluate(OldLit,_,Lit,I,O,D):- functor(OldLit,Name,Arity), functor(NewLit,Name,Arity), Lit, copy_args(OldLit,NewLit,I), copy_args(OldLit,NewLit,O), copy_consts(Lit,NewLit,Arity), update_lit(LitNum,nil,NewLit,I,O,D), \+('$aleph_local'(lazy_evaluated,LitNum)), asserta('$aleph_local'(lazy_evaluated,LitNum)), !. evaluate(_,_,_,_,_,_). copy_io_args([],_,_,_). copy_io_args([New|NewL],Old,I,O):- copy_args(Old,New,I), copy_args(Old,New,O), copy_io_args(NewL,Old,I,O). copy_args(_,_,[]). copy_args(Old,New,[Arg/_|T]):- tparg(Arg,Old,Term), tparg(Arg,New,Term), copy_args(Old,New,T), !. copy_consts(_,_,0):- !. copy_consts(Old,New,Arg):- arg(Arg,Old,Term), arg(Arg,New,Term1), var(Term1), !, Term1 = aleph_const(Term), Arg0 is Arg - 1, copy_consts(Old,New,Arg0). copy_consts(Old,New,Arg):- Arg0 is Arg - 1, copy_consts(Old,New,Arg0). % copy_modeterm(+Old,-New) % copy term structure from Old to New % by finding an appropriate mode declaration copy_modeterm(Lit1,Lit2):- functor(Lit1,Name,Arity), find_mode(mode,Name/Arity,Mode), functor(Lit2,Name,Arity), copy_modeterms(Mode,Lit2,Arity), \+((\+ (Lit1 = Lit2))). % find_mode(+modetype,+Name/+Arity,-Mode) % find a mode for Name/Arity of type modetype find_mode(mode,Name/Arity,Mode):- !, functor(Mode,Name,Arity), '$aleph_global'(mode,mode(_,Mode)). find_mode(modeh,Name/Arity,Mode):- !, functor(Mode,Name,Arity), '$aleph_global'(modeh,modeh(_,Mode)). find_mode(modeb,Name/Arity,Mode):- !, functor(Mode,Name,Arity), '$aleph_global'(modeb,modeb(_,Mode)). % copy_modeterms(+Mode,+Lit,+Arity) % copy all term structures in a mode template copy_modeterms(_,_,0):- !. copy_modeterms(Mode,Lit,Arg):- arg(Arg,Mode,Term), nonvar(Term), functor(Term,Name,Arity), \+((Name = '+'; Name = '-'; Name = '#')), !, functor(NewTerm,Name,Arity), arg(Arg,Lit,NewTerm), copy_modeterms(Term,NewTerm,Arity), Arg0 is Arg - 1, copy_modeterms(Mode,Lit,Arg0). copy_modeterms(Mode,Lit,Arg):- Arg0 is Arg - 1, copy_modeterms(Mode,Lit,Arg0). % theorem-prover for lazy evaluation of literals lazy_prove(Type,Lit,Clause,Intervals):- (Clause = (Head:-Body)-> lazy_prove(Intervals,Type,Lit,Head,Body); lazy_prove(Intervals,Type,Lit,Clause,true)). lazy_prove([],_,_,_,_). lazy_prove([Interval|Intervals],Type,Lit,Head,Body):- lazy_index_prove(Interval,Type,Lit,Head,Body), lazy_prove(Intervals,Type,Lit,Head,Body). lazy_index_prove(Start-Finish,_,_,_,_):- Start > Finish, !. lazy_index_prove(Start-Finish,Type,Lit,Head,Body):- lazy_index_prove1(Type,Lit,Head,Body,Start), Start1 is Start + 1, lazy_index_prove(Start1-Finish,Type,Lit,Head,Body). % bind input args of lazy literal % each example gives an set of input bindings % this is different from Aleph 2 where only a single binding was obtained lazy_index_prove1(Type,Lit,Head,Body,Num):- depth_bound_call((example(Num,Type,Head),Body)), \+('$aleph_local'(lazy_evaluate,eval(Type,Lit))), asserta('$aleph_local'(lazy_evaluate,eval(Type,Lit))), fail. lazy_index_prove1(_,_,_,_,_). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % S L P % implemented as described by Muggleton, ILP-96 condition_target:- '$aleph_global'(condition,set(condition,true)), add_generator, '$aleph_global'(modeh,modeh(_,Pred)), functor(Pred,Name,Arity), p_message('conditioning'), make_sname(Name,SName), functor(SPred,SName,Arity), SPred =.. [_|Args], functor(Fact,Name,Arity), example(_,_,Fact), Fact =.. [_|Args], condition(SPred), fail. condition_target:- \+('$aleph_global'(condition,set(condition,true))), add_generator, !. condition_target. add_generator:- '$aleph_global'(modeh,modeh(_,Pred)), functor(Pred,Name,Arity), make_sname(Name,SName), functor(SPred,SName,Arity), (clause(SPred,_)-> true; add_generator(Name/Arity), p1_message('included generator'), p_message(SName/Arity)), fail. add_generator. add_generator(Name/Arity):- make_sname(Name,SName), functor(SPred,SName,Arity), find_mode(modeh,Name/Arity,Mode), once(copy_modeterms(Mode,SPred,Arity)), split_args(Mode,Mode,Input,Output,Constants), range_restrict(Input,SPred,[],B1), range_restrict(Output,SPred,B1,B2), range_restrict(Constants,SPred,B2,B3), list_to_goals(B3,Body), \+(clause(SPred,Body)), asserta((SPred:-Body)), fail. add_generator(_). make_sname(Name,SName):- concat(['*',Name],SName). range_restrict([],_,R,R). range_restrict([Pos/Type|T],Pred,R0,R):- functor(TCheck,Type,1), tparg(Pos,Pred,X), arg(1,TCheck,X), range_restrict(T,Pred,[TCheck|R0],R). condition(Fact):- slprove(condition,Fact), !. condition(_). sample(_,0,[]):- !. sample(Name/Arity,N,S):- functor(Pred,Name,Arity), retractall('$aleph_local'(slp_samplenum,_)), retractall('$aleph_local'(slp_sample,_)), asserta('$aleph_local'(slp_samplenum,1)), repeat, slprove(stochastic,Pred), asserta('$aleph_local'(slp_sample,Pred)), retract('$aleph_local'(slp_samplenum,N1)), N2 is N1 + 1, asserta('$aleph_local'(slp_samplenum,N2)), N2 > N, !, retract('$aleph_local'(slp_samplenum,N2)), functor(Fact,Name,Arity), findall(Fact,(retract('$aleph_local'(slp_sample,Fact))),S). gsample(Name/Arity,_):- make_sname(Name,SName), functor(SPred,SName,Arity), clause(SPred,Body), ground((SPred:-Body)), !, update_gsample(Name/Arity,_). gsample(_,0):- !. gsample(Name/Arity,N):- functor(Pred,Name,Arity), make_sname(Name,SName), functor(SPred,SName,Arity), Pred =.. [_|Args], retractall('$aleph_local'(slp_samplenum,_)), asserta('$aleph_local'(slp_samplenum,0)), repeat, slprove(stochastic,SPred), SPred =..[_|Args], retract('$aleph_local'(slp_samplenum,N1)), N2 is N1 + 1, asserta('$aleph_local'(slp_samplenum,N2)), assertz(example(N2,rand,Pred)), N2 >= N, !, retract('$aleph_local'(slp_samplenum,N2)), asserta('$aleph_global'(size,size(rand,N))), asserta('$aleph_global'(last_example,last_example(rand,N))), asserta('$aleph_global'(atoms,atoms(rand,[1-N]))), asserta('$aleph_global'(atoms_left,atoms_left(rand,[1-N]))). update_gsample(Name/Arity,_):- functor(Pred,Name,Arity), make_sname(Name,SName), functor(SPred,SName,Arity), retractall('$aleph_global'(gsample,gsample(_))), retractall('$aleph_local'(slp_samplenum,_)), asserta('$aleph_local'(slp_samplenum,0)), SPred =.. [_|Args], Pred =.. [_|Args], clause(SPred,Body), ground((SPred:-Body)), record_example(check,rand,(Pred:-Body),N1), retract('$aleph_local'(slp_samplenum,_)), asserta('$aleph_local'(slp_samplenum,N1)), fail. update_gsample(_,N):- '$aleph_local'(slp_samplenum,N), N > 0, !, retract('$aleph_local'(slp_samplenum,N)), set(gsamplesize,N), retract('$aleph_global'(atoms,atoms(rand,_))), retract('$aleph_global'(atoms_left,atoms_left(rand,_))), retract('$aleph_global'(last_example,last_example(rand,_))), assert('$aleph_global'(atoms,atoms(rand,[1-N]))), assert('$aleph_global'(atoms_left,atoms_left(rand,[1-N]))), assert('$aleph_global'(last_example,last_example(rand,N))). update_gsample(_,_). slprove(_,true):- !. slprove(Mode,not(Goal)):- slprove(Mode,Goal), !, fail. slprove(Mode,(Goal1,Goal2)):- !, slprove(Mode,Goal1), slprove(Mode,Goal2). slprove(Mode,(Goal1;Goal2)):- !, slprove(Mode,Goal1); slprove(Mode,Goal2). slprove(_,Goal):- predicate_property(Goal,built_in), !, Goal. slprove(stochastic,Goal):- findall(Count/Clause, (clause(Goal,Body),Clause=(Goal:-Body),find_count(Clause,Count)), ClauseCounts), renormalise(ClauseCounts,Normalised), aleph_random(X), rselect_clause(X,Normalised,(Goal:-Body)), slprove(stochastic,Body). slprove(condition,Goal):- functor(Goal,Name,Arity), functor(Head,Name,Arity), clause(Head,Body), \+(\+((Head=Goal,slprove(condition,Body)))), inc_count((Head:-Body)). renormalise(ClauseCounts,Normalised):- sum_counts(ClauseCounts,L), L > 0, renormalise(ClauseCounts,L,Normalised). sum_counts([],0). sum_counts([N/_|T],C):- sum_counts(T,C1), C is N + C1. renormalise([],_,[]). renormalise([Count/Clause|T],L,[Prob/Clause|T1]):- Prob is Count/L, renormalise(T,L,T1). rselect_clause(X,[P/C|_],C):- X =< P, !. rselect_clause(X,[P/_|T],C):- X1 is X - P, rselect_clause(X1,T,C). find_count(Clause,N):- copy_term(Clause,Clause1), '$aleph_global'(slp_count,Clause1,N), !. find_count(_,1). inc_count(Clause):- retract('$aleph_global'(slp_count,Clause,N)), !, N1 is N + 1, asserta('$aleph_global'(slp_count,Clause,N1)). inc_count(Clause):- asserta('$aleph_global'(slp_count,Clause,2)). find_posgain(PCover,P):- '$aleph_global'(greedy,set(greedy,true)), !, interval_count(PCover,P). find_posgain(PCover,P):- '$aleph_global'(atoms_left,atoms_left(pos,PLeft)), intervals_intersection(PLeft,PCover,PC), interval_count(PC,P). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % S E A R C H I / O record_clause(good,Label,Clause,_):- setting(good,true), setting(goodfile_stream,Stream), !, set_output(Stream), Label = [_,_,L|_], aleph_writeq('$aleph_good'(L,Label,Clause)), write('.'), nl, flush_output(Stream), set_output(user_output). record_clause(Flag,Label,Clause,Nodes):- Flag \= good, setting(recordfile_stream,Stream), !, set_output(Stream), show_clause(Flag,Label,Clause,Nodes), flush_output(Stream), set_output(user_output). record_clause(_,_,_,_). record_theory(Flag,Label,Clauses,Nodes):- setting(recordfile_stream,Stream), !, set_output(Stream), show_theory(Label,Clauses,Nodes,Flag), flush_output(Stream), set_output(user_output). record_theory(_,_,_,_). record_theory(Flag,Label,Clauses,Nodes):- setting(recordfile_stream,Stream), !, set_output(Stream), show_theory(Label,Clauses,Nodes,Flag), flush_output(Stream), set_output(user_output). record_theory(_,_,_,_). record_sat_example(N):- setting(recordfile_stream,Stream), !, set_output(Stream), p1_message('sat'), p_message(N), flush_output(Stream), set_output(user_output). record_sat_example(_). record_search_stats(Clause,Nodes,Time):- setting(recordfile_stream,Stream), !, set_output(Stream), p1_message('clauses constructed'), p_message(Nodes), p1_message('search timeit'), p_message(Time), p_message('best clause'), pp_dclause(Clause), % show(hypothesis), flush_output(Stream), set_output(user_output). record_search_stats(_,_,_). record_tsearch_stats(Theory,Nodes,Time):- setting(recordfile_stream,Stream), !, set_output(Stream), p1_message('theories constructed'), p_message(Nodes), p1_message('search timeit'), p_message(Time), p_message('best theory'), pp_dclauses(Theory), % show(hypothesis), flush_output(Stream), set_output(user_output). record_tsearch_stats(_,_,_). record_theory(Time):- setting(recordfile_stream,Stream), !, set_output(Stream), show(theory), p1_message('timeit taken'), p_message(Time), nl, ('$aleph_global'(maxcover,set(maxcover,true))-> show(aleph,theory/5), nl, show(aleph,max_set/4), nl, show(aleph,rules/1); true), flush_output(Stream), set_output(user_output). record_theory(_). record_features(Time):- setting(recordfile_stream,Stream), !, set_output(Stream), show(features), p1_message('timeit taken'), p_message(Time), flush_output(Stream), set_output(user_output). record_features(_). record_settings:- setting(recordfile_stream,Stream), !, set_output(Stream), ('$aleph_global'(os,set(os,unix)) -> execute(date), execute(hostname); true), show(settings), flush_output(Stream), set_output(user_output). record_settings. show_clause(Flag,Label,Clause,Nodes):- broadcast(clause(Flag,Label,Clause,Nodes)), p_message('-------------------------------------'), (Flag=good -> p_message('good clause'); (Flag=sample-> p_message('selected from sample'); p_message('found clause'))), pp_dclause(Clause), (setting(evalfn,Evalfn)-> true; Evalfn = coverage), show_stats(Evalfn,Label), p1_message('clause label'), p_message(Label), p1_message('clauses constructed'), p_message(Nodes), p_message('-------------------------------------'). show_theory(Flag,Label,Clauses,Nodes):- p_message('-------------------------------------'), (Flag=good -> p_message('good theory'); (Flag=sample-> p_message('selected from sample'); p_message('found theory'))), pp_dclauses(Clauses), (setting(evalfn,Evalfn)-> true; Evalfn = accuracy), show_stats(Evalfn,Label), p1_message('theory label'), p_message(Label), p1_message('theories constructed'), p_message(Nodes), p_message('-------------------------------------'). update_search_stats(N,T):- (retract('$aleph_global'(search_stats,search_stats(N0,T0))) -> N1 is N0 + N, T1 is T0 + T; N1 is N, T1 is T), asserta('$aleph_global'(search_stats,search_stats(N1,T1))). record_total_stats:- setting(recordfile_stream,Stream), !, set_output(Stream), show_total_stats, flush_output(Stream), set_output(user_output). record_total_stats. record_atoms_left:- setting(recordfile_stream,Stream), !, set_output(Stream), show_atoms_left, flush_output(Stream), set_output(user_output). record_atoms_left. show_total_stats:- '$aleph_global'(search_stats,search_stats(Nodes,_)), !, p1_message('total clauses constructed'), p_message(Nodes). show_total_stats. show_atoms_left:- '$aleph_global'(atoms_left,atoms_left(pos,PLeft)), interval_count(PLeft,NLeft), '$aleph_global'(size,size(pos,NPos)), '$aleph_global'(search_stats,search_stats(_,Time)), EstTime is (Time*NLeft)/(NPos - NLeft), p1_message('positive examples left'), p_message(NLeft), p1_message('estimated timeit to finish (secs)'), p_message(EstTime), !. show_atoms_left. show_stats(Evalfn,[P,N,_,F|_]):- ((Evalfn = user; Evalfn = entropy; Evalfn = gini) -> Value is -F; Value is F ), concat(['pos cover = ',P,' neg cover = ',N],Mess), p1_message(Mess), print_eval(Evalfn,Value). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A U T O -- R E F I N E % % built-in refinement operator gen_auto_refine:- (setting(autorefine,true) -> true; set(autorefine,true), process_modes, process_determs), !. gen_auto_refine. process_modes:- once(aleph_abolish('$aleph_link_vars'/2)), once(aleph_abolish('$aleph_has_vars'/3)), once(aleph_abolish('$aleph_has_ovar'/4)), once(aleph_abolish('$aleph_has_ivar'/4)), '$aleph_global'(modeb,modeb(_,Mode)), process_mode(Mode), fail. process_modes:- '$aleph_global'(determination,determination(Name/Arity,_)), find_mode(modeh,Name/Arity,Mode), split_args(Mode,Mode,I,O,_), functor(Lit,Name,Arity), copy_modeterms(Mode,Lit,Arity), add_ivars(Lit,I), add_ovars(Lit,O), add_vars(Lit,I,O), fail. process_modes. process_determs:- once(aleph_abolish('$aleph_determination'/2)), '$aleph_global'(determination,determination(Name/Arity,Name1/Arity1)), functor(Pred,Name1,Arity1), find_mode(modeb,Name1/Arity1,Mode), copy_modeterms(Mode,Pred,Arity1), Determ = '$aleph_determination'(Name/Arity,Pred), (Determ -> true; assert(Determ)), fail. process_determs. process_mode(Mode):- functor(Mode,Name,Arity), split_args(Mode,Mode,I,O,C), functor(Lit,Name,Arity), copy_modeterms(Mode,Lit,Arity), add_ioc_links(Lit,I,O,C), add_ovars(Lit,O), add_vars(Lit,I,O). add_ioc_links(Lit,I,O,C):- Clause = ('$aleph_link_vars'(Lit,Lits):- var_types(Lits,VT), Body), get_o_links(O,Lit,VT,true,OGoals), get_i_links(I,Lit,VT,OGoals,IOGoals), get_c_links(C,Lit,IOGoals,Body), assert(Clause). add_ovars(Lit,O):- aleph_member(Pos/Type,O), tparg(Pos,Lit,V), ('$aleph_has_ovar'(Lit,V,Type,Pos)->true; assert('$aleph_has_ovar'(Lit,V,Type,Pos))), fail. add_ovars(_,_). add_ivars(Lit,I):- aleph_member(Pos/Type,I), tparg(Pos,Lit,V), ('$aleph_has_ivar'(Lit,V,Type,Pos)->true; assert('$aleph_has_ivar'(Lit,V,Type,Pos))), fail. add_ivars(_,_). add_vars(Lit,I,O):- get_var_types(I,Lit,IVarTypes), get_var_types(O,Lit,OVarTypes), ('$aleph_has_vars'(Lit,IVarTypes,OVarTypes) -> true; assert('$aleph_has_vars'(Lit,IVarTypes,OVarTypes))). get_var_types([],_,[]). get_var_types([Pos/Type|PlaceTypes],Lit,[Var/Type|Rest]):- tparg(Pos,Lit,Var), get_var_types(PlaceTypes,Lit,Rest). get_o_links([],_,_,Goals,Goals). get_o_links([Pos/Type|T],Lit,VarTypes,GoalsSoFar,Goals):- tparg(Pos,Lit,V), Goal = (aleph_output_var(V,Type,VarTypes); aleph_output_var(V,Type,Lit,Pos)), prefix_lits((Goal),GoalsSoFar,G1), get_o_links(T,Lit,VarTypes,G1,Goals). get_i_links([],_,_,Goals,Goals). get_i_links([Pos/Type|T],Lit,VarTypes,GoalsSoFar,Goals):- tparg(Pos,Lit,V), Goal = aleph_input_var(V,Type,VarTypes), prefix_lits((Goal),GoalsSoFar,G1), get_i_links(T,Lit,VarTypes,G1,Goals). get_c_links([],_,Goals,Goals). get_c_links([Pos/Type|T],Lit,GoalsSoFar,Goals):- tparg(Pos,Lit,V), TypeFact =.. [Type,C], Goal = (TypeFact,V=C), prefix_lits((Goal),GoalsSoFar,G1), get_c_links(T,Lit,G1,Goals). aleph_input_var(Var,Type,VarTypes):- aleph_member(Var/Type1,VarTypes), nonvar(Type1), Type = Type1. aleph_output_var(Var,Type,VarTypes):- aleph_member(Var/Type1,VarTypes), nonvar(Type1), Type = Type1. aleph_output_var(_,_,_). aleph_output_var(Var,Type,Lit,ThisPos):- '$aleph_has_ovar'(Lit,Var,Type,Pos), Pos @< ThisPos. var_types([Head|Body],VarTypes):- hvar_types(Head,HVarTypes), bvar_types(Body,HVarTypes,BVarTypes), aleph_append(BVarTypes,HVarTypes,VarTypesList), sort(VarTypesList,VarTypes). hvar_types(Head,HVarTypes):- '$aleph_has_vars'(Head,IVarTypes,OVarTypes), aleph_append(IVarTypes,OVarTypes,HVarTypes). bvar_types([],V,V). bvar_types([Lit|Lits],VTSoFar,BVarTypes):- '$aleph_has_vars'(Lit,IVarTypes,OVarTypes), consistent_vartypes(IVarTypes,VTSoFar), \+ inconsistent_vartypes(OVarTypes,VTSoFar), aleph_append(OVarTypes,VTSoFar,VT1), bvar_types(Lits,VT1,BVarTypes). consistent_vartypes([],_). consistent_vartypes([Var/Type|VarTypes],VTSoFar):- aleph_member2(Var/Type,VTSoFar), consistent_vartypes(VarTypes,VTSoFar). inconsistent_vartypes([Var/Type|_],VTSoFar):- aleph_member(Var1/Type1,VTSoFar), Var == Var1, Type \== Type1, !. inconsistent_vartypes([_|VarTypes],VTSoFar):- inconsistent_vartypes(VarTypes,VTSoFar). aleph_get_hlit(Name/Arity,Head):- functor(Head,Name,Arity), find_mode(modeh,Name/Arity,Mode), once(split_args(Mode,Mode,_,_,C)), copy_modeterms(Mode,Head,Arity), get_c_links(C,Head,true,Equalities), Equalities. aleph_get_lit(Lit,[H|Lits]):- functor(H,Name,Arity), aleph_get_lit(Lit,Name/Arity), '$aleph_link_vars'(Lit,[H|Lits]), \+(aleph_member2(Lit,[H|Lits])). aleph_get_lit(Lit,Target):- '$aleph_determination'(Target,Lit). % aleph_mode_linked(+Lits) % checks to see if a sequence of literals are within mode language % using information compiled by process_modes/0 aleph_mode_linked([H|B]):- aleph_mode_linked(B,[H]). aleph_mode_linked([],_):- !. aleph_mode_linked([Lit|Lits],LitsSoFar):- '$aleph_link_vars'(Lit,LitsSoFar), aleph_append([Lit],LitsSoFar,L1), aleph_mode_linked(Lits,L1). auto_refine(nil,Head):- example_saturated(Example), functor(Example,Name,Arity), aleph_get_hlit(Name/Arity,Head), Head \== nil. auto_refine(nil,Head):- '$aleph_global'(modeh,modeh(_,Pred)), functor(Pred,Name,Arity), aleph_get_hlit(Name/Arity,Head), Head \== nil. auto_refine((H:-B),(H1:-B1)):- !, goals_to_list((H,B),LitList), setting(clauselength,L), length(LitList,ClauseLength), ClauseLength < L, aleph_get_lit(Lit,LitList), aleph_append([Lit],LitList,LitList1), list_to_goals(LitList1,(H1,B1)), \+(prune((H1:-B1))), \+(tautology((H1:-B1))), (setting(language,Lang) -> lang_ok(Lang,H1,B1); true), (setting(newvars,NewVars) -> newvars_ok(NewVars,H1,B1); true). auto_refine(Head,Clause):- auto_refine((Head:-true),Clause). % refinement with lookahead auto_refine(1,Clause1,Clause2):- !, auto_refine(Clause1,Clause2). auto_refine(L,Clause1,Clause2):- L1 is L - 1, auto_refine(L1,Clause1,Clause), (Clause2 = Clause; auto_refine(Clause,Clause2)). auto_extend((H:-B),Lit,(H1:-B1)):- !, goals_to_list((H,B),LitList), setting(clauselength,L), length(LitList,ClauseLength), ClauseLength < L, aleph_get_lit(Lit,LitList), aleph_append([Lit],LitList,LitList1), list_to_goals(LitList1,(H1,B1)), (setting(language,Lang) -> lang_ok(Lang,H1,B1); true), (setting(newvars,NewVars) -> newvars_ok(NewVars,H1,B1); true), \+(tautology((H1:-B1))), \+(prune((H1:-B1))). tautology((nil:-Body)):- !, in(Body,L1,Rest), in(Rest,not(L2)), L1 == L2. tautology((Head:-Body)):- in(Body,Lit), Head == Lit, !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A U T O -- M O D E % automatic inference of mode declarations given a set of % determinations. The procedure works in two parts: (i) finding % equivalence classes of types; and (ii) finding an input/output % assignment. % % Finding equivalence classes of types is similar to % the work of McCreath and Sharma, Proc of the 8th Australian % Joint Conf on AI pages 75-82, 1995. However, unlike there % types in the same equivalence class are given the same name only if % they "overlap" significantly (the overlap of type1 with type2 % is the proportion of elements of type1 that are also elements of type2). % Significantly here means an overlap at least some threshold % T (set using typeoverlap, with default 0.95). % Since this may not be perfect, modes are also produced % for equality statements that re-introduce co-referencing amongst % differently named types in the same equivalence class. % The user has to however explicitly include a determination declaration for % the equality predicate. % % The i/o assignment is not straightforward, as we may be dealing % with non-functional definitions. The assignment sought here is one % that maximises the number of input args as this gives the % largest bottom clause. This assignment is % is sought by means of a search procedure over mode sequences. % Suppose we have a mode sequence M = that uses the types T. % An argument of type t in mode m{i} is an input iff t overlaps % significantly (used in the same sense as earlier) with some type in T. % Otherwise the argument is an output. % The utility of each mode sequence M is f(M) = g(M) + h(M) where % g(M) is the number of input args in M; and h(M) is a (lower) estimate % of the number of input args in any mode sequence of which M is a prefix. % The search strategy adopted is a simple hill-climbing one. % % All very complicated: there must be a simpler approach. % Requires generative background predicates. search_modes:- '$aleph_global'(targetpred,targetpred(N/A)), findall(N1/A1,determinations(N/A,N1/A1),L), number_types([N/A|L],0,TypedPreds,Last), get_type_elements(TypedPreds), interval_to_list(1-Last,Types), get_type_equivalences(Types,Equiv1), merge_equivalence_classes(Equiv1,Equiv), store_type_equivalences(Equiv), setting(typeoverlap,Thresh), infer_modes(TypedPreds,Thresh,Types,Modes), infer_equalities(EqModes), Modes = [_|BodyModes], infer_negations(BodyModes,NegModes), (setting(updateback,Update) -> true; Update = true), p_message('found modes'), add_inferred_modes(Modes,Update), add_inferred_modes(EqModes,Update), add_inferred_modes(NegModes,Update), fail. search_modes. number_types([],Last,[],Last). number_types([N/A|T],L0,[Pred|T1],L1):- functor(Pred,N,A), L is L0 + A, number_types(A,L,Pred), number_types(T,L,T1,L1). number_types(0,_,_):- !. number_types(A,N,Pred):- arg(A,Pred,N), A1 is A - 1, N1 is N - 1, number_types(A1,N1,Pred). get_type_elements([]). get_type_elements([Pred|Preds]):- functor(Pred,Name,Arity), functor(Template,Name,Arity), interval_to_list(1-Arity,AL), get_type_elements(example(_,_,Template),Template,Pred,AL), get_type_elements(Template,Template,Pred,AL), get_type_elements(Preds). get_type_elements(Fact,Template,Pred,AL):- aleph_member(Arg,AL), findall(Val,(Fact,ground(Fact),arg(Arg,Template,Val)),Vals), arg(Arg,Pred,Type), sort(Vals,SVals), (retract('$aleph_search'(modes,type(Type,_,OtherVals))) -> aleph_ord_union(SVals,OtherVals,ArgVals); ArgVals = SVals), length(ArgVals,N), asserta('$aleph_search'(modes,type(Type,N,ArgVals))), fail. get_type_elements(_,_,_,_). get_type_equivalences([],[]). get_type_equivalences([First|Rest],[Class|Classes]):- get_type_equivalence(Rest,[First],Class,Left), get_type_equivalences(Left,Classes). get_type_equivalence([],Class1,Class,[]):- sort(Class1,Class). get_type_equivalence([Type|Rest],Class1,Class,Left):- type_equivalent(Class1,Type), !, get_type_equivalence(Rest,[Type|Class1],Class,Left). get_type_equivalence([Type|Rest],Class1,Class,[Type|Left]):- get_type_equivalence(Rest,Class1,Class,Left). merge_equivalence_classes([Class],[Class]):- !. merge_equivalence_classes(Classes1,Classes2):- aleph_delete(Class1,Classes1,Left), aleph_delete(Class2,Left,Left1), class_equivalent(Class1,Class2), !, aleph_ord_union(Class1,Class2,NewClass), merge_equivalence_classes([NewClass|Left1],Classes2). merge_equivalence_classes(Classes,Classes). class_equivalent(Class1,Class2):- aleph_member(Type1,Class1), type_equivalent(Class2,Type1), !. type_equivalent([T1|_],T2):- '$aleph_search'(modes,type(T1,_,E1)), '$aleph_search'(modes,type(T2,_,E2)), intersects(E1,E2), !. type_equivalent([_|T],T2):- type_equivalent(T,T2). store_type_equivalences([]). store_type_equivalences([[CType|Class]|Classes]):- length([CType|Class],N), store_type_equivalence([CType|Class],CType,N), store_type_equivalences(Classes). store_type_equivalence([],_,_). store_type_equivalence([Type|Types],CType,Neq):- retract('$aleph_search'(modes,type(Type,N,Elements))), store_type_overlaps(Types,Type,Elements,N), asserta('$aleph_search'(modes,type(Type,CType,Neq,N,Elements))), store_type_equivalence(Types,CType,Neq). store_type_overlaps([],_,_,_). store_type_overlaps([T1|Types],T,E,N):- '$aleph_search'(modes,type(T1,N1,E1)), aleph_ord_intersection(E1,E,Int), length(Int,NInt), O is NInt/N, O1 is NInt/N1, asserta('$aleph_search'(modes,typeoverlap(T,T1,O,O1))), store_type_overlaps(Types,T,E,N). infer_modes([Head|Rest],Thresh,Types,[Head1|Rest1]):- infer_mode(Head,Thresh,head,[],Head1,Seen), aleph_delete_list(Seen,Types,TypesLeft), infer_ordered_modes(Rest,Thresh,body,Seen,TypesLeft,Rest1). infer_ordered_modes([],_,_,_,_,[]):- !. infer_ordered_modes(L,Thresh,Loc,Seen,Left,[Mode|Rest]):- score_modes(L,Thresh,Seen,Left,ScoredPreds), keysort(ScoredPreds,[_-Pred|_]), infer_mode(Pred,Thresh,Loc,Seen,Mode,Seen1), aleph_delete(Pred,L,L1), aleph_delete_list(Seen1,Left,Left1), infer_ordered_modes(L1,Thresh,Loc,Seen1,Left1,Rest). score_modes([],_,_,_,[]). score_modes([Pred|Preds],Thresh,Seen,Left,[Cost-Pred|Rest]):- Pred =.. [_|Types], evaluate_backward(Types,Thresh,Seen,G), aleph_delete_list(Types,Left,Left1), estimate_forward(Seen,Thresh,Left1,H0), estimate_forward(Types,Thresh,Left1,H1), Diff is H1 - H0, (Diff < 0 -> H is 0; H is Diff), Cost is -(G + H), score_modes(Preds,Thresh,Seen,Left,Rest). evaluate_backward([],_,_,0.0). evaluate_backward([Type|Types],Thresh,Seen,Score):- best_overlap(Seen,Type,_,Overlap), (Overlap >= Thresh -> Score1 = 1.0; Score1 = 0.0), evaluate_backward(Types,Thresh,Seen,Score2), Score is Score1 + Score2. estimate_forward([],_,_,0.0). estimate_forward([Type|Types],Thresh,Left,Score):- estimate_forward1(Left,Thresh,Type,S1), estimate_forward(Types,Thresh,Left,S2), Score is S1 + S2. estimate_forward1([],_,_,0.0). estimate_forward1([T1|Types],Thresh,T,Score):- type_overlap(T1,T,O1), (O1 >= Thresh -> S1 is 1.0; S1 is 0.0), estimate_forward1(Types,Thresh,T,S2), Score is S1 + S2. infer_mode(Pred,Thresh,Loc,Seen0,InferredMode,Seen):- Pred =.. [Name|Types], infer_mode1(Types,Thresh,Loc,Seen0,Modes), Mode =.. [Name|Modes], length(Types,Arity), ('$aleph_global'(targetpred,targetpred(Name/Arity)) -> InferredMode = modeh(*,Mode); InferredMode = mode(*,Mode)), aleph_ord_union(Seen0,Types,Seen). infer_mode1([],_,_,_,[]). infer_mode1([Type|Types],Thresh,Loc,Seen,[Mode|Modes]):- best_overlap(Seen,Type,Best,Overlap), (Overlap >= Thresh -> '$aleph_search'(modes,typemapped(Best,_,NewType)), asserta('$aleph_search'(modes,typemapped(Type,Best,NewType))), concat([type,NewType],Name), Mode = +Name; (Overlap > 0.0 -> asserta('$aleph_search'(modes,typemapped(Type,Best,Type))); asserta('$aleph_search'(modes,typemapped(Type,Type,Type)))), concat([type,Type],Name), (Loc = head -> Mode = +Name; Mode = -Name) ), infer_mode1(Types,Thresh,Loc,Seen,Modes). best_overlap([T1],T,T1,O):- !, type_overlap(T,T1,O). best_overlap([T1|Types],T,Best,O):- type_overlap(T,T1,O1), best_overlap(Types,T,T2,O2), (O2 > O1 -> O is O2, Best = T2; O is O1, Best = T1). best_overlap([],T,T,0.0). type_overlap(T,T1,O):- T > T1, !, ('$aleph_search'(modes,typeoverlap(T1,T,_,O)) -> true; O = 0.0). type_overlap(T,T1,O):- ('$aleph_search'(modes,typeoverlap(T,T1,O,_)) -> true; O = 0.0). infer_equalities(EqModes):- findall(mode(1,(Eq)),(pairwise_equality(Eq);grounding_equality(Eq)), EqL), sort(EqL,EqModes). infer_negations([],[]). infer_negations([mode(_,Pred)|Modes],NegModes):- Pred =.. [_|Args], aleph_member1(-_,Args), !, infer_negations(Modes,NegModes). infer_negations([mode(_,Pred)|Modes],[mode(1,not(Pred))|NegModes]):- infer_negations(Modes,NegModes). pairwise_equality((+N1 = +N2)):- '$aleph_search'(modes,typemapped(_,Best,T1)), '$aleph_search'(modes,typemapped(Best,_,T2)), T1 \== T2, concat([type,T1],N1), concat([type,T2],N2). grounding_equality((+N1 = #N1)):- '$aleph_search'(modes,typemapped(T1,_,T1)), concat([type,T1],N1). add_inferred_modes([],_). add_inferred_modes([Mode|Modes],Flag):- write(Mode), nl, (Flag = true -> Mode; true), add_inferred_modes(Modes,Flag). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % S T O C H A S T I C S E A R C H % sample_clauses(+N,-Clauses) % return sample of at most N legal clauses from hypothesis space % If a bottom clause exists then % Each clause is drawn randomly. The length of the clause is % determined by: % (a) user-specified distribution over clauselengths % using set(clauselength_distribution,Distribution); % Distribution is a list of the form p1-1, p2-2,... % specifying that clauselength 1 has prob p1, etc. % Note: sum pi must = 1. This is not checked; or % (b) uniform distribution over all legal clauses. % (if clauselength_distribution is not set) % this uses a Monte-Carlo estimate of the number of % legal clauses in the hypothesis space % If a bottom clause does not exist, then legal clauses are constructed % using the mode declarations. Only option (a) is allowed. If % clauselength_distribution is not set, then a uniform distribution over % lengths is assumed. % Each element of Clauses is of the form L-[E,T,Lits,Clause] where % L is the clauselength; E,T are example number and type (pos, neg) used % to build the bottom clause; Lits contains the literal numbers in the % bottom clause for Clause. If no bottom clause then E,T = 0 and Lits = [] % Clauses is in ascending order of clause length sample_clauses(N,Clauses):- setting(construct_bottom,Bottom), sample_nclauses(Bottom,N,Clauses). sample_nclauses(nil,N,Clauses):- !, gen_auto_refine, (setting(clauselength_distribution,D) -> true; setting(clauselength,CL), Uniform is 1.0/CL, distrib(1-CL,Uniform,D)), sample_nclauses_using_modes(N,D,CList), remove_alpha_variants(CList,CList1), keysort(CList1,Clauses). sample_nclauses(_,N,Clauses):- retractall('$aleph_sat'(random,rselect(_))), ('$aleph_sat'(example,example(_,_)) -> true; rsat), setting(clauselength,CL), (setting(clauselength_distribution,Universe) -> Sample is N; estimate_numbers(CL,1,400,Universe), (N > Universe -> Sample is Universe; Sample is N)), get_clause_sample(Sample,Universe,CL,CList), keysort(CList,Clauses). % sample_nclauses_using_modes(+N,+D,-Clauses) % get upto N legal clauses using mode declarations % and distribution D over clauselengths sample_nclauses_using_modes(0,_,[]):- !. sample_nclauses_using_modes(N,D,[Clause|Rest]):- legal_clause_using_modes(100,D,Clause), N1 is N - 1, sample_nclauses_using_modes(N1,D,Rest). % legal_clause_using_modes(+N,+D,-Clause) % make at most N attempts to obtain a legal clause Clause % from mode language using distribution D over clauselengths % if all N attempts fail, then just return most general clause legal_clause_using_modes(N,D,L-[0,0,[],Clause]):- N > 0, sample_clause_using_modes(D,L,Clause), \+(prune(Clause)), split_clause(Clause,Head,Body), (setting(language,Lang) -> lang_ok(Lang,Head,Body); true), (setting(newvars,NewVars) -> newvars_ok(NewVars,Head,Body); true), !. legal_clause_using_modes(N,D,Clause):- N > 1, N1 is N - 1, legal_clause_using_modes(N1,D,Clause), !. legal_clause_using_modes(_,_,1-[0,0,[],Clause]):- sample_clause_using_modes([1.0-1],1,Clause). sample_clause_using_modes(D,L,Clause):- findall(H,auto_refine(nil,H),HL), HL \= [], random_select(Head,HL,_), draw_element(D,L), (L = 1 -> Clause = Head; L1 is L - 1, sample_clause_using_modes(L1,Head,Clause)). sample_clause_using_modes(N,ClauseSoFar,Clause):- findall(C,auto_refine(ClauseSoFar,C),CL), CL \= [], !, (N = 1 -> random_select(Clause,CL,_); random_select(C1,CL,_), N1 is N - 1, sample_clause_using_modes(N1,C1,Clause)). sample_clause_using_modes(_,Clause,Clause). % get_clause_sample(+N,+U,+CL,-Clauses) % get upto N legal clauses of at most length CL drawn from universe U % U is either the total number of legal clauses % or a distribution over clauselengths % the clauses are constructed by drawing randomly from bottom get_clause_sample(0,_,_,[]):- !. get_clause_sample(N,Universe,CL,[L-[E,T,C1,C]|Clauses]):- (number(Universe) -> get_rrandom(Universe,ClauseNum), num_to_length(ClauseNum,CL,L), UpperLim is CL; draw_element(Universe,L), UpperLim is L), draw_legalclause_wo_repl(L,UpperLim,C,C1), !, '$aleph_sat'(example,example(E,T)), N1 is N - 1, get_clause_sample(N1,Universe,CL,Clauses). get_clause_sample(N,Universe,CL,Clauses):- N1 is N - 1, get_clause_sample(N1,Universe,CL,Clauses). % draw_legalclause_wo_repl(+L,+CL,-C,-Lits) % randomly draw without replacement a legal clause of length >= L and =< CL % also returns literals from bottom used to construct clause draw_legalclause_wo_repl(L,CL,C,C1):- L =< CL, randclause_wo_repl(L,C,legal,C1), !. draw_legalclause_wo_repl(L,CL,C,C1):- L < CL, L1 is L + 1, draw_legalclause_wo_repl(L1, CL,C,C1). % estimate_clauselength_distribution(+L,+T,+K,-D) % for each clauselength l <= L, estimate the probability of % drawing a good clause % here, a ``good clause'' is one that is in the top K-percentile of clauses % estimation is by Monte Carlo using at most T trials % probabilities are normalised to add to 1 estimate_clauselength_distribution(L,T,K,D):- '$aleph_sat'(example,example(Type,Example)), '$aleph_sat'(random,clauselength_distribution(Type,Example,L,T,K,D)), !. estimate_clauselength_distribution(L,T,K,D):- setting(evalfn,Evalfn), estimate_clauselength_scores(L,T,Evalfn,[],S), select_good_clauses(S,K,Good), estimate_frequency(L,Good,Freq), normalise_distribution(Freq,D), ('$aleph_sat'(example,example(Type,Example)) -> asserta('$aleph_sat'(random,clauselength_distribution(Type, Example,L,T,K,D))); true). estimate_clauselength_scores(0,_,_,S,S):- !. estimate_clauselength_scores(L,T,Evalfn,S1,S):- set(clauselength_distribution,[1.0-L]), p1_message('Estimate scores of clauses with length'), p_message(L), sample_clauses(T,Clauses), estimate_scores(Clauses,Evalfn,S1,S2), L1 is L - 1, estimate_clauselength_scores(L1,T,Evalfn,S2,S). estimate_scores([],_,S,S):- !. estimate_scores([L-[_,_,_,C]|Rest],Evalfn,S1,S):- label_create(C,Label), extract_count(pos,Label,PC), extract_count(neg,Label,NC), complete_label(Evalfn,C,[PC,NC,L],[_,_,_,Val|_]), estimate_scores(Rest,Evalfn,[-Val-L|S1],S). % ``good'' clauses are defined to be those in the top K-percentile % policy on ties is to include them select_good_clauses(S,K,Good):- keysort(S,S1), length(S1,Total), N is integer(K*Total/100), select_good_clauses(S1,N,[],Good). select_good_clauses([],_,Good,Good):- !. select_good_clauses(_,N,Good,Good):- N =< 0, !. select_good_clauses([Score-X|T],N,GoodSoFar,Good):- select_good_clauses(T,Score,N,[Score-X|GoodSoFar],N0,Good1,T1), N1 is N0 - 1, select_good_clauses(T1,N1,Good1,Good). select_good_clauses([],_,N,G,N,G,[]):- !. select_good_clauses([Score-X|T],Score,N,GoodSoFar,N0,Good1,T1):- !, N1 is N - 1, select_good_clauses(T,Score,N1,[Score-X|GoodSoFar],N0,Good1,T1). select_good_clauses(L,_,N,G,N,G,L). estimate_frequency(0,_,[]). estimate_frequency(L,Good,[N-L|T]):- count_frequency(Good,L,N), L1 is L - 1, estimate_frequency(L1,Good,T). count_frequency([],_,0). count_frequency([Entry|T],X,N):- count_frequency(T,X,N1), (Entry = _-X -> N is N1 + 1; N is N1). % estimate total number of legal clauses in space % bounded by bot estimate_numbers(Total):- ('$aleph_sat'(example,example(_,_)) -> true; rsat), setting(clauselength,CL), estimate_numbers(CL,1,400,Total). % estimate_numbers(+L,+Trials,+Sample,-T) % estimate total number of legal clauses of length <= L in space % bounded by bot % estimated number is cached for future use % estimation is by Monte Carlo, averaged over Trials trials % with given sample size estimate_numbers(L,Trials,Sample,Total):- '$aleph_sat'(example,example(Type,Example)), '$aleph_sat'(random,sample(Type,Example,L,Trials,Sample)), '$aleph_sat'(random,hypothesis_space(Total)), !. estimate_numbers(L,Trials,Sample,Total):- retractall('$aleph_sat'(random,sample(_,_,_,_,_))), retractall('$aleph_sat'(random,hypothesis_space(_))), estimate_numbers(L,Trials,Sample,0,Total), asserta('$aleph_sat'(random,hypothesis_space(Total))), '$aleph_sat'(example,example(Type,Example)), asserta('$aleph_sat'(random,sample(Type,Example,L,Trials,Sample))). % estimate_numbers(+L,+Trials,+Sample,+TotalSoFar,-Total) % estimate the number of legal clauses of length <= L % estimated number of legal clauses at each length are cached for future use % TotalSoFar is an accumulator of the number legal clauses so far % Total is the cumulative total of the number of legal clauses estimate_numbers(0,_,_,T,T):- !. estimate_numbers(L,Trials,Sample,TotalSoFar,T):- retractall('$aleph_sat'(random,number_of_clauses(L,_))), estimate_number(Trials,Sample,L,T0), asserta('$aleph_sat'(random,number_of_clauses(L,T0))), L1 is L - 1, T1 is T0 + TotalSoFar, estimate_numbers(L1,Trials,Sample,T1,T). % estimate_number(+T,+S,+L,-N) % monte carlo estimate of number of legal clauses of length L % estimate formed from average over T trials with sample S estimate_number(_,_,L,0):- '$aleph_sat'(lastlit,Last), Last < L, !. estimate_number(T,S,L,N):- T > 0, p1_message('Estimate legal clauses with length'), p_message(L), estimate_number(T,S,0,L,Total), N is float(Total/T), concat(['trials=',T,' sample=', S, ' estimate=', N],Mess), p_message(Mess). estimate_number(1,S,Total,L,N):- !, estimate_number(L,S,N1), N is Total + N1. estimate_number(T,S,Total,L,N):- p_message('New Trial'), estimate_number(L,S,N1), Total1 is Total + N1, T1 is T - 1, estimate_number(T1,S,Total1,L,N). % estimate_number(+L,+S,-N) % estimate the number of legal clauses of length L in the search space % estimation based on sample size S estimate_number(1,_,1):- !. estimate_number(L,S,N):- estimate_proportion(S,L,legal,P,_), '$aleph_sat'(lastlit,Last), total_clauses(L,Last,Total), N is float(P*Total). % estimate_proportion(+N,+L,+S,-P,-Clauses) % estimate prop. of at most N random clauses of length L and status S % clauses are generated without replacement % S is one of legal or illegal depending on whether C is inside or % outside the mode language provided % Clauses is the list of at most N def. clauses % If S is a variable then clauses can be legal or illegal % Thus estimate_proportion(10000,2,S,P,C) returns the % proportion and list of 2 literal clauses which are either % legal or illegal in a sample of at most 10000 % Keeps legal clauses obtained in rselect_legal for later use estimate_proportion(0,_,_,0,[]):- !. estimate_proportion(N,L,S,P,Clauses):- retractall('$aleph_sat'(random,rselect(_))), retractall('$aleph_sat'(random,rselect_legal(L,_,_,_,_))), get_random_wo_repl(N,L,Clauses), length(Clauses,Total), count_clause_status(Clauses,S,A,_), (Total = 0 -> P = 0; P is A/Total), '$aleph_sat'(example,example(E,T)), retractall('$aleph_sat'(random,rselect(_))), store_legal_clauses(Clauses,L,E,T). % get_random_wo_repl(+N,+L,-List) % randomly construct at most N definite clauses of length L % returns Status/Clause list where Status is one of legal/illegal get_random_wo_repl(0,_,[]):- !. get_random_wo_repl(N,L,[S/[C,C1]|Clauses]):- randclause_wo_repl(L,C,S,C1), !, N1 is N - 1, get_random_wo_repl(N1,L,Clauses). get_random_wo_repl(_,_,[]). % print_distribution print_distribution:- write('Clause Length'), tab(8), write('Estimated number of clauses'), nl, write('_____________'), tab(8), write('___________________________'), nl, findall(L-N,'$aleph_sat'(random,number_of_clauses(L,N)),List), sort(List,List1), aleph_member(L-N,List1), write(L), tab(20), write(N), nl, fail. print_distribution:- nl, write('Estimated size of hypothesis space = '), ('$aleph_sat'(random,hypothesis_space(S)) -> true; S = 0), write(S), write(' clauses'), nl. % count_clause_status(+List,+Status,-C1,-C2) % count number of clauses in List with status Status % C1 is the number of such clauses % C2 is the number of clauses with some other status count_clause_status(_,S,_,0):- var(S), !. count_clause_status(Clauses,S,A,B):- count_clause_status1(Clauses,S,A,B). count_clause_status1([],_,0,0):- !. count_clause_status1([S1/_|T],S,A,B):- count_clause_status1(T,S,A1,B1), (S == S1 -> A is A1 + 1, B is B1; A is A1, B is B1 + 1). % store_legal_clauses(+List,+L,+E,+T) % store all legal clauses of length L obtained with bottom clause for % example E of type T % useful later when a random legal clause of length L is required store_legal_clauses([],_,_,_). store_legal_clauses([S/[C,C1]|Clauses],L,E,T):- (S == legal -> asserta('$aleph_sat'(random,rselect_legal(L,E,T,C,C1))); true), store_legal_clauses(Clauses,L,E,T). % randclause_wo_repl(+L,-C,-S,-Lits) % as randclause/4 but ensures that clause obtained is without replacement % only makes at most 100 attempts to find such a clause % also returns lits from bottom clause selected % if all attempts fail, then return the most general clause randclause_wo_repl(L,C,S,C1):- randclause_wo_repl(100,L,C,S,C1). randclause_wo_repl(N,L,C,S,C1):- N > 0, randclause(L,C,S,C1), % if not accounting for variable renamings % copy_term(C,C1), % if accounting for variable renamings % numbervars(C1,0,_), % if accounting for variable renamings \+(prune(C)), split_clause(C,Head,Body), (setting(language,Lang) -> lang_ok(Lang,Head,Body); true), (setting(newvars,NewVars) -> newvars_ok(NewVars,Head,Body); true), \+('$aleph_sat'(random,rselect(C1))), !, asserta('$aleph_sat'(random,rselect(C1))). randclause_wo_repl(N,L,C,S,C1):- N > 0, N1 is N - 1, randclause_wo_repl(N1,L,C,S,C1), !. randclause_wo_repl(_,1,C,S,C1):- randclause(1,C,S,C1). % if not accounting for variable renamings % copy_term(C,C1), % if accounting for variable renamings % numbervars(C1,0,_), % if accounting for variable renamings % randclause(+L,-C,-S,-Lits) % returns definite clause C of length L with status S comprised of Lits % drawn at random from the bottom clause % also returns the literals in the bottom clause that were selected % body literals of C are randomly selected from the bottom clause % S is one of legal or illegal depending on whether C is inside or % outside the mode language provided % needs a bottom clause to be constructed before it is meaningful % this can be done with the sat predicate for eg: sat(1) % if set(store_bottom,true) then use stored bottom clause instead % if S is legal, then checks to see if previously generated legal % clauses exist for this bottom clause (these would have been generated % when trying to estimate the number of legal clause at each length) randclause(1,C,legal,[1]):- !, bottom_key(_,_,Key,_), (Key = nil -> get_pclause([1],[],C,_,_,_); get_pclause([1],Key,[],C,_,_,_)). randclause(L,C,Status,Lits):- Status == legal, '$aleph_sat'(example,example(E,T)), retract('$aleph_sat'(random,rselect_legal(L,E,T,C,Lits))). % can do things more efficiently if we want to generate legal clauses only randclause(L,C,Status,Lits):- Status == legal, !, bottom_key(_,_,Key,_), (Key = nil -> '$aleph_sat_litinfo'(1,_,_,_,_,D); '$aleph_sat_litinfo'(1,Key,_,_,_,_,D)), L1 is L - 1, repeat, randselect1(L1,Key,D,[1],BodyLits), Lits = [1|BodyLits], clause_status(Lits,Key,[],legal,legal), !, (Key = nil -> get_pclause(Lits,[],C,_,_,_); get_pclause(Lits,Key,[],C,_,_,_)). randclause(L,C,Status,Lits):- L1 is L - 1, bottom_key(_,_,Key,_), (Key = nil -> '$aleph_sat'(lastlit,Last); '$aleph_sat'(lastlit,Key,Last)), repeat, randselect(L1,Last,Key,[],BodyLits), aleph_append(BodyLits,[1],Lits), clause_status(Lits,Key,[],legal,Status1), Status1 = Status, !, (Key = nil -> get_pclause(Lits,[],C,_,_,_); get_pclause(Lits,Key,[],C,_,_,_)). % clause_status(+Lits,+LitsSoFar,+StatusSoFar,-Status) % compute status of a clause % Lits is the lits left to add to the clause % LitsSoFar is the lits in the clause so far % StatusSoFar is the Status of the clause so far % if a literal to be added contains unbound input vars then % status is illegal clause_status(Lits,LitsSoFar,Status1,Status2):- bottom_key(_,_,Key,_), clause_status(Lits,Key,LitsSoFar,Status1,Status2). clause_status([],_,_,S,S):- !. clause_status([Lit|Lits],Key,LitsSoFar,S,S1):- get_ovars(LitsSoFar,Key,[],OVars), get_ivars([Lit],Key,[],IVars), aleph_subset1(IVars,OVars), !, aleph_append([Lit],LitsSoFar,Lits1), clause_status(Lits,Key,Lits1,S,S1). clause_status(_,_,_,_,illegal). % randselect(+L,+Last,+Key,+LitsSoFar,-Lits) % randomly select L distinct literals to give Lits % Last is the last literal number in the bottom clause % LitsSoFar is the literals selected so far randselect(0,_,_,_,[]):- !. randselect(_,Last,_,LitsSoFar,[]):- length(LitsSoFar,L1), L1 is Last - 1, !. randselect(L,Last,Key,LitsSoFar,[LitNum|Lits]):- get_rand_lit(Last,Key,LitsSoFar,LitNum), L1 is L - 1, randselect(L1,Last,Key,[LitNum|LitsSoFar],Lits). % randselect1(+L,+Key,+Avail,+LitsSoFar,-Lits) % randomly select L distinct literals from Avail to give Lits % LitsSoFar is the literals selected so far randselect1(0,_,_,_,[]):- !. randselect1(_,_,[],_,[]):- !. randselect1(L,Key,Avail,LitsSoFar,[LitNum|Lits]):- random_select(LitNum,Avail,Left), (Key = nil -> '$aleph_sat_litinfo'(LitNum,_,_,_,_,D); '$aleph_sat_litinfo'(LitNum,Key,_,_,_,_,D)), update_list(D,Left,Left1), aleph_delete_list([LitNum|LitsSoFar],Left1,Avail1), L1 is L - 1, randselect1(L1,Key,Avail1,[LitNum|LitsSoFar],Lits). % get_rand_lit(+Last,+Key,+LitsSoFar,-LitNum) % randomly select a literal number from 2 - Last % and not in list LitsSoFar % 2 because 1 is reserved for head literal get_rand_lit(Last,Key,LitsSoFar,LitNum):- repeat, get_rand_lit(Last,Key,LitNum), \+(aleph_member(LitNum,LitsSoFar)), !. % have to use repeat/0 in case literal number from random no generator % no longer exists in lits database get_rand_lit(Last,Key,LitNum):- repeat, get_random(Last,LitNum), LitNum > 1, (Key = nil -> '$aleph_sat_litinfo'(LitNum,_,_,_,_,_); '$aleph_sat_litinfo'(LitNum,Key,_,_,_,_,_)), !. % total_clauses(+L,+N1,-N2) % total number of clauses of length L is N2 % constructed from bottom clause of length N1 total_clauses(1,_,1.0):- !. total_clauses(L,Bot,N):- L1 is L - 1, Bot1 is Bot - 1, total_clauses(L1,Bot1,N1), N is N1*Bot1. % num_to_length(+N,+CL,-L) % find length of clause numbered N % clause length should be =< CL num_to_length(N,_,1):- N =< 1.0, !. num_to_length(N,CL,L):- num_to_length1(2,CL,N,1.0,L). num_to_length1(L,CL,_,_,CL):- L >= CL, !. num_to_length1(L,CL,N,TotalSoFar,Length):- '$aleph_sat'(random,number_of_clauses(L,T)), NClauses is TotalSoFar + T, (N =< NClauses -> (T < 1.0 -> Length is L - 1; Length = L) ; L1 is L + 1, num_to_length1(L1,CL,N,NClauses,Length)). % refinement operator for randomised local search % Type is one of clauses or theories rls_refine(clauses,_-[_,_,_,nil],Clause):- !, sample_clauses(1,[Clause]), \+(old_move(clauses,Clause)). rls_refine(clauses,Clause1,Clause2):- setting(moves,Max), MaxMoves is Max, once(retract('$aleph_search'(rls_move,M))), M =< MaxMoves, p1_message('move'), p_message(M), M1 is M + 1, asserta('$aleph_search'(rls_move,M1)), clause_move(Move,Clause1,Clause2), p_message(Move), \+(old_move(clauses,Clause2)). rls_refine(theories,[_-[_,_,_,nil]],Theory):- !, once(theory_move(add_clause,[],Theory)), \+(old_move(theories,Theory)). rls_refine(theories,Theory1,Theory2):- setting(moves,MaxMoves), once(retract('$aleph_search'(rls_move,M))), M =< MaxMoves, p1_message('move'), p_message(M), M1 is M + 1, asserta('$aleph_search'(rls_move,M1)), theory_move(_,Theory1,Theory2), \+(old_move(theories,Theory2)). % clause_move(+Type,+C1,-C2) % local moves from clause C1 to give C2 % A move is: % a) delete a literal from C1 (Type = delete_lit) % b) add a legal literal to C1 (Type = add_lit) clause_move(delete_lit,C1,C2):- C1 = L-[E,T,Lits,Clause], (Lits = [H|Rest] -> aleph_delete(_,Rest,Left), Lits1 = [H|Left], bottom_key(E,T,Key,_), clause_status(Lits1,Key,[],legal,legal), L1 is L - 1, (Key = nil -> get_pclause(Lits1,[],Clause1,_,_,_); get_pclause(Lits1,Key,[],Clause1,_,_,_)), \+(prune(Clause1)) ; clause_to_list(Clause,[Head|Body]), aleph_delete(_,Body,Left), aleph_mode_linked([Head|Left]), list_to_clause([Head|Left],Clause1), \+(prune(Clause1)), L1 is L - 1, Lits1 = []), C2 = L1-[E,T,Lits1,Clause1]. clause_move(add_lit,C1,C2):- C1 = L-[E,T,Lits,Clause], setting(clauselength,CL), L < CL, (Lits = [] -> auto_refine(Clause,Clause1), L1 is L + 1, Lits1 = []; aleph_delete(Lit,Lits,Left), bottom_key(E,T,Key,_), (Key = nil -> '$aleph_sat_litinfo'(Lit,_,_,_,_,D); '$aleph_sat_litinfo'(Lit,Key,_,_,_,_,D)), aleph_member(Lit1,D), \+(aleph_member(Lit1,Left)), aleph_append([Lit1],Lits,Lits1), clause_status(Lits1,Key,[],legal,legal), L1 is L + 1, (Key = nil -> get_pclause(Lits1,[],Clause1,_,_,_); get_pclause(Lits1,Key,[],Clause1,_,_,_)), \+(prune(Clause1))), C2 = L1-[E,T,Lits1,Clause1]. % theory_move(+Type,+T1,-T2) % local moves from theory T1 to give T2 % A move is: % a) delete a clause from T1 (Type = delete_clause) % b) add a legal clause to T1 (Type = add_clause) % c) delete a literal from a clause in T1 (Type = delete_lit) % d) add a legal literal to a clause in T1 (Type = add_lit) theory_move(delete_clause,T1,T2):- aleph_delete(_,T1,T2), T2 \= []. theory_move(add_clause,T1,T2):- setting(clauses,Max), length(T1,L), L < Max, sample_clauses(1,[Clause]), aleph_append([Clause],T1,T2). theory_move(delete_lit,T1,T2):- aleph_delete(Clause,T1,T), clause_move(delete_lit,Clause,Clause1), aleph_append([Clause1],T,T2). theory_move(add_lit,T1,T2):- aleph_delete(Clause,T1,T), clause_move(add_lit,Clause,Clause1), aleph_append([Clause1],T,T2). old_move(clauses,N-[_,_,L,C]):- (setting(cache_clauselength,N1) -> true; N1 = 3), N =< N1, (L = [] -> clause_to_list(C,C1), sort(C1,Hash), numbervars(Hash,0,_); sort(L,Hash)), ('$aleph_search_seen'(N,Hash) -> p_message('old move'), true; asserta('$aleph_search_seen'(N,Hash)), !, fail). old_move(theories,T):- % remove_alpha_variants(T,T1), numbervars(T,0,_), length(T,N), ('$aleph_search_seen'(N,Hash) -> p_message('old move'), true; asserta('$aleph_search_seen'(N,Hash)), !, fail). extract_clauses_with_length([],[]). extract_clauses_with_length([L-[_,_,_,C]|T],[L-C|T1]):- extract_clauses_with_length(T,T1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % U T I L I T I E S % concatenate elements of a list into an atom concat([Atom],Atom):- !. concat([H|T],Atom):- concat(T,AT), name(AT,L2), name(H,L1), aleph_append(L2,L1,L), name(Atom,L). split_clause((Head:-true),Head,true):- !. split_clause((Head:-Body1),Head,Body2):- !, Body1 = Body2. split_clause([Head|T],Head,T):- !. split_clause([Head],Head,[true]):- !. split_clause(Head,Head,true). strip_true((Head:-true),Head):- !. strip_true(Clause,Clause). % pretty print a definite clause pp_dclause(Clause):- ('$aleph_global'(portray_literals,set(portray_literals,true))-> pp_dclause(Clause,true); pp_dclause(Clause,nil)). % pretty print a set of definite clauses pp_dclauses(Theory):- aleph_member(_-[_,_,_,Clause],Theory), pp_dclause(Clause), fail. pp_dclauses(_):- nl. pp_dclause((H:-true),Pretty):- !, pp_dclause(H,Pretty). pp_dclause((H:-B),Pretty):- !, copy_term((H:-B),(Head:-Body)), numbervars((Head:-Body),0,_), aleph_portray(Head,Pretty), (Pretty = true -> write(' if:'); write(' :-')), nl, '$aleph_global'(print,set(print,N)), print_lits(Body,Pretty,1,N). pp_dclause((Lit),Pretty):- copy_term(Lit,Lit1), numbervars(Lit1,0,_), aleph_portray(Lit1,Pretty), write('.'), nl. % pretty print a definite clause list: head of list is + literal pp_dlist([]):- !. pp_dlist(Clause):- ('$aleph_global'(portray_literals,set(portray_literals,true))-> pp_dlist(Clause,true); pp_dlist(Clause,nil)). pp_dlist(Clause,Pretty):- copy_term(Clause,[Head1|Body1]), numbervars([Head1|Body1],0,_), aleph_portray(Head1,Pretty), (Body1 = [] -> write('.'), nl; (Pretty = true -> write(' if:'); write(' :-')), nl, '$aleph_global'(print,set(print,N)), print_litlist(Body1,Pretty,1,N)). print_litlist([],_,_,_). print_litlist([Lit],Pretty,LitNum,_):- !, print_lit(Lit,Pretty,LitNum,LitNum,'.',_). print_litlist([Lit|Lits],Pretty,LitNum,LastLit):- print_lit(Lit,Pretty,LitNum,LastLit,', ',NextLit), print_litlist(Lits,Pretty,NextLit,LastLit). print_lits((Lit,Lits),Pretty,LitNum,LastLit):- !, (Pretty = true -> Sep = ' and '; Sep = ', '), print_lit(Lit,Pretty,LitNum,LastLit,Sep,NextLit), print_lits(Lits,Pretty,NextLit,LastLit). print_lits((Lit),Pretty,LitNum,_):- print_lit(Lit,Pretty,LitNum,LitNum,'.',_). print_lit(Lit,Pretty,LitNum,LastLit,Sep,NextLit):- (LitNum = 1 -> tab(3);true), aleph_portray(Lit,Pretty), write(Sep), (LitNum=LastLit-> nl,NextLit=1; NextLit is LitNum + 1). p1_message(Mess):- write('['), write(Mess), write('] '). p_message(Mess):- write('['), write(Mess), write(']'), nl. err_message(Mess):- p1_message('error'), p_message(Mess). aleph_delete_all(_,[],[]). aleph_delete_all(X,[Y|T],T1):- X == Y, !, aleph_delete_all(X,T,T1). aleph_delete_all(X,[Y|T],[Y|T1]):- aleph_delete_all(X,T,T1). aleph_delete_list([],L,L). aleph_delete_list([H1|T1],L1,L):- aleph_delete(H1,L1,L2), !, aleph_delete_list(T1,L2,L). aleph_delete_list([_|T1],L1,L):- aleph_delete_list(T1,L1,L). aleph_delete(H,[H|T],T). aleph_delete(H,[H1|T],[H1|T1]):- aleph_delete(H,T,T1). aleph_delete1(H,[H|T],T):- !. aleph_delete1(H,[H1|T],[H1|T1]):- aleph_delete1(H,T,T1). aleph_delete0(_,[],[]). aleph_delete0(H,[H|T],T):- !. aleph_delete0(H,[H1|T],[H1|T1]):- aleph_delete0(H,T,T1). aleph_append(A,[],A). aleph_append(A,[H|T],[H|T1]):- aleph_append(A,T,T1). % aleph_remove_nth(+N,+List1,-Elem,-List2) % remove the nth elem from a List aleph_remove_nth(1,[H|T],H,T):- !. aleph_remove_nth(N,[H|T],X,[H|T1]):- N1 is N - 1, aleph_remove_nth(N1,T,X,T1). % aleph_remove_n(+N,+List1,-List2,-List3) % remove the n elems from List1 into List2. List3 is the rest of List1 aleph_remove_n(0,L,[],L):- !. aleph_remove_n(_,[],[],[]):- !. aleph_remove_n(N,[H|T],[H|T1],L):- N1 is N - 1, aleph_remove_n(N1,T,T1,L). % aleph_rpermute(+List1,-List2) % randomly permute the elements of List1 into List2 aleph_rpermute(List1,List2):- length(List1,N1), aleph_rpermute(List1,N1,List2). aleph_rpermute([],0,[]):- !. aleph_rpermute(L1,N1,[X|Rest]):- get_random(N1,R), aleph_remove_nth(R,L1,X,L2), N2 is N1 - 1, aleph_rpermute(L2,N2,Rest). % aleph_rsample(+N,+List1,-List2) % randomly sample N elements from List1 into List2 aleph_rsample(N,List1,List2):- length(List1,N1), aleph_rsample(N,N1,List1,List2). aleph_rsample(N,N1,L,L):- N >= N1, !. aleph_rsample(SampleSize,Total,[X|L1],[X|L2]):- get_random(Total,R), R =< SampleSize, !, SampleSize0 is SampleSize - 1, Total0 is Total - 1, aleph_rsample(SampleSize0,Total0,L1,L2). aleph_rsample(SampleSize,Total,[_|L1],L2):- Total0 is Total - 1, aleph_rsample(SampleSize,Total0,L1,L2). % get_first_n(+N,+List1,-List2) % get the first n elements in List1 get_first_n(0,_,[]):- !. get_first_n(_,[],[]):- !. get_first_n(N,[H|T],[H|T1]):- N1 is N - 1, get_first_n(N1,T,T1). % erase_refs(+List) % erase database references: only works for Yap erase_refs([]). erase_refs([DbRef|DbRefs]):- erase(DbRef), erase_refs(DbRefs). % max_in_list(+List,-Max) % return largest element in a list max_in_list([X],X):- !. max_in_list([X|T],Z):- max_in_list(T,Y), (X @> Y -> Z = X; Z = Y). % min_in_list(+List,-Max) % return largest element in a list min_in_list([X],X):- !. min_in_list([X|T],Z):- min_in_list(T,Y), (X @> Y -> Z = Y; Z = X). % remove_alpha_variants(+List1,-List2):- % remove alphabetic variants from List1 to give List2 remove_alpha_variants([],[]). remove_alpha_variants([X|Y],L):- aleph_member(X1,Y), alphabetic_variant(X,X1), !, remove_alpha_variants(Y,L). remove_alpha_variants([X|Y],[X|L]):- remove_alpha_variants(Y,L). % alphabetic_variant(+Term1,+Term2) % true if Term1 is the alphabetic variant of Term2 alphabetic_variant(Term1,Term2):- copy_term(Term1/Term2,T1/T2), numbervars(T1,0,_), numbervars(T2,0,_), T1 = T2. % tparg(+TermPlace,+Term1,?Term2) % return Term2 at position specified by TermPlace in Term1 tparg([Place],Term,Arg):- !, arg(Place,Term,Arg). tparg([Place|Places],Term,Arg):- arg(Place,Term,Term1), tparg(Places,Term1,Arg). aleph_member1(H,[H|_]):- !. aleph_member1(H,[_|T]):- aleph_member1(H,T). aleph_member2(X,[Y|_]):- X == Y, !. aleph_member2(X,[_|T]):- aleph_member2(X,T). aleph_member3(A,A-B):- A =< B. aleph_member3(X,A-B):- A < B, A1 is A + 1, aleph_member3(X,A1-B). aleph_member(X,[X|_]). aleph_member(X,[_|T]):- aleph_member(X,T). aleph_reverse(L1, L2) :- revzap(L1, [], L2). revzap([X|L], L2, L3) :- revzap(L, [X|L2], L3). revzap([], L, L). goals_to_clause((Head,Body),(Head:-Body)):- !. goals_to_clause(Head,Head). clause_to_list((Head:-true),[Head]):- !. clause_to_list((Head:-Body),[Head|L]):- !, goals_to_list(Body,L). clause_to_list(Head,[Head]). extend_clause(nil,Lit,(Lit)):- !. extend_clause((Head:-Body),Lit,(Head:-Body1)):- !, app_lit(Lit,Body,Body1). extend_clause(Head,Lit,(Head:-Lit)). app_lit(L,(L1,L2),(L1,L3)):- !, app_lit(L,L2,L3). app_lit(L,L1,(L1,L)). prefix_lits(L,true,L):- !. prefix_lits(L,L1,((L),L1)). get_goaldiffs((G1,G2),(G1,G3),Diffs):- !, get_goaldiffs(G2,G3,Diffs). get_goaldiffs(true,G,G):- !. get_goaldiffs(G1,(G1,G2),G2). nlits((_:-B),N):- !, nlits(B,N1), N is N1 + 1. nlits((_,Lits),N):- !, nlits(Lits,N1), N is N1 + 1. nlits(_,1). list_to_clause([Goal],(Goal:-true)):- !. list_to_clause([Head|Goals],(Head:-Body)):- list_to_goals(Goals,Body). list_to_goals([Goal],Goal):- !. list_to_goals([Goal|Goals],(Goal,Goals1)):- list_to_goals(Goals,Goals1). goals_to_list((true,Goals),T):- !, goals_to_list(Goals,T). goals_to_list((Goal,Goals),[Goal|T]):- !, goals_to_list(Goals,T). goals_to_list(true,[]):- !. goals_to_list(Goal,[Goal]). % get_litnums(+First,+Last,-LitNums) % get list of Literal numbers in the bottom clause get_litnums(LitNum,Last,[]):- LitNum > Last, !. get_litnums(LitNum,Last,[LitNum|LitNums]):- '$aleph_sat_litinfo'(LitNum,_,_,_,_,_), !, NextLit is LitNum + 1, get_litnums(NextLit,Last,LitNums). get_litnums(LitNum,Last,LitNums):- NextLit is LitNum + 1, get_litnums(NextLit,Last,LitNums). get_clause(LitNum,Last,_,[]):- LitNum > Last, !. get_clause(LitNum,Last,TVSoFar,[FAtom|FAtoms]):- '$aleph_sat_litinfo'(LitNum,_,Atom,_,_,_), !, get_flatatom(Atom,TVSoFar,FAtom,TV1), NextLit is LitNum + 1, get_clause(NextLit,Last,TV1,FAtoms). get_clause(LitNum,Last,TVSoFar,FAtoms):- NextLit is LitNum + 1, get_clause(NextLit,Last,TVSoFar,FAtoms). get_flatatom(not(Atom),TVSoFar,not(FAtom),TV1):- !, get_flatatom(Atom,TVSoFar,FAtom,TV1). get_flatatom(Atom,TVSoFar,FAtom,TV1):- functor(Atom,Name,Arity), functor(FAtom,Name,Arity), flatten_args(Arity,Atom,FAtom,TVSoFar,TV1). get_pclause([LitNum],TVSoFar,Clause,TV,Length,LastDepth):- !, get_pclause1([LitNum],TVSoFar,TV,Clause,Length,LastDepth). get_pclause([LitNum|LitNums],TVSoFar,Clause,TV,Length,LastDepth):- get_pclause1([LitNum],TVSoFar,TV1,Head,Length1,_), get_pclause1(LitNums,TV1,TV,Body,Length2,LastDepth), Clause = (Head:-Body), Length is Length1 + Length2. get_pclause1([LitNum],TVSoFar,TV1,Lit,Length,LastDepth):- !, '$aleph_sat_litinfo'(LitNum,LastDepth,Atom,_,_,_), get_flatatom(Atom,TVSoFar,Lit,TV1), functor(Lit,Name,_), (Name = '='-> Length = 0; Length = 1). get_pclause1([LitNum|LitNums],TVSoFar,TV2,(Lit,Lits1),Length,LastDepth):- '$aleph_sat_litinfo'(LitNum,_,Atom,_,_,_), get_flatatom(Atom,TVSoFar,Lit,TV1), get_pclause1(LitNums,TV1,TV2,Lits1,Length1,LastDepth), functor(Lit,Name,_), (Name = '='-> Length = Length1; Length is Length1 + 1). get_pclause([LitNum],Key,TVSoFar,Clause,TV,Length,LastDepth):- !, get_pclause1([LitNum],Key,TVSoFar,TV,Clause,Length,LastDepth). get_pclause([LitNum|LitNums],Key,TVSoFar,Clause,TV,Length,LastDepth):- get_pclause1([LitNum],Key,TVSoFar,TV1,Head,Length1,_), get_pclause1(LitNums,Key,TV1,TV,Body,Length2,LastDepth), Clause = (Head:-Body), Length is Length1 + Length2. get_pclause1([LitNum],Key,TVSoFar,TV1,Lit,Length,LastDepth):- !, '$aleph_sat_litinfo'(LitNum,Key,LastDepth,Atom,_,_,_), get_flatatom(Atom,TVSoFar,Lit,TV1), functor(Lit,Name,_), (Name = '='-> Length = 0; Length = 1). get_pclause1([LitNum|LitNums],Key,TVSoFar,TV2,(Lit,Lits1),Length,LastDepth):- '$aleph_sat_litinfo'(LitNum,Key,_,Atom,_,_,_), get_flatatom(Atom,TVSoFar,Lit,TV1), get_pclause1(LitNums,Key,TV1,TV2,Lits1,Length1,LastDepth), functor(Lit,Name,_), (Name = '='-> Length = Length1; Length is Length1 + 1). flatten_args(0,_,_,TV,TV):- !. flatten_args(Arg,Atom,FAtom,TV,TV1):- arg(Arg,Atom,Term), Arg1 is Arg - 1, (Term = aleph_const(Const) -> arg(Arg,FAtom,Const), flatten_args(Arg1,Atom,FAtom,TV,TV1); (integer(Term) -> update(TV,Term/Var,TV0), arg(Arg,FAtom,Var), flatten_args(Arg1,Atom,FAtom,TV0,TV1); (functor(Term,Name,Arity), functor(FTerm,Name,Arity), arg(Arg,FAtom,FTerm), flatten_args(Arity,Term,FTerm,TV,TV0), flatten_args(Arg1,Atom,FAtom,TV0,TV1) ) ) ). % returns intersection of S1, S2 and S1-Intersection intersect1(Elems,[],[],Elems):- !. intersect1([],_,[],[]):- !. intersect1([Elem|Elems],S2,[Elem|Intersect],ElemsLeft):- aleph_member1(Elem,S2), !, intersect1(Elems,S2,Intersect,ElemsLeft). intersect1([Elem|Elems],S2,Intersect,[Elem|ElemsLeft]):- intersect1(Elems,S2,Intersect,ElemsLeft). aleph_subset1([],_). aleph_subset1([Elem|Elems],S):- aleph_member1(Elem,S), !, aleph_subset1(Elems,S). aleph_subset2([X|Rest],[X|S]):- aleph_subset2(Rest,S). aleph_subset2(S,[_|S1]):- aleph_subset2(S,S1). aleph_subset2([],[]). % two sets are equal equal_set([],[]). equal_set([H|T],S):- aleph_delete1(H,S,S1), equal_set(T,S1), !. uniq_insert(_,X,[],[X]). uniq_insert(descending,H,[H1|T],[H,H1|T]):- H @> H1, !. uniq_insert(ascending,H,[H1|T],[H,H1|T]):- H @< H1, !. uniq_insert(_,H,[H|T],[H|T]):- !. uniq_insert(Order,H,[H1|T],[H1|T1]):- !, uniq_insert(Order,H,T,T1). quicksort(_,[],[]). quicksort(Order,[X|Tail],Sorted):- partition(X,Tail,Small,Big), quicksort(Order,Small,SSmall), quicksort(Order,Big,SBig), (Order=ascending-> aleph_append([X|SBig],SSmall,Sorted); aleph_append([X|SSmall],SBig,Sorted)). partition(_,[],[],[]). partition(X,[Y|Tail],[Y|Small],Big):- X @> Y, !, partition(X,Tail,Small,Big). partition(X,[Y|Tail],Small,[Y|Big]):- partition(X,Tail,Small,Big). update_list([],L,L). update_list([H|T],L,Updated):- update(L,H,L1), !, update_list(T,L1,Updated). update([],H,[H]). update([H|T],H,[H|T]):- !. update([H1|T],H,[H1|T1]):- update(T,H,T1). % checks if 2 sets intersect intersects(S1,S2):- aleph_member(Elem,S1), aleph_member1(Elem,S2), !. % checks if bitsets represented as lists of intervals intersect intervals_intersects([L1-L2|_],I):- intervals_intersects1(L1-L2,I), !. intervals_intersects([_|I1],I):- intervals_intersects(I1,I). intervals_intersects1(L1-_,[M1-M2|_]):- L1 >= M1, L1 =< M2, !. intervals_intersects1(L1-L2,[M1-_|_]):- M1 >= L1, M1 =< L2, !. intervals_intersects1(L1-L2,[_|T]):- intervals_intersects1(L1-L2,T). % checks if bitsets represented as lists of intervals intersect % returns first intersection intervals_intersects([L1-L2|_],I,I1):- intervals_intersects1(L1-L2,I,I1), !. intervals_intersects([_|ILeft],I,I1):- intervals_intersects(ILeft,I,I1). intervals_intersects1(I1,[I2|_],I):- interval_intersection(I1,I2,I), !. intervals_intersects1(I1,[_|T],I):- intervals_intersects1(I1,T,I). interval_intersection(L1-L2,M1-M2,L1-L2):- L1 >= M1, L2 =< M2, !. interval_intersection(L1-L2,M1-M2,M1-M2):- M1 >= L1, M2 =< L2, !. interval_intersection(L1-L2,M1-M2,L1-M2):- L1 >= M1, M2 >= L1, M2 =< L2, !. interval_intersection(L1-L2,M1-M2,M1-L2):- M1 >= L1, M1 =< L2, L2 =< M2, !. %most of the timeit no intersection, so optimise on that % optimisation by James Cussens intervals_intersection([],_,[]). intervals_intersection([A-B|T1],[C-D|T2],X) :- !, (A > D -> intervals_intersection([A-B|T1],T2,X); (C > B -> intervals_intersection(T1,[C-D|T2],X); (B > D -> (C > A -> X=[C-D|Y]; X=[A-D|Y] ), intervals_intersection([A-B|T1],T2,Y); (C > A -> X=[C-B|Y]; X=[A-B|Y] ), intervals_intersection(T1,[C-D|T2],Y) ) ) ). intervals_intersection(_,[],[]). % finds length of intervals in a list interval_count([],0). interval_count([L1-L2|T],N):- N1 is L2 - L1 + 1, interval_count(T,N2), N is N1 + N2. interval_count(I/_,N):- interval_count(I,N). % interval_select(+N,+List1,-Elem) % select the Nth elem from an interval list interval_select(N,[A-B|_],X):- N =< B - A + 1, !, X is A + N - 1. interval_select(N,[A-B|T],X):- N1 is N - (B - A + 1), interval_select(N1,T,X). % interval_sample(+N,List1,-List2) % get a random sample of N elements from List1 interval_sample(N,List1,List2):- intervals_to_list(List1,L1), aleph_rsample(N,L1,L2), list_to_intervals(L2,List2). % convert list to intervals list_to_intervals(List,Intervals):- sort(List,List1), list_to_intervals1(List1,Intervals). list_to_intervals1([],[]). list_to_intervals1([Start|T],[Start-Finish|I1]):- list_to_interval(Start,T,Finish,T1), list_to_intervals1(T1,I1). list_to_interval(Finish,[],Finish,[]). list_to_interval(Finish,[Next|T],Finish,[Next|T]):- Next - Finish > 1, !. list_to_interval(_,[Start|T],Finish,Rest):- list_to_interval(Start,T,Finish,Rest). % converts an interval-list into a list of (sorted) numbers intervals_to_list(L,L1):- intervals_to_list(L,[],L0), sort(L0,L1), !. intervals_to_list([],L,L). intervals_to_list([Interval|Intervals],L1,L2):- interval_to_list(Interval,L1,L), intervals_to_list(Intervals,L,L2). % converts an interval into a list interval_to_list(Start-Finish,[]):- Start > Finish, !. interval_to_list(Start-Finish,[Start|T]):- Start1 is Start+1, interval_to_list(Start1-Finish,T). % converts an interval into a list % with an accumulator list. Result will be in reverse order interval_to_list(Start-Finish,L,L):- Start > Finish, !. interval_to_list(Start-Finish,L,L1):- Start1 is Start+1, interval_to_list(Start1-Finish,[Start|L],L1). % interval_subsumes(+I1,+I2) % checks to see if interval I1 subsumes I2 interval_subsumes(Start1-Finish1,Start2-Finish2):- Start1 =< Start2, Finish1 >= Finish2. interval_subtract(Start1-Finish1,Start1-Finish1,[]):- !. interval_subtract(Start1-Finish1,Start1-Finish2,[S2-Finish1]):- !, S2 is Finish2 + 1. interval_subtract(Start1-Finish1,Start2-Finish1,[Start1-S1]):- !, S1 is Start2 - 1. interval_subtract(Start1-Finish1,Start2-Finish2,[Start1-S1,S2-Finish1]):- S1 is Start2 - 1, S2 is Finish2 + 1, S1 >= Start1, Finish1 >= S2, !. % code for set manipulation utilities % taken from the Yap library % aleph_ord_subtract(+Set1,+Set2,?Difference) % is true when Difference contains all and only the elements of Set1 % which are not also in Set2. aleph_ord_subtract(Set1,[],Set1) :- !. aleph_ord_subtract([],_,[]) :- !. aleph_ord_subtract([Head1|Tail1],[Head2|Tail2],Difference) :- compare(Order,Head1,Head2), aleph_ord_subtract(Order,Head1,Tail1,Head2,Tail2,Difference). aleph_ord_subtract(=,_, Tail1,_, Tail2,Difference) :- aleph_ord_subtract(Tail1,Tail2,Difference). aleph_ord_subtract(<,Head1,Tail1,Head2,Tail2,[Head1|Difference]) :- aleph_ord_subtract(Tail1,[Head2|Tail2],Difference). aleph_ord_subtract(>,Head1,Tail1,_, Tail2,Difference) :- aleph_ord_subtract([Head1|Tail1],Tail2,Difference). % aleph_ord_disjoint(+Set1,+Set2) % is true when the two ordered sets have no element in common. If the % arguments are not ordered,I have no idea what happens. aleph_ord_disjoint([],_) :- !. aleph_ord_disjoint(_,[]) :- !. aleph_ord_disjoint([Head1|Tail1],[Head2|Tail2]) :- compare(Order,Head1,Head2), aleph_ord_disjoint(Order,Head1,Tail1,Head2,Tail2). aleph_ord_disjoint(<,_,Tail1,Head2,Tail2) :- aleph_ord_disjoint(Tail1,[Head2|Tail2]). aleph_ord_disjoint(>,Head1,Tail1,_,Tail2) :- aleph_ord_disjoint([Head1|Tail1],Tail2). % aleph_ord_union(+Set1,+Set2,?Union) % is true when Union is the union of Set1 and Set2. Note that when % something occurs in both sets,we want to retain only one copy. aleph_ord_union(Set1,[],Set1) :- !. aleph_ord_union([],Set2,Set2) :- !. aleph_ord_union([Head1|Tail1],[Head2|Tail2],Union) :- compare(Order,Head1,Head2), aleph_ord_union(Order,Head1,Tail1,Head2,Tail2,Union). aleph_ord_union(=,Head, Tail1,_, Tail2,[Head|Union]) :- aleph_ord_union(Tail1,Tail2,Union). aleph_ord_union(<,Head1,Tail1,Head2,Tail2,[Head1|Union]) :- aleph_ord_union(Tail1,[Head2|Tail2],Union). aleph_ord_union(>,Head1,Tail1,Head2,Tail2,[Head2|Union]) :- aleph_ord_union([Head1|Tail1],Tail2,Union). % aleph_ord_union(+Set1,+Set2,?Union,?Difference) % is true when Union is the union of Set1 and Set2 and Difference is the % difference between Set2 and Set1. aleph_ord_union(Set1,[],Set1,[]) :- !. aleph_ord_union([],Set2,Set2,Set2) :- !. aleph_ord_union([Head1|Tail1],[Head2|Tail2],Union,Diff) :- compare(Order,Head1,Head2), aleph_ord_union(Order,Head1,Tail1,Head2,Tail2,Union,Diff). aleph_ord_union(=,Head, Tail1,_, Tail2,[Head|Union],Diff) :- aleph_ord_union(Tail1,Tail2,Union,Diff). aleph_ord_union(<,Head1,Tail1,Head2,Tail2,[Head1|Union],Diff) :- aleph_ord_union(Tail1,[Head2|Tail2],Union,Diff). aleph_ord_union(>,Head1,Tail1,Head2,Tail2,[Head2|Union],[Head2|Diff]) :- aleph_ord_union([Head1|Tail1],Tail2,Union,Diff). aleph_ord_intersection(_,[],[]) :- !. aleph_ord_intersection([],_,[]) :- !. aleph_ord_intersection([Head1|Tail1],[Head2|Tail2],Intersection) :- compare(Order,Head1,Head2), aleph_ord_intersection(Order,Head1,Tail1,Head2,Tail2,Intersection). aleph_ord_intersection(=,Head,Tail1,_,Tail2,[Head|Intersection]) :- aleph_ord_intersection(Tail1,Tail2,Intersection). aleph_ord_intersection(<,_,Tail1,Head2,Tail2,Intersection) :- aleph_ord_intersection(Tail1,[Head2|Tail2],Intersection). aleph_ord_intersection(>,Head1,Tail1,_,Tail2,Intersection) :- aleph_ord_intersection([Head1|Tail1],Tail2,Intersection). aleph_ord_subset([], _) :- !. aleph_ord_subset([Head1|Tail1], [Head2|Tail2]) :- compare(Order, Head1, Head2), aleph_ord_subset(Order, Head1, Tail1, Head2, Tail2). aleph_ord_subset(=, _, Tail1, _, Tail2) :- aleph_ord_subset(Tail1, Tail2). aleph_ord_subset(>, Head1, Tail1, _, Tail2) :- aleph_ord_subset([Head1|Tail1], Tail2). vars_in_term([],Vars,Vars1):- sort(Vars,Vars1), !. vars_in_term([Var|T],VarsSoFar,Vars):- var(Var), !, vars_in_term(T,[Var|VarsSoFar],Vars). vars_in_term([Term|T],VarsSoFar,Vars):- Term =.. [_|Terms], !, vars_in_term(Terms,VarsSoFar,V1), vars_in_term(T,V1,Vars). vars_in_term([_|T],VarsSoFar,Vars):- vars_in_term(T,VarsSoFar,Vars). occurs_in(Vars,(Lit,_)):- occurs_in(Vars,Lit), !. occurs_in(Vars,(_,Lits)):- !, occurs_in(Vars,Lits). occurs_in(Vars,Lit):- functor(Lit,_,Arity), occurs1(Vars,Lit,1,Arity). occurs1(Vars,Lit,Argno,MaxArgs):- Argno =< MaxArgs, arg(Argno,Lit,Term), vars_in_term([Term],[],Vars1), aleph_member(X,Vars), aleph_member(Y,Vars1), X == Y, !. occurs1(Vars,Lit,Argno,MaxArgs):- Argno < MaxArgs, Next is Argno + 1, occurs1(Vars,Lit,Next,MaxArgs). declare_dynamic(Name/Arity):- dynamic Name/Arity. aleph_abolish(Name/Arity):- functor(Pred,Name,Arity), (predicate_property(Pred,dynamic) -> retractall(Pred); abolish(Name/Arity)). aleph_open(File,read,Stream):- !, (exists(File) -> open(File,read,Stream); fail). aleph_open(File,Mode,Stream):- open(File,Mode,Stream). clean_up:- clean_up_init, clean_up_sat, clean_up_reduce. clean_up_init:- aleph_abolish('$aleph_good'/3), retractall('$aleph_search'(last_good,_)), aleph_abolish('$aleph_feature'/2). clean_up_sat:- aleph_abolish('$aleph_sat'/2), aleph_abolish('$aleph_local'/2), aleph_abolish('$aleph_sat_atom'/2), aleph_abolish('$aleph_sat_ovars'/2), aleph_abolish('$aleph_sat_ivars'/2), aleph_abolish('$aleph_sat_varscopy'/3), aleph_abolish('$aleph_sat_varequiv'/3), aleph_abolish('$aleph_sat_terms'/4), aleph_abolish('$aleph_sat_vars'/4), aleph_abolish('$aleph_sat_litinfo'/6), retractall('$aleph_search'(pclause,_)), gc. clean_up_reduce:- aleph_abolish('$aleph_local'/2), clean_up_search, retractall('$aleph_search'(pclause,_)), gc. clean_up_search:- retractall('$aleph_search'(bad,_)), retractall('$aleph_search'(best,_)), retractall('$aleph_search'(best_label,_)), retractall('$aleph_search'(clauseprior,_)), retractall('$aleph_search'(covers,_)), retractall('$aleph_search'(coversn,_)), retractall('$aleph_search'(current,_)), retractall('$aleph_search'(label,_)), retractall('$aleph_search'(modes,_)), retractall('$aleph_search'(nextnode,_)), retractall('$aleph_search'(openlist,_)), retractall('$aleph_search'(pclause,_)), retractall('$aleph_search'(selected,_)), retractall('$aleph_search_seen'(_,_)), retractall('$aleph_search_expansion'(_,_,_,_)), retractall('$aleph_search_gain'(_,_,_,_)), retractall('$aleph_search_node'(_,_,_,_,_,_,_,_)). clean_up_examples:- clean_up_examples(pos), clean_up_examples(neg), clean_up_examples(rand). clean_up_tree:- retractall('$aleph_search'(tree,_)), retractall('$aleph_search'(tree_startdistribution,_)), retractall('$aleph_search'(tree_leaf,_)), retractall('$aleph_search'(tree_lastleaf,_)), retractall('$aleph_search'(tree_newleaf,_)), retractall('$aleph_search'(tree_besterror,_)), retractall('$aleph_search'(tree_gain,_)). clean_up_examples(Type):- retractall('$aleph_global'(size,size(Type,_))), retractall('$aleph_global'(atoms,atoms(Type,_))), retractall('$aleph_global'(atoms_left,atoms_left(Type,_))), retractall('$aleph_global'(last_example,last_example(Type,_))). clean_up_hypothesis:- retractall('$aleph_global'(hypothesis,hypothesis(_,_,_,_))). depth_bound_call(G):- '$aleph_global'(depth,set(depth,D)), call_with_depth_bound(G,D). call_with_depth_bound((H:-B),D):- !, call_with_depth_bound((H,B),D). call_with_depth_bound((A,B),D):- !, depth_bound_call(A,D), call_with_depth_bound(B,D). call_with_depth_bound(A,D):- depth_bound_call(A,D). binom_lte(_,_,O,0.0):- O < 0, !. binom_lte(N,P,O,Prob):- binom(N,P,O,Prob1), O1 is O - 1, binom_lte(N,P,O1,Prob2), Prob is Prob1 + Prob2, !. binom(N,_,O,0.0):- O > N, !. binom(N,P,O,Prob):- aleph_choose(N,O,C), E1 is P^O, P2 is 1 - P, O2 is N - O, E2 is P2^O2, Prob is C*E1*E2, !. aleph_choose(N,I,V):- NI is N-I, (NI > I -> pfac(N,NI,I,V) ; pfac(N,I,NI,V)). pfac(0,_,_,1). pfac(1,_,_,1). pfac(N,N,_,1). pfac(N,I,C,F):- N1 is N-1, C1 is C-1, pfac(N1,I,C1,N1F), F1 is N/C, F is N1F*F1. % record_example(+Check,+Type,+Example,-N) % records Example of type Type % if Check = check, then checks to see if example exists % also updates number of related databases accordingly % if Check = nocheck then no check is done % returns example number N and Flag % if Flag = new then example is a new example of Type record_example(check,Type,Example,N1):- (once(example(N1,Type,Example)) -> true; record_example(nocheck,Type,Example,N1), (retract('$aleph_global'(atoms,atoms(Type,Atoms))) -> true; Atoms = []), (retract('$aleph_global'(atoms_left,atoms_left(Type,AtomsLeft)))-> true; AtomsLeft = []), (retract('$aleph_global'(last_example,last_example(Type,_))) -> true; true), update(Atoms,N1-N1,NewAtoms), update(AtomsLeft,N1-N1,NewAtomsLeft), asserta('$aleph_global'(atoms,atoms(Type,NewAtoms))), asserta('$aleph_global'(atoms_left,atoms_left(Type, NewAtomsLeft))), asserta('$aleph_global'(last_example,last_example(Type,N1)))), !. record_example(nocheck,Type,Example,N1):- (retract('$aleph_global'(size,size(Type,N)))-> true; N is 0), N1 is N + 1, asserta('$aleph_global'(size,size(Type,N1))), (Type \= neg -> setting(skolemvars,Sk1), skolemize(Example,Fact,Body,Sk1,SkolemVars), record_skolemized(Type,N1,SkolemVars,Fact,Body), (Sk1 = SkolemVars -> true; set(skolemvars,SkolemVars)); split_clause(Example,Head,Body), record_nskolemized(Type,N1,Head,Body)), !. record_targetpred:- retract('$aleph_local'(backpred,Name/Arity)), once('$aleph_global'(determination,determination(Name/Arity,_))), asserta('$aleph_global'(targetpred,targetpred(Name/Arity))), record_testclause(Name/Arity), fail. record_targetpred. check_recursive_calls:- '$aleph_global'(targetpred,targetpred(Name/Arity)), '$aleph_global'(determination,determination(Name/Arity,Name/Arity)), record_recursive_sat_call(Name/Arity), set(recursion,true), fail. check_recursive_calls. check_posonly:- '$aleph_global'(size,size(rand,N)), N > 0, !. check_posonly:- setting(evalfn,posonly), \+('$aleph_global'(modeh,modeh(_,_))), p1_message('error'), p_message('missing modeh declaration in posonly mode'), !, fail. check_posonly:- retractall('$aleph_global'(slp_count,_,_)), retractall('$aleph_local'(slp_sample,_)), retractall('$aleph_local'(slp_samplenum,_)), setting(evalfn,posonly), setting(gsamplesize,S), condition_target, '$aleph_global'(targetpred,targetpred(Name/Arity)), gsample(Name/Arity,S), !. check_posonly. check_prune_defs:- clause(prune(_),_), !, set(prune_defs,true). check_prune_defs. check_auto_refine:- (setting(construct_bottom,reduction);setting(construct_bottom,nil)), \+(setting(autorefine,true)), !, (setting(refine,user) -> true; set(refine,auto)). check_auto_refine. check_user_search:- setting(evalfn,user), \+(cost_cover_required), set(lazy_on_cost,true), !. check_user_search. check_abducibles:- '$aleph_global'(abducible,abducible(Name/Arity)), record_testclause(Name/Arity), record_abclause(Name/Arity), fail. check_abducibles. cost_cover_required:- clause(cost(_,Label,Cost),Body), vars_in_term([Label],[],Vars), (occurs_in(Vars,p(Cost)); occurs_in(Vars,Body)), !. set_lazy_recalls:- '$aleph_global'(lazy_evaluate,lazy_evaluate(Name/Arity)), functor(Pred,Name,Arity), % asserta('$aleph_global'(lazy_recall,lazy_recall(Name/Arity,1))), asserta('$aleph_global'(lazy_recall,lazy_recall(Name/Arity,0))), '$aleph_global'(mode,mode(Recall,Pred)), '$aleph_global'(lazy_recall,lazy_recall(Name/Arity,N)), (Recall = '*' -> RecallNum = 100; RecallNum = Recall), RecallNum > N, retract('$aleph_global'(lazy_recall,lazy_recall(Name/Arity,N))), asserta('$aleph_global'(lazy_recall,lazy_recall(Name/Arity,RecallNum))), fail. set_lazy_recalls. set_lazy_on_contradiction(_,_):- '$aleph_global'(lazy_on_contradiction,set(lazy_on_contradiction,nil)), !. set_lazy_on_contradiction(P,N):- Tot is P + N, Tot >= 100, !, set(lazy_on_contradiction,true). set_lazy_on_contradiction(_,_). % The "pclause" trick: much more effective with the use of recorded/3 % clause for testing partial clauses obtained in search % only needed when learning recursive theories or % proof_strategy is not restricted_sld. record_testclause(Name/Arity):- functor(Head,Name,Arity), Clause = (Head:- '$aleph_search'(pclause,pclause(Head,Body)), Body, !), assertz(Clause). % The "pclause" trick for abducible predicates record_abclause(Name/Arity):- functor(Head,Name,Arity), Clause = (Head:- '$aleph_search'(abduced,pclause(Head,Body)), Body, !), assertz(Clause). % clause for incorporating recursive calls into bottom clause % this is done by allowing calls to the positive examples record_recursive_sat_call(Name/Arity):- functor(Head,Name,Arity), Clause = (Head:- '$aleph_global'(stage,set(stage,saturation)), '$aleph_sat'(example,example(Num,Type)), example(Num1,Type,Head), Num1 \= Num, !), % to prevent tautologies assertz(Clause). skolemize((Head:-Body),SHead,SBody,Start,SkolemVars):- !, copy_term((Head:-Body),(SHead:-Body1)), numbervars((SHead:-Body1),Start,SkolemVars), goals_to_list(Body1,SBody). skolemize(UnitClause,Lit,[],Start,SkolemVars):- copy_term(UnitClause,Lit), numbervars(Lit,Start,SkolemVars). skolemize(UnitClause,Lit):- skolemize(UnitClause,Lit,[],0,_). record_nskolemized(Type,N1,Head,true):- !, assertz(example(N1,Type,Head)). record_nskolemized(Type,N1,Head,Body):- assertz((example(N1,Type,Head):-Body)). record_skolemized(Type,N1,SkolemVars,Head,Body):- assertz(example(N1,Type,Head)), functor(Head,Name,Arity), update_backpreds(Name/Arity), add_backs(Body), add_skolem_types(SkolemVars,Head,Body). add_backs([]). add_backs([Lit|Lits]):- asserta('$aleph_global'(back,back(Lit))), functor(Lit,Name,Arity), declare_dynamic(Name/Arity), assertz(Lit), add_backs(Lits). add_skolem_types(10000,_,_):- !. % no new skolem variables add_skolem_types(_,Head,Body):- add_skolem_types([Head]), add_skolem_types(Body). add_skolem_types([]). add_skolem_types([Lit|Lits]):- functor(Lit,PSym,Arity), get_modes(PSym/Arity,L), add_skolem_types1(L,Lit), add_skolem_types(Lits). add_skolem_types1([],_). add_skolem_types1([Lit|Lits],Fact):- split_args(Lit,_,I,O,C), add_skolem_types2(I,Fact), add_skolem_types2(O,Fact), add_skolem_types2(C,Fact), add_skolem_types1(Lits,Fact). add_skolem_types2([],_). add_skolem_types2([Pos/Type|Rest],Literal):- tparg(Pos,Literal,Arg), SkolemType =.. [Type,Arg], ('$aleph_global'(back,back(SkolemType))-> true; asserta('$aleph_global'(back,back(SkolemType))), asserta(SkolemType)), add_skolem_types2(Rest,Literal). copy_args(_,_,Arg,Arity):- Arg > Arity, !. copy_args(Lit,Lit1,Arg,Arity):- arg(Arg,Lit,T), arg(Arg,Lit1,T), NextArg is Arg + 1, copy_args(Lit,Lit1,NextArg,Arity). copy_iargs(0,_,_,_):- !. copy_iargs(Arg,Old,New,Arg):- !, Arg1 is Arg - 1, copy_iargs(Arg1,Old,New,Arg). copy_iargs(Arg,Old,New,Out):- arg(Arg,Old,Val), arg(Arg,New,Val), Arg1 is Arg - 1, copy_iargs(Arg1,Old,New,Out). index_clause((Head:-true),NextClause,(Head)):- !, retract('$aleph_global'(last_clause,last_clause(ClauseNum))), NextClause is ClauseNum + 1, asserta('$aleph_global'(last_clause,last_clause(NextClause))). index_clause(Clause,NextClause,Clause):- retract('$aleph_global'(last_clause,last_clause(ClauseNum))), NextClause is ClauseNum + 1, asserta('$aleph_global'(last_clause,last_clause(NextClause))). update_backpreds(Name/Arity):- '$aleph_local'(backpred,Name/Arity), !. update_backpreds(Name/Arity):- assertz('$aleph_local'(backpred,Name/Arity)). reset_counts:- retractall('$aleph_sat'(lastterm,_)), retractall('$aleph_sat'(lastvar,_)), asserta('$aleph_sat'(lastterm,0)), asserta('$aleph_sat'(lastvar,0)), !. % reset the number of successes for a literal: cut to avoid useless backtrack reset_succ:- retractall('$aleph_local'(last_success,_)), asserta('$aleph_local'(last_success,0)), !. skolem_var(Var):- atomic(Var), !, name(Var,[36|_]). skolem_var(Var):- gen_var(Num), name(Num,L), name(Var,[36|L]). gen_var(Var1):- retract('$aleph_sat'(lastvar,Var0)), !, Var1 is Var0 + 1, asserta('$aleph_sat'(lastvar,Var1)). gen_var(0):- asserta('$aleph_sat'(lastvar,0)). copy_var(OldVar,NewVar,Depth):- gen_var(NewVar), '$aleph_sat_vars'(OldVar,TNo,_,_), asserta('$aleph_sat_vars'(NewVar,TNo,[],[])), asserta('$aleph_sat_varscopy'(NewVar,OldVar,Depth)). gen_litnum(Lit1):- retract('$aleph_sat'(lastlit,Lit0)), !, Lit1 is Lit0 + 1, asserta('$aleph_sat'(lastlit,Lit1)). gen_litnum(0):- asserta('$aleph_sat'(lastlit,0)). gen_nlitnum(Lit1):- retract('$aleph_sat'(lastnlit,Lit0)), !, Lit1 is Lit0 - 1, asserta('$aleph_sat'(lastnlit,Lit1)). gen_nlitnum(-1):- asserta('$aleph_sat'(lastnlit,-1)). % generate a new feature number % provided it is less than the maximum number of features allowed gen_featurenum(Feature1):- '$aleph_feature'(last_feature,Feature0), !, Feature1 is Feature0 + 1, setting(max_features,FMax), Feature1 =< FMax, retract('$aleph_feature'(last_feature,Feature0)), asserta('$aleph_feature'(last_feature,Feature1)). gen_featurenum(1):- asserta('$aleph_feature'(last_feature,1)). gen_lits([],[]). gen_lits([Lit|Lits],[LitNum|Nums]):- gen_litnum(LitNum), asserta('$aleph_sat_litinfo'(LitNum,0,Lit,[],[],[])), gen_lits(Lits,Nums). update_theory(ClauseIndex):- retract('$aleph_global'(hypothesis,hypothesis(OldLabel,Hypothesis, OldPCover,OldNCover))), index_clause(Hypothesis,ClauseIndex,Clause), ('$aleph_global'(example_selected,example_selected(_,Seed))-> true; PCover = [Seed-_|_]), (setting(lazy_on_cost,true) -> nlits(Clause,L), label_create(Clause,Label), extract_pos(Label,PCover), extract_neg(Label,NCover), interval_count(PCover,PC), interval_count(NCover,NC), setting(evalfn,Evalfn), complete_label(Evalfn,Clause,[PC,NC,L],NewLabel), assertz('$aleph_global'(theory,theory(ClauseIndex, NewLabel/Seed,Clause, PCover,NCover))); assertz('$aleph_global'(theory,theory(ClauseIndex, OldLabel/Seed,Clause, OldPCover,OldNCover)))), add_clause_to_background(ClauseIndex). add_clause_to_background(ClauseIndex):- '$aleph_global'(theory,theory(ClauseIndex,Label/_,Clause,_,_)), (setting(minpos,PMin) -> true; PMin = 1), Label = [PC,_,_,F|_], PC >= PMin, setting(minscore,MinScore), F >= MinScore, !, (retract('$aleph_global'(rules,rules(Rules)))-> asserta('$aleph_global'(rules,rules([ClauseIndex|Rules]))); asserta('$aleph_global'(rules,rules([ClauseIndex])))), (setting(updateback,Update) -> true; Update = true), (Update = true -> assertz(Clause); true), !. add_clause_to_background(_). rm_seeds:- update_theory(ClauseIndex), !, '$aleph_global'(theory,theory(ClauseIndex,_,_,PCover,NCover)), rm_seeds(pos,PCover), (setting(evalfn,posonly) -> rm_seeds(rand,NCover); true), '$aleph_global'(atoms_left,atoms_left(pos,PLeft)), interval_count(PLeft,PL), p1_message('atoms left'), p_message(PL), !. rm_seeds. rm_seeds(pos,PCover):- setting(construct_features,true), setting(feature_construction,exhaustive), !, retract('$aleph_global'(atoms_left,atoms_left(pos,OldIntervals))), ('$aleph_global'(example_selected,example_selected(_,Seed))-> true; PCover = [Seed-_|_]), rm_seeds1([Seed-Seed],OldIntervals,NewIntervals), assertz('$aleph_global'(atoms_left,atoms_left(pos,NewIntervals))). rm_seeds(Type,RmIntervals) :- retract('$aleph_global'(atoms_left,atoms_left(Type,OldIntervals))), rm_seeds1(RmIntervals,OldIntervals,NewIntervals), assertz('$aleph_global'(atoms_left,atoms_left(Type,NewIntervals))). rm_seeds1([],Done,Done). rm_seeds1([Start-Finish|Rest],OldIntervals,NewIntervals) :- rm_interval(Start-Finish,OldIntervals,MidIntervals),!, rm_seeds1(Rest,MidIntervals,NewIntervals). % update lower estimate on maximum size cover set for an atom update_coverset(Type,_):- '$aleph_global'(hypothesis,hypothesis(Label,_,PCover,_)), Label = [_,_,_,Gain|_], worse_coversets(PCover,Type,Gain,Worse), (Worse = [] -> true; update_theory(NewClause), update_coversets(Worse,NewClause,Type,Label)). % revise coversets of previous atoms worse_coversets(_,_,_,[]):- \+('$aleph_global'(maxcover,set(maxcover,true))), !. worse_coversets([],_,_,[]). worse_coversets([Interval|Intervals],Type,Gain,Worse):- worse_coversets1(Interval,Type,Gain,W1), worse_coversets(Intervals,Type,Gain,W2), aleph_append(W2,W1,Worse), !. worse_coversets1(Start-Finish,_,_,[]):- Start > Finish, !. worse_coversets1(Start-Finish,Type,Gain,Rest):- '$aleph_global'(max_set,max_set(Type,Start,Label1,_)), Label1 = [_,_,_,Gain1|_], Gain1 >= Gain, !, Next is Start + 1, worse_coversets1(Next-Finish,Type,Gain,Rest), !. worse_coversets1(Start-Finish,Type,Gain,[Start|Rest]):- Next is Start + 1, worse_coversets1(Next-Finish,Type,Gain,Rest), !. update_coversets([],_,_,_). update_coversets([Atom|Atoms],ClauseNum,Type,Label):- (retract('$aleph_global'(max_set,max_set(Type,Atom,_,_)))-> true; true), asserta('$aleph_global'(max_set,max_set(Type,Atom,Label,ClauseNum))), update_coversets(Atoms,ClauseNum,Type,Label), !. rm_intervals([],I,I). rm_intervals([I1|I],Intervals,Result):- rm_interval(I1,Intervals,Intervals1), rm_intervals(I,Intervals1,Result), !. rm_interval(_,[],[]). rm_interval(I1,[Interval|Rest],Intervals):- interval_intersection(I1,Interval,I2), !, interval_subtract(Interval,I2,I3), rm_interval(I1,Rest,I4), aleph_append(I4,I3,Intervals). rm_interval(I1,[Interval|Rest],[Interval|Intervals]):- rm_interval(I1,Rest,Intervals). % gen_sample(+Type,+N) % select N random samples from the set of examples uncovered. Type is one of pos/neg % if N = 0 returns first example in Set % resamples the same example R times where set(resample,R) gen_sample(Type,0):- !, '$aleph_global'(atoms_left,atoms_left(Type,[ExampleNum-_|_])), retractall('$aleph_global'(example_selected,example_selected(_,_))), p1_message('select example'), p_message(ExampleNum), (setting(resample,Resample) -> true; Resample = 1), gen_sample(Resample,Type,ExampleNum). gen_sample(Type,SampleSize):- '$aleph_global'(atoms_left,atoms_left(Type,Intervals)), % p1_message('select from'), p_message(Intervals), interval_count(Intervals,AtomsLeft), N is min(AtomsLeft,SampleSize), assertz('$aleph_local'(sample_num,0)), retractall('$aleph_global'(example_selected,example_selected(_,_))), (setting(resample,Resample) -> true; Resample = 1), repeat, '$aleph_local'(sample_num,S1), S is S1 + 1, (S =< N -> get_random(AtomsLeft,INum), select_example(INum,0,Intervals,ExampleNum), \+('$aleph_global'(example_selected, example_selected(Type,ExampleNum))), p1_message('select example'), p_message(ExampleNum), retract('$aleph_local'(sample_num,S1)), assertz('$aleph_local'(sample_num,S)), gen_sample(Resample,Type,ExampleNum), fail; retract('$aleph_local'(sample_num,S1))), !. gen_sample(0,_,_):- !. gen_sample(R,Type,ExampleNum):- assertz('$aleph_global'(example_selected, example_selected(Type,ExampleNum))), R1 is R - 1, gen_sample(R1,Type,ExampleNum). select_example(Num,NumberSoFar,[Start-Finish|_],ExampleNum):- Num =< NumberSoFar + Finish - Start + 1, !, ExampleNum is Num - NumberSoFar + Start - 1. select_example(Num,NumberSoFar,[Start-Finish|Rest],ExampleNum):- N1 is NumberSoFar + Finish - Start + 1, select_example(Num,N1,Rest,ExampleNum). % get_random(+Last,-Num) % get a random integer between 1 and Last get_random(Last,INum):- aleph_random(X), INum1 is integer(X*Last + 0.5), (INum1 = 0 -> INum = 1; (INum1 > Last -> INum = Last; INum = INum1 ) ). % get_rrandom(+Last,-Num) % get a random floating point number between 1 and Last get_rrandom(Last,Num):- aleph_random(X), Num is X*Last. % distrib(+Interval,+Prob,-Distrib) % generate discrete distribution Distrib % by assigning all elements in Interval the probability Prob distrib(X-Y,_,[]):- X > Y, !. distrib(X-Y,P,[P-X|D]):- X1 is X + 1, distrib(X1-Y,P,D). % draw_element(+D,-E) % draw element E using distribution D % D is a list specifying the probability of each element E % in the form p1-e1, p2-e2, ... ,pn-en % proportions pi are normalised to add to 1 draw_element(D,E):- normalise_distribution(D,Distr), aleph_random(X), draw_element(Distr,0,X,E). draw_element([P1-E1|T],CumProb,X,E):- CumProb1 is CumProb + P1, (X =< CumProb1 -> E = E1; draw_element(T,CumProb1,X,E)). normalise_distribution(D,Distr):- key_sum(D,Sum), (0.0 is float(Sum) -> Distr = D; normalise_distribution(D,Sum,D1), keysort(D1,Distr)). key_sum([],0.0). key_sum([K1-_|T],Sum):- key_sum(T,S1), Sum is float(K1 + S1). normalise_distribution([],_,[]). normalise_distribution([K1-X1|T],Sum,[K2-X1|T1]):- K2 is K1/Sum, normalise_distribution(T,Sum,T1). % random_select(-Num,+List1,-List2) % randomly remove an element Num from List1 to give List2 random_select(X,[X],[]):- !. random_select(X,L,Left):- length(L,N), N > 0, get_random(N,I), aleph_remove_nth(I,L,X,Left). % random_nselect(+Num,+List1,-List2) % randomly remove Num elements from List1 to give List2 random_nselect(0,_,[]):- !. random_nselect(_,[],[]):- !. random_nselect(N,List1,[X|List2]):- random_select(X,List1,Left), N1 is N - 1, random_nselect(N1,Left,List2). % random_select_from_intervals(-Num,+IList) % randomly select an element from an interval list random_select_from_intervals(N,IList):- interval_count(IList,L), get_random(L,X), interval_select(X,IList,N). normal(Mean,Sigma,X):- std_normal(X1), X is Mean + Sigma*X1. get_normal(0,_,_,[]):- !. get_normal(N,Mean,Sigma,[X|Xs]):- N > 0, normal(Mean,Sigma,X), N1 is N - 1, get_normal(N1,Mean,Sigma,Xs). % Polar method for generating random variates % from a standard normal distribution. % From A.M. Law and W.D. Kelton, "Simulation Modeling and Analysis", % McGraw-Hill,2000 std_normal(X):- aleph_random(U1), aleph_random(U2), V1 is 2*U1 - 1, V2 is 2*U2 - 1, W is V1^2 + V2^2, (W > 1 -> std_normal(X); Y is sqrt((-2.0*log(W))/W), X is V1*Y). % Approximate method for computing the chi-square value % given the d.f. and probability (to the right). Uses % a normal approximation and Monte-Carlo simulation. % The normal approximation used is the one proposed by % E.B. Wilson and M.M. Hilferty (1931). "The distribution of chi-square" % PNAS, 17, 684. % Monte-Carlo simulation uses 1000 trials. chi_square(DF,Prob,ChisqVal):- DF > 0, Mean is 1 - 2/(9*DF), Sigma is sqrt(2/(9*DF)), NTrials is 1000, get_normal(NTrials,Mean,Sigma,X), sort(X,Z), ProbLeft is 1.0 - Prob, Index is integer(ProbLeft*NTrials), (Index > NTrials -> aleph_remove_nth(NTrials,Z,Val,_); aleph_remove_nth(Index,Z,Val,_)), ChisqVal is DF*(Val^3). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % L A B E L S A N D E V A L F N S % label_create(Clause,Label):- '$aleph_global'(last_example,last_example(pos,Last1)), Type1 = pos, (setting(evalfn,posonly) -> '$aleph_global'(last_example,last_example(rand,Last2)), Type2 = rand; '$aleph_global'(last_example,last_example(neg,Last2)), Type2 = neg), label_create(Clause,Type1,[1-Last1],Type2,[1-Last2],Label). label_create(Type,Clause,Label):- '$aleph_global'(last_example,last_example(Type,Last)), label_create(Clause,Type,[1-Last],Label). label_create(Clause,Type1,Set1,Type2,Set2,Label):- split_clause(Clause,Head,Body), nlits((Head,Body),Length), assertz('$aleph_search'(pclause,pclause(Head,Body))), setting(depth,Depth), setting(prooftime,Time), setting(proof_strategy,Proof), prove(Depth/Time/Proof,Type1,(Head:-Body),Set1,Cover1,_), prove(Depth/Time/Proof,Type2,(Head:-Body),Set2,Cover2,_), retractall('$aleph_search'(pclause,_)), assemble_label(Cover1,Cover2,Length,Label), !. label_create(Clause,Type,Set,Label):- split_clause(Clause,Head,Body), assertz('$aleph_search'(pclause,pclause(Head,Body))), setting(depth,Depth), setting(prooftime,Time), setting(proof_strategy,Proof), prove(Depth/Time/Proof,Type,(Head:-Body),Set,Cover,_), retractall('$aleph_search'(pclause,_)), (Type = pos -> assemble_label(Cover,unknown,unknown,Label); assemble_label(unknown,Cover,unknown,Label)). label_pcover(Label,P):- extract_cover(pos,Label,P). label_ncover(Label,N):- extract_cover(neg,Label,N). label_union([],Label,Label):- !. label_union(Label,[],Label):- !. label_union(Label1,Label2,Label):- extract_cover(pos,Label1,Pos1), extract_cover(pos,Label2,Pos2), extract_cover(neg,Label1,Neg1), extract_cover(neg,Label2,Neg2), extract_length(Label1,L1), extract_length(Label2,L2), update_list(Pos2,Pos1,Pos), update_list(Neg2,Neg1,Neg), Length is L1 + L2, list_to_intervals(Pos,PCover), list_to_intervals(Neg,NCover), assemble_label(PCover,NCover,Length,Label). label_print_examples(Type,Label):- extract_cover(Type,Label,C), examples(Type,C). label_print_eval([]):- !. label_print_eval(Label):- Eval = coverage, evalfn(Eval,Label,Val), print_eval(Eval,Val). print_eval(Evalfn,Val):- evalfn_name(Evalfn,Name), p1_message(Name), p_message(Val). eval_rule(0,Label):- '$aleph_global'(hypothesis,hypothesis(_,Clause,_,_)), !, label_create(Clause,Label), p_message('Rule 0'), pp_dclause(Clause), extract_count(pos,Label,PC), extract_count(neg,Label,NC), extract_length(Label,L), label_print_eval([PC,NC,L]), nl. eval_rule(ClauseNum,Label):- integer(ClauseNum), ClauseNum > 0, '$aleph_global'(theory,theory(ClauseNum,_,Clause,_,_)), !, label_create(Clause,Label), extract_count(pos,Label,PC), extract_count(neg,Label,NC), concat(['Rule ',ClauseNum],RuleTag), (setting(evalfn,posonly) -> concat(['Pos cover = ',PC,' Rand cover = ',NC],CoverTag); concat(['Pos cover = ',PC,' Neg cover = ',NC],CoverTag)), p1_message(RuleTag), p_message(CoverTag), pp_dclause(Clause), setting(verbosity,V), (V >= 2 -> p_message('positive examples covered'), label_print_examples(pos,Label), p_message('negative examples covered'), label_print_examples(neg,Label); true), nl. eval_rule(_,_). evalfn(Label,Val):- (setting(evalfn,Eval)->true;Eval=coverage), evalfn(Eval,Label,Val). evalfn_name(compression,'compression'). evalfn_name(coverage,'pos-neg'). evalfn_name(accuracy,'accuracy'). evalfn_name(wracc,'novelty'). evalfn_name(laplace,'laplace estimate'). evalfn_name(pbayes,'pseudo-bayes estimate'). evalfn_name(auto_m,'m estimate'). evalfn_name(mestimate,'m estimate'). evalfn_name(mse,'mse'). evalfn_name(posonly,'posonly bayes estimate'). evalfn_name(entropy,'entropy'). evalfn_name(gini,'gini value'). evalfn_name(sd,'standard deviation'). evalfn_name(user,'user defined cost'). evalfn(compression,[P,N,L|_],Val):- (P = -inf -> Val is -inf; Val is P - N - L + 1), !. evalfn(coverage,[P,N,_|_],Val):- (P = -inf -> Val is -inf; Val is P - N), !. evalfn(laplace,[P,N|_],Val):- (P = -inf -> Val is 0.5; Val is (P + 1) / (P + N + 2)), !. % the evaluation function below is due to Steve Moyle's implementation % of the work by Lavrac, Flach and Zupan evalfn(wracc,[P,N|_],Val):- ('$aleph_search'(clauseprior,Total-[P1-pos,_]) -> Val is P/Total - (P1/Total)*((P+N)/Total); Val is -0.25), !. evalfn(entropy,[P,N|_],Val):- (P = -inf -> Val is 1.0; ((P is 0); (N is 0) -> Val is 0.0; Total is P + N, P1 is P/Total, Q1 is 1-P1, Val is -(P1*log(P1) + Q1*log(Q1))/log(2) ) ), !. evalfn(gini,[P,N|_],Val):- (P = -inf -> Val is 1.0; Total is P + N, P1 is P/Total, Val is 2*P1*(1-P1)), !. evalfn(accuracy,[P,N|_],Val):- (P = -inf -> Val is 0.5; Val is P / (P + N)), !. % the evaluation functions below are due to James Cussens evalfn(pbayes,[P,N|_],Val):- (P = -inf -> Val is 0.5; Acc is P/(P+N), setting(prior,PriorD), normalise_distribution(PriorD,NPriorD), aleph_member1(Prior-pos,NPriorD), (0 is Prior-Acc -> Val=Prior; K is (Acc*(1 - Acc)) / ((Prior-Acc)^2 ), Val is (P + K*Prior) / (P + N + K))), !. evalfn(posonly,[P,0,L|_],Val):- '$aleph_global'(size,size(rand,RSize)), Val is log(P) + log(RSize+2.0) - (L+1)/P, !. evalfn(auto_m,[P,N|_],Val):- (P = -inf -> Val is 0.5; Cover is P + N, setting(prior,PriorD), normalise_distribution(PriorD,NPriorD), aleph_member1(Prior-pos,NPriorD), K is sqrt(Cover), Val is (P + K*Prior) / (Cover+K)), !. evalfn(mestimate,[P,N|_],Val):- (P = -inf -> Val is 0.5; Cover is P + N, setting(prior,PriorD), normalise_distribution(PriorD,NPriorD), aleph_member1(Prior-pos,NPriorD), (setting(m,M) -> K = M; K is sqrt(Cover)), Val is (P + K*Prior) / (Cover+K)), !. evalfn(_,_,X):- X is -inf. assemble_label(P,N,L,[P,N,L]). extract_cover(pos,[P,_,_],P1):- intervals_to_list(P,P1), !. extract_cover(neg,[_,N,_],N1):- intervals_to_list(N,N1),!. extract_cover(_,[]). extract_count(pos,[P,_,_],P1):- interval_count(P,P1), !. extract_count(neg,[_,N,_],N1):- interval_count(N,N1), !. extract_count(neg,_,0). extract_pos([P|_],P). extract_neg([_,N|_],N). extract_length([_,_,L|_],L). get_start_label(_,[0,0,0,F]):- (setting(interactive,true); setting(search,ic)), !, F is -inf. get_start_label(user,[1,0,2,F]):- !, F is -inf. get_start_label(entropy,[1,0,2,-0.5]):- !. get_start_label(gini,[1,0,2,-0.5]):- !. get_start_label(wracc,[1,0,2,-0.25]):- !. get_start_label(Evalfn,[1,0,2,Val]):- evalfn(Evalfn,[1,0,2],Val). %%%%%%%%%%%%%%%%%%%%%%%%%%%%% % I / O S T U F F % read_all(+Prefix) % read background and examples read_all(Prefix):- read_all(Prefix,Prefix,Prefix). % read_all/2 and read_all/3 largely % provided by Stasinos Konstantopoulos and Mark Reid read_all(BPrefix,EPrefix):- read_all(BPrefix,EPrefix,EPrefix). read_all(Back,Pos,Neg):- clean_up, reset, read_background(Back), read_examples(Pos,Neg), record_targetpred, check_recursive_calls, check_prune_defs, check_user_search, check_posonly, check_auto_refine, check_abducibles. read_background(Back):- construct_name(background,Back,File), aleph_reconsult(File), broadcast(background(loaded)). read_examples(Pos,Neg):- (setting(train_pos,PosF) -> set(use_file_extensions,nil), read_examples_files(pos,PosF,_), noset(use_file_extensions); read_examples_files(pos,Pos,PosF), set(train_pos,PosF) ), (setting(train_neg,NegF) -> set(use_file_extensions,nil), read_examples_files(neg,NegF,_), noset(use_file_extensions); read_examples_files(neg,Neg,NegF), set(train_neg,NegF) ), '$aleph_global'(size,size(pos,P)), '$aleph_global'(size,size(neg,N)), set_lazy_recalls, (setting(prior,_) -> true; normalise_distribution([P-pos,N-neg],Prior), set(prior,Prior) ), reset_counts, asserta('$aleph_global'(last_clause,last_clause(0))), broadcast(examples(loaded)). read_examples_files(Type,Name,F):- clean_up_examples(Type), asserta('$aleph_global'(size,size(Type,0))), (Name = [_|_] -> read_examples_from_files(Name,Type,F); read_examples_from_file(Type,Name,F)), '$aleph_global'(size,size(Type,N)), (N > 0 -> Ex = [1-N]; Ex = []), asserta('$aleph_global'(atoms,atoms(Type,Ex))), asserta('$aleph_global'(atoms_left,atoms_left(Type,Ex))), asserta('$aleph_global'(last_example,last_example(Type,N))). read_examples_from_files([],_,[]). read_examples_from_files([Name|Files],Type,[FileName|FileNames]):- read_examples_from_file(Type,Name,FileName), read_examples_from_files(Files,Type,FileNames). read_examples_from_file(Type,Name,File):- construct_name(Type,Name,File), (aleph_open(File,read,Stream) -> concat(['consulting ',Type, ' examples'],Mess), p1_message(Mess), p_message(File); p1_message('cannot open'), p_message(File), fail), repeat, read(Stream,Example), (Example=end_of_file-> close(Stream); record_example(nocheck,Type,Example,_), fail), !. read_examples_from_file(_,_,'?'). construct_name(_,Name,Name):- setting(use_file_extensions,nil), !. construct_name(Type,Prefix,Name):- name(Prefix,PString), file_extension(Type,SString), aleph_append(SString,PString,FString), name(Name,FString). file_extension(pos,Suffix):- name('.f',Suffix). file_extension(neg,Suffix):- name('.n',Suffix). file_extension(background,Suffix):- name('.b',Suffix). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % M I S C. D E F I N I T I O N S execute(C):- system(C), !. execute(_). % store critical values of current search state store(searchstate):- !, retractall('$aleph_global'(save,save(searchstate,_))), ('$aleph_global'(atoms_left,atoms_left(pos,PosLeft)) -> asserta('$aleph_global'(save, save(searchstate,atoms_left(pos,PosLeft)))); true), ('$aleph_global'(atoms_left,atoms_left(neg,NegLeft)) -> asserta('$aleph_global'(save, save(searchstate,atoms_left(neg,NegLeft)))); true), ('$aleph_global'(size,size(pos,PSize)) -> asserta('$aleph_global'(save, save(searchstate,size(pos,PSize)))); true), ('$aleph_global'(size,size(neg,NSize)) -> asserta('$aleph_global'(save, save(searchstate,size(neg,NSize)))); true), ('$aleph_global'(noise,set(noise,Noise)) -> asserta('$aleph_global'(save, save(searchstate,set(noise,Noise)))); true), ('$aleph_global'(minacc,set(minacc,MinAcc)) -> asserta('$aleph_global'(save, save(searchstate,set(minacc,MinAcc)))); true). % store current bottom clause store(bottom):- !, ('$aleph_global'(store_bottom,set(store_bottom,true)) -> store_bottom; true). store(Parameter):- ('$aleph_global'(Parameter,set(Parameter,Value)) -> true; Value = unknown), retractall('$aleph_global'(save,save(Parameter,_))), asserta('$aleph_global'(save,save(Parameter,Value))). % store values of a list of parameters store_values([]). store_values([Parameter|T]):- store(Parameter), store_values(T). % store all relevant info related to current bottom % details are stored in 5 idbs: % 1. bottom: points to 2 other idbs sat_X_n and lits_X_N % 2. sat_X_N: where X is the type of the current example and N the number % this contains misc stuff recorded by sat/2 for use by reduce/1 % 3. lits_X_N: contains the lits in bottom % 4. ovars_X_N: contains output vars of lits in bottom % 5. ivars_X_N: contains input vars of lits in bottom store_bottom:- bottom_key(Num,Type,Key,true), asserta('$aleph_sat'(stored,stored(Num,Type,Key))), '$aleph_sat'(lastterm,LastTerm), asserta('$aleph_sat'(lasterm,Key,LastTerm)), '$aleph_sat'(lastvar,LastVar), asserta('$aleph_sat'(lastvar,Key,LastVar)), '$aleph_sat'(botsize,BotSize), asserta('$aleph_sat'(botsize,Key,BotSize)), '$aleph_sat'(lastlit,LastLit), asserta('$aleph_sat'(lastlit,Key,LastLit)), '$aleph_sat'(hovars,HOVars), asserta('$aleph_sat'(hovars,Key,HOVars)), '$aleph_sat'(hivars,HIVars), asserta('$aleph_sat'(hivars,Key,HIVars)), '$aleph_sat'(eq,Eq), asserta('$aleph_sat'(eq,Key,Eq)), '$aleph_sat_ivars'(Lit,IVars), asserta('$aleph_sat_ivars'(Lit,Key,IVars)), '$aleph_sat_ovars'(Lit,OVars), asserta('$aleph_sat_ovars'(Lit,Key,OVars)), '$aleph_sat_litinfo'(Lit,Depth,Atom,I,O,D), asserta('$aleph_sat_litinfo'(Lit,Key,Depth,Atom,I,O,D)), fail. store_bottom. reinstate(searchstate):- !, retractall('$aleph_global'(atoms_left,atoms_left(_,_))), retractall('$aleph_global'(size,size(_,_))), ('$aleph_global'(save,save(searchstate,atoms_left(pos,PosLeft))) -> asserta('$aleph_global'(atoms_left,atoms_left(pos,PosLeft))); true), ('$aleph_global'(save,save(searchstate,atoms_left(neg,NegLeft))) -> asserta('$aleph_global'(atoms_left,atoms_left(neg,NegLeft))); true), ('$aleph_global'(save,save(searchstate,size(pos,PSize))) -> asserta('$aleph_global'(size,size(pos,PSize))); true), ('$aleph_global'(save,save(searchstate,size(neg,NSize))) -> asserta('$aleph_global'(size,size(neg,NSize))); true), ('$aleph_global'(save,save(searchstate,set(noise,Noise))) -> set(noise,Noise); true), ('$aleph_global'(save,save(searchstate,set(minacc,MinAcc))) -> set(minacc,MinAcc); true), retractall('$aleph_global'(save,save(searchstate,_))). reinstate(Parameter):- retract('$aleph_global'(save,save(Parameter,Value))), !, (Value = unknown -> noset(Parameter); set(Parameter,Value)). reinstate(_). % reinstate list of values of parameters reinstate_values([]). reinstate_values([Parameter|T]):- reinstate(Parameter), reinstate_values(T). % reinstate all saved values reinstate_values:- reinstate_file_streams, '$aleph_global'(save,save(_,_)), repeat, retract('$aleph_global'(save,save(Parameter,Value))), (Value = unknown -> noset(Parameter) ; set(Parameter,Value)), \+('$aleph_global'(save,save(_,_))), !. reinstate_values. reinstate_file_streams:- setting(recordfile,File), set(recordfile,File), fail. reinstate_file_streams:- setting(goodfile,File), set(goodfile,File), fail. reinstate_file_streams. % bottom_key(?N,?T,-Key,-Flag) % returns key that indexes bottom clause info for example N of type T % Flag is one of "true" or "nil" depending on whether bottom % requires storing bottom_key(N,T,Key,Flag):- ((var(N),var(T)) -> '$aleph_sat'(example,example(N,T)); true), (setting(store_bottom,true) -> ('$aleph_sat'(stored,stored(N,T,Key)) -> Flag = nil; concat([T,'_',N],Key), Flag = true ); Key = nil, Flag = nil). set(Variable,Value):- check_setting(Variable,Value), (Value = inf -> V is inf; (Value = +inf -> V is inf; (Value = -inf -> V is -inf; V = Value) ) ), retractall('$aleph_global'(Variable,set(Variable,_))), assertz('$aleph_global'(Variable,set(Variable,V))), broadcast(set(Variable,V)), special_consideration(Variable,Value). setting(Variable,Value):- nonvar(Variable), '$aleph_global'(Variable,set(Variable,Value1)), !, Value = Value1. setting(Variable,Value):- default_setting(Variable,Value). noset(Variable):- nonvar(Variable), retract('$aleph_global'(Variable,set(Variable,Value))), !, rm_special_consideration(Variable,Value), set_default(Variable). noset(_). man(M):- aleph_manual(M). determinations(Pred1,Pred2):- '$aleph_global'(determination,determination(Pred1,Pred2)). determination(Pred1,Pred2):- nonvar(Pred1), '$aleph_global'(determination,determination(Pred1,Pred2)), !. determination(Pred1,Pred2):- noset(autorefine), assertz('$aleph_global'(determination,determination(Pred1,Pred2))), (nonvar(Pred1) -> update_backpreds(Pred1); true). abducible(Name/Arity):- assertz('$aleph_global'(abducible,abducible(Name/Arity))). commutative(Name/Arity):- assertz('$aleph_global'(commutative,commutative(Name/Arity))). symmetric(Name/Arity):- assertz('$aleph_global'(symmetric,symmetric(Name/Arity))). lazy_evaluate(Name/Arity):- assertz('$aleph_global'(lazy_evaluate,lazy_evaluate(Name/Arity))). model(Name/Arity):- assertz('$aleph_global'(model,model(Name/Arity))). positive_only(Name/Arity):- assertz('$aleph_global'(positive_only,positive_only(Name/Arity))). mode(Recall,Pred):- modeh(Recall,Pred), modeb(Recall,Pred). modes(N/A,Mode):- Mode = modeh(_,Pred), '$aleph_global'(modeh,Mode), functor(Pred,N,A). modes(N/A,Mode):- Mode = modeb(_,Pred), '$aleph_global'(modeb,Mode), functor(Pred,N,A). modeh(Recall,Pred):- ('$aleph_global'(mode,mode(Recall,Pred)) -> true; noset(autorefine), assertz('$aleph_global'(modeh,modeh(Recall,Pred))), assertz('$aleph_global'(mode,mode(Recall,Pred))), functor(Pred,Name,Arity), update_backpreds(Name/Arity)). modeb(Recall,Pred):- ('$aleph_global'(modeb,modeb(Recall,Pred)) -> true; noset(autorefine), assertz('$aleph_global'(modeb,modeb(Recall,Pred))), ('$aleph_global'(mode,mode(Recall,Pred)) -> true; assertz('$aleph_global'(mode,mode(Recall,Pred))))). % add_determinations(+PSym,Stratified) % add determination declarations for a background predicate % these are obtained from the determinations of the target predicate % If Stratified is true then only stratified definitions are allowed add_determinations(PSym,Stratified):- '$aleph_global'(targetpred,targetpred(Target)), determinations(Target,OtherPred), (Stratified = true -> OtherPred \= Target; true), determination(PSym,OtherPred), fail. add_determinations(_,_). % add_modes(+PSym) % add modes declarations for a (new) predicate % these are obtained from the modes of the target predicate add_modes(Name/_):- '$aleph_global'(targetpred,targetpred(Target)), modes(Target,Mode), Mode =.. [ModeType,Recall,TargetMode], TargetMode =.. [_|Args], PredMode =.. [Name|Args], NewMode =.. [ModeType,Recall,PredMode], call(NewMode), fail. add_modes(_). feature(Id,Feature):- '$aleph_feature'(feature,feature(Id,_,_,Template,Body)), Feature = (Template:-Body). gen_feature(Feature,Label,Class):- nonvar(Feature), !, (var(Id) -> gen_featurenum(Id); true), split_clause(Feature,Template,Body), assertz('$aleph_feature'(feature,feature(Id,Label,Class,Template,Body))). show(settings):- nl, p_message('settings'), findall(P-V,'$aleph_global'(P,set(P,V)),L), sort(L,L1), aleph_member(Parameter-Value,L1), tab(8), write(Parameter=Value), nl, fail. show(determinations):- nl, p_message('determinations'), show_global(determination,determination(_,_)). show(modes):- nl, p_message('modes'), show_global(mode,mode(_,_)). show(modehs):- nl, p_message('modehs'), show_global(modeh,modeh(_,_)). show(modebs):- nl, p_message('modebs'), show_global(modeb,modeb(_,_)). show(sizes):- nl, p_message('sizes'), show_global(size,size(_,_)). show(bottom):- nl, p_message('bottom clause'), setting(verbosity,V), V > 0, '$aleph_sat'(lastlit,Last), get_clause(1,Last,[],FlatClause), pp_dlist(FlatClause). show(theory):- nl, p_message('theory'), nl, '$aleph_global'(rules,rules(L)), aleph_reverse(L,L1), aleph_member(ClauseNum,L1), '$aleph_global'(theory,theory(ClauseNum,_,_,_,_)), eval_rule(ClauseNum,_), % pp_dclause(Clause), fail. show(theory):- get_performance. show(pos):- nl, p_message('positives'), store(greedy), examples(pos,_), reinstate(greedy), fail. show(posleft):- nl, p_message('positives left'), example(_,pos,Atom), \+(Atom), write(Atom), write('.'), nl, fail. show(neg):- nl, p_message('negatives'), store(greedy), examples(neg,_), reinstate(greedy), fail. show(rand):- nl, p_message('random'), examples(rand,_), fail. show(uspec):- nl, p_message('uspec'), examples(uspec,_), fail. show(gcws):- nl, p_message('gcws hypothesis'), '$aleph_search'(gcwshyp,hypothesis(_,C,_,_)), pp_dclause(C), fail. show(abgen):- nl, p_message('abduced hypothesis'), '$aleph_search'(abgenhyp,hypothesis(_,AbGen,_,_)), aleph_member(C,AbGen), pp_dclause(C), fail. show(hypothesis):- setting(portray_hypothesis,Pretty), aleph_portray(hypothesis,Pretty), fail. show(search):- setting(portray_search,Pretty), aleph_portray(search,Pretty). show(good):- setting(good,true), nl, p_message('good clauses'), (setting(minscore,FMin) -> true; FMin is -inf), setting(evalfn,Evalfn), '$aleph_good'(_,Label,Clause), Label = [_,_,_,F|_], F >= FMin, pp_dclause(Clause), show_stats(Evalfn,Label), fail. show(good):- setting(good,true), setting(goodfile,File), aleph_open(File,read,Stream), (setting(minscore,FMin) -> true; FMin is -inf), setting(evalfn,Evalfn), repeat, read(Stream,Fact), (Fact = '$aleph_good'(_,Label,Clause) -> Label = [_,_,_,F|_], F >= FMin, show_stats(Evalfn,Label), pp_dclause(Clause), fail; close(Stream), ! ). show(features):- setting(evalfn,Evalfn), ('$aleph_feature'(feature,_) -> true; gen_features), p_message('features from good clauses'), '$aleph_feature'(feature,feature(Id,Label,_,Head,Body)), show_stats(Evalfn,Label), pp_dclause(feature(Id,(Head:-Body))), fail. show(constraints):- setting(good,true), nl, p_message('constraints'), setting(noise,N), FMin is -N, '$aleph_good'(_,Label,Clause), split_clause(Clause,nil,_), Label = [_,_,_,F], F >= FMin, pp_dclause(Clause), show_stats(coverage,Label), fail. show(constraints):- show(nil/0). show(Name/Arity):- functor(Pred,Name,Arity), current_predicate(Name,Pred), nl, p1_message('definition'), p_message(Name/Arity), clause(Pred,Body), \+(in(Body,'$aleph_search'(pclause,pclause(_,_)))), pp_dclause((Pred:-Body)), fail. show(train_pos):- setting(portray_examples,Pretty), aleph_portray(train_pos,Pretty). show(train_neg):- setting(portray_examples,Pretty), aleph_portray(train_neg,Pretty). show(test_pos):- setting(portray_examples,Pretty), aleph_portray(test_pos,Pretty). show(test_neg):- setting(portray_examples,Pretty), aleph_portray(test_neg,Pretty). show(_). settings:- show(settings). % examples(?Type,?List) % show all examples numbers in List of Type examples(Type,List):- setting(portray_literals,Pretty), example(Num,Type,Atom), aleph_member1(Num,List), aleph_portray(Atom,Pretty), write('.'), nl, fail. examples(_,_). % bottom(-Clause) % returns current bottom clause bottom(Clause):- '$aleph_sat'(lastlit,Last), get_clause(1,Last,[],ClauseList), list_to_clause(ClauseList,Clause). % posleft(-List) % returns positive examples left to be covered posleft(PList):- '$aleph_global'(atoms_left,atoms_left(pos,PosLeft)), intervals_to_list(PosLeft,PList). % write_rules/0 due to Mark Reid write_rules:- setting(rulefile,File), write_rules(File), !. write_rules. write_features:- setting(featurefile,File), write_features(File), !. write_features. write_rules(File):- aleph_open(File,write,Stream), set_output(Stream), '$aleph_global'(rules,rules(L)), aleph_reverse(L,L1), write_rule(L1), flush_output(Stream), set_output(user_output). write_rule(Rules):- aleph_member(RuleId,Rules), '$aleph_global'(theory,theory(RuleId,_,Rule,_,_)), pp_dclause(Rule), fail. write_rule(_). write_features(File):- aleph_open(File,write,Stream), set_output(Stream), listing('$aleph_feature'/2), close(Stream), set_output(user_output). write_features(_). best_hypothesis(Head1,Body1,[P,N,L]):- '$aleph_search'(selected,selected([P,N,L|_],Clause,_,_)), split_clause(Clause,Head2,Body2), !, Head1 = Head2, Body1 = Body2. hypothesis(Head1,Body1,Label):- '$aleph_search'(pclause,pclause(Head2,Body2)), !, Head1 = Head2, Body1 = Body2, get_hyp_label((Head2:-Body2),Label). hypothesis(Head1,Body1,Label):- '$aleph_global'(hypothesis,hypothesis(_,Theory,_,_)), (Theory = [_|_] -> aleph_member(Clause,Theory); Theory = Clause), split_clause(Clause,Head2,Body2), Head1 = Head2, Body1 = Body2, get_hyp_label((Head2:-Body2),Label). rdhyp:- retractall('$aleph_search'(pclause,_)), retractall('$aleph_search'(covers,_)), retractall('$aleph_search'(coversn,_)), read(Clause), add_hyp(Clause), nl, show(hypothesis). addhyp:- '$aleph_global'(hypothesis,hypothesis(Label,Theory,PCover,NCover)), Theory = [_|_], !, add_theory(Label,Theory,PCover,NCover). addhyp:- '$aleph_global'(hypothesis,hypothesis(Label,_,PCover,_)), !, rm_seeds, worse_coversets(PCover,pos,Label,Worse), (Worse = [] -> true; '$aleph_global'(last_clause,last_clause(NewClause)), update_coversets(Worse,NewClause,pos,Label)), !. addhyp:- '$aleph_search'(selected,selected(Label,RClause,PCover,NCover)), !, add_hyp(Label,RClause,PCover,NCover), rm_seeds, worse_coversets(PCover,pos,Label,Worse), (Worse = [] -> true; '$aleph_global'(last_clause,last_clause(NewClause)), update_coversets(Worse,NewClause,pos,Label)), !. % add bottom clause as hypothesis % provided minacc, noise and search constraints are met % otherwise the example saturated is added as hypothesis add_bottom:- retractall('$aleph_search'(selected,selected(_,_,_,_))), bottom(Bottom), add_hyp(Bottom), '$aleph_global'(hypothesis,hypothesis(Label,Clause,_,_)), (clause_ok(Clause,Label) -> true; '$aleph_sat'(example,example(Num,Type)), example(Num,Type,Example), retract('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), setting(evalfn,Evalfn), complete_label(Evalfn,Example,[1,0,1],Label1), asserta('$aleph_global'(hypothesis,hypothesis(Label1,(Example:-true),[Num-Num],[])))). % specialise a hypothesis by recursive construction of % abnormality predicates sphyp:- retractall('$aleph_search'(sphyp,hypothesis(_,_,_,_))), retractall('$aleph_search'(gcwshyp,hypothesis(_,_,_,_))), retract('$aleph_global'(hypothesis, hypothesis([P,N,L|T],Clause,PCover,NCover))), asserta('$aleph_search'(sphyp,hypothesis([P,N,L|T],Clause,PCover,NCover))), store(searchstate), gcws, retractall('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), asserta('$aleph_global'(hypothesis, hypothesis([P,N,L|T],Clause,PCover,NCover))), reinstate(searchstate). addgcws:- retract('$aleph_search'(gcwshyp,hypothesis(Label,C,P,N))), !, asserta('$aleph_search'(gcwshyp,hypothesis(Label,C,P,N))), addhyp, add_gcws. rmhyp:- retract('$aleph_search'(pclause,pclause(Head,Body))), asserta('$aleph_local'(pclause,pclause(Head,Body))), !. rmhyp:- retract('$aleph_global'(hypothesis,hypothesis(Label,Clause1,P,N))), asserta('$aleph_local'(hypothesis,hypothesis(Label,Clause1,P,N))), !. rmhyp. covers:- get_hyp(Hypothesis), label_create(Hypothesis,Label), extract_cover(pos,Label,P), examples(pos,P), length(P,PC), p1_message('examples covered'), p_message(PC), retractall('$aleph_search'(covers,_)), asserta('$aleph_search'(covers,covers(P,PC))). coversn:- get_hyp(Hypothesis), label_create(Hypothesis,Label), extract_cover(neg,Label,N), examples(neg,N), length(N,NC), p1_message('examples covered'), p_message(NC), retractall('$aleph_search'(coversn,_)), asserta('$aleph_search'(coversn,coversn(N,NC))). % covers(-Number) % as in covers/0, but first checks if being done % within a greedy search covers(P):- get_hyp(Hypothesis), (setting(greedy,true) -> '$aleph_global'(atoms,atoms_left(pos,Pos)); '$aleph_global'(atoms,atoms(pos,Pos))), label_create(Hypothesis,pos,Pos,Label), retractall('$aleph_search'(covers,_)), extract_pos(Label,PCover), interval_count(PCover,P), asserta('$aleph_search'(covers,covers(PCover,P))). % coversn(-Number) % as in coversn/0, but first checks if being done % within a greedy search coversn(N):- get_hyp(Hypothesis), (setting(greedy,true) -> '$aleph_global'(atoms_left,atoms_left(neg,Neg)); '$aleph_global'(atoms_left,atoms(neg,Neg))), label_create(Hypothesis,neg,Neg,Label), retractall('$aleph_search'(coversn,_)), extract_neg(Label,NCover), interval_count(NCover,N), asserta('$aleph_search'(coversn,coverns(NCover,N))). % covers(-List,-Number) % as in covers/1, but returns list of examples covered and their count covers(PList,P):- get_hyp(Hypothesis), (setting(greedy,true) -> '$aleph_global'(atoms,atoms_left(pos,Pos)); '$aleph_global'(atoms,atoms(pos,Pos))), label_create(Hypothesis,pos,Pos,Label), retractall('$aleph_search'(covers,_)), extract_pos(Label,PCover), intervals_to_list(PCover,PList), length(PList,P), asserta('$aleph_search'(covers,covers(PCover,P))). % coversn(-List,-Number) % as in coversn/1, but returns list of examples covered and their count coversn(NList,N):- get_hyp(Hypothesis), (setting(greedy,true) -> '$aleph_global'(atoms_left,atoms_left(neg,Neg)); '$aleph_global'(atoms_left,atoms(neg,Neg))), label_create(Hypothesis,neg,Neg,Label), retractall('$aleph_search'(coversn,_)), extract_neg(Label,NCover), intervals_to_list(NCover,NList), length(NList,N), asserta('$aleph_search'(coversn,coverns(NCover,N))). example_saturated(Example):- '$aleph_sat'(example,example(Num,Type)), example(Num,Type,Example). reset:- clean_up, clear_cache, aleph_abolish('$aleph_global'/2), aleph_abolish(example/3), assert_static(example(0,uspec,nil)), set_default(_), !. % Generic timing routine due to Mark Reid. % Under cygwin, cputime cannot be trusted % so walltime is used instead. To use cputime, set the body of this % predicate to "Time is cputime". stopwatch(Time) :- Time is cputime. % statistics(walltime,[Time|_]). wallclock(Time):- statistics(real_time,[Time|_]). timeit(P,N,[Mean,Sd]):- time_loop(N,P,Times), mean(Times,Mean), sd(Times,Sd). test(F,Flag,N,T):- retractall('$aleph_local'(covered,_)), retractall('$aleph_local'(total,_)), asserta('$aleph_local'(covered,0)), asserta('$aleph_local'(total,0)), (F = [_|_] -> test_files(F,Flag); test_file(F,Flag) ), retract('$aleph_local'(covered,N)), retract('$aleph_local'(total,T)). test_files([],_). test_files([File|Files],Flag):- test_file(File,Flag), test_files(Files,Flag). test_file('?',_):- !. test_file(File,Flag):- setting(portray_examples,Pretty), aleph_open(File,read,Stream), !, repeat, read(Stream,Example), (Example = end_of_file -> close(Stream); retract('$aleph_local'(total,T0)), T1 is T0 + 1, asserta('$aleph_local'(total,T1)), (once(depth_bound_call(Example)) -> (Flag = show -> p1_message(covered), aleph_portray(Example,Pretty), nl; true); (Flag = show -> p1_message('not covered'), aleph_portray(Example,Pretty), nl; true), fail), retract('$aleph_local'(covered,N0)), N1 is N0 + 1, asserta('$aleph_local'(covered,N1)), fail), !. test_file(File,_):- p1_message('cannot open'), p_message(File). in(nil,_):- !, fail. in(bottom,Lit):- !, '$aleph_sat'(lastlit,Last), get_clause(1,Last,[],FlatClause), aleph_member(Lit,FlatClause). in((Head:-true),Head):- !. in((Head:-Body),L):- !, in((Head,Body),L). in((L1,_),L1). in((_,R),L):- !, in(R,L). in(L,L). in((L1,L),L1,L). in((L1,L),L2,(L1,Rest)):- !, in(L,L2,Rest). in(L,L,true). % draw a random number from a distribution random(X,normal(Mean,Sigma)):- var(X), !, normal(Mean,Sigma,X). random(X,normal(_,_)):- !, number(X). % X >= Mean - 3*Sigma, % X =< Mean + 3*Sigma. random(X,Distr):- Distr = [_|_], var(X), !, draw_element(Distr,X1), X = X1. random(X,Distr):- Distr = [_|_], nonvar(X), !, aleph_member(Prob-X,Distr), Prob > 0.0. mean(L,M):- sum(L,Sum), length(L,N), M is Sum/N. sd(L,Sd):- length(L,N), (N = 1 -> Sd = 0.0; sum(L,Sum), sumsq(L,SumSq), Sd is sqrt(SumSq/(N-1) - (Sum*Sum)/(N*(N-1)))). sum([],0). sum([X|T],S):- sum(T,S1), S is X + S1. sumsq([],0). sumsq([X|T],S):- sumsq(T,S1), S is X*X + S1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % auxilliary definitions for some of the above set_default(A):- default_setting(A,B), set(A,B), fail. set_default(_). default_setting(A,B):- set_def(A,_,_,_,B,_), B \= ''. % special case for threads as only SWI supports it check_setting(threads,B):- set_def(threads,_,_,Dom,_,_), check_legal(Dom,B), prolog_type(P), (B > 1 -> (P = swi -> true; err_message(set(threads,B)), fail ); true ), !. check_setting(A,B):- set_def(A,_,_,Dom,_,_), !, (check_legal(Dom,B) -> true; err_message(set(A,B))). check_setting(_,_). check_legal(int(L)-int(U),X):- !, number(L,IL), number(U,IU), number(X,IX), IX >= IL, IX =< IU. check_legal(float(L)-float(U),X):- !, number(L,FL), number(U,FU), number(X,FX), FX >= FL, FX =< FU. check_legal([H|T],X):- !, aleph_member1(X,[H|T]). check_legal(read(filename),X):- X \= '?', !, exists(X). check_legal(_,_). number(+inf,Inf):- Inf is inf, !. number(-inf,MInf):- MInf is -inf, !. number(X,Y):- Y is X, !. setting_definition(A,B,C,D,E,F1):- set_def(A,B,C,D,E,F), (F = noshow -> F1 = dontshow; F = F1). % set_def(Parameter,Class,TextDescr,Type,Default,Flag) set_def(abduce, search-search_strategy, 'Abduce Atoms and Generalise', [true, nil], nil, show). set_def(best, search-search_space, 'Label to beat', prolog_term,'', show). set_def(cache_clauselength, miscellaneous, 'Maximum Length of Cached Clauses', int(1)-int(+inf), 3, show). set_def(caching, miscellaneous, 'Cache Clauses in Search', [true, nil], nil, show). set_def(check_redundant, miscellaneous, 'Check for Redundant Literals', [true, nil], nil, show). set_def(check_good, miscellaneous, 'Check good clauses for duplicates', [true, nil], nil, show). set_def(check_useless, saturation, 'Remove I/O unconnected Literals', [true, nil], nil, show). set_def(classes, tree, 'Class labels', prolog_term,'', show). set_def(clauselength_distribution, search-search_strategy, 'Probablity Distribution over Clauses', prolog_term,'', show). set_def(clauselength, search-search_space, 'Maximum Clause Length', int(1)-int(+inf), 4, show). set_def(clauses, search-search_space, 'Maximum Clauses per Theory', int(1)-int(+inf),'', show). set_def(condition, evaluation, 'Condition SLP', [true, nil], nil, show). set_def(confidence, tree, 'Confidence for Rule Pruning', float(0.0)-float(1.0), 0.95, show). set_def(construct_bottom, saturation, 'Build a bottom clause', [saturation, reduction, nil], saturation, show). set_def(depth, miscellaneous, 'Theorem Proving Depth', int(1)-int(+inf), 10, show). set_def(evalfn, evaluation, 'Evaluation Function', [coverage, compression, posonly, pbayes, accuracy, laplace, auto_m, mestimate, mse, entropy, gini, sd, wracc, user], coverage, show). set_def(explore, search-search_space, 'Exhaustive Search of all alternatives', [true, nil], nil, show). set_def(good, miscellaneous, 'Store good clauses', [true, nil], nil, show). set_def(goodfile, miscellaneous, 'File of good clauses', write(filename),'', show). set_def(gsamplesize, evaluation, 'Size of random sample', int(1)-int(+inf), 100, show). set_def(i, saturation, 'bound layers of new variables', int(1)-int(+inf), 2, show). set_def(interactive, search-search_strategy, 'Interactive theory construction', [true, nil], nil, show). set_def(language, search-search_space, 'Maximum occurrence of any predicate symbol in a clause', int(1)-int(+inf), +inf, show). set_def(lazy_negs, evaluation, 'Lazy theorem proving on negative examples', [true, nil], nil, show). set_def(lazy_on_contradiction, evaluation, 'Lazy theorem proving on contradictions', [true, nil], nil, show). set_def(lazy_on_cost, evaluation, 'Lazy theorem proving on cost', [true, nil], nil, show). set_def(lookahead, search-search_space, 'Lookahead for automatic refinement operator', int(1)-int(+inf), 1, show). set_def(m, evaluation, 'M-estimate', float(0.0)-float(+inf),'', show). set_def(max_abducibles, search-search_space, 'Maximum number of atoms in an abductive explanation', int(1)-int(+inf), 2, show). set_def(max_features, miscellaneous, 'Maximum number of features to be constructed', int(1)-int(+inf), +inf, show). set_def(minacc, evaluation, 'Minimum clause accuracy', float(0.0)-float(1.0), 0.0, show). set_def(mingain, tree, 'Minimum expected gain', float(0.000001)-float(+inf), 0.05, show). set_def(minpos, evaluation, 'Minimum pos covered by a clause', int(0)-int(+inf), 1, show). set_def(minposfrac, evaluation, 'Minimum proportion of positives covered by a clause', float(0.0)-float(1.0), 0, show). set_def(minscore, evaluation, 'Minimum utility of an acceptable clause', float(-inf)-float(+inf), -inf, show). set_def(moves, search-search_strategy, 'Number of moves in a randomised local search', int(0)-int(+inf), 5, show). set_def(newvars, search-search_space, 'Existential variables in a clause', int(0)-int(+inf), +inf, show). set_def(nodes, search-search_space, 'Nodes to be explored in the search', int(1)-int(+inf), 5000, show). set_def(noise, evaluation, 'Maximum negatives covered', int(0)-int(+inf), 0, show). set_def(nreduce_bottom, saturation, 'Negative examples based reduction of bottom clause', [true, nil], nil, show). set_def(openlist, search-search_space, 'Beam width in a greedy search', int(1)-int(+inf), +inf, show). set_def(optimise_clauses, miscellaneous, 'Perform query Optimisation', [true, nil], nil, show). set_def(permute_bottom, saturation, 'Randomly permute order of negative literals in the bottom clause', [true, nil], nil, show). set_def(portray_examples, miscellaneous, 'Pretty print examples', [true, nil], nil, show). set_def(portray_hypothesis, miscellaneous, 'Pretty print hypotheses', [true, nil], nil, show). set_def(portray_literals, miscellaneous, 'Pretty print literals', [true, nil], nil, show). set_def(portray_search, miscellaneous, 'Pretty print search', [true, nil], nil, show). set_def(print, miscellaneous, 'Literals printed per line', int(1)-int(+inf), 4, show). set_def(prior, miscellaneous, 'Prior class distribution', prolog_term,'', show-ro). set_def(proof_strategy, miscellaneous, 'Current proof strategy', [restricted_sld, sld, user], restricted_sld, show). set_def(prooftime, miscellaneous, 'Theorem proving timeit', float(0.0)-float(+inf), +inf, show). set_def(prune_tree, tree, 'Tree pruning', [true, nil], nil, show). set_def(recordfile, miscellaneous, 'Log filename', write(filename),'', show). set_def(record, miscellaneous, 'Log to file', [true, nil], nil, show). set_def(refineop, search-search_strategy, 'Current refinement operator', [user, auto, scs, nil],'', show-ro). set_def(refine, search-search_strategy, 'Nature of customised refinement operator', [user, auto, scs, nil], nil, show). set_def(resample, search-search_strategy, 'Number of times to resample an example', int(1)-int(+inf), 1, show). set_def(rls_type, search-search_strategy, 'Type of randomised local search', [gsat, wsat, rrr, anneal], gsat, show). set_def(rulefile, miscellaneous, 'Rule file', write(filename),'', show). set_def(samplesize, search-search_strategy, 'Size of sample', int(0)-int(+inf), 0, show). set_def(scs_percentile, search-search_strategy, 'Percentile of good clauses for SCS search', float(0.0)-float(100.0),'', show). set_def(scs_prob, search-search_strategy, 'Probability of getting a good clause in SCS search', float(0.0)-float(1.0),'', show). set_def(scs_sample, search-search_strategy, 'Sample size in SCS search', int(1)-int(+inf), '', show). set_def(search, search-search_strategy, 'Search Strategy', [bf, df, heuristic, ibs, ils, rls, scs, id, ic, ar, nil], bf, show). set_def(searchstrat, search-search_strategy, 'Current Search Strategy', [bf, df, heuristic, ibs, ils, rls, scs, id, ic, ar], bf, show-ro). set_def(searchtime, search-search_strategy, 'Search timeit in seconds', float(0.0)-float(+inf), +inf, show). set_def(skolemvars, miscellaneous, 'Counter for non-ground examples', int(1)-int(+inf), 10000, show). set_def(splitvars, saturation, 'Split variable co-refencing', [true, nil], nil, show). set_def(stage, miscellaneous, 'Aleph processing mode', [saturation, reduction, command], command, show-ro). set_def(store_bottom, saturation, 'Store bottom', [true, nil], nil, show). set_def(subsample, search-search_strategy, 'Subsample for evaluating a clause', [true,nil], nil, show). set_def(subsamplesize, search-search_strategy, 'Size of subsample for evaluating a clause', int(1)-int(+inf), +inf, show). set_def(temperature, search-search_strategy, 'Temperature for randomised search annealing', float(0.0)-float(+inf), '', show). set_def(test_neg, miscellaneous, 'Negative examples for testing theory', read(filename),'', show). set_def(test_pos, miscellaneous, 'Positive examples for testing theory', read(filename),'', show). set_def(threads, miscellaneous, 'Number of threads', int(1)-int(+inf), 1, show). set_def(train_neg, miscellaneous, 'Negative examples for training', read(filename),'', show). set_def(train_pos, miscellaneous, 'Positive examples for training', read(filename),'', show). set_def(tree_type, tree, 'Type of tree to construct', [classification, class_probability, regression, model], '', show). set_def(tries, search-search_strategy, 'Number of restarts for a randomised search', int(1)-int(+inf), 10, show). set_def(typeoverlap, miscellaneous, 'Type overlap for induce_modes', float(0.0)-float(1.0), 0.95, show). set_def(uniform_sample, search-search_strategy, 'Distribution to draw clauses from randomly', [true, nil], nil, show). set_def(updateback, miscellaneous, 'Update background knowledge with clauses found on search', [true, nil], true, noshow). set_def(verbosity, miscellaneous, 'Level of verbosity', int(1)-int(+inf), 1, show). set_def(version, miscellaneous, 'Aleph version', int(0)-int(+inf), 5, show-ro). set_def(walk, search-search_strategy, 'Random walk probability for Walksat', float(0.0)-float(1.0), '', show). % the following needed for compatibility with P-Progol special_consideration(search,ida):- set(search,bf), set(evalfn,coverage), !. special_consideration(search,compression):- set(search,heuristic), set(evalfn,compression), !. special_consideration(search,posonly):- set(search,heuristic), set(evalfn,posonly), !. special_consideration(search,user):- set(search,heuristic), set(evalfn,user), !. special_consideration(refine,Refine):- set(refineop,Refine), !. special_consideration(refineop,auto):- gen_auto_refine, !. special_consideration(portray_literals,true):- set(print,1), !. special_consideration(record,true):- noset(recordfile_stream), (setting(recordfile,F) -> aleph_open(F,append,Stream), set(recordfile_stream,Stream); true), !. special_consideration(record,nil):- noset(recordfile_stream), !. special_consideration(recordfile,File):- noset(recordfile_stream), (setting(record,true) -> aleph_open(File,append,Stream), set(recordfile_stream,Stream); true), !. special_consideration(good,true):- noset(goodfile_stream), (setting(goodfile,F) -> aleph_open(F,append,Stream), set(goodfile_stream,Stream); true), !. special_consideration(good,nil):- noset(goodfile_stream), !. special_consideration(goodfile,File):- noset(goodfile_stream), (setting(good,true) -> aleph_open(File,append,Stream), set(goodfile_stream,Stream); true), !. special_consideration(minscore,_):- aleph_abolish('$aleph_feature'/2), !. special_consideration(_,_). rm_special_consideration(portray_literals,_):- set_default(print), !. rm_special_consideration(refine,_):- set_default(refineop), !. rm_special_consideration(record,_):- noset(recordfile_stream), !. rm_special_consideration(recordfile_stream,_):- (setting(recordfile_stream,S) -> close(S); true), !. rm_special_consideration(good,_):- noset(goodfile_stream), !. rm_special_consideration(goodfile_stream,_):- (setting(goodfile_stream,S) -> close(S); true), !. rm_special_consideration(_,_). get_hyp((Head:-Body)):- '$aleph_search'(pclause,pclause(Head,Body)), !. get_hyp(Hypothesis):- '$aleph_global'(hypothesis,hypothesis(_,Hypothesis,_,_)). add_hyp(end_of_file):- !. add_hyp(Clause):- nlits(Clause,L), label_create(Clause,Label), extract_count(pos,Label,PCount), extract_count(neg,Label,NCount), retractall('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), extract_pos(Label,P), extract_neg(Label,N), setting(evalfn,Evalfn), complete_label(Evalfn,Clause,[PCount,NCount,L],Label1), asserta('$aleph_global'(hypothesis,hypothesis(Label1,Clause,P,N))). add_hyp(Label,Clause,P,N):- retractall('$aleph_global'(hypothesis,hypothesis(_,_,_,_))), asserta('$aleph_global'(hypothesis,hypothesis(Label,Clause,P,N))). add_theory(Label,Theory,PCover,NCover):- aleph_member(C,Theory), add_hyp(Label,C,PCover,NCover), update_theory(_), fail. add_theory(_,_,PCover,NCover):- rm_seeds(pos,PCover), (setting(evalfn,posonly) -> rm_seeds(rand,NCover); true), '$aleph_global'(atoms_left,atoms_left(pos,PLeft)), interval_count(PLeft,PL), p1_message('atoms left'), p_message(PL), !. add_gcws:- retract('$aleph_search'(gcwshyp,hypothesis(L,C,P,N))), asserta('$aleph_global'(hypothesis,hypothesis(L,C,P,N))), update_theory(_), fail. add_gcws. restorehyp:- retract('$aleph_local'(pclause,pclause(Head,Body))), assertz('$aleph_search'(pclause,pclause(Head,Body))), !. restorehyp:- retract('$aleph_local'(hypothesis,hypothesis(Label,Clause1,P,N))), asserta('$aleph_global'(hypothesis,hypothesis(Label,Clause1,P,N))), !. restorehyp. get_hyp_label(_,Label):- var(Label), !. get_hyp_label((_:-Body),[P,N,L]):- nlits(Body,L1), L is L1 + 1, ('$aleph_search'(covers,covers(_,P))-> true; covers(_), '$aleph_search'(covers,covers(_,P))), ('$aleph_search'(coversn,coverns(_,N))-> true; coversn(_), '$aleph_search'(coversn,coversn(_,N))). show_global(Key,Pred):- '$aleph_global'(Key,Pred), copy_term(Pred,Pred1), numbervars(Pred1,0,_), aleph_writeq(Pred1), write('.'), nl, fail. show_global(_,_). aleph_portray(hypothesis,true):- aleph_portray(hypothesis), !. aleph_portray(hypothesis,nil):- p_message('hypothesis'), hypothesis(Head,Body,_), pp_dclause((Head:-Body)), !. aleph_portray(_,hypothesis):- !. aleph_portray(search,true):- aleph_portray(search), !. aleph_portray(search,_):- !. aleph_portray(train_pos,true):- aleph_portray(train_pos), !. aleph_portray(train_pos,_):- !, setting(train_pos,File), show_file(File). aleph_portray(train_neg,true):- aleph_portray(train_neg), !. aleph_portray(train_neg,_):- !, setting(train_neg,File), show_file(File). aleph_portray(test_pos,true):- aleph_portray(test_pos), !. aleph_portray(test_pos,_):- !, setting(test_pos,File), show_file(File). aleph_portray(test_neg,true):- aleph_portray(test_neg), !. aleph_portray(test_neg,_):- !, setting(test_neg,File), show_file(File). aleph_portray(Lit,true):- aleph_portray(Lit), !. aleph_portray(Lit,_):- aleph_writeq(Lit). aleph_writeq(Lit):- write_term(Lit,[numbervars(true),quoted(true)]). show_file(File):- aleph_open(File,read,Stream), repeat, read(Stream,Clause), (Clause = end_of_file -> close(Stream); writeq(Clause), write('.'), nl, fail). time_loop(0,_,[]):- !. time_loop(N,P,[T|Times]):- wallclock(S), P, wallclock(F), T is F - S, N1 is N - 1, time_loop(N1,P,Times). list_profile :- % get number of calls for each profiled procedure findall(D-P,profile_data(P,calls,D),LP), % sort them sort(LP,SLP), % and output (note the most often called predicates will come last write_profile_data(SLP). write_profile_data([]). write_profile_data([D-P|SLP]) :- % just swap the two calls to get most often called predicates first. 'format'('~w: ~w~n', [P,D]), write_profile_data(SLP). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % F I N A L C O M M A N D S :- nl, nl, write('A L E P H'), nl, aleph_version(Version), write('Version '), write(Version), nl, aleph_version_date(Date), write('Last modified: '), write(Date), nl, nl, aleph_manual(Man), write('Manual: '), write(Man), nl, nl. :- aleph_version(V), set(version,V), reset.