%%% -*- Mode: Prolog; -*- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % $Date: 2011-11-28 14:41:26 +0100 (Mon, 28 Nov 2011) $ % $Revision: 6764 $ % % This file is part of ProbLog % http://dtai.cs.kuleuven.be/problog % % ProbLog was developed at Katholieke Universiteit Leuven % % Copyright 2008, 2009, 2010 % Katholieke Universiteit Leuven % % Main authors of this file: % Angelika Kimmig, Vitor Santos Costa,Bernd Gutmann, % Theofrastos Mantadelis, Guy Van den Broeck % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Artistic License 2.0 % % Copyright (c) 2000-2006, The Perl Foundation. % % Everyone is permitted to copy and distribute verbatim copies of this % license document, but changing it is not allowed. Preamble % % This license establishes the terms under which a given free software % Package may be copied, modified, distributed, and/or % redistributed. The intent is that the Copyright Holder maintains some % artistic control over the development of that Package while still % keeping the Package available as open source and free software. % % You are always permitted to make arrangements wholly outside of this % license directly with the Copyright Holder of a given Package. If the % terms of this license do not permit the full use that you propose to % make of the Package, you should contact the Copyright Holder and seek % a different licensing arrangement. Definitions % % "Copyright Holder" means the individual(s) or organization(s) named in % the copyright notice for the entire Package. % % "Contributor" means any party that has contributed code or other % material to the Package, in accordance with the Copyright Holder's % procedures. % % "You" and "your" means any person who would like to copy, distribute, % or modify the Package. % % "Package" means the collection of files distributed by the Copyright % Holder, and derivatives of that collection and/or of those files. A % given Package may consist of either the Standard Version, or a % Modified Version. % % "Distribute" means providing a copy of the Package or making it % accessible to anyone else, or in the case of a company or % organization, to others outside of your company or organization. % % "Distributor Fee" means any fee that you charge for Distributing this % Package or providing support for this Package to another party. It % does not mean licensing fees. % % "Standard Version" refers to the Package if it has not been modified, % or has been modified only in ways explicitly requested by the % Copyright Holder. % % "Modified Version" means the Package, if it has been changed, and such % changes were not explicitly requested by the Copyright Holder. % % "Original License" means this Artistic License as Distributed with the % Standard Version of the Package, in its current version or as it may % be modified by The Perl Foundation in the future. % % "Source" form means the source code, documentation source, and % configuration files for the Package. % % "Compiled" form means the compiled bytecode, object code, binary, or % any other form resulting from mechanical transformation or translation % of the Source form. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Permission for Use and Modification Without Distribution % % (1) You are permitted to use the Standard Version and create and use % Modified Versions for any purpose without restriction, provided that % you do not Distribute the Modified Version. % % Permissions for Redistribution of the Standard Version % % (2) You may Distribute verbatim copies of the Source form of the % Standard Version of this Package in any medium without restriction, % either gratis or for a Distributor Fee, provided that you duplicate % all of the original copyright notices and associated disclaimers. At % your discretion, such verbatim copies may or may not include a % Compiled form of the Package. % % (3) You may apply any bug fixes, portability changes, and other % modifications made available from the Copyright Holder. The resulting % Package will still be considered the Standard Version, and as such % will be subject to the Original License. % % Distribution of Modified Versions of the Package as Source % % (4) You may Distribute your Modified Version as Source (either gratis % or for a Distributor Fee, and with or without a Compiled form of the % Modified Version) provided that you clearly document how it differs % from the Standard Version, including, but not limited to, documenting % any non-standard features, executables, or modules, and provided that % you do at least ONE of the following: % % (a) make the Modified Version available to the Copyright Holder of the % Standard Version, under the Original License, so that the Copyright % Holder may include your modifications in the Standard Version. (b) % ensure that installation of your Modified Version does not prevent the % user installing or running the Standard Version. In addition, the % modified Version must bear a name that is different from the name of % the Standard Version. (c) allow anyone who receives a copy of the % Modified Version to make the Source form of the Modified Version % available to others under (i) the Original License or (ii) a license % that permits the licensee to freely copy, modify and redistribute the % Modified Version using the same licensing terms that apply to the copy % that the licensee received, and requires that the Source form of the % Modified Version, and of any works derived from it, be made freely % available in that license fees are prohibited but Distributor Fees are % allowed. % % Distribution of Compiled Forms of the Standard Version or % Modified Versions without the Source % % (5) You may Distribute Compiled forms of the Standard Version without % the Source, provided that you include complete instructions on how to % get the Source of the Standard Version. Such instructions must be % valid at the time of your distribution. If these instructions, at any % time while you are carrying out such distribution, become invalid, you % must provide new instructions on demand or cease further % distribution. If you provide valid instructions or cease distribution % within thirty days after you become aware that the instructions are % invalid, then you do not forfeit any of your rights under this % license. % % (6) You may Distribute a Modified Version in Compiled form without the % Source, provided that you comply with Section 4 with respect to the % Source of the Modified Version. % % Aggregating or Linking the Package % % (7) You may aggregate the Package (either the Standard Version or % Modified Version) with other packages and Distribute the resulting % aggregation provided that you do not charge a licensing fee for the % Package. Distributor Fees are permitted, and licensing fees for other % components in the aggregation are permitted. The terms of this license % apply to the use and Distribution of the Standard or Modified Versions % as included in the aggregation. % % (8) You are permitted to link Modified and Standard Versions with % other works, to embed the Package in a larger work of your own, or to % build stand-alone binary or bytecode versions of applications that % include the Package, and Distribute the result without restriction, % provided the result does not expose a direct interface to the Package. % % Items That are Not Considered Part of a Modified Version % % (9) Works (including, but not limited to, modules and scripts) that % merely extend or make use of the Package, do not, by themselves, cause % the Package to be a Modified Version. In addition, such works are not % considered parts of the Package itself, and are not subject to the % terms of this license. % % General Provisions % % (10) Any use, modification, and distribution of the Standard or % Modified Versions is governed by this Artistic License. By using, % modifying or distributing the Package, you accept this license. Do not % use, modify, or distribute the Package, if you do not accept this % license. % % (11) If your Modified Version has been derived from a Modified Version % made by someone other than you, you are nevertheless required to % ensure that your Modified Version complies with the requirements of % this license. % % (12) This license does not grant you the right to use any trademark, % service mark, tradename, or logo of the Copyright Holder. % % (13) This license includes the non-exclusive, worldwide, % free-of-charge patent license to make, have made, use, offer to sell, % sell, import and otherwise transfer the Package with respect to any % patent claims licensable by the Copyright Holder that are necessarily % infringed by the Package. If you institute patent litigation % (including a cross-claim or counterclaim) against any party alleging % that the Package constitutes direct or contributory patent % infringement, then this Artistic License to you shall terminate on the % date that such litigation is filed. % % (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT % HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED % WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A % PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT % PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT % HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, % INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE % OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % prefix-trees for managing a DNF % remembers shortest prefix of a conjunction only (i.e. a*b+a*b*c results in a*b only, but b*a+a*b*c is not reduced) % children are sorted, but branches aren't (to speed up search while keeping structure sharing from proof procedure) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- module(ptree, [init_ptree/1, delete_ptree/1, member_ptree/2, enum_member_ptree/2, insert_ptree/2, delete_ptree/2, edges_ptree/2, count_ptree/2, prune_check_ptree/2, empty_ptree/1, merge_ptree/2, merge_ptree/3, bdd_ptree/3, bdd_struct_ptree/3, bdd_ptree_map/4, bdd_struct_ptree_map/4, traverse_ptree/2, %theo print_ptree/1, %theo statistics_ptree/0, %theo print_nested_ptree/1, %theo trie_to_bdd_trie/5, %theo trie_to_bdd_struct_trie/5, nested_trie_to_bdd_trie/5, %theo nested_trie_to_bdd_struct_trie/5, ptree_decomposition/3, ptree_decomposition_struct/3, nested_ptree_to_BDD_script/3, %theo nested_ptree_to_BDD_struct_script/3, ptree_db_trie_opt_performed/3, bdd_vars_script/1 ]). % load library modules :- use_module(library(tries)). :- use_module(library(lists), [append/3, member/2, memberchk/2, delete/3]). :- use_module(library(system), [tmpnam/1]). :- use_module(library(ordsets), [ord_intersection/3, ord_union/3]). % load our own modules :- use_module(flags). :- use_module(utils). :- use_module(nestedtries, [nested_trie_to_depth_breadth_trie/4]). % switch on all tests to reduce bug searching time :- style_check(all). :- yap_flag(unknown,error). % this is a test to determine whether YAP provides the needed trie library :- initialization( ( predicate_property(trie_disable_hash, imported_from(tries)) -> trie_disable_hash ; print_message(warning,'The predicate tries:trie_disable_hash/0 does not exist. Please update trie library.') ) ). %%%%%%%%%%%%%%%%%%%%%%% % Define module flags %%%%%%%%%%%%%%%%%%%%%%% :- initialization(( problog_define_flag(use_db_trie, problog_flag_validate_boolean, 'use the builtin trie 2 trie transformation', false), problog_define_flag(db_trie_opt_lvl, problog_flag_validate_integer, 'optimization level for the trie 2 trie transformation', 0), problog_define_flag(compare_opt_lvl, problog_flag_validate_boolean, 'comparison mode for optimization level', false), problog_define_flag(db_min_prefix, problog_flag_validate_integer, 'minimum size of prefix for dbtrie to optimize', 2), problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false), problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true), problog_define_flag(use_dec_trie, problog_flag_validate_boolean, 'use the decomposition method', false), problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false), problog_define_flag(export_map_file, problog_flag_validate_boolean, 'activates export of a variable map file', false, output) )). %%%%%%%%%%%%%%%%%%%%%%%% % ptree basics %%%%%%%%%%%%%%%%%%%%%%%% init_ptree(Trie) :- trie_open(Trie). delete_ptree(Trie) :- trie_close(Trie), !. delete_ptree(_). empty_ptree(Trie) :- trie_usage(Trie, 0, 0, 0). traverse_ptree(Trie, List) :- trie_traverse(Trie, Ref), trie_get_entry(Ref, List). traverse_ptree_mode(Mode) :- trie_traverse_mode(Mode). %%%%%%%%%%%%%%%%%%%%%%%% % member %%%%%%%%%%%%%%%%%%%%%%%% % non-backtrackable (to check) member_ptree(List, Trie) :- trie_check_entry(Trie, List, _). % backtrackable (to list) enum_member_ptree(List, Trie) :- trie_path(Trie, List). trie_path(Trie, List) :- trie_traverse(Trie, Ref), trie_get_entry(Ref, List). %%%%%%%%%%%%%%%%%%%%%%%% % insert conjunction %%%%%%%%%%%%%%%%%%%%%%%% insert_ptree(false, _Trie) :-!. insert_ptree(true, Trie) :- !, trie_delete(Trie), trie_put_entry(Trie, [true], _). insert_ptree(List, Trie) :- (trie_check_entry(Trie, [true], _) -> % prune if there is a prob=1 proof true ; trie_put_entry(Trie, List, _) ). %%%%%%%%%%%%%%%%%%%%%%%% % delete conjunction %%%%%%%%%%%%%%%%%%%%%%%% delete_ptree(List, Trie) :- trie_check_entry(Trie, List, Ref), trie_remove_entry(Ref). %%%%%%%% % return list -Edges of all edge labels in ptree % doesn't use any heuristic to order those for the BDD % (automatic reordering has to do the job) %%%%%%%%% edges_ptree(Trie, []) :- empty_ptree(Trie), !. edges_ptree(Trie, []) :- trie_check_entry(Trie, [true], _), !. edges_ptree(Trie ,Edges) :- setof(X, trie_literal(Trie, X), Edges). trie_literal(Trie, X) :- trie_traverse(Trie,Ref), trie_get_entry(Ref, List), member(X, List). %%%%%%%% % number of conjunctions in the tree %%%%%%%%% count_ptree(Trie, N) :- trie_usage(Trie, N, _, _). %%%%%%%% % check whether some branch of ptree is a subset of conjunction List % useful for pruning the search for proofs (optional due to time overhead) % currently not implemented, just fails %%%%%%% prune_check_ptree(_List, _Trie) :- format(user,'FAIL: prune check currently not supported~n',[]), flush_output(user), fail. %%%%%%%%%%%%% % merge two ptrees % - take care not to loose proper prefixes that are proofs! %%%%%%%%%%%%%%% merge_ptree(T1, _) :- trie_check_entry(T1, [true], _), !. merge_ptree(_, T2) :- trie_check_entry(T2, [true], _), !. % is this strange on the loop condition? merge_ptree(T1, T2) :- trie_join(T1, T2). merge_ptree(T1, _, T3) :- trie_check_entry(T1, [true], _), !, trie_open(T3), trie_put_entry(T3, [true], _). merge_ptree(_, T2, T3) :- trie_check_entry(T2, [true], _), !, trie_open(T3), trie_put_entry(T3, [true], _). merge_ptree(T1, T2, T3) :- trie_dup(T1, T3), trie_join(T3, T2). %%%%%%%%%%%%%%%%%%%%%%%% % Write structural BDD script for given trie to file % does NOT write a parameter file but unifies a list of used variables % % Specialized versions are: % - bdd_ptree -> bdd_struct_ptree % - bdd_ptree_map -> bdd_struct_ptree_map % - nested_ptree_to_BDD_script -> nested_ptree_to_BDD_struct_script % - trie_to_bdd_trie -> trie_to_bdd_struct_trie % - nested_trie_to_bdd_trie -> nested_trie_to_bdd_struct_trie % - ptree_decomposition -> ptree_decomposition_struct % - bdd_ptree_script -> bdd_struct_ptree_script %%%%%%%%%%%%%%%%%%%%%%%% :- dynamic(c_num/1). bdd_struct_ptree(Trie, FileBDD, Variables) :- bdd_struct_ptree_script(Trie, FileBDD, Variables), eraseall(map). bdd_struct_ptree_map(Trie, FileBDD, Variables, Mapping) :- bdd_struct_ptree_script(Trie, FileBDD, Variables), findall(X, recorded(map, X, _), Map), add_probs(Map, Mapping), eraseall(map). bdd_struct_ptree_script(Trie, FileBDD, Variables) :- edges_ptree(Trie, Variables), name_vars(Variables), % expected by output_compressed_script/1? length(Variables, VarCount), assertz(c_num(1)), bdd_pt(Trie, CT), c_num(NN), IntermediateSteps is NN - 1, tell(FileBDD), format('@BDD1~n~w~n~w~n~w~n', [VarCount, 0, IntermediateSteps]), output_compressed_script(CT), told, retractall(c_num(_)), retractall(compression(_, _)). name_vars([]). name_vars([A|B]) :- ( A=not(ID) -> get_var_name(ID,_) ; get_var_name(A,_) ), name_vars(B). nested_ptree_to_BDD_struct_script(Trie, BDDFileName, Variables):- tmpnam(TmpFile1), open(TmpFile1, 'write', BDDS), ( generate_BDD_from_trie(Trie, Inter, BDDS) -> ( next_intermediate_step(TMP), InterCNT is TMP - 1, format(BDDS,'~q~n',[Inter]), close(BDDS), ( get_used_vars(Variables, VarCNT) -> true; VarCNT = 0 ), prefix_bdd_file_with_header(BDDFileName,VarCNT,InterCNT,TmpFile1), cleanup_BDD_generation );( close(BDDS), delete_file_silently(TmpFile1), cleanup_BDD_generation, fail ) ). trie_to_bdd_struct_trie(A, B, OutputFile, OptimizationLevel, Variables) :- trie_to_depth_breadth_trie(A, B, LL, OptimizationLevel), (atomic_concat('L', InterStep, LL) -> % what does this mean? retractall(deref(_,_)), (problog_flag(deref_terms, true) -> asserta(deref(LL,no)), mark_for_deref(B), V = 3 ; V = 1 ), variables_in_dbtrie(B, Variables), %not the most efficient solution length(Variables, VarCNT), %this 2 should be changed tell(OutputFile), write('@BDD'), write(V), nl, write(VarCNT), nl, write(0), nl, write(InterStep), nl, trie_write(B, LL), write(LL), nl, told ; (is_state(LL) -> Variables = [] ; Variables = [LL] ), tell(OutputFile), write('@BDD1'), nl, write(1), nl, write(0), nl, write(1), nl, get_var_name(LL, NLL), write('L1 = '),write(NLL),nl, write('L1'), nl, told ). nested_trie_to_bdd_struct_trie(A, B, OutputFile, OptimizationLevel, Variables):- %trie_nested_to_depth_breadth_trie(A, B, LL, OptimizationLevel, problog:problog_chktabled), nested_trie_to_depth_breadth_trie(A, B, LL, OptimizationLevel), (is_label(LL) -> retractall(deref(_,_)), (problog_flag(deref_terms, true) -> asserta(deref(LL,no)), mark_for_deref(B), V = 3 ; V = 1 ), variables_in_dbtrie(B, Variables), %not the most efficient solution length(Variables, VarCNT), %this 2 should be changed tell(OutputFile), write('@BDD'), write(V), nl, write(VarCNT), nl, write(0), nl, (LL = not(NegL)-> atomic_concat('L', NegStep, NegL), number_atom(NegStepN, NegStep), InterStep is NegStepN + 1, atomic_concat('L', InterStep, FL), write(InterStep), nl, trie_write(B, FL), write(FL), write(' = ~'), write(NegL), nl, write(FL), nl ; atomic_concat('L', InterStep, LL), write(InterStep), nl, trie_write(B, LL), write(LL), nl ), told ; (is_state(LL) -> Variables = [] ; Variables = [LL] ), tell(OutputFile), write('@BDD1'), nl, write(1), nl, write(0), nl, write(1), nl, simplify(LL, FLL), (FLL = not(_) -> write('L1 = ~') ; write('L1 = ') ), get_var_name(FLL, NLL), write(NLL),nl, write('L1'), nl, told ). ptree_decomposition_struct(Trie, BDDFileName, Variables) :- tmpnam(TmpFile1), nb_setval(next_inter_step, 1), variables_in_dbtrie(Trie, Variables), length(Variables, VarCnt), tell(TmpFile1), decompose_trie(Trie, Variables, L), (is_label(L)-> atomic_concat('L', LCnt, L), write(L),nl ; LCnt = 1, write('L1 = '), (L == false -> write('FALSE') ; write(L) ), nl, write('L1'), nl ), told, prefix_bdd_file_with_header(BDDFileName,VarCnt,LCnt,TmpFile1). %%%%%%%%%%%%%%%%%%%%%%%% % write BDD info for given ptree to file % - initializes leaf BDDs (=variables) first % - then compresses ptree to exploit subtree sharing % - bdd_pt/1 does the work on the structure itself %%%%%%%%%%%%%%%%%%%%%%%% bdd_ptree(Trie, FileBDD, FileParam) :- bdd_ptree_script(Trie, FileBDD, FileParam), eraseall(map). % version returning variable mapping bdd_ptree_map(Trie, FileBDD, FileParam, Mapping) :- bdd_ptree_script(Trie, FileBDD, FileParam), findall(X, recorded(map, X, _), Map), add_probs(Map, Mapping), eraseall(map). add_probs([], []). add_probs([m(A,Name)|Map], [m(A, Name, Prob)|Mapping]) :- % FIXME: Does this work with non-ground facts problog:get_fact_probability(A, Prob), add_probs(Map, Mapping). % number of variables may be to high: % counted on trie, but conversion to old tree representation % transforms A*B+A to A (prefix-test) bdd_ptree_script(Trie, FileBDD, FileParam) :- edges_ptree(Trie, Edges), tell(FileParam), bdd_vars_script(Edges), flush_output, told, length(Edges, VarCount), assertz(c_num(1)), bdd_pt(Trie, CT), c_num(NN), IntermediateSteps is NN - 1, tell(FileBDD), format('@BDD1~n~w~n~w~n~w~n', [VarCount, 0, IntermediateSteps]), output_compressed_script(CT), told, retractall(c_num(_)), retractall(compression(_, _)). % write parameter file by iterating over all var/not(var) occuring in the tree bdd_vars_script(Vars):- bdd_vars_script(Vars, Names), (problog_flag(export_map_file, true) -> problog_flag(map_file, MapFile), os:convert_filename_to_working_path(MapFile, MapFileName), flush_output, tell(MapFileName), problog:get_fact_list(Vars, Facts), writemap(Names, Facts), flush_output, told ; true ). writemap([],[]). writemap([Name|Names],[Fact|Facts]):- write(map(Name,Fact)),nl, writemap(Names, Facts). bdd_vars_script([], []). bdd_vars_script([false|T], Names):- bdd_vars_script(T, Names). bdd_vars_script([true|T], Names):- bdd_vars_script(T, Names). bdd_vars_script([not(A)|B], Names) :- !, bdd_vars_script([A|B], Names). bdd_vars_script([A|B], [NameA|Names]) :- bdd_vars_script_intern(A, NameA), bdd_vars_script(B, Names). bdd_vars_script_intern(A, NameA) :- (number(A) -> % it's a ground fact get_var_name(A,NameA), (problog:decision_fact(A,_) -> % it's a ground decision (problog:problog_control(check,internal_strategy) -> problog:get_fact_probability(A,P), format('@~w~n~12f~n~w~n',[NameA,P,1]) ; dtproblog:initial_probability(P), format('@~w~n~12f~n~w~n',[NameA,P,1]) ) ; % it's a normal ProbLog fact problog:get_fact_probability(A,P), format('@~w~n~12f~n',[NameA,P]) ) ; % it's somethin else, call the specialist - it's a non-ground or continuous fact bdd_vars_script_intern2(A, NameA) ). bdd_vars_script_intern2(A, NameA) :- get_var_name(A,NameA), atom_codes(A,A_Codes), once(append(Part1,[95|Part2],A_Codes)), % 95 = '_' number_codes(ID,Part1), ( % let's check whether Part2 contains an 'l' (l=low) member(108,Part2) -> ( % it does, so it's a continuous fact problog:get_continuous_fact_parameters(ID,gaussian(Mu,Sigma)), format('@~w~n0~n0~n~12f;~12f~n',[NameA,Mu,Sigma]) ); ( number_codes(Grounding_ID,Part2), (problog:decision_fact(ID,_) -> % it's a non-ground decision (problog:problog_control(check,internal_strategy) -> problog:grounding_is_known(Goal,Grounding_ID), problog:dynamic_probability_fact_extract(Goal,P), format('@~w~n~12f~n~w~n',[NameA,P,1]) ; dtproblog:initial_probability(P), format('@~w~n~12f~n~w~n',[NameA,P,1]) ) ; (problog:dynamic_probability_fact(ID) -> problog:grounding_is_known(Goal,Grounding_ID), problog:dynamic_probability_fact_extract(Goal,P) ; problog:get_fact_probability(ID,P) ), format('@~w~n~12f~n',[NameA,P]) ) ) ). %%%%%%%%%%%%%%%%%%%%%%%% % find top level symbol for script %%%%%%%%%%%%%%%%%%%%%%%% % special cases: variable-free formulae bdd_pt(Trie, false) :- empty_ptree(Trie), !, retractall(c_num(_)), assertz(c_num(2)). bdd_pt(Trie, true) :- trie_check_entry(Trie, [true], _), !, retractall(c_num(_)), assertz(c_num(2)). % general case: transform trie to nested tree structure for compression bdd_pt(Trie, CT) :- trie_to_tree(Trie, Tree), once(compress_pt(Tree, CT)). trie_to_tree(Trie, Tree) :- findall(Path, trie_path(Trie, Path), Paths), add_trees(Paths, [], Tree). add_trees([], Tree, Tree). add_trees([List|Paths], Tree0, Tree) :- ins_pt(List, Tree0, TreeI), add_trees(Paths, TreeI, Tree). % default: prune if adding prefix of known proof(s) ins_pt([], _T, []) :- !. % alternative: keep extensions of prefix % ins_pt([],T,T) :- !. ins_pt([A|B], [s(A1, AT)|OldT], NewT) :- compare(Comp, A1, A), (Comp == = -> (AT == [] -> NewT=[s(A1, AT)|OldT] ; NewT = [s(A1, NewAT)|OldT], ins_pt(B, AT, NewAT)) ; Comp == > -> NewT = [s(A1, AT)|Tree], ins_pt([A|B], OldT, Tree) ; NewT = [s(A, BTree), s(A1, AT)|OldT], ins_pt(B, [], BTree) ). ins_pt([A|B], [], [s(A, NewAT)]) :- ins_pt(B, [], NewAT). %%%%%%%%%%%% % BDD compression: alternates and- and or-levels to build BDD bottom-up % each sub-BDD will be either a conjunction of a one-node BDD with some BDD or a disjunction of BDDs % uses the internal database to temporarily store a map of components %%%%%%%%%%%% % T is completely compressed and contains single variable % i.e. T of form x12 or ~x34 compress_pt(T, TT) :- atom(T), test_var_name(T), !, get_next_name(TT), assertz(compression(TT, [T])). % T is completely compressed and contains subtrees % i.e. T of form 'L56' compress_pt(T, T) :- atom(T). % T not yet compressed % i.e. T is a tree-term (nested list & s/2 structure) % -> execute one layer of compression, then check again compress_pt(T, CT) :- \+ atom(T), and_or_compression(T, IT), compress_pt(IT, CT). % transform tree-term T into tree-term CT where last two layers have been processed % i.e. introduce names for subparts (-> Map) and replace (all occurrenes of) subparts by this names and_or_compression(T, CT) :- and_comp(T, AT), or_comp(AT, CT). % replace leaves that are single child by variable representing father-AND-child and_comp(T, AT) :- all_leaves_pt(T, Leaves), compression_mapping(Leaves, Map), replace_pt(T, Map, AT). % replace list of siblings by variable representing their disjunction or_comp(T, AT) :- all_leaflists_pt(T, Leaves), compression_mapping(Leaves, Map), replace_pt(T, Map, AT). all_leaves_pt(T, L) :- all(X, some_leaf_pt(T, X), L). some_leaf_pt([s(A, [])|_], s(A,[])). some_leaf_pt([s(A, L)|_], s(A, L)) :- not_or_atom(L). some_leaf_pt([s(_, L)|_], X) :- some_leaf_pt(L, X). some_leaf_pt([_|L],X) :- some_leaf_pt(L,X). all_leaflists_pt(L, [L]) :- atomlist(L), !. all_leaflists_pt(T, L) :- all(X,some_leaflist_pt(T, X), L), !. all_leaflists_pt(_, []). some_leaflist_pt([s(_, L)|_], L) :- atomlist(L). some_leaflist_pt([s(_, L)|_], X) :- some_leaflist_pt(L, X). some_leaflist_pt([_|L], X) :- some_leaflist_pt(L, X). not_or_atom(T) :- ( T = not(T0) -> atom(T0); atom(T) ). atomlist([]). atomlist([A|B]) :- not_or_atom(A), atomlist(B). % for each subtree that will be compressed, add its name % only introduce 'L'-based names when subtree composes elements, store these in compression/2 for printing the script compression_mapping([], []). compression_mapping([First|B], [N-First|BB]) :- ( First = s(A0, []) % subtree is literal -> use variable's name x17 from map (add ~ for negative case) -> ( A0 = not(A) -> ( recorded(map, m(A, Tmp), _), %check atomic_concat(['~', Tmp], N) ); recorded(map, m(A0, N), _) %check ) ; (First = s(A, L), not_or_atom(L)) % subtree is node with single completely reduced child -> use next 'L'-based name -> (get_next_name(N), assertz(compression(N, s(A, L)))) ; (First = [L], not_or_atom(L)) % subtree is an OR with a single completely reduced element -> use element's name -> N = L ; (atomlist(First), % subtree is an OR with only (>1) completely reduced elements -> use next 'L'-based name get_next_name(N), assertz(compression(N, First))) ), compression_mapping(B, BB). % replace_pt(+T,+Map,-NT) % given the tree-term T and the Map of Name-Subtree entries, replace each occurence of Subtree in T with Name -> result NT replace_pt(T, [], T). replace_pt([], _, []). replace_pt(L, M, R) :- atomlist(L), member(R-L, M), !. replace_pt([L|LL], [M|MM], R) :- replace_pt_list([L|LL], [M|MM], R). replace_pt_list([T|Tree], [M|Map], [C|Compr]) :- replace_pt_single(T, [M|Map], C), replace_pt_list(Tree, [M|Map], Compr). replace_pt_list([], _, []). replace_pt_single(s(A, T), [M|Map], Res) :- atomlist(T), member(Res-s(A, T), [M|Map]), !. replace_pt_single(s(A, T), [M|Map], s(A, Res)) :- atomlist(T), member(Res-T, [M|Map]), !. replace_pt_single(s(A, T), [M|Map], Res) :- member(Res-s(A, T), [M|Map]), !. replace_pt_single(s(A, T), [M|Map], s(A, TT)) :- !, replace_pt_list(T, [M|Map], TT). replace_pt_single(A, _, A) :- not_or_atom(A). %%%%%%%%%%%% % output for script % input argument is compressed tree, i.e. true/false or name assigned in last compression step %%%%%%%%%%%% output_compressed_script(false) :- !, format('L1 = FALSE~nL1~n', []). output_compressed_script(true) :- !, format('L1 = TRUE~nL1~n', []). % for each name-subtree pair, write corresponding line to script, e.g. L17 = x4 * L16 % stop after writing definition of root (last entry in compression/2), add it's name to mark end of script output_compressed_script(T) :- once(retract(compression(Short, Long))), (T = Short -> format('~w = ', [Short]), format_compression_script(Long), format('~w~n', [Short]) ; format('~w = ', [Short]), format_compression_script(Long), output_compressed_script(T)). format_compression_script(s(A0, B0)) :- % checkme ( A0 = not(A) -> ( recorded(map, m(A, C), _), format('~~~w * ~w~n', [C, B0]) ) ; ( recorded(map, m(A0, C), _), format('~w * ~w~n', [C, B0]) ) ). format_compression_script([A]) :- format('~w~n', [A]). format_compression_script([A, B|C]) :- format('~w + ', [A]), format_compression_script([B|C]). %%%%%%%%%%%%%%%%%%%%%%%% % auxiliaries for translation to BDD %%%%%%%%%%%%%%%%%%%%%%%% % prefix the current counter with "L" get_next_name(Name) :- retract(c_num(N)), NN is N + 1, assertz(c_num(NN)), atomic_concat('L', N, Name). % create BDD-var as fact id prefixed by x % learning.yap relies on this format! % when changing, also adapt test_var_name/1 below simplify_list(List, SList):- findall(NEL, (member(El, List), simplify(El, NEL)), SList). simplify(not(false), true):- !. simplify(not(true), false):- !. simplify(not(not(A)), B):- !, simplify(A, B). simplify(A, A). simplify(not(false), true):- !. simplify(not(true), false):- !. simplify(not(not(A)), B):- !, simplify(A, B). simplify(A, A). get_var_name(true, 'TRUE'):- !. get_var_name(false, 'FALSE'):- !. get_var_name(Variable, Name):- atomic(Variable), !, atomic_concat([x, Variable], Name), (recorded(map, m(Variable, Name), _) -> true ; recorda(map, m(Variable, Name), _) ). get_var_name(not(A), NameA):- get_var_name(A, NameA). /* get_var_name(true, 'TRUE') :-!. get_var_name(false, 'FALSE') :-!. get_var_name(not(A), NameA):- !, get_var_name(A, NameA). get_var_name(A, NameA) :- atomic_concat([x, A], NameA), ( recorded(map, m(A, NameA), _) -> true ; recorda(map, m(A, NameA), _) ).*/ % test used by base case of compression mapping to detect single-variable tree % has to match above naming scheme test_var_name(T) :- atomic_concat(x, _, T). test_var_name(T) :- atomic_concat('~x', _, T). % Theo debuging additions print_ptree(Trie):- trie_print(Trie). statistics_ptree:- trie_stats(Memory,Tries,Entries,Nodes), write('--------------------------------'),nl, write('Memory: '),write(Memory),nl, write('Tries: '), write(Tries),nl, write('Entries: '), write(Entries),nl, write('Nodes: '), write(Nodes),nl, write('--------------------------------'),nl. :- dynamic(nested_ptree_printed/1). print_nested_ptree(Trie):- retractall(nested_ptree_printed(_)), print_nested_ptree(Trie, 0, ' '), retractall(nested_ptree_printed(_)). print_nested_ptree(Trie, _, _):- nested_ptree_printed(Trie), !. print_nested_ptree(Trie, Level, Space):- spacy_print(begin(t(Trie)), Level, Space), fail. print_nested_ptree(Trie, Level, Space):- assertz(nested_ptree_printed(Trie)), trie_path(Trie, Path), NewLevel is Level + 1, spacy_print(Path, NewLevel, Space), (member(t(Hash), Path); member(not(t(Hash)), Path)), problog:problog_chktabled(Hash, SubTrie), NewLevel2 is NewLevel + 1, print_nested_ptree(SubTrie, NewLevel2, Space), fail. print_nested_ptree(Trie, Level, Space):- spacy_print(end(t(Trie)), Level, Space). spacy_print(Msg, 0, _):- write(Msg), nl, !. spacy_print(Msg, Level, Space):- Level > 0, write(Space), NewLevel is Level - 1, spacy_print(Msg, NewLevel, Space). % Theo Naive method works with Nested Trie to BDD Script :- dynamic(get_used_vars/2). :- dynamic(generated_trie/2). :- dynamic(next_intermediate_step/1). nested_ptree_to_BDD_script(Trie, BDDFileName, VarFileName):- tmpnam(TmpFile1), open(TmpFile1, 'write', BDDS), (generate_BDD_from_trie(Trie, Inter, BDDS) -> next_intermediate_step(TMP), InterCNT is TMP - 1, write(BDDS, Inter), nl(BDDS), close(BDDS), ( get_used_vars(Vars, VarCNT) -> true; VarCNT = 0 ), prefix_bdd_file_with_header(BDDFileName,VarCNT,InterCNT,TmpFile1), open(VarFileName, 'write', VarStream), bddvars_to_script(Vars, VarStream), close(VarStream), cleanup_BDD_generation ; close(BDDS), delete_file_silently(TmpFile1), cleanup_BDD_generation, fail ). cleanup_BDD_generation:- retractall(get_used_vars(_, _)), retractall(generated_trie(_, _)), retractall(next_intermediate_step(_)). generate_BDD_from_trie(Trie, TrieInter, Stream):- empty_ptree(Trie), !, get_next_intermediate_step(TrieInter), write(Stream, TrieInter), write(Stream, ' = FALSE'), nl(Stream), !. generate_BDD_from_trie(Trie, TrieInter, _Stream):- clause(generated_trie(STrie, TrieInter), true), STrie = Trie, !. generate_BDD_from_trie(Trie, TrieInter, Stream):- findall(LineInter, ( trie_path(Trie, L), generate_line(L, LineTerms, LineInter, Stream), write_bdd_line(LineTerms, LineInter, '*', Stream) ), OrLineTerms), (OrLineTerms = [Inter|[]] -> TrieInter = Inter ; get_next_intermediate_step(TrieInter), write_bdd_line(OrLineTerms, TrieInter, '+', Stream) ), assertz(generated_trie(Trie, TrieInter)). write_bdd_line([], _LineInter, _Operator, _Stream):-!. write_bdd_line(LineTerms, LineInter, Operator, Stream):- write(Stream, LineInter), write(Stream, '='), write_bdd_lineterm(LineTerms, Operator, Stream). write_bdd_lineterm([LineTerm|[]], _Operator, Stream):- write(Stream, LineTerm), nl(Stream), !. write_bdd_lineterm([LineTerm|LineTerms], Operator, Stream):- write(Stream, LineTerm), write(Stream, Operator), write_bdd_lineterm(LineTerms, Operator, Stream). generate_line([], [], Inter, _Stream):- !, get_next_intermediate_step(Inter). generate_line([not(t(Hash))|L], [TrieInter|T] , Inter, Stream):- !, problog:problog_chktabled(Hash, Trie), generate_BDD_from_trie(Trie, TrieInterTmp, Stream), atomic_concat(['~', TrieInterTmp], TrieInter), generate_line(L, T, Inter, Stream). generate_line([t(Hash)|L], [TrieInter|T] , Inter, Stream):- !, problog:problog_chktabled(Hash, Trie), generate_BDD_from_trie(Trie, TrieInter, Stream), generate_line(L, T, Inter, Stream). generate_line([V|L], [BDDV|T], Inter, Stream):- make_bdd_var(V, BDDV), generate_line(L, T, Inter, Stream). % % Currently it is dublicate with bdd_vars_script predicate % finally should be merged % bddvars_to_script([], _Stream):-!. bddvars_to_script([H|T], Stream):- (number(H) -> CurVar = H ; atom_codes(H, H_Codes), % 95 = '_' append(Part1, [95|Part2], H_Codes), number_codes(CurVar, Part1), number_codes(Grounding_ID, Part2) ), (problog:dynamic_probability_fact(CurVar) -> problog:grounding_is_known(Goal, Grounding_ID), problog:dynamic_probability_fact_extract(Goal, P) ; problog:get_fact_probability(CurVar, P) ), get_var_name(H, VarName), format(Stream, '@~w~n~12f~n', [VarName, P]), bddvars_to_script(T, Stream). get_next_intermediate_step('L1'):- \+ clause(next_intermediate_step(_), _), !, assertz(next_intermediate_step(2)). get_next_intermediate_step(Inter):- next_intermediate_step(InterStep), retract(next_intermediate_step(InterStep)), NextInterStep is InterStep + 1, assertz(next_intermediate_step(NextInterStep)), atomic_concat(['L', InterStep], Inter). make_bdd_var('true', 'TRUE'):-!. make_bdd_var('false', 'FALSE'):-!. /*make_bdd_var(neg(V), NotVName):- !, make_bdd_var(not(V), NotVName).*/ make_bdd_var(not(V), NotVName):- !, get_var_name(V, VName), atomic_concat(['~', VName], NotVName), add_to_vars(V). make_bdd_var(V, VName):- get_var_name(V, VName), add_to_vars(V). add_to_vars(V):- clause(get_used_vars(Vars, _Cnt), true), memberchk(V, Vars),!. add_to_vars(V):- clause(get_used_vars(Vars, Cnt), true), !, retract(get_used_vars(Vars, Cnt)), NewCnt is Cnt + 1, assertz(get_used_vars([V|Vars], NewCnt)). add_to_vars(V):- assertz(get_used_vars([V], 1)). %%%%%%%%%%%%%%% depth breadth builtin support %%%%%%%%%%%%%%%%% %%% %%% Pending: %%% 1) Replace term in trie, written in C level %%% *2) Support for false, true and 1 var %%% 3) Decide if it is necessary to propagete loop from child %%% 4) Possible memory leak with [true] (go(0)) %%% *5) Handle correctly the trie_replace when not(false), not(true) %%% 6) Compare sort with a good insert sort %%% 7) Have a look to the write to file predicates %%% variables_in_dbtrie(Trie, []):- empty_ptree(Trie), !. variables_in_dbtrie(Trie, []):- trie_check_entry(Trie, [true], _R), !. variables_in_dbtrie(Trie, L):- all(V, variable_in_dbtrie(Trie,V), L). variable_in_dbtrie(Trie, V):- trie_traverse(Trie, R), trie_get_entry(R, L), get_next_variable(NV, L), get_variable(NV, V). get_next_variable(V, depth(L, _S)):- member(V, L), \+ is_label(V). get_next_variable(V, breadth(L, _S)):- member(V, L), \+ is_label(V). get_next_variable(V, L):- member(V, L), \+ is_label(V), \+ isnestedtrie(V). get_variable(not(V), R):- !, get_variable(V, R). get_variable(R, R). %trie_get_depth_breadth_reduction_opt_level_count(1, CNT1), %trie_get_depth_breadth_reduction_opt_level_count(2, CNT2), %trie_get_depth_breadth_reduction_opt_level_count(3, CNT3), %writeln([CNT1, CNT2, CNT3]), %trie_print(B), trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):- trie_to_depth_breadth_trie(A, B, LL, OptimizationLevel), (is_label(LL) -> atomic_concat('L', InterStep, LL), retractall(deref(_,_)), (problog_flag(deref_terms, true) -> asserta(deref(LL,no)), mark_for_deref(B), V = 3 ; V = 1 ), variables_in_dbtrie(B, Edges), %not the most efficient solution length(Edges, VarCNT), %this 2 should be changed tell(FileParam), bdd_vars_script(Edges), told, tell(OutputFile), write('@BDD'), write(V), nl, write(VarCNT), nl, write(0), nl, write(InterStep), nl, trie_write(B, LL), write(LL), nl, told ; (is_state(LL) -> Edges = [] ; Edges = [LL] ), tell(FileParam), bdd_vars_script(Edges), told, tell(OutputFile), write('@BDD1'), nl, write(1), nl, write(0), nl, write(1), nl, (LL = not(ID) -> get_var_name(ID, NLL), write('L1 = ~'), write(NLL),nl ; get_var_name(LL, NLL), write('L1 = '), write(NLL),nl ), write('L1'), nl, told ). is_state(true). is_state(false). nested_trie_to_bdd_trie(A, B, OutputFile, OptimizationLevel, FileParam):- % trie_nested_to_depth_breadth_trie(A, B, LL, OptimizationLevel, problog:problog_chktabled), nested_trie_to_depth_breadth_trie(A, B, LL, OptimizationLevel), simplify(LL, FLL), (is_label(FLL) -> retractall(deref(_,_)), (problog_flag(deref_terms, true) -> asserta(deref(FLL,no)), mark_for_deref(B), V = 3 ; V = 1 ), variables_in_dbtrie(B, Edges), %not the most efficient solution length(Edges, VarCNT), %this 2 should be changed tell(FileParam), bdd_vars_script(Edges), told, tell(OutputFile), write('@BDD'), write(V), nl, write(VarCNT), nl, write(0), nl, (FLL = not(NegL)-> atomic_concat('L', NegStep, NegL), number_atom(NegStepN, NegStep), InterStep is NegStepN + 1, atomic_concat('L', InterStep, FL), write(InterStep), nl, trie_write(B, FL), write(FL), write(' = ~'), write(NegL), nl, write(FL), nl ; atomic_concat('L', InterStep, FLL), write(InterStep), nl, trie_write(B, FLL), write(FLL), nl ), told ; (is_state(FLL) -> Edges = [] ; Edges = [FLL] ), tell(FileParam), simplify_list(Edges, SEdges), bdd_vars_script(SEdges), told, tell(OutputFile), write('@BDD1'), nl, write(1), nl, write(0), nl, write(1), nl, (FLL = not(_) -> write('L1 = ~') ; write('L1 = ') ), get_var_name(FLL, NLL), write(NLL),nl, write('L1'), nl, told ). /* variables_in_dbtrie(B, Edges), %not the most efficient solution length(Edges, VarCNT), %this 2 should be changed tell(FileParam), bdd_vars_script(Edges), told, (atomic_concat('L', InterStep, LL) -> tell(OutputFile), write('@BDD1'), nl, write(VarCNT), nl, write(0), nl, write(InterStep), nl, trie_write(B, LL), write(LL), nl, told ; tell(OutputFile), write('@BDD1'), nl, write(1), nl, write(0), nl, write(1), nl, fix(LL, NLL), write('L1 = '),write(NLL),nl, write('L1'), nl, told ). fix(false, 'FALSE'):-!. fix(true, 'TRUE'):-!. fix(A, A). */ preprocess(Index, DepthBreadthTrie, OptimizationLevel, StartCount, FinalEndCount):- problog:problog_chktabled(Index, Trie), !, trie_dup(Trie, CopyTrie), initialise_ancestors(Ancestors), make_nested_trie_base_cases(CopyTrie, t(Index), DepthBreadthTrie, OptimizationLevel, StartCount, EndCount, Ancestors), trie_close(CopyTrie), Next is Index + 1, preprocess(Next, DepthBreadthTrie, OptimizationLevel, EndCount, FinalEndCount). preprocess(_, _, _, FinalEndCount, FinalEndCount). make_nested_trie_base_cases(Trie, t(ID), DepthBreadthTrie, OptimizationLevel, StartCount, FinalEndCount, Ancestors):- trie_to_depth_breadth_trie(Trie, DepthBreadthTrie, Label, OptimizationLevel, StartCount, EndCount), (Label \= t(_) -> FinalEndCount = EndCount, problog:problog_chktabled(ID, RTrie),!, get_set_trie_from_id(t(ID), Label, RTrie, Ancestors, _, Ancestors) ; trie_get_depth_breadth_reduction_entry(NestedEntry), trie_replace_entry(Trie, NestedEntry, Label, false), add_to_ancestors(Label, Ancestors, NewAncestors), make_nested_trie_base_cases(Trie, t(ID), DepthBreadthTrie, OptimizationLevel, EndCount, FinalEndCount, NewAncestors) ). trie_nested_to_depth_breadth_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel, Module:GetTriePredicate):- integer(OptimizationLevel), trie_open(DepthBreadthTrie), (problog_flag(trie_preprocess, true) -> preprocess(1, DepthBreadthTrie, OptimizationLevel, 0, StartCount) ; StartCount = 0 ), initialise_ancestors(Ancestors), initialise_ancestors(Childs), trie_nested_to_db_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel, StartCount, _, Module:GetTriePredicate, Ancestors, _, _, Childs), eraseall(problog_trie_table). trie_nested_to_db_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel, StartCount, FinalEndCount, Module:GetTriePredicate, AncestorList, ContainsLoop, Childs, ChildsAcc):- trie_dup(Trie, CopyTrie), nested_trie_to_db_trie(CopyTrie, DepthBreadthTrie, FinalLabel, OptimizationLevel, StartCount, FinalEndCount, Module:GetTriePredicate, AncestorList, ContainsLoop, Childs, ChildsAcc), trie_close(CopyTrie). nested_trie_to_db_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel, StartCount, FinalEndCount, Module:GetTriePredicate, Ancestors, ContainsLoop, Childs, ChildsAcc):- trie_to_depth_breadth_trie(Trie, DepthBreadthTrie, Label, OptimizationLevel, StartCount, EndCount), (Label \= t(_) -> (var(ContainsLoop) -> ContainsLoop = false ; true ), FinalLabel = Label, FinalEndCount = EndCount, Childs = ChildsAcc ; trie_get_depth_breadth_reduction_entry(NestedEntry), trie_get_entry(NestedEntry, Proof), (loopcheck(Proof, Ancestors) -> % to fix ContainsLoop = true, NewLabel = false, NewEndCount = EndCount ; % writeln(in(Label)), get_set_trie_from_id(Label, NewLabel, NestedTrie, Ancestors, Module:GetTriePredicate, ChildChilds), % writeln(out(NewLabel)), (nonvar(NewLabel) -> NewEndCount = EndCount ; add_to_ancestors(Label, Ancestors, CurAncestors), initialise_ancestors(ChildChildsAcc), trie_nested_to_db_trie(NestedTrie, DepthBreadthTrie, NewLabel, OptimizationLevel, EndCount, NewEndCount, Module:GetTriePredicate, CurAncestors, CheckLoop, ChildChilds, ChildChildsAcc), (CheckLoop -> StoreAncestors = CurAncestors ; initialise_ancestors(StoreAncestors) ), get_set_trie_from_id(Label, NewLabel, NestedTrie, StoreAncestors, Module:GetTriePredicate, ChildChilds) ) ), trie_replace_entry(Trie, NestedEntry, Label, NewLabel), (problog_flag(refine_anclst, true) -> combine_ancestors(ChildsAcc, ChildChilds, AllChilds), add_to_ancestors(Label, AllChilds, FAllChilds) ; initialise_ancestors(FAllChilds) ), nested_trie_to_db_trie(Trie, DepthBreadthTrie, FinalLabel, OptimizationLevel, NewEndCount, FinalEndCount, Module:GetTriePredicate, Ancestors, ContainsLoop, Childs, FAllChilds) ). initialise_ancestors(Ancestors):- (problog_flag(anclst_represent, list) -> Ancestors = [] ; Ancestors = 0 ). add_to_ancestors(t(ID), Ancestors, NewAncestors):- (problog_flag(anclst_represent, list) -> ord_union(Ancestors, [t(ID)], NewAncestors) ; NewAncestors is Ancestors \/ (1 << (ID - 1)) ). combine_ancestors(Ancestors, AddAncestors, Ancestors):- var(AddAncestors), !. combine_ancestors(Ancestors, AddAncestors, AllAncestors):- (problog_flag(anclst_represent, list) -> ord_union(Ancestors, AddAncestors, AllAncestors) ; AllAncestors is Ancestors \/ AddAncestors ). my_trie_print(T):- trie_traverse(T, R), trie_get_entry(R, E), writeln(E), fail. my_trie_print(_T). loopcheck(Proof, AncestorList):- contains_nested_trie(Proof, ID), % memberchk(t(ID), AncestorList). % writeln(chk_id(ID, AncestorList)), chk_id(ID, AncestorList), !. chk_id(ID, AncestorList):- (problog_flag(anclst_represent, list) -> memberchk(t(ID), AncestorList) ; (AncestorList /\ (1 << (ID - 1))) > 0 ). chk_id(ID, AncestorList):- get_negated_synonym_id(ID, NegID), % writeln(get_negated_synonym_id(ID, NegID)), (problog_flag(anclst_represent, list) -> memberchk(t(NegID), AncestorList) ; (AncestorList /\ (1 << (NegID - 1))) > 0 ). % % can also check for a proof with A, not(A) % % get_negated_synonym_id(ID, NegID):- % tabling:problog_tabling_get_negated_from_id(ID, Ref), % recorded(problog_table, store(_, NegID, _, _, _), Ref). get_negated_synonym_id(ID, NegID):- tabling:has_synonyms, recorded(problog_table, store(Pred, ID, _, _, _), _), Pred =.. [Name0|Args], atomic_concat(problog_, Name1, Name0), atomic_concat(Name, '_original', Name1), (recorded(problog_table_synonyms, negated(Name, NotName1), _); recorded(problog_table_synonyms, negated(NotName1, Name), _)), atomic_concat([problog_, NotName1, '_original'], NotName), NegPred =.. [NotName|Args], recorded(problog_table, store(NegPred, NegID, _, _, _), _). is_nested_trie(T):- nonvar(T), is_nested_trie(T, _). is_nested_trie(NT, ID):- nonvar(NT), NT = not(T), !, is_nested_trie(T, ID). is_nested_trie(t(ID), ID). contains_nested_trie(L, ID):- member(T, L), is_nested_trie(T, ID). subset([],_):-!. subset(_,[]):-!,fail. subset([H|T1], [H|T2]):- subset(T1, T2). subset([H1|T1], [H2|T2]):- compare(>, H1, H2), subset([H1|T1],T2). get_set_trie_from_id(t(ID), L, T, AncestorList, _GetTriePredicate, Childs):- nonvar(ID), atomic(L), nonvar(AncestorList), nonvar(T), !, (problog_flag(refine_anclst, true) -> (problog_flag(anclst_represent, list) -> ord_intersection(AncestorList, Childs, RefinedAncestorList) ; RefinedAncestorList is AncestorList /\ Childs ) ; RefinedAncestorList = AncestorList ), recordz(problog_trie_table, get_step_from_id(ID, L, T, RefinedAncestorList, Childs), _). get_set_trie_from_id(t(ID), L, T, SuperSetAncestorList, _GetTriePredicate, Childs):- % (clause(theo,_) ->writeln(get_set_trie_from_id(t(ID), L, T, SuperSetAncestorList, _GetTriePredicate, Childs));true), recorded(problog_trie_table, get_step_from_id(ID, L, T, AncestorList, StoredChilds), _), (problog_flag(refine_anclst, true) -> StoredChilds = Childs ; true ), (problog_flag(subset_check, true) -> (problog_flag(anclst_represent, list) -> subset(AncestorList, SuperSetAncestorList) ; AncestorList is AncestorList /\ SuperSetAncestorList % writeln(hi) ) ; AncestorList = SuperSetAncestorList ), !. get_set_trie_from_id(t(ID), _L, T, _SuperSetAncestorList, _GetTriePredicate, _):- recorded(problog_trie_table, get_step_from_id(ID, _, T, _AncestorList, _Childs), _), !. get_set_trie_from_id(t(ID), _L, T, _AncestorList, Module:GetTriePredicate, _):- Goal =.. [GetTriePredicate, ID, T], call(Module:Goal). trie_replace_entry(_Trie, Entry, _E, false):- !, trie_remove_entry(Entry). trie_replace_entry(Trie, Entry, E, true):- !, trie_get_entry(Entry, Proof), delete(Proof, E, NewProof), (NewProof = [] -> trie_delete(Trie), trie_put_entry(Trie, [true], _) ; trie_remove_entry(Entry), trie_put_entry(Trie, NewProof, _) ). /*trie_replace_entry(Trie, Entry, E, R):- trie_get_entry(Entry, List), replace_in_list(List, NewProof, E, R), trie_remove_entry(Entry), trie_put_entry(Trie, NewProof, _).*/ /*trie_replace_entry(Trie, _Entry, E, R):- trie_replace_term2(Trie, E, R).*/ trie_replace_entry(Trie, _Entry, t(ID), R):- trie_replace_nested_trie(Trie, ID, R). trie_replace_term2(Trie, OldTerm, NewTerm):- trie_dup(Trie, A), %writeln(trie), %my_trie_print(A), trie_delete(Trie), trie_replace_term(A, Trie, OldTerm, NewTerm), trie_close(A). trie_delete(Trie):- trie_traverse(Trie, R), trie_remove_entry(R), fail. trie_delete(_Trie). trie_replace_term(Trie, NewTrie, OldTerm, NewTerm):- trie_traverse(Trie, R), trie_get_entry(R, L), replace_in_list(L, NL, OldTerm, NewTerm), trie_put_entry(NewTrie, NL, _), fail. trie_replace_term(_Trie, _NewTrie, _OldTerm, _NewTerm). replace_in_list([],[],_,_):-!. replace_in_list([H|T], [N|NT], H, N):- !, replace_in_list(T, NT, H, N). replace_in_list([H|T], [NH|NT], R, N):- functor(H, _, 1), !, replace_in_functor(H, NH, R, N), replace_in_list(T, NT, R, N). replace_in_list([H|T], [H|NT], R, N):- replace_in_list(T, NT, R, N). replace_in_functor(F, NF, T, R):- F =.. L, replace_in_list(L, NL, T, R), NF =.. NL. trie_write(T, MAXL):- atomic_concat('L', MAXLA, MAXL), atom_number(MAXLA, MAXLN), trie_traverse(T, R), trie_get_entry(R, L), %write(user_output, L),nl(user_output), (dnfbddformat(L, MAXLN) -> true ; write(user_error, warning(L, not_processed)), nl(user_error) ), fail. trie_write(_, _). dnfbddformat(depth(T, L), MAXL):- atomic_concat('L', LA, L), atom_number(LA, LN), MAXL >= LN, seperate(T, Li, V), %sort(Li, SL), %reverse(SL, RSL), append(Li, V, R), bddlineformat(R, L, ' * '), forall(deref(I, L), ( atomic_concat('L', D, I), write('D'), write(D), nl )). dnfbddformat(breadth(T, L), MAXL):- atomic_concat('L', LA, L), atom_number(LA, LN), MAXL >= LN, seperate(T, Li, V), %sort(Li, SL), %reverse(SL, RSL), append(V, Li, R), bddlineformat(R, L, ' + '), forall(deref(I, L), ( atomic_concat('L', D, I), write('D'), write(D), nl )). bddlineformat([not(H)|T], O):- write('~'), !, bddlineformat([H|T], O). bddlineformat([H], _O):- (is_label(H) -> Var = H ; get_var_name(H, Var) ), write(Var), nl, !. bddlineformat([H|T], O):- (is_label(H) -> Var = H ; get_var_name(H, Var) ), write(Var), write(O), bddlineformat(T, O). /* bddlineformat([not(H)], O):- !, write('~'), bddlineformat([H], O). bddlineformat([H], _O):-!, (is_label(H) -> VarName = H ; get_var_name(H, VarName) ), write(VarName), nl. bddlineformat([not(H)|T], O):- !, write('~'), bddlineformat([H|T], O). bddlineformat([H|T], O):- (is_label(H) -> VarName = H ; get_var_name(H, VarName) ), write(VarName), write(O), bddlineformat(T, O).*/ bddlineformat(T, L, O):- (is_label(L) -> write(L), write(' = '), bddlineformat(T, O) ; write(user_output,bdd_script_error([L,T,O])),nl(user_output) ). is_label(not(L)):- !, is_label(L). is_label(Label):- atom(Label), atomic_concat('L', _, Label). isnestedtrie(not(T)):- !, isnestedtrie(T). isnestedtrie(t(_T)). seperate([], [], []). seperate([H|T], [H|Labels], Vars):- is_label(H), !, seperate(T, Labels, Vars). seperate([H|T], Labels, [H|Vars]):- seperate(T, Labels, Vars). ptree_decomposition(Trie, BDDFileName, VarFileName) :- tmpnam(TmpFile1), nb_setval(next_inter_step, 1), variables_in_dbtrie(Trie, T), length(T, VarCnt), tell(VarFileName), bdd_vars_script(T), told, tell(TmpFile1), decompose_trie(Trie, T, L), (is_label(L)-> atomic_concat('L', LCnt, L), write(L),nl ; LCnt = 1, write('L1 = '), (L == false -> write('FALSE') ; write(L) ), nl, write('L1'), nl ), told, prefix_bdd_file_with_header(BDDFileName,VarCnt,LCnt,TmpFile1). get_next_inter_step(I):- nb_getval(next_inter_step, I), NI is I + 1, nb_setval(next_inter_step, NI). decompose_trie(Trie, _, false):- empty_ptree(Trie), !. decompose_trie(Trie, _, 'TRUE'):- trie_check_entry(Trie, [true], _R),!. decompose_trie(Trie, [H|[]], Var):- trie_usage(Trie, 1, _, _), get_var_name(H, VarA), trie_check_entry(Trie, [L], _R), (not(H) == L -> Var = not(VarA) , Var = VarA ), !. decompose_trie(Trie, [H|_T], L3):- trie_open(TrieWith), trie_open(TrieWithNeg), trie_open(TrieWithOut), trie_seperate(Trie, H, TrieWith, TrieWithNeg, TrieWithOut), /*trie_print(Trie), dwriteln('-----------'), trie_print(TrieWith), dwriteln('-----------'), trie_print(TrieWithNeg), dwriteln('-----------'), trie_print(TrieWithOut), dwriteln('-----------'),*/ variables_in_dbtrie(TrieWith, T1), variables_in_dbtrie(TrieWithNeg, T2), variables_in_dbtrie(TrieWithOut, T3), %dwriteln([T1, not(T2), T3]), decompose_trie(TrieWith, T1, LWith), trie_close(TrieWith), decompose_trie(TrieWithNeg, T2, LWithNeg), trie_close(TrieWithNeg), decompose_trie(TrieWithOut, T3, LWithOut), trie_close(TrieWithOut), get_var_name(H, Var), %dwriteln([Var, ' * ', LWith, ' + ~', Var, ' * ', LWithNeg, ' + ', LWithOut]), (LWith == false -> L1 = false ; (Var == 'TRUE' -> L1 = LWith ; (LWith == 'TRUE' -> L1 = Var ; get_next_inter_step(I), atomic_concat(['L', I], L1), atomic_concat([L1, ' = ', Var, '*', LWith], W1), write(W1), nl ) ) ), (LWithNeg == false -> L2 = false ; (Var == 'TRUE' -> L2 = false ; (LWithNeg == 'TRUE' -> atomic_concat(['~', Var], L2) ; get_next_inter_step(I2), atomic_concat(['L', I2], L2), atomic_concat([L2, ' = ~', Var, '*', LWithNeg], W2), write(W2), nl ) ) ), (one_true(L1, L2, LWithOut) -> L3 = 'TRUE' ; (all_false(L1, L2, LWithOut)-> L3 = false ; (one_non_false(L1, L2, LWithOut, L3) -> true ; get_next_inter_step(I3), atomic_concat(['L', I3], L3), write(L3), write(' = '), non_false([L1,L2,LWithOut], [First|Rest]), write(First), forall(member(NonFalse, Rest), (write('+'), write(NonFalse))), nl ) ) ). dwriteln(A):- write(user_error, A),nl(user_error),flush_output. non_false([], []):-!. non_false([H|T], [H|NT]):- H \== false, non_false(T, NT). non_false([H|T], NT):- H == false, non_false(T, NT). one_true('TRUE', _, _):-!. one_true(_, 'TRUE', _):-!. one_true(_, _, 'TRUE'):-!. all_false(false,false,false). one_non_false(L, false, false, L):- L \== false, !. one_non_false(false, L, false, L):- L \== false, !. one_non_false(false, false, L, L):- L \== false, !. trie_seperate(Trie, Var, TrieWith, TrieWithNeg, TrieWithOut):- trie_traverse(Trie, R), trie_get_entry(R, Proof), (memberchk(Var, Proof) -> remove_from_list(Var, Proof, NProof), (NProof == [] -> trie_put_entry(TrieWith, [true], _) ; trie_put_entry(TrieWith, NProof, _) ) ; (memberchk(not(Var), Proof) -> remove_from_list(not(Var), Proof, NProof), (NProof == [] -> trie_put_entry(TrieWithNeg, [true], _) ; trie_put_entry(TrieWithNeg, NProof, _) ) ; trie_put_entry(TrieWithOut, Proof, _) ) ), fail. trie_seperate(_Trie, _Var, _TrieWith, _TrieWithNeg, _TrieWithOut). remove_from_list(_E, [], []):-!. remove_from_list(E, [E|T], NT):- !, remove_from_list(E, T, NT). remove_from_list(E, [A|T], [A|NT]):- remove_from_list(E, T, NT). ptree_db_trie_opt_performed(LVL1, LVL2, LVL3):- trie_get_depth_breadth_reduction_opt_level_count(1, LVL1), trie_get_depth_breadth_reduction_opt_level_count(2, LVL2), trie_get_depth_breadth_reduction_opt_level_count(3, LVL3). :- dynamic(deref/2). mark_for_deref(DB_Trie):- traverse_ptree_mode(OLD), traverse_ptree_mode(backward), mark_deref(DB_Trie), traverse_ptree_mode(OLD). mark_deref(DB_Trie):- traverse_ptree(DB_Trie, DB_Term), (DB_Term = depth(List, Inter); DB_Term = breadth(List, Inter)), member(L, List), ((is_label(L), \+ deref(L, _)) -> asserta(deref(L, Inter)) ; true ), fail. mark_deref(_).