Angelika's updates.

2009-03-24 01:06:50 +00:00 · 2009-03-24 01:06:50 +00:00 · bab1fd36ec
commit bab1fd36ec
parent b55572baa8
4 changed files with 80 additions and 21 deletions
--- a/packages/ProbLog/problog.yap
+++ b/packages/ProbLog/problog.yap
@ -151,13 +151,14 @@ init_global_params :-
 	set_problog_flag(bdd_file,example_bdd),
 	set_problog_flag(dir,output),
 	set_problog_flag(save_bdd,false),
+	set_problog_flag(verbose,true).
 %	problog_flags,
-	print_sep_line,
-	format('~n     use problog_help/0 for information~n',[]),
-	format('~n     use problog_flags/0 to display current parameter values~2n',[]),
-	print_sep_line,
-	nl,
-	flush_output.
+%	print_sep_line,
+%	format('~n     use problog_help/0 for information~n',[]),
+%	format('~n     use problog_flags/0 to display current parameter values~2n',[]),
+%	print_sep_line,
+%	nl,
+%	flush_output.

 % parameter initialization to be called after returning to user's directory:
 :- initialization(init_global_params).
@ -337,10 +338,17 @@ reset_non_ground_facts :-

 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % access/update the probability of ID's fact
-% hardware-access version: naively scan all problog-predicates
+% hardware-access version: naively scan all problog-predicates,
+% cut choice points if ID is ground (they'll all fail as ID is unique),
+% but not if it isn't (used to iterate over all facts when writing out probabilities for learning)
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 get_fact_probability(ID,Prob) :-
-	get_internal_fact(ID,ProblogTerm,_ProblogName,ProblogArity),
+	(
+	ground(ID) -> 
+		get_internal_fact(ID,ProblogTerm,_ProblogName,ProblogArity),!
+	;
+	get_internal_fact(ID,ProblogTerm,_ProblogName,ProblogArity)
+	),
 	arg(ProblogArity,ProblogTerm,Log),
 	Prob is exp(Log).
 set_fact_probability(ID,Prob) :-
@ -389,13 +397,30 @@ write_tunable_fact(ID) :-
 % recover fact for given id
 % list version not exported (yet?)
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% ID of ground fact
 get_fact(ID,OutsideTerm) :-
 	get_internal_fact(ID,ProblogTerm,ProblogName,ProblogArity),
+	!,
 	ProblogTerm =.. [_Functor,ID|Args],
 	atomic_concat('problog_',OutsideFunctor,ProblogName),
 	Last is ProblogArity-1,
 	nth(Last,Args,_LogProb,OutsideArgs),
 	OutsideTerm =.. [OutsideFunctor|OutsideArgs].
+% ID of instance of non-ground fact: get fact from grounding table
+get_fact(ID,OutsideTerm) :-
+	recover_grounding_id(ID,GID),
+	grounding_is_known(OutsideTerm,GID).
+
+recover_grounding_id(Atom,ID) :-
+	name(Atom,List),
+	reverse(List,Rev),
+	recover_number(Rev,NumRev),
+	reverse(NumRev,Num),
+	name(ID,Num).
+recover_number([95|_],[]) :- !.  % name('_',[95])
+recover_number([A|B],[A|C]) :-
+	recover_number(B,C).
+

 get_fact_list([],[]).
 get_fact_list([ID|IDs],[Fact|Facts]) :-
@ -586,12 +611,17 @@ put_module(Goal,Module,Module:Goal).
 eval_dnf(ID,Prob,Status) :- 
 	((ID = 1, problog_flag(save_bdd,true)) -> problog_control(on,remember); problog_control(off,remember)),
 	count_ptree(ID,NX),
+	(
+	    problog_flag(verbose,true)
+	->
 	(
 	    NX=1
 	->
 	    format(user,'1 proof~n',[]);
            format(user,'~w proofs~n',[NX])
-	),
+	);
+	true
+        ),
 	problog_flag(dir,DirFlag),
 	problog_flag(bdd_file,BDDFileFlag),
 	atomic_concat([DirFlag,BDDFileFlag],BDDFile),
@ -621,7 +651,7 @@ eval_dnf(ID,Prob,Status) :-
 	;
 	    (
 		statistics(walltime,[_,E3]),
-		format(user,'~w ms BDD processing~n',[E3]),
+		(problog_flag(verbose,true) -> format(user,'~w ms BDD processing~n',[E3]);true),
 		see(ResultFile),
 		read(probability(Prob)),
 		seen,
@ -772,7 +802,7 @@ evalStep(Ans,Status) :-
 	stopDiff(Delta),
 	count_ptree(1,NProofs),
 	count_ptree(2,NCands),
-	format(user,'~w proofs, ~w stopped derivations~n',[NProofs,NCands]),
+	(problog_flag(verbose,true) -> format(user,'~w proofs, ~w stopped derivations~n',[NProofs,NCands]);true),
 	flush_output(user),
 	eval_lower(NProofs,Low,StatusLow),
 	(StatusLow \== ok ->
@ -792,7 +822,7 @@ evalStep(Ans,Status) :-
 		Status = StatusUp
 	    ;
 	        Diff is Up-Low,
-		format(user,'difference:  ~6f~n',[Diff]),
+		(problog_flag(verbose,true) -> format(user,'difference:  ~6f~n',[Diff]);true),
 		flush_output(user),
 		((Diff < Delta; Diff =:= 0) -> Ans = 1; Ans = 0),
 		Status = ok)).
@ -809,7 +839,7 @@ eval_lower(N,P,Status) :-
 	(Status = ok -> 
 	    retract(low(_,_)),
 	    assert(low(N,P)),
-	    format(user,'lower bound: ~6f~n',[P]),
+	    (problog_flag(verbose,true) -> format(user,'lower bound: ~6f~n',[P]);true),
 	    flush_output(user)
 	;
 	true).
@ -829,7 +859,7 @@ eval_upper(N,UpP,ok) :-
 	    retract(up(_,_)),
 	    assert(up(N,UpP))
 	;
-	format(user,'~w - continue using old up~n',[StatusUp]),
+	(problog_flag(verbose,true) -> format(user,'~w - continue using old up~n',[StatusUp]);true),
 	flush_output(user),
 	up(_,UpP)).

@ -1057,7 +1087,7 @@ montecarlo(Goal,Delta,K,File) :-
 	close(Log),
 	statistics(walltime,[T1,_]),
 	init_ptree(1),
-	format('search for ~q~n',[Goal]),
+	(problog_flag(verbose,true) -> format('search for ~q~n',[Goal]);true),
 	montecarlo(Goal,Delta,K,0,File,0,T1),
 	problog_control(off,mc),
 	delete_ptree(1).
@ -1077,11 +1107,11 @@ montecarlo(Goal,Delta,K,SamplesSoFar,File,PositiveSoFar,InitialTime) :-
 	statistics(walltime,[T2,_]),
 	Time is (T2-InitialTime)/1000,
 	count_ptree(1,CacheSize),
-	format('~n~w samples~nestimated probability ~w~n95 percent confidence interval [~w,~w]~n',[SamplesNew,Prob,Low,High]),
+	(problog_flag(verbose,true) -> format('~n~w samples~nestimated probability ~w~n95 percent confidence interval [~w,~w]~n',[SamplesNew,Prob,Low,High]);true),
 	open(File,append,Log),
 	format(Log,'~w  ~8f  ~8f  ~8f  ~8f  ~3f  ~w  ~w~n',[SamplesNew,Prob,Low,High,Diff,Time,CacheSize,Next]),
 	close(Log),
-	((Diff<Delta; Diff =:= 0) -> 	format('Runtime ~w sec~2n',[Time]),assert(mc_prob(Prob))
+	((Diff<Delta; Diff =:= 0) -> 	(problog_flag(verbose,true) -> format('Runtime ~w sec~2n',[Time]);true),assert(mc_prob(Prob))
 		    ;	
 	                montecarlo(Goal,Delta,K,SamplesNew,File,Next,InitialTime)).

--- a/packages/ProbLog/problog/flags.yap
+++ b/packages/ProbLog/problog/flags.yap
@ -12,7 +12,7 @@

 :- ensure_loaded(library(system)).

-:- dynamic bdd_time/1, first_threshold/1, last_threshold/1, id_stepsize/1, prunecheck/1, maxsteps/1, mc_batchsize/1, mc_logfile/1, bdd_file/1, bdd_par_file/1, bdd_result/1, work_dir/1, save_bdd/1.
+:- dynamic bdd_time/1, first_threshold/1, last_threshold/1, id_stepsize/1, prunecheck/1, maxsteps/1, mc_batchsize/1, mc_logfile/1, bdd_file/1, bdd_par_file/1, bdd_result/1, work_dir/1, save_bdd/1, problog_verbose/1.

 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % global parameters that can be set using set_problog_flag/2
@ -52,6 +52,9 @@ get_problog_flag(dir,X) :-
 	work_dir(X).
 get_problog_flag(save_bdd,X) :-
 	save_bdd(X).
+get_problog_flag(verbose,X) :-
+	problog_verbose(X).
+

 %%%%%%%%%%%%
 % BDD timeout in seconds, used as option in BDD tool
@ -211,6 +214,8 @@ set_problog_flag(bdd_result,X) :-

 %%%%%%%%%%%%
 % working directory: all the temporary and output files will be located there
+% it assumes a subdirectory of the current working dir
+% on initialization, the current dir is the one where the user's file is located
 %%%%%%%%%%%%
 set_problog_flag(dir,X) :-
 	\+ atom(X),
@ -220,7 +225,8 @@ set_problog_flag(dir,X) :-
 	fail.
 set_problog_flag(dir,X) :-
 	retractall(work_dir(_)),
-	atomic_concat([X,'/'],D),
+	working_directory(PWD,PWD),
+	atomic_concat([PWD,'/',X,'/'],D),
 	atomic_concat(['mkdir ',D],Mkdir),
 	(file_exists(X) -> true; shell(Mkdir)),
 	assert(work_dir(D)).
@ -244,6 +250,24 @@ set_problog_flag(save_bdd,_) :-
 	flush_output(user),
 	fail.

+%%%%%%%%%%%%
+% determine whether ProbLog outputs information (number of proofs, intermediate results, ...) 
+% default is true, as otherwise problog_delta won't output intermediate bounds
+%%%%%%%%%%%%
+
+set_problog_flag(verbose,true) :-
+	!,
+	retractall(problog_verbose(_)),
+	assert(problog_verbose(true)).
+set_problog_flag(verbose,false) :-
+	!,
+	retractall(problog_verbose(_)),
+	assert(problog_verbose(false)).
+set_problog_flag(verbose,_) :-
+	format(user,'\% ERROR: value must be \'true\' or \'false\'!~n',[]),
+	flush_output(user),
+	fail.
+

 %%%%%%%%%%%%%%%%%%%%%%%%
 % show values
@ -278,6 +302,8 @@ problog_flags :-
 	print_param('directory for files',WorkDir,'dir','atom'),
 	problog_flag(save_bdd,Save),
 	print_param('save BDD files for (last) lower bound',Save,'save_bdd','true/false'),
+	problog_flag(verbose,Verbose),
+	print_param('output intermediate information',Verbose,'verbose','true/false'),
 	print_sep_line,
 	format('~n',[]),
 	flush_output.
--- a/packages/ProbLog/problog/tptree.yap
+++ b/packages/ProbLog/problog/tptree.yap
@ -274,7 +274,7 @@ bdd_vars_script([A0|B],N) :-
 	    (
 		atom_chars(A,A_Chars),
 		% 95 = '_'
-		append(Part1,[95|Part2],A_Chars),
+		append(Part1,[95|Part2],A_Chars),!,  % eliminate append's choice point
 		number_chars(A_Number,Part1),
 		number_chars(Grounding_ID,Part2)
 	    )
@ -488,6 +488,7 @@ 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).
--- a/packages/ProbLog/problog_learning.yap
+++ b/packages/ProbLog/problog_learning.yap
@ -28,6 +28,7 @@
 			       file_property/2,
 			       delete_file/1,
 			       make_directory/1,
+			       working_directory/2,
 			       shell/1,
 	                       shell/2]).

@ -132,7 +133,8 @@ set_learning_flag(output_directory,Directory) :-
 	    make_directory(Directory)
 	),

-	atomic_concat([Directory,'/'],Path),
+	working_directory(PWD,PWD),
+	atomic_concat([PWD,'/',Directory,'/'],Path),
 	atomic_concat([Directory,'/log.dat'],Logfile),
 	
 	retractall(output_directory(_)),