1%%% -*- Mode: Prolog; -*-
2
3%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4%
5%  $Date: 2011-12-05 14:07:19 +0100 (Mon, 05 Dec 2011) $
6%  $Revision: 6766 $
7%
8%  Main authors of this file:
9%  Bernd Gutmann
10%
11%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
12%
13% Artistic License 2.0
14%
15% Copyright (c) 2000-2006, The Perl Foundation.
16%
17% Everyone is permitted to copy and distribute verbatim copies of this
18% license document, but changing it is not allowed.  Preamble
19%
20% This license establishes the terms under which a given free software
21% Package may be copied, modified, distributed, and/or
22% redistributed. The intent is that the Copyright Holder maintains some
23% artistic control over the development of that Package while still
24% keeping the Package available as open source and free software.
25%
26% You are always permitted to make arrangements wholly outside of this
27% license directly with the Copyright Holder of a given Package. If the
28% terms of this license do not permit the full use that you propose to
29% make of the Package, you should contact the Copyright Holder and seek
30% a different licensing arrangement.  Definitions
31%
32% "Copyright Holder" means the individual(s) or organization(s) named in
33% the copyright notice for the entire Package.
34%
35% "Contributor" means any party that has contributed code or other
36% material to the Package, in accordance with the Copyright Holder's
37% procedures.
38%
39% "You" and "your" means any person who would like to copy, distribute,
40% or modify the Package.
41%
42% "Package" means the collection of files distributed by the Copyright
43% Holder, and derivatives of that collection and/or of those files. A
44% given Package may consist of either the Standard Version, or a
45% Modified Version.
46%
47% "Distribute" means providing a copy of the Package or making it
48% accessible to anyone else, or in the case of a company or
49% organization, to others outside of your company or organization.
50%
51% "Distributor Fee" means any fee that you charge for Distributing this
52% Package or providing support for this Package to another party. It
53% does not mean licensing fees.
54%
55% "Standard Version" refers to the Package if it has not been modified,
56% or has been modified only in ways explicitly requested by the
57% Copyright Holder.
58%
59% "Modified Version" means the Package, if it has been changed, and such
60% changes were not explicitly requested by the Copyright Holder.
61%
62% "Original License" means this Artistic License as Distributed with the
63% Standard Version of the Package, in its current version or as it may
64% be modified by The Perl Foundation in the future.
65%
66% "Source" form means the source code, documentation source, and
67% configuration files for the Package.
68%
69% "Compiled" form means the compiled bytecode, object code, binary, or
70% any other form resulting from mechanical transformation or translation
71% of the Source form.
72%
73%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
74%
75% Permission for Use and Modification Without Distribution
76%
77% (1) You are permitted to use the Standard Version and create and use
78% Modified Versions for any purpose without restriction, provided that
79% you do not Distribute the Modified Version.
80%
81% Permissions for Redistribution of the Standard Version
82%
83% (2) You may Distribute verbatim copies of the Source form of the
84% Standard Version of this Package in any medium without restriction,
85% either gratis or for a Distributor Fee, provided that you duplicate
86% all of the original copyright notices and associated disclaimers. At
87% your discretion, such verbatim copies may or may not include a
88% Compiled form of the Package.
89%
90% (3) You may apply any bug fixes, portability changes, and other
91% modifications made available from the Copyright Holder. The resulting
92% Package will still be considered the Standard Version, and as such
93% will be subject to the Original License.
94%
95% Distribution of Modified Versions of the Package as Source
96%
97% (4) You may Distribute your Modified Version as Source (either gratis
98% or for a Distributor Fee, and with or without a Compiled form of the
99% Modified Version) provided that you clearly document how it differs
100% from the Standard Version, including, but not limited to, documenting
101% any non-standard features, executables, or modules, and provided that
102% you do at least ONE of the following:
103%
104% (a) make the Modified Version available to the Copyright Holder of the
105% Standard Version, under the Original License, so that the Copyright
106% Holder may include your modifications in the Standard Version.  (b)
107% ensure that installation of your Modified Version does not prevent the
108% user installing or running the Standard Version. In addition, the
109% modified Version must bear a name that is different from the name of
110% the Standard Version.  (c) allow anyone who receives a copy of the
111% Modified Version to make the Source form of the Modified Version
112% available to others under (i) the Original License or (ii) a license
113% that permits the licensee to freely copy, modify and redistribute the
114% Modified Version using the same licensing terms that apply to the copy
115% that the licensee received, and requires that the Source form of the
116% Modified Version, and of any works derived from it, be made freely
117% available in that license fees are prohibited but Distributor Fees are
118% allowed.
119%
120% Distribution of Compiled Forms of the Standard Version or
121% Modified Versions without the Source
122%
123% (5) You may Distribute Compiled forms of the Standard Version without
124% the Source, provided that you include complete instructions on how to
125% get the Source of the Standard Version. Such instructions must be
126% valid at the time of your distribution. If these instructions, at any
127% time while you are carrying out such distribution, become invalid, you
128% must provide new instructions on demand or cease further
129% distribution. If you provide valid instructions or cease distribution
130% within thirty days after you become aware that the instructions are
131% invalid, then you do not forfeit any of your rights under this
132% license.
133%
134% (6) You may Distribute a Modified Version in Compiled form without the
135% Source, provided that you comply with Section 4 with respect to the
136% Source of the Modified Version.
137%
138% Aggregating or Linking the Package
139%
140% (7) You may aggregate the Package (either the Standard Version or
141% Modified Version) with other packages and Distribute the resulting
142% aggregation provided that you do not charge a licensing fee for the
143% Package. Distributor Fees are permitted, and licensing fees for other
144% components in the aggregation are permitted. The terms of this license
145% apply to the use and Distribution of the Standard or Modified Versions
146% as included in the aggregation.
147%
148% (8) You are permitted to link Modified and Standard Versions with
149% other works, to embed the Package in a larger work of your own, or to
150% build stand-alone binary or bytecode versions of applications that
151% include the Package, and Distribute the result without restriction,
152% provided the result does not expose a direct interface to the Package.
153%
154% Items That are Not Considered Part of a Modified Version
155%
156% (9) Works (including, but not limited to, modules and scripts) that
157% merely extend or make use of the Package, do not, by themselves, cause
158% the Package to be a Modified Version. In addition, such works are not
159% considered parts of the Package itself, and are not subject to the
160% terms of this license.
161%
162% General Provisions
163%
164% (10) Any use, modification, and distribution of the Standard or
165% Modified Versions is governed by this Artistic License. By using,
166% modifying or distributing the Package, you accept this license. Do not
167% use, modify, or distribute the Package, if you do not accept this
168% license.
169%
170% (11) If your Modified Version has been derived from a Modified Version
171% made by someone other than you, you are nevertheless required to
172% ensure that your Modified Version complies with the requirements of
173% this license.
174%
175% (12) This license does not grant you the right to use any trademark,
176% service mark, tradename, or logo of the Copyright Holder.
177%
178% (13) This license includes the non-exclusive, worldwide,
179% free-of-charge patent license to make, have made, use, offer to sell,
180% sell, import and otherwise transfer the Package with respect to any
181% patent claims licensable by the Copyright Holder that are necessarily
182% infringed by the Package. If you institute patent litigation
183% (including a cross-claim or counterclaim) against any party alleging
184% that the Package constitutes direct or contributory patent
185% infringement, then this Artistic License to you shall terminate on the
186% date that such litigation is filed.
187%
188% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
189% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
190% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
191% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
192% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
193% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
194% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
195% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
196%
197%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
198
199
200:- module(completion, [propagate_evidence/2,
201		       bdd_cluster/2,
202		       split_atom_name/3,
203		       reset_completion/0]).
204
205:- style_check(all).
206:- yap_flag(unknown,error).
207
208% load library modules
209:- use_module(library(lists),[member/2,append/3,reverse/2]).
210:- use_module(library(system), [tmpnam/1]).
211
212% load our own modules
213:- use_module('../problog').
214:- use_module(grounder).
215:- use_module(logger).
216:- use_module(termhandling).
217:- use_module(flags).
218:- use_module(print_learning).
219:- use_module(utils).
220:- use_module(utils_learning).
221
222:- dynamic seen_atom/4.
223:- dynamic bdd_cluster/2.
224
225:- initialization(problog_define_flag(propagate_known,problog_flag_validate_boolean,'Propagate known atoms',true,learning_bdd_generation)).
226:- initialization(problog_define_flag(propagate_det,problog_flag_validate_boolean,'Propagate deterministic atoms',true,learning_bdd_generation)).
227:- initialization(problog_define_flag(output_dot_files,problog_flag_validate_boolean,'Output .dot files for BDD scripts',true,learning_bdd_generation)).
228:- initialization(problog_define_flag(split_bdds,problog_flag_validate_boolean,'Split BDD scripts when possible',true,learning_bdd_generation)).
229
230
231%========================================================================
232%=
233%========================================================================
234
235reset_completion :-
236	retractall(seen_atom(_,_,_,_)),
237	retractall(bdd_cluster(_,_)).
238
239%========================================================================
240%=
241%========================================================================
242
243propagate_evidence(_,_) :-
244	\+ current_predicate(user:known/3),
245	!,
246	throw(error(system_error,'The predicate user:known/3 is not defined. If you really have empty interpretations declare the user:known/3 as dynamic and come back.')).
247
248
249propagate_evidence(InterpretationID,Query_Type) :-
250	atomic(InterpretationID),
251
252	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
253	%% Clean up                                     %%%
254	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
255	eraseall(rules),
256	eraseall(unpropagated_rules),
257	eraseall(known_atoms),
258	grounder_reset,
259
260	(
261	 Query_Type==test
262	->
263	 (
264	  Key_BDD_script_generation=test_bdd_script_generation,
265	  Key_BDD_script_generation_grounding=test_bdd_script_generation_grounding,
266	  Key_BDD_script_generation_completion=test_bdd_script_generation_completion,
267	  Key_BDD_script_generation_propagation=test_bdd_script_generation_propagation,
268	  Key_BDD_script_generation_splitting=test_bdd_script_generation_splitting,
269	  Key_BDD_script_generation_active_ground_atoms=test_bdd_script_generation_active_ground_atoms,
270	  Key_BDD_script_generation_propagated_ground_atoms=test_bdd_script_generation_propagated_ground_atoms
271	 );
272	 (
273	  Key_BDD_script_generation=train_bdd_script_generation,
274	  Key_BDD_script_generation_grounding=train_bdd_script_generation_grounding,
275	  Key_BDD_script_generation_completion=train_bdd_script_generation_completion,
276	  Key_BDD_script_generation_propagation=train_bdd_script_generation_propagation,
277	  Key_BDD_script_generation_splitting=train_bdd_script_generation_splitting,
278	  Key_BDD_script_generation_active_ground_atoms=train_bdd_script_generation_active_ground_atoms,
279	  Key_BDD_script_generation_propagated_ground_atoms=train_bdd_script_generation_propagated_ground_atoms
280	 )
281	),
282
283
284	logger_start_timer(Key_BDD_script_generation),
285
286	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
287	%% Calc dep()                                   %%%
288	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
289	logger_start_timer(Key_BDD_script_generation_grounding),
290	format_learning(5,'d',[]),
291        % iterate over all evidence atoms
292	forall(user:known(InterpretationID,Atom,Value),
293	       (
294		grounder_compute_reachable_atoms(Atom,InterpretationID,Success),
295		(
296		    (Success==true; Value==false)
297		->
298		    true
299		;
300		    throw(unprovable_evidence(Atom))
301		)
302	       )
303	      ),
304	logger_stop_timer(Key_BDD_script_generation_grounding),
305
306	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
307	%% Calc completion                              %%%
308	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
309	logger_start_timer(Key_BDD_script_generation_completion),
310	format_learning(5,'c',[]),
311	once(completion(InterpretationID)),
312	logger_stop_timer(Key_BDD_script_generation_completion),
313
314	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
315	%% Bring out intermediate garbage               %%%
316	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
317        grounder_reset,
318	!,
319	garbage_collect_atoms,
320
321
322	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
323	%% Calc propagation                             %%%
324	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
325	problog_flag(propagate_known,Propagate_Known),
326
327	(
328	 Propagate_Known==true
329	->
330	 (
331	  logger_start_timer(Key_BDD_script_generation_propagation),
332	  format_learning(5,'p',[]),
333	  once(propagate),
334	  logger_stop_timer(Key_BDD_script_generation_propagation)
335	 );
336	 true
337	),
338
339	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
340	%% Split BDD Script                             %%%
341	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
342	problog_flag(split_bdds,Split_BDDs),
343	format_learning(5,'S',[]),
344	(
345	 Split_BDDs==false
346	->
347	 (
348	  findall(R,(recorded(rules,_,R);recorded(unpropagated_rules,_,R)),All_R),
349	  Cluster=[All_R]
350	 );
351	 (
352	  logger_start_timer(Key_BDD_script_generation_splitting),
353	  split_rules(Cluster),
354	  logger_stop_timer(Key_BDD_script_generation_splitting)
355	 )
356	),
357
358
359
360	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
361	%% Print BDD script                             %%%
362	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
363	format_learning(5,'s',[]),
364	print_script_per_cluster(Cluster,InterpretationID,1,0,Seen_Atoms,[],ClusterIDs),
365	store_known_atoms(InterpretationID,ClusterIDs,Query_Type),
366	key_statistics(known_atoms,Known_Atoms,_),
367	logger_add_to_variable(Key_BDD_script_generation_active_ground_atoms,Seen_Atoms),
368	logger_add_to_variable(Key_BDD_script_generation_propagated_ground_atoms,Known_Atoms),
369
370
371	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
372	%% Clean up                                     %%%
373	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
374	eraseall(rules),
375	eraseall(unpropagated_rules),
376	eraseall(known_atoms),
377	grounder_reset,
378	logger_stop_timer(Key_BDD_script_generation).
379
380
381%========================================================================
382%=
383%========================================================================
384
385print_script_per_cluster([],_,_,Seen_Atoms,Seen_Atoms,Cluster_IDs,Cluster_IDs).
386print_script_per_cluster([Refs|T],InterpretationID,Cluster_ID,Old_Seen_Atoms,Seen_Atoms,Old_Cluster_IDs,Cluster_IDs) :-
387	create_bdd_file_name(InterpretationID,Cluster_ID,File_Name),
388	%trace,
389	once(print_simplecudd_script(Refs,File_Name,This_Seen_Atoms)),
390	New_Seen_Atoms is Old_Seen_Atoms+This_Seen_Atoms,
391	Next_Cluster_ID is Cluster_ID+1,
392	print_script_per_cluster(T,InterpretationID,Next_Cluster_ID,New_Seen_Atoms,Seen_Atoms,[Cluster_ID|Old_Cluster_IDs],Cluster_IDs).
393
394
395%========================================================================
396%=
397%========================================================================
398
399completion(InterpretationID) :-
400	% iterate over all reachable atoms where the completion
401	% can be computed. This will skip reachable probabilistic facts.
402	forall((
403	        grounder_reachable_atom(Head),
404		grounder_completion_for_atom(Head,InterpretationID,Rule)
405	       ),
406	       (
407		once(propagate_interpretation(Rule,InterpretationID,Rule2)),
408		simplify(Rule2,Rule3,_),
409		(
410		 (Rule3\==false,record_constraint_cs_check(Rule3))
411		->
412		 true;
413		 (
414		  print_theory,
415		  format(user_error,'=============================~n',[]),
416		  format(user_error,'Inconsistency error at building completion for atom ~q (Example ~q)~n',[Head,InterpretationID]),
417		  format(user_error,'  Completion was~n    ~q~2n',[Rule]),
418		  format(user_error,'  After subsituting evidence~n    ~q~2n',[Rule2]),
419		  format(user_error,'  After simplifying~n    ~q~2n',[Rule3]),
420		  format(user_error,'=============================~2n',[]),
421		  throw(theory_is_inconsistent)
422		 )
423		)
424	       )
425	      ),
426
427%	print_theory,
428
429        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
430        % Store known Atoms %%
431        %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
432        forall(user:known(InterpretationID,Atom,Value),
433	       recorda(known_atoms,'$atom'(Atom) <=> Value,_)
434	      ).
435
436
437
438%========================================================================
439%= find rule which makes sense to propagate
440%========================================================================
441
442propagate :-
443	problog_flag(propagate_det,true),
444	!,
445	repeat,
446	once(propagate_intern_known(Result1)),
447%	print_theory,
448	Result1==false,
449	once(propagate_intern_deterministic(Result2)),
450	Result2==false,
451	!.
452propagate :-
453	repeat,
454	once(propagate_intern_known(Result1)),
455	Result1==false,
456	!.
457
458propagate_intern_known(true) :-
459	recorded(unpropagated_rules,Atom <=> AtomValue,Key1),
460	!,
461	erase(Key1),
462	recorda(known_atoms,Atom <=> AtomValue,_),
463	forall(
464	       (
465		recorded(rules,Rule,Key2),
466		once(propagate(Rule,Atom,AtomValue,NewRule,true)) % will succeed only when Atom appears in Rule
467	       ),
468	       (
469		erase(Key2),
470		once(simplify(NewRule,NewRuleSimplified,_)),
471		(
472		 (NewRuleSimplified\==false,record_constraint_cs_check(NewRuleSimplified))
473		->
474		 true;
475		 (
476		  print_theory,
477		  format(user_error,'Propagating ~q=~q for ~q leads to an inconsistency.!!!~2n',[Atom,AtomValue,Rule]),
478		  throw(inconsitent)
479		 )
480		)
481	       )
482	      ).
483propagate_intern_known(false).
484
485propagate_intern_deterministic(true) :-
486	recorded(rules,Atom <=> AtomValue,Key1),
487	!,
488	erase(Key1),
489	forall(
490	       (
491		recorded(rules,Rule,Key2),
492		once(propagate(Rule,Atom,AtomValue,NewRule,true)) % will succeed only when Atom appears in Rule
493	       ),
494	       (
495		erase(Key2),
496		once(simplify(NewRule,NewRuleSimplified,_)),
497		(
498		 (NewRuleSimplified\=false,record_constraint_cs_check(NewRuleSimplified))
499		->
500		 true;
501		 (
502		  print_theory,
503		  format(user_error,'Propagating ~q=~q for ~q leads to an inconsistency.!!!~2n',[Atom,AtomValue,Rule]),
504		  throw(inconsitent)
505		 )
506		)
507	       )
508	      ).
509propagate_intern_deterministic(false).
510
511
512%========================================================================
513%=
514%========================================================================
515
516record_constraint_cs_check( (X <=> Y) ) :-
517	recorda(rules,(X <=> Y),_).
518record_constraint_cs_check((X,Y)) :-
519	record_constraint_cs_check(X),
520	record_constraint_cs_check(Y).
521record_constraint_cs_check( (X;Y)) :-
522	recorda(rules,(X;Y),_).
523record_constraint_cs_check( \+ '$atom'(X) ) :-
524	(
525	 recorded(unpropagated_rules, ('$atom'(X)<=>OldValue),_)
526	->
527	 OldValue==false;
528	 recorda(unpropagated_rules, ('$atom'(X) <=> false),_)
529	).
530record_constraint_cs_check('$atom'(X)) :-
531	(
532	 recorded(unpropagated_rules, ('$atom'(X)<=>OldValue),_)
533	->
534	 OldValue==true;
535	 recorda(unpropagated_rules, ('$atom'(X) <=> true),_)
536	).
537record_constraint_cs_check(true).
538
539%========================================================================
540%=
541%========================================================================
542
543
544split_atom_name(Name,ID,GroundID) :-
545	atom(Name),
546	atomic_concat(x,Temp,Name),
547	atom_codes(Temp,TempC),
548
549	(
550	 append(Head,[95|Tail],TempC) % 95-_-
551	->
552	 (
553	  number_chars(ID,Head),
554	  number_chars(GroundID,Tail)
555	 );
556	 (
557	  number_chars(ID,TempC),
558	  GroundID=0
559	 )
560	),
561	!.
562
563store_known_atoms(ID,ClusterIDs,Query_Type) :-
564	(
565	 Query_Type==test
566	->
567	 (
568	  KK_True_Array=known_count_true_test,
569	  KK_False_Array=known_count_false_test
570	 );
571	 (
572	  KK_True_Array=known_count_true_training,
573	  KK_False_Array=known_count_false_training
574	 )
575	),
576
577	retractall(bdd_cluster(ID,_)),
578
579	assertz(bdd_cluster(ID,ClusterIDs)),
580	create_known_values_file_name(ID,File_Name),
581	open(File_Name,'write',Handle),
582	format(Handle,'completion:bdd_cluster(~w,~w).~n',[ID,ClusterIDs]),
583
584	forall((
585		recorded(known_atoms,'$atom'(Atom) <=> Value,_),
586		remember(Atom,Name),
587		split_atom_name(Name,FactID,GroundID)
588	       ),
589	       (
590		(
591		 Value==true
592		->
593		 add_to_array_element(KK_True_Array,FactID,1,_);
594		 add_to_array_element(KK_False_Array,FactID,1,_)
595		),
596		know_atom_expected_count(Value,Count),
597		format(Handle,'completion:known_count(~w,~w,~w,~w). % ~w~n',[ID,FactID,GroundID,Count,Atom])
598	       )
599	      ),
600
601	close(Handle).
602
603know_atom_expected_count(true,1).
604know_atom_expected_count(false,0).
605
606
607%========================================================================
608%=
609%========================================================================
610
611print_theory :-
612	format_learning(5,'~n  Current Theory~n  == Unpropagated Rules ==~n',[]),
613	forall(recorded(unpropagated_rules,Rule,Key),
614	       format_learning(5,'   ~q.  (~q)~n',[Rule,Key])
615	      ),
616
617	format_learning(5,'  == Rules ==~n',[]),
618	forall(recorded(rules,Rule,Key),
619	       format_learning(5,'   ~q.  (~q)~n',[Rule,Key])),
620
621	format_learning(5,'  == Known and Propagated Atoms ==~n',[]),
622	forall(recorded(known_atoms,Head <=> Bodies,Key),
623	       format_learning(5,'   ~q <=> ~q.  (~q)~n',[Head,Bodies,Key])
624	      ),
625
626	format_learning(5,'~3n',[]).
627
628
629%========================================================================
630%= split_rules(-Cluster)
631%========================================================================
632split_rules(Cluster) :-
633	eraseall(cluster),
634
635        % add all rules to the clusters
636	forall(recorded(rules,Expression,Reference),
637	       include_in_clusters(Expression,Reference)),
638
639	% add all unpropagated rules to the clusters
640	forall(recorded(unpropagated_rules,Expression,Reference),
641	       include_in_clusters(Expression,Reference)),
642
643	garbage_collect_atoms,
644
645	% Merge clusters until
646	% no more clusters can be merged
647	(
648	 repeat,
649	 merge_cluster(Result),
650	 Result==false,
651	 !
652	),
653
654	findall(Keys,recorded(cluster,c(_Facts,Keys),_),Cluster),
655	eraseall(cluster),
656
657	garbage_collect_atoms.
658
659%========================================================================
660%= include_in_clusters(+Expression,+Reference)
661%========================================================================
662
663include_in_clusters(Expression,Reference) :-
664	(
665	 setof(F, Expression^term_element(Expression, F), Facts_Sorted)
666	->
667	 true;
668	 Facts_Sorted = []
669	),
670
671	bb_put(facts,Facts_Sorted),
672	bb_put(rule_keys,[Reference]),
673
674	% iterate over all cluster that overlap with Current_Facts
675	forall((
676		recorded(cluster,c(CFacts,Cluster_Rule_Keys),CKey),
677		bb_get(facts,Current_Facts),
678		sorted_overlap_test(Current_Facts,CFacts)
679	       ),
680	       (
681		erase(CKey),
682		bb_get(rule_keys,Current_Rule_Keys),
683		append(Current_Facts,CFacts,Merged_Facts),
684		append(Current_Rule_Keys,Cluster_Rule_Keys,Merged_Rule_Keys),
685		sort(Merged_Facts,Sorted_Facts),
686		bb_put(facts,Sorted_Facts),
687		bb_put(rule_keys,Merged_Rule_Keys)
688	       )
689	      ),
690
691	%clean up and store the new (possibly merged) cluster
692	bb_delete(facts,Final_Facts),
693	bb_delete(rule_keys,Final_Rule_Keys),
694	recorda(cluster,c(Final_Facts,Final_Rule_Keys),_).
695
696%========================================================================
697%= find two clusters that should be merged because they both
698%= contain the same fact
699%========================================================================
700
701merge_cluster(true) :-
702	recorded(cluster,c(CFacts1,Cluster_Rule_Keys1),CKey1),
703	recorded(cluster,c(CFacts2,Cluster_Rule_Keys2),CKey2),
704	CKey1 @< CKey2,
705	sorted_overlap_test(CFacts1,CFacts2),
706	!,
707	erase(CKey1),
708	erase(CKey2),
709
710	append(CFacts1,CFacts2,Merged_Facts),
711	sort(Merged_Facts,Sorted_Facts),
712
713	append(Cluster_Rule_Keys1,Cluster_Rule_Keys2,Merged_Rule_Keys),
714	recorda(cluster,c(Sorted_Facts,Merged_Rule_Keys),_).
715merge_cluster(false).
716
717%========================================================================
718%=
719%========================================================================
720
721print_simplecudd_script(Refs,BDDFilename,Seen_Atoms) :-
722	retractall(seen_atom(_,_,_,_)),
723	retractall(script_hash(_,_)),
724
725	bb_put(counter,0),
726	bb_put(det_counter,0),
727	bb_put(grounding_counter,0),
728
729	tmpnam(Temp_File_Name),
730	open(Temp_File_Name,'write',Handle1),
731	findall(X,(
732		   member(R,Refs),
733		   recorded(_,Expression,R),
734		   print_expression(Expression,Handle1,X)
735		  ),L),
736	reverse(L,L_Rev),
737	list_to_conjunction(L_Rev,Con),
738
739
740	print_expression_and_final(Con,Handle1,'',Final),
741
742	(
743	 (atom_codes(Final,[76|_]))  % X='L....'
744	->
745	 LastID=Final;
746	 (
747	  next_counter(LastID),
748	  format(Handle1,'~w=~w~n',[LastID,Final])
749	 )
750	),
751
752	format(Handle1,'~w~n',[LastID]),
753	close(Handle1),
754
755	succeeds_n_times(seen_atom(_,_,_,_),Seen_Atoms),
756	bb_get(counter,IntermediateSteps),
757
758	prefix_bdd_file_with_header(BDDFilename,Seen_Atoms,IntermediateSteps,Temp_File_Name),
759
760	problog_flag(output_dot_files,Output_Dot_Files),
761
762	(
763	 Output_Dot_Files==true
764	->
765	 (
766	  atomic_concat([BDDFilename,'.dot'],Dot_File_Name),
767	  open(Dot_File_Name,'write',Handle2),
768	  format(Handle2,'digraph d{~n',[]),
769
770	  forall(seen_atom(Atom,ID,_FactID,_),
771		 format(Handle2,'~q [label="~q\\n~q", style="filled", color="lightblue"];~n',[ID,Atom,ID])
772		),
773
774	  findall(X,(member(R,Refs),recorded(_,Expression,R),print_dot_expression(Expression,Handle2,X)),_L2),
775
776	  % switch off printing final line until bugfix
777	  %list_to_conjunction(L2,Con2),
778%	  print_dot_expression(Con2,Handle2,_),
779	  format(Handle2,'}~n',[]),
780	  close(Handle2)
781	 );
782	 true
783	),
784
785	retractall(script_hash(_,_)),
786	retractall(seen_atom(_,_,_,_)).
787
788
789%========================================================================
790%=
791%========================================================================
792
793print_expression(Term,_Handle,N) :-
794	script_hash(Term,N),
795	!.
796
797print_expression(X <=> Y, Handle,N3) :-
798	print_expression(X,Handle,N1),
799	print_expression(Y,Handle,N2),
800	next_counter(N3),
801	assert(script_hash(X <=> Y, N3)),
802	format(Handle,'~w = ~w ~~# ~w~n',[N3,N1,N2]).
803print_expression( (X,Y), Handle,Number) :-
804	print_expression_and((X,Y),Handle,'',Number),
805	assert(script_hash((X,Y), Number)).
806print_expression( (X;Y), Handle,Number) :-
807	print_expression_or((X;Y),Handle,'',Number),
808	assert(script_hash((X;Y), Number)).
809print_expression( \+ '$atom'(X), _Handle,ID) :-
810	remember(X,Name),
811	atomic_concat(['~',Name],ID).
812print_expression( true, _Handle,'TRUE').
813print_expression( false, _Handle,'FALSE').
814print_expression('$atom'(X), _Handle,ID) :-
815	remember(X,ID).
816
817print_expression_or((X;Y), Handle,OldAcc,Number) :-
818	!,
819	print_expression(X,Handle,NX),
820	atomic_concat([OldAcc,NX,' + '],NewAcc),
821	print_expression_or(Y,Handle,NewAcc,Number).
822print_expression_or(X, Handle,OldAcc,Number) :-
823	print_expression(X,Handle,NX),
824	next_counter(Number),
825	format(Handle,'~w = ~w~w~n',[Number,OldAcc,NX]).
826
827
828print_expression_and((X,Y), Handle,OldAcc,Number) :-
829	!,
830	print_expression(X,Handle,NX),
831	atomic_concat([OldAcc,NX,' * '],NewAcc),
832	print_expression_and(Y,Handle,NewAcc,Number).
833print_expression_and(X, Handle,OldAcc,Number) :-
834	print_expression(X,Handle,NX),
835	next_counter(Number),
836	format(Handle,'~w = ~w~w~n',[Number,OldAcc,NX]).
837
838
839print_expression_and_final((X,Y), Handle,OldAcc,Number) :-
840	!,
841	atomic_concat([OldAcc,X,' * '],NewAcc),
842	print_expression_and_final(Y,Handle,NewAcc,Number).
843print_expression_and_final( true, _Handle,_ACC,'TRUE').
844print_expression_and_final(X, Handle,OldAcc,Number) :-
845	next_counter(Number),
846	format(Handle,'~w = ~w~w~n',[Number,OldAcc,X]).
847
848
849%========================================================================
850%=
851%========================================================================
852
853print_dot_expression_or((X;Y), Handle,Number) :-
854	!,
855	print_dot_expression(X,Handle,NX),
856	print_dot_line(NX,Number,Handle),
857	print_dot_expression_or(Y,Handle,Number).
858print_dot_expression_or(X, Handle,Number) :-
859	print_dot_expression(X,Handle,NX),
860	print_dot_line(NX,Number,Handle).
861
862
863print_dot_expression_and((X,Y), Handle,Number) :-
864	!,
865	print_dot_expression(X,Handle,NX),
866	print_dot_line(NX,Number,Handle),
867	print_dot_expression_and(Y,Handle,Number).
868print_dot_expression_and(X, Handle,Number) :-
869	print_dot_expression(X,Handle,NX),
870	print_dot_line(NX,Number,Handle).
871
872
873
874
875print_dot_expression(X <=> Y, Handle,N3) :-
876	print_dot_expression(X,Handle,N1),
877	print_dot_expression(Y,Handle,N2),
878	next_counter(N3),
879	format(Handle,'~w [label="<=>",shape="diamond", style="filled", color="lightsalmon"];~n',[N3]),
880	print_dot_line(N1,N3,Handle),
881	print_dot_line(N2,N3,Handle).
882print_dot_expression( (X,Y), Handle,Number) :-
883	next_counter(Number),
884	format(Handle,'~w [label="^",shape="triangle", style="filled", color="lightgoldenrod"];~n',[Number]),
885	print_dot_expression_and((X,Y),Handle,Number).
886print_dot_expression( (X;Y), Handle,Number) :-
887	next_counter(Number),
888	format(Handle,'~w [label="v",shape="invtriangle", style="filled", color="greenyellow"];~n',[Number]),
889	print_dot_expression_or((X;Y),Handle,Number).
890print_dot_expression( \+ '$atom'(X), _Handle,ID) :-
891	remember(X,Name),
892	atomic_concat(['~',Name],ID).
893print_dot_expression(true, _Handle,'TRUE').
894print_dot_expression( false, _Handle,'FALSE').
895print_dot_expression( '$atom'(X), _Handle,ID) :-
896	remember(X,ID).
897
898
899print_dot_line(N1,N2,Handle) :-
900	(
901	 atomic_concat('~',ID,N1)
902	->
903	 format(Handle,'~w -> ~w [style="dashed, bold"];~n',[ID,N2]);
904	 format(Handle,'~w -> ~w;~n',[N1,N2])
905	).
906
907%========================================================================
908%=
909%========================================================================
910
911
912remember(X,Name) :-
913	seen_atom(X,Name,_,_),
914	!.
915remember(X,X) :-
916	atom(X),
917	atom_codes(X,[76|_]),  % X='L....'
918	!.
919remember(X,Name) :-
920	probabilistic_fact(P,X,ID),
921	!,
922	(
923	 non_ground_fact(ID)
924	->
925	 (
926	  next_grounding_id(Grounding_ID),
927	  atomic_concat([x,ID,'_',Grounding_ID],Name)
928	 );
929	 atomic_concat([x,ID],Name)
930	),
931	assertz(seen_atom(X,Name,ID,P)).
932remember(X,Name) :-
933	next_det_counter(Det_ID),
934	atomic_concat([y,Det_ID],Name),
935	assertz(seen_atom(X,Name,det,1.0)).
936
937
938next_grounding_id(N) :-
939	bb_get(grounding_counter,N),
940	N2 is N+1,
941	bb_put(grounding_counter,N2).
942
943next_det_counter(ID) :-
944	bb_get(det_counter,N),
945	N2 is N+1,
946	atomic_concat(['y',N2],ID),
947	bb_put(det_counter,N2).
948
949next_counter(ID) :-
950	bb_get(counter,N),
951	N2 is N+1,
952	atomic_concat(['L',N2],ID),
953	bb_put(counter,N2).
954
955
956