From 5ea98bcf5388faac8f618d8209a05c7a4f7a6e64 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 5 Oct 2018 10:26:34 +0100 Subject: [PATCH 1/3] LBFGS --- .../ProbLog/problog_examples/learn_graph.pl | 8 +- packages/ProbLog/problog_lbdd.yap | 30 +- packages/ProbLog/problog_lbfgs.yap | 1012 +++++++++++++++++ packages/yap-lbfgs/ex1.pl | 27 +- packages/yap-lbfgs/ex2.pl | 24 +- packages/yap-lbfgs/lbfgs.pl | 126 +- packages/yap-lbfgs/yap_lbfgs.c | 311 +++-- 7 files changed, 1346 insertions(+), 192 deletions(-) create mode 100644 packages/ProbLog/problog_lbfgs.yap diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 65ccb0b12..4e15cfedf 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -14,8 +14,8 @@ % will run 20 iterations of learning with default settings %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:- use_module(library(problog)). -:- use_module(library(problog_learning)). +:- use_module(library(matrix)). +:- use_module(('../problog_lbfgs')). %%%% % background knowledge @@ -99,3 +99,7 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). +:- set_problog_flag(init_method,(Query,_,BDD, + problog_exact_lbdd(user:Query,BDD))). + + diff --git a/packages/ProbLog/problog_lbdd.yap b/packages/ProbLog/problog_lbdd.yap index 6c48af41e..6663cfbf9 100644 --- a/packages/ProbLog/problog_lbdd.yap +++ b/packages/ProbLog/problog_lbdd.yap @@ -6,24 +6,23 @@ :- use_module(library(bdd)). :- use_module(library(bhash)). -problog_exact_lbdd(Goal,Prob,Status) :- - problog_control(on, exact), - problog_low_lbdd(Goal,0,Prob,Status), - problog_control(off, exact). +problog_exact_lbdd(Goal,BDD) :- + problog_low_lbdd(Goal, 0, _, _, BDD). -problog_low_lbdd(Goal, Threshold, _, _) :- +problog_low_lbdd(Goal, Threshold, _, _, _) :- init_problog_low(Threshold), problog_control(off, up), timer_start(sld_time), problog_call(Goal), add_solution, fail. -problog_low_lbdd(_, _, Prob, ok) :- +problog_low_lbdd(_, _, Prob, ok, bdd(Dir, Tree, MapList)) :- timer_stop(sld_time,SLD_Time), problog_var_set(sld_time, SLD_Time), nb_getval(problog_completed_proofs, Trie_Completed_Proofs), - tabled_trie_to_bdd(Trie_Completed_Proofs, BDD, MapList), + trie_to_bdd(Trie_Completed_Proofs, BDD, MapList), bind_maplist(MapList, BoundVars), + bdd_tree(BDD, bdd(Dir, Tree, _Vars)), bdd_to_probability_sum_product(BDD, BoundVars, Prob), (problog_flag(verbose, true)-> problog_statistics @@ -73,6 +72,23 @@ problog_fl_bdd(_,Prob) :- (problog_flag(retain_tables, true) -> retain_tabling; true), clear_tabling. +problog_full_bdd(Goal,_K, _) :- + init_problog_low(0.0), + problog_control(off, up), + timer_start(sld_time), + problog_call(Goal), + add_solution, + fail. +problog_full_bdd(_,Prob) :- + timer_stop(sld_time,SLD_Time), + problog_var_set(sld_time, SLD_Time), + nb_getval(problog_completed_proofs, Trie_Completed_Proofs), + tabled_trie_to_bdd(Trie_Completed_Proofs, BDD, MapList), + bind_maplist(MapList, BoundVars), + bdd_to_probability_sum_product(BDD, BoundVars, Prob), + (problog_flag(retain_tables, true) -> retain_tabling; true), + clear_tabling. + bind_maplist([], []). bind_maplist([Node-_|MapList], [ProbFact|BoundVars]) :- get_fact_probability(Node,ProbFact), diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap new file mode 100644 index 000000000..fc04eaa84 --- /dev/null +++ b/packages/ProbLog/problog_lbfgs.yap @@ -0,0 +1,1012 @@ +%xb%%% -*- Mode: Prolog; -*- + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% $Date: 2011-04-21 14:18:59 +0200 (Thu, 21 Apr 2011) $ +% $Revision: 6364 $ +% +% 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: +% Bernd Gutmann, Vitor Santos Costa +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% 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. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +:- module(learning,[do_learning/1, + do_learning/2, + reset_learning/0, + sigmoid/3, + inv_sigmoid/3 + ]). + +% switch on all the checks to reduce bug searching time +:- style_check(all). +:- yap_flag(unknown,error). + +% load modules from the YAP library +:- use_module(library(lists), [member/2,max_list/2, min_list/2, sum_list/2]). +:- use_module(library(system), [file_exists/1, shell/2]). +:- use_module(library(rbtrees)). +:- use_module(library(lbfgs)). + +% load our own modules +:- reexport(problog). +:- use_module('problog/logger'). +:- use_module('problog/flags'). +:- use_module('problog/os'). +:- use_module('problog/print_learning'). +:- use_module('problog/utils_lbdd'). +:- use_module('problog/utils'). +:- use_module('problog/tabling'). + +% used to indicate the state of the system +:- dynamic(values_correct/0). +:- dynamic(learning_initialized/0). +:- dynamic(current_iteration/1). +:- dynamic(example_count/1). +%:- dynamic(query_probability_intern/2). +%:- dynamic(query_gradient_intern/4). +:- dynamic(last_mse/1). +:- dynamic(query_is_similar/2). +:- dynamic(query_md5/2). + + +% used to identify queries which have identical proofs +:- dynamic(query_is_similar/2). +:- dynamic(query_md5/3). + +% used to identify queries which have identical proofs +:- dynamic(query_is_similar/2). +:- dynamic(query_md5/3). + +:- multifile(user:example/4). +:- multifile(user:problog_discard_example/1). +user:example(A,B,C,=) :- + current_predicate(user:example/3), + user:example(A,B,C), + \+ user:problog_discard_example(B). + +:- multifile(user:test_example/4). +user:test_example(A,B,C,=) :- + current_predicate(user:test_example/3), + user:test_example(A,B,C), + \+ user:problog_discard_example(B). + + + +%======================================================================== +%= store the facts with the learned probabilities to a file +%======================================================================== + +save_model:- + current_iteration(Iteration), + create_factprobs_file_name(Iteration,Filename), + export_facts(Filename). + + + + +%======================================================================== +%= find out whether some example IDs are used more than once +%= if so, complain and stop +%= +%======================================================================== + +check_examples :- + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Check example IDs + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ( + (user:example(ID,_,_,_), \+ atomic(ID)) + -> + ( + format(user_error,'The example id of training example ~q ',[ID]), + format(user_error,'is not atomic (e.g foo42, 23, bar, ...).~n',[]), + throw(error(examples)) + ); true + ), + + ( + (user:test_example(ID,_,_,_), \+ atomic(ID)) + -> + ( + format(user_error,'The example id of test example ~q ',[ID]), + format(user_error,'is not atomic (e.g foo42, 23, bar, ...).~n',[]), + throw(error(examples)) + ); true + ), + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Check example probabilities + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ( + (user:example(ID,_,P,_), (\+ number(P); P>1 ; P<0)) + -> + ( + format(user_error,'The training example ~q does not have a valid probability value (~q).~n',[ID,P]), + throw(error(examples)) + ); true + ), + + ( + (user:test_example(ID,_,P,_), (\+ number(P); P>1 ; P<0)) + -> + ( + format(user_error,'The test example ~q does not have a valid probability value (~q).~n',[ID,P]), + throw(error(examples)) + ); true + ), + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Check that no example ID is repeated, + % and if it is repeated make sure the query is the same + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ( + ( + ( + user:example(ID,QueryA,_,_), + user:example(ID,QueryB,_,_), + QueryA \= QueryB + ) ; + + ( + user:test_example(ID,QueryA,_,_), + user:test_example(ID,QueryB,_,_), + QueryA \= QueryB + ); + + ( + user:example(ID,QueryA,_,_), + user:test_example(ID,QueryB,_,_), + QueryA \= QueryB + ) + ) + -> + ( + format(user_error,'The example id ~q is used several times.~n',[ID]), + throw(error(examples)) + ); true + ). +%======================================================================== +%= +%======================================================================== + +reset_learning :- + retractall(learning_initialized), + retractall(values_correct), + retractall(current_iteration(_)), + retractall(example_count(_)), +% retractall(query_probability_intern(_,_)),% +% retractall(query_gradient_intern(_,_,_,_)), + retractall(last_mse(_)), + retractall(query_is_similar(_,_)), + retractall(query_md5(_,_,_)), + + set_problog_flag(alpha,auto), + set_problog_flag(learning_rate,examples), + logger_reset_all_variables. + + + +%======================================================================== +%= initialize everything and perform Iterations times gradient descent +%= can be called several times +%= if it is called with an epsilon parameter, it stops when the change +%= in the MSE is smaller than epsilon +%======================================================================== + +do_learning(Iterations) :- + do_learning(Iterations,-1). + +do_learning(Iterations,Epsilon) :- + current_predicate(user:example/4), + !, + integer(Iterations), + number(Epsilon), + Iterations>0, + do_learning_intern(Iterations,Epsilon). +do_learning(_,_) :- + format(user_error,'~n~Error: No training examples specified.~n~n',[]). + + +do_learning_intern(0,_) :- + !. +do_learning_intern(Iterations,Epsilon) :- + Iterations>0, + init_learning, + current_iteration(CurrentIteration), + retractall(current_iteration(_)), + NextIteration is CurrentIteration+1, + assertz(current_iteration(NextIteration)), + EndIteration is CurrentIteration+Iterations-1, + + format_learning(1,'~nIteration ~d of ~d~n',[CurrentIteration,EndIteration]), + logger_set_variable(iteration,CurrentIteration), + logger_start_timer(duration), +% mse_testset, + % ground_truth_difference, + gradient_descent, + + problog_flag(log_frequency,Log_Frequency), + + ( + ( Log_Frequency>0, 0 =:= CurrentIteration mod Log_Frequency) + -> + once(save_model); + true + ), + +% update_values, + + ( + last_mse(Last_MSE) + -> + ( + retractall(last_mse(_)), + logger_get_variable(mse_trainingset,Current_MSE), + assertz(last_mse(Current_MSE)), + !, + MSE_Diff is abs(Last_MSE-Current_MSE) + ); ( + logger_get_variable(mse_trainingset,Current_MSE), + assertz(last_mse(Current_MSE)), + MSE_Diff is Epsilon+1 + ) + ), + + ( + (problog_flag(rebuild_bdds,BDDFreq),BDDFreq>0,0 =:= CurrentIteration mod BDDFreq) + -> + ( + retractall(values_correct), + retractall(query_is_similar(_,_)), + retractall(query_md5(_,_,_)), + empty_bdd_directory, + init_queries + ); true + ), + + + !, + logger_stop_timer(duration), + + + logger_write_data, + + + + RemainingIterations is Iterations-1, + + ( + MSE_Diff>Epsilon + -> + do_learning_intern(RemainingIterations,Epsilon); + true + ). + + +%======================================================================== +%= find proofs and build bdds for all training and test examples +%= +%= +%======================================================================== +init_learning :- + learning_initialized, + !. +init_learning :- + check_examples, + +% empty_output_directory, + logger_write_header, + + format_learning(1,'Initializing everything~n',[]), + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Check, if continuous facts are used. + % if yes, switch to problog_exact + % continuous facts are not supported yet. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + set_default_gradient_method, + ( problog_flag(continuous_facts, true ) + -> + problog_flag(init_method,(_,_,_,_,OldCall)), + ( + ( + continuous_fact(_), + OldCall\=problog_exact_save(_,_,_,_,_) + ) + -> + ( + format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]), + set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))) + ); + true + ) + ; + problog_tabled(_) + -> + ( + format_learning(2,'Theory uses tabling.~nWill use problog_exact/3 as initalization method.~2n',[]), + set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))) + ); + true + ), + + succeeds_n_times(user:test_example(_,_,_,_),TestExampleCount), + format_learning(3,'~q test examples~n',[TestExampleCount]), + + succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount), + assertz(example_count(TrainingExampleCount)), + format_learning(3,'~q training examples~n',[TrainingExampleCount]), + + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % build BDD script for every example + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + once(init_queries), + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % done + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + assertz(current_iteration(0)), + assertz(learning_initialized), + + format_learning(1,'~n',[]). + + empty_bdd_directory :- + current_key(_,I), + integer(I), + recorded(I,bdd(_,_,_),R), + erase(R), + fail. +empty_bdd_directory. + + +set_default_gradient_method :- + problog_flag(continuous_facts, true), + !, + problog_flag(init_method,OldMethod), + format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]), + set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))). +set_default_gradient_method :- + problog_tabled(_), problog_flag(fast_proofs,false), + !, + format_learning(2,'Theory uses tabling.~nWill use problog_exact/3 as initalization method.~2n',[]), + set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))). +%set_default_gradient_method :- +% problog_flag(init_method,(gene(X,Y),N,Bdd,graph2bdd(X,Y,N,Bdd))), +% !. +set_default_gradient_method. + +%======================================================================== +%= This predicate goes over all training and test examples, +%= calls the inference method of ProbLog and stores the resulting +%= BDDs +%======================================================================== + + +init_queries :- + format_learning(2,'Build BDDs for examples~n',[]), + forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)), + forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)). + +bdd_input_file(Filename) :- + problog_flag(output_directory,Dir), + concat_path_with_filename(Dir,'input.txt',Filename). + +init_one_query(QueryID,Query,Type) :- +% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % if BDD file does not exist, call ProbLog + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ( + recorded(QueryID, _, _) + -> + format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) + ; + b_setval(problog_required_keep_ground_ids,false), + problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), + Query =.. [_,X,Y] + -> + Bdd = bdd(Dir, Tree, MapList), + ( + graph2bdd(X,Y,N,Bdd) + -> + rb_new(H0), + maplist_to_hash(MapList, H0, Hash), + Tree \= [], + tree_to_grad(Tree, Hash, [], Grad) + ; + Bdd = bdd(-1,[],[]), + Grad=[] + ), + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ; + problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> + b_setval(problog_required_keep_ground_ids,false), + rb_new(H0), + strip_module(Call,_,Goal), + !, + Bdd = bdd(Dir, Tree, MapList), +% trace, + problog:problog_kbest_as_bdd(Goal,NOf,Bdd), + maplist_to_hash(MapList, H0, Hash), + Tree \= [], + %put_code(0'.), + tree_to_grad(Tree, Hash, [], Grad), + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ; + problog_flag(init_method,(Query,NOf,Bdd,Call)) -> + b_setval(problog_required_keep_ground_ids,false), + rb_new(H0), + Bdd = bdd(Dir, Tree, MapList), +% trace, + problog:Call, + maplist_to_hash(MapList, H0, Hash), + Tree \= [], + %put_code(0'.), + tree_to_grad(Tree, Hash, [], Grad), + recordz(QueryID,bdd(Dir, Grad, MapList),_) + ). + +qprobability(bdd(Dir, Tree, MapList), Slope, Prob) :- +/* query_probability(21,6.775948e-01). */ + run_sp(Tree, Slope, 1.0, Prob0), + (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0). + + +qgradient(bdd(Dir, Tree, MapList), Slope, I, Grad) :- + member(I-_, MapList), + run_grad(Tree, I, Slope, 0.0, Grad0), + ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). + +% writeln(grad(QueryID:I:Grad)), +% assert(query_gradient_intern(QueryID,I,p,Grad)), +% fail. +%gradient(QueryID, g, Slope) :- +% gradient(QueryID, l, Slope). + +maplist_to_hash([], H0, H0). +maplist_to_hash([I-V|MapList], H0, Hash) :- + rb_insert(H0, V, I, H1), + maplist_to_hash(MapList, H1, Hash). + +tree_to_grad([], _, Grad, Grad). +tree_to_grad([Node|Tree], H, Grad0, Grad) :- + node_to_gradient_node(Node, H, GNode), + tree_to_grad(Tree, H, [GNode|Grad0], Grad). + +node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :- + rb_lookup(X,Id,H), + (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), + (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). +node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- + rb_lookup(X,Id,H), + (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), + (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). + +run_sp([], _, P0, P0). +run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- + P is EP*PL+ (1.0-EP)*PR, + run_sp(Tree, Slope, P, PF). +run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- + P is EP*PL + (1.0-EP)*(1.0 - PR), + run_sp(Tree, Slope, P, PF). + +run_grad([], _I, _, G0, G0). +run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- + P is EP*PL+ (1.0-EP)*PR, + G0 is EP*GL + (1.0-EP)*GR, + % don' t forget the -X + ( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ), + run_grad(Tree, I, Slope, G, GF). +run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- + P is EP*PL + (1.0-EP)*(1.0 - PR), + G0 is EP*GL - (1.0 - EP) * GR, + ( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ), + run_grad(Tree, I, Slope, G, GF). + + + + + +%======================================================================== +%= +%= +%= +%======================================================================== +query_probability(QueryID,Prob) :- + Prob <== qp[QueryID]. + +%======================================================================== +%= +%= +%= +%======================================================================== + + + +% FIXME +ground_truth_difference :- + findall(Diff,(tunable_fact(FactID,GroundTruth), + \+continuous_fact(FactID), + \+ var(GroundTruth), + %% get_fact_probability(FactID,Prob), + Prob <== p[FactID], + Diff is abs(GroundTruth-Prob)),AllDiffs), + ( + AllDiffs=[] + -> + ( + MinDiff=0.0, + MaxDiff=0.0, + DiffMean=0.0 + ) ; + ( + length(AllDiffs,Len), + sum_list(AllDiffs,AllDiffsSum), + min_list(AllDiffs,MinDiff), + max_list(AllDiffs,MaxDiff), + DiffMean is AllDiffsSum/Len + ) + ), + + logger_set_variable(ground_truth_diff,DiffMean), + logger_set_variable(ground_truth_mindiff,MinDiff), + logger_set_variable(ground_truth_maxdiff,MaxDiff). + +%======================================================================== +%= Calculates the mse of training and test data +%= +%= -Float +%======================================================================== + +mse_trainingset_only_for_linesearch(MSE) :- + update_values, + + example_count(Example_Count), + + bb_put(error_train_line_search,0.0), + forall(user:example(QueryID,_Query,QueryProb,Type), + ( + once(update_query(QueryID,'.',probability)), + query_probability(QueryID,CurrentProb), + once(update_query_cleanup(QueryID)), + ( + (Type == '='; (Type == '<', CurrentProb>QueryProb); (Type=='>',CurrentProb + ( + bb_get(error_train_line_search,Old_Error), + New_Error is Old_Error + (CurrentProb-QueryProb)**2, + bb_put(error_train_line_search,New_Error) + );true + ) + ) + ), + bb_delete(error_train_line_search,Error), + MSE is Error/Example_Count, + format_learning(3,' (~8f)~n',[MSE]), + retractall(values_correct). + +mse_testset :- + current_iteration(Iteration), + create_test_predictions_file_name(Iteration,File_Name), + open(File_Name,'write',Handle), + format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), + format(Handle,"% Iteration, train/test, QueryID, Query, GroundTruth, Prediction %~n",[]), + format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), + + format_learning(2,'MSE_Test ',[]), + update_values, + bb_put(llh_test_queries,0.0), + findall(SquaredError, + (user:test_example(QueryID,Query,TrueQueryProb,Type), + once(update_query(QueryID,'+',probability)), + query_probability(QueryID,CurrentProb), + format(Handle,'ex(~q,test,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,CurrentProb]), + + once(update_query_cleanup(QueryID)), + ( + (Type == '='; (Type == '<', CurrentProb>QueryProb); (Type=='>',CurrentProb + SquaredError is (CurrentProb-TrueQueryProb)**2; + SquaredError = 0.0 + ), + bb_get(llh_test_queries,Old_LLH_Test_Queries), + New_LLH_Test_Queries is Old_LLH_Test_Queries+log(CurrentProb), + bb_put(llh_test_queries,New_LLH_Test_Queries) + ), + AllSquaredErrors), + + close(Handle), + bb_delete(llh_test_queries,LLH_Test_Queries), + + length(AllSquaredErrors,Length), + + ( + Length>0 + -> + ( + sum_list(AllSquaredErrors,SumAllSquaredErrors), + min_list(AllSquaredErrors,MinError), + max_list(AllSquaredErrors,MaxError), + MSE is SumAllSquaredErrors/Length + );( + MSE=0.0, + MinError=0.0, + MaxError=0.0 + ) + ), + + logger_set_variable(mse_testset,MSE), + logger_set_variable(mse_min_testset,MinError), + logger_set_variable(mse_max_testset,MaxError), + logger_set_variable(llh_test_queries,LLH_Test_Queries), + format_learning(2,' (~8f)~n',[M]). + + +%======================================================================== +%= Calculates the sigmoid function respectivly the inverse of it +%= warning: applying inv_sigmoid to 0.0 or 1.0 will yield +/-inf +%= +%= +Float, -Float +%======================================================================== + +sigmoid(T,Slope,Sig) :- + IN <== T, + OUT is 1/(1+exp(-IN*Slope)), + Sig <== OUT. + +inv_sigmoid(T,Slope,InvSig) :- + InvSig <== -log(1/T-1)/Slope. + + +%======================================================================== +%= Perform one iteration of gradient descent +%= +%= assumes that everything is initialized, if the current values +%= of query_probability/2 and query_gradient/4 are not up to date +%= they will be recalculated +%= finally, the values_correct/0 is retracted to signal that the +%= probabilities of the examples have to be recalculated +%======================================================================== + +save_old_probabilities :- + old_prob <== p. + + +% vsc: avoid silly search +gradient_descent :- + current_iteration(Iteration), + create_training_predictions_file_name(Iteration,File_Name), + Handle = user_error, + format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), + format(Handle,"% Iteration, train/test, QueryID, Query, GroundTruth, Prediction %~n",[]), + format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), + format_learning(2,'Gradient ',[]), + findall(FactID,tunable_fact(FactID,GroundTruth),L), length(L,N), +% leash(0),trace, + lbfgs_initialize(N,X,0,Solver), + N1 is N-1, + forall(tunable_fact(FactID,GroundTruth), (X[FactID] <== 0.5)), + problog_flag(sigmoid_slope,Slope), + lbfgs_run(Solver,BestFA), + BestF <== BestFA[0], + format('~2nOptimization done~nWe found a minimum ~4f +.~2n',[BestF]), + forall(tunable_fact(FactID,GroundTruth), set_tunable(FactID,GroundTruth,X)), + lbfgs_finalize(Solver). + +set_tunable(I, GroundTruth,P) :- + Pr <== P[I], + get_fact(I,Source), + format('fact(~d, ~q, ~4f, ~4f).~n',[I,Source,GroundTruth,Pr]), + set_fact_probability(I,Pr). + +prob2log(X,Slope,FactID) :- + get_fact_probability(FactID, V0), + inv_sigmoid(V0, Slope, V). + +log2prob(X,Slope,FactID) :- + V0 <== X[FactID], + sigmoid(V0, Slope, V). + +bind_maplist([], Slope, X). +bind_maplist([Node-Theta|MapList], Slope, X) :- + Theta <== X[Node], + bind_maplist(MapList, Slope, X). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% start calculate gradient + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +user:evaluate(L, X,Grad,N,_,_) :- + Handle = user_error, + problog_flag(sigmoid_slope,Slope), + Probs = X, %<== array[N] of floats, + N1 is N-1, + forall(between(0,N1,I), + (Grad[I] <== 0.0) %, sigmoid(X[I],Slope,Probs[I]) ) + ), + findall(LL, + compute_grad(N, X, Grad, Probs, Slope, Handle, LL), + LLs + ), + sum_list(LLs,LLH_Training_Queries), + forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID])), + L[0] <== LLH_Training_Queries. + +compute_grad(N, X, Grad, Probs, Slope, Handle, LL) :- + user:example(QueryID,Query,QueryProb,Type), + recorded(QueryID, BDD, _), + BDD = bdd(Dir, GradTree, MapList), + bind_maplist(MapList, Slope, Probs), + qprobability(BDD,Slope,BDDProb), + gradientpair(BDD,Slope,BDDProb, QueryProb, Grad), + LL is (((BDDProb)-(QueryProb))**2). + +gradientpair(BDD,Slope,BDDProb, QueryProb, Grad) :- + qgradient(BDD, Slope, FactID, GradValue), + % writeln(FactID), + G0 <== Grad[FactID], + GN is G0-GradValue*(QueryProb-BDDProb), + %writeln(FactID:(G0->GN)), + Grad[FactID] <== GN. +gradientpair(_BDD,_Slope,_BDDProb, _Grad). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% stop calculate gradient +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- + problog_flag(sigmoid_slope,Slope), + X0 <== X[0], + X1 <== X[1], + format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0 ,X1,FX,X_Norm,G_Norm,Step,Ls]). + + +%======================================================================== +%= initialize the logger module and set the flags for learning +%= don't change anything here! use set_problog_flag/2 instead +%======================================================================== + +init_flags :- + prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' + prolog_file_name(output,Output_Folder), % get absolute file name for './output' + problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), + problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), + problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), + problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), + problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), + problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general), + problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler), + problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler), + problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general), + % problog_define_flag(continuous_facts,problog_flag_validate_boolean,'support parameter learning of continuous distributions',1.0,learning_general), + problog_define_flag(learning_rate,problog_flag_validate_posnumber,'Default learning rate (If line_search=false)',examples,learning_line_search,flags:examples_handler), + problog_define_flag(line_search, problog_flag_validate_boolean,'estimate learning rate by line search',false,learning_line_search), + problog_define_flag(line_search_never_stop, problog_flag_validate_boolean,'make tiny step if line search returns 0',true,learning_line_search), + problog_define_flag(line_search_tau, problog_flag_validate_indomain_0_1_open,'tau value for line search',0.618033988749,learning_line_search), + problog_define_flag(line_search_tolerance,problog_flag_validate_posnumber,'tolerance value for line search',0.05,learning_line_search), + problog_define_flag(line_search_interval, problog_flag_validate_dummy,'interval for line search',(0,100),learning_line_search,flags:linesearch_interval_handler). + +init_logger :- + logger_define_variable(iteration, int), + logger_define_variable(duration,time), + logger_define_variable(mse_trainingset,float), + logger_define_variable(mse_min_trainingset,float), + logger_define_variable(mse_max_trainingset,float), + logger_define_variable(mse_testset,float), + logger_define_variable(mse_min_testset,float), + logger_define_variable(mse_max_testset,float), + logger_define_variable(gradient_mean,float), + logger_define_variable(gradient_min,float), + logger_define_variable(gradient_max,float), + logger_define_variable(ground_truth_diff,float), + logger_define_variable(ground_truth_mindiff,float), + logger_define_variable(ground_truth_maxdiff,float), + logger_define_variable(learning_rate,float), + logger_define_variable(alpha,float), + logger_define_variable(llh_training_queries,float), + logger_define_variable(llh_test_queries,float). + +:- initialization(init_flags). + +:- initialization(init_logger). + diff --git a/packages/yap-lbfgs/ex1.pl b/packages/yap-lbfgs/ex1.pl index fae5512c5..55730d0c5 100644 --- a/packages/yap-lbfgs/ex1.pl +++ b/packages/yap-lbfgs/ex1.pl @@ -22,35 +22,36 @@ :- use_module(library(matrix)). + + % This is the call back function which evaluates F and the gradient of F -evaluate(FX,X,G,_N,_Step) :- +evaluate(FX,X,G,_N,_Step,_User) :- X0 <== X[0], FX is sin(X0), G0 is cos(X0), G[0] <== G0. % This is the call back function which is invoked to report the progress -% if the last argument is set to anywhting else than 0, the optimizer will +% if the last argument is set to anything else than 0, the lbfgs will % stop right now -progress(FX,X,G,X_Norm,G_Norm,Step,_N,Iteration,Ls, 0) :- +progress(FX,X,G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- X0 <== X[0], - format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n', - [Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). + format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f + |X\'|=~4f Step=~4f Ls=~4f~n', + [Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). demo :- - format('Optimizing the function f(x0) = sin(x0)~n',[]), - optimizer_initialize(1,X,Status), + format('Optimizing the function f(x0) = sin(x0)~n',[]), + lbfgs_initialize(1,X,0,Solver), StartX is random*10, format('We start the search at the random position x0=~5f~2n',[StartX]), X[0] <== StartX, - - optimizer_run(Status, BestF, BestX0, O), + lbfgs_run(Solver,BestF,Status), BestX0 <== X[0], - optimizer_finalize(Status), - format('~2nOptimization done~nWe found a minimum at f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,O]). - - + lbfgs_finalize(Solver), + format('~2nOptimization done~nWe found a minimum at + f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,Status]). diff --git a/packages/yap-lbfgs/ex2.pl b/packages/yap-lbfgs/ex2.pl index 3a4f39320..82a12f0dd 100644 --- a/packages/yap-lbfgs/ex2.pl +++ b/packages/yap-lbfgs/ex2.pl @@ -20,13 +20,14 @@ :- use_module(library(lbfgs)). :- use_module(library(matrix)). +f(X0,X1,FX) :- + FX is (X0-2)*(X0-2) + (X1-1)*(X1-1). % This is the call back function which evaluates F and the gradient of F -evaluate(FX,X,G,_N,_Step) :- +evaluate(FX,X,G,_N,_Step,_U) :- X0 <== X[0], X1 <== X[1], - - FX is (X0-2)*(X0-2) + (X1-1)*(X1-1), + f(X0,X1,FX), G0 is 2*(X0-2), G1 is 2*(X1-2), G[0] <== G0, @@ -38,28 +39,27 @@ evaluate(FX,X,G,_N,_Step) :- progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- X0 <== X[0], X1 <== X[1], - format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0,X1,FX,X_Norm,G_Norm,Step,Ls]). + format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0,X1,FX,X_Norm,G_Norm,Step,Ls]). demo :- format('Optimizing the function f(x0,x1) = (x0-2)^2 + (x1-1)^2~n',[]), - optimizer_initialize(2,X,Status), + + lbfgs_initialize(2,X,0,Solver), StartX0 is random*1000-500, StartX1 is random*1000-500, - + format('We start the search at the random position (x0,x1)=(~5f,~5f)~2n',[StartX0,StartX1]), X[0] <== StartX0, - X[1] <== StartX1, - - - optimizer_run(Status,BestF,BestX0, O), + X[1] <== StartX1, + lbfgs_run(Solver,BestF,Status), BestX0 <== X[0], BestX1 <== X[1], - - optimizer_finalize, + + optimizer_finalize(Solver), format('~2nOptimization done~nWe found a minimum at f(~f,~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestX1,BestF,Status]). diff --git a/packages/yap-lbfgs/lbfgs.pl b/packages/yap-lbfgs/lbfgs.pl index bec3cc7c7..93b9c677f 100644 --- a/packages/yap-lbfgs/lbfgs.pl +++ b/packages/yap-lbfgs/lbfgs.pl @@ -20,14 +20,16 @@ -:- module(lbfgs,[optimizer_initialize/3, - optimizer_run/4, +:- module(lbfgs,[lbfgs_initialize/3, + lbfgs_initialize/4, + lbfgs_run/2, - optimizer_finalize/1, + lbfgs_finalize/1, - optimizer_set_parameter/3, - optimizer_get_parameter/3, - optimizer_parameters/1]). + lbfgs_set_parameter/3, + lbfgs_get_parameter/3, + lbfgs_parameters/0, + lbfgs_parameters/1]). % switch on all the checks to reduce bug searching time % :- yap_flag(unknown,error). @@ -48,9 +50,11 @@ minimization problem: ~~~~~~~~~~~~~~~~~~~~~~~~ -### Contact -YAP-LBFGS has been developed by Bernd Gutmann. In case you publish something using YAP-LBFGS, please give credit to me and to libLBFGS. And if you find YAP-LBFGS useful, or if you find a bug, or if you -port it to another system, ... please send me an email. +### Contact YAP-LBFGS has been developed by Bernd Gutmann. In case you +publish something using YAP-LBFGS, please give credit to me and to +libLBFGS. And if you find YAP-LBFGS useful, or if you find a bug, or +if you port it to another system, ... please send me an email. + ### License @@ -72,9 +76,9 @@ it by :-use_module(library(lbfgs)). ~~~~ -+ use optimizer_set_paramater(Name,Value) to change parameters -+ use optimizer_get_parameter(Name,Value) to see current parameters -+ use optimizer_parameters to print this overview ++ use lbfgs_set_paramater(Name,Value) to change parameters ++ use lbfgs_get_parameter(Name,Value) to see current parameters ++ use lbfgs_parameters to print this overview @@ -89,17 +93,18 @@ calculates `f(x0)` and the gradient `d/dx0 f=cos(x0)`. :- use_module(lbfgs). % This is the call back function which evaluates F and the gradient of F -evaluate(FX,_N,_Step) :- - optimizer_get_x(0,X0), - FX is sin(X0), +evaluate(FX,X,G,_N,_Step,_User) :- + X0 <== X[0], +F is sin(X0), + FX[0] <== F, G0 is cos(X0), - optimizer_set_g(0,G0). + G[0] <== G0. % This is the call back function which is invoked to report the progress -% if the last argument is set to anything else than 0, the optimizer will +% if the last argument is set to anything else than 0, the lbfgs will % stop right now -progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- - optimizer_get_x(0,X0), +progress(FX,X,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- + X0 <== X[0], format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n', [Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). @@ -108,16 +113,16 @@ progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- demo :- format('Optimizing the function f(x0) = sin(x0)~n',[]), - optimizer_initialize(1,evaluate,progress), + lbfgs_initialize(1,X,0,Solver), StartX is random*10, format('We start the search at the random position x0=~5f~2n',[StartX]), - optimizer_set_x(0,StartX), + X[0] <== StartX, - optimizer_run(BestF,Status), - optimizer_get_x(0,BestX0), - optimizer_finalize, + lbfgs_run(Solver,BestF,Status), + BestX0 <== X[0], + lbfgs_finalize(Solver), format('~2nOptimization done~nWe found a minimum at f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,Status]). ~~~~~ @@ -151,49 +156,54 @@ yes :- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates'). -/** @pred optimizer_initialize(+N,+Evaluate,+Progress) +/** @pred lbfgs_initialize(+N, -SolverInfo) The same as before, except that the user module is the default value. Example ~~~~ -optimizer_initialize(1) +lbfgs_initialize(1, Block) ~~~~~ */ +lbfgs_initialize(N,X,t(N,X,U,Params)) :- + lbfgs_initialize(N,X,0,t(N,X,U,Params)). -optimizer_initialize(N,X,t(N,X,XO,Params)) :- - +lbfgs_initialize(N,X,U,t(N,X,U,Params)) :- + lbfgs_defaults(Params), integer(N), N>0, % check whether there are such call back functions - optimizer_reserve_memory(N,X,XO,Params). + lbfgs_grab(N,X). % install call back predicates in the user module which call % the predicates given by the arguments -/** @pred optimizer_finalize/0 + +/** @pred lbfgs_finalize/0 Clean up the memory. */ -optimizer_finalize(t(N,X,XO,Params)) :- +lbfgs_finalize(t(N,X,U,Params)) :- initialized, - optimizer_free_memory(X,XO,Params) , + lbfgs_release(X) , + lbfgs_release_parameters(Params) , retractall(initialized). -/** @pred optimizer_run/3 + +/** @pred lbfgs_run/2 Do the work. */ -optimizer_run(t(N,X,XO,Params),FX,XO,Status) :- - optimizer_run(N,X, FX, XO, Status, Params). +lbfgs_run(t(N,X,U,Params),FX) :- + lbfgs(N,X, Params, U, FX). -/** @pred optimizer_parameters/1 +/** @pred lbfgs_parameters/1 Prints a table with the current parameters. See the documentation of libLBFGS for the meaning of each parameter. ~~~~ - ?- optimizer_parameters. + ?- lbfgs_parameters. ========================================================================================== Type Name Value Description ========================================================================================== @@ -215,22 +225,26 @@ int orthantwise_end -1 End index for computing the L1 norm ========================================================================================== ~~~~ */ -optimizer_parameterse(t(X,XO,Params)) :- - optimizer_get_parameter(m,M ,Params), - optimizer_get_parameter(epsilon,Epsilon ,Params), - optimizer_get_parameter(past,Past ,Params), - optimizer_get_parameter(delta,Delta ,Params), - optimizer_get_parameter(max_iterations,Max_Iterations ,Params), - optimizer_get_parameter(linesearch,Linesearch ,Params), - optimizer_get_parameter(max_linesearch,Max_Linesearch ,Params), - optimizer_get_parameter(min_step,Min_Step ,Params), - optimizer_get_parameter(max_step,Max_Step ,Params), - optimizer_get_parameter(ftol,Ftol ,Params), - optimizer_get_parameter(gtol,Gtol ,Params), - optimizer_get_parameter(xtol,Xtol ,Params), - optimizer_get_parameter(orthantwise_c,Orthantwise_C ,Params), - optimizer_get_parameter(orthantwise_start,Orthantwise_Start ,Params), - optimizer_get_parameter(orthantwise_end,Orthantwise_End ,Params), +lbfgs_parameters :- + lbfgs_defaults(Params), + lbfgs_parameters(t(_X,_,_,Params)). + +lbfgs_parameters(t(_,_,_,Params)) :- + lbfgs_get_parameter(m,M ,Params), + lbfgs_get_parameter(epsilon,Epsilon ,Params), + lbfgs_get_parameter(past,Past ,Params), + lbfgs_get_parameter(delta,Delta ,Params), + lbfgs_get_parameter(max_iterations,Max_Iterations ,Params), + lbfgs_get_parameter(linesearch,Linesearch ,Params), + lbfgs_get_parameter(max_linesearch,Max_Linesearch ,Params), + lbfgs_get_parameter(min_step,Min_Step ,Params), + lbfgs_get_parameter(max_step,Max_Step ,Params), + lbfgs_get_parameter(ftol,Ftol ,Params), + lbfgs_get_parameter(gtol,Gtol ,Params), + lbfgs_get_parameter(xtol,Xtol ,Params), + lbfgs_get_parameter(orthantwise_c,Orthantwise_C ,Params), + lbfgs_get_parameter(orthantwise_start,Orthantwise_Start ,Params), + lbfgs_get_parameter(orthantwise_end,Orthantwise_End ,Params), format('/******************************************************************************************~n',[] ), print_param('Name','Value','Description','Type' ,Params), @@ -251,9 +265,9 @@ optimizer_parameterse(t(X,XO,Params)) :- print_param(orthantwise_start,Orthantwise_Start,'Start index for computing the L1 norm of the variables.',int ,Params), print_param(orthantwise_end,Orthantwise_End,'End index for computing the L1 norm of the variables.',int ,Params), format('******************************************************************************************/~n',[]), - format(' use optimizer_set_paramater(Name,Value) to change parameters~n',[]), - format(' use optimizer_get_parameter(Name,Value) to see current parameters~n',[]), - format(' use optimizer_parameters to print this overview~2n',[]). + format(' use lbfgs_set_parameter(Name,Value,Solver) to change parameters~n',[]), + format(' use lbfgs_get_parameter(Name,Value,Solver) to see current parameters~n',[]), + format(' use lbfgs_parameters to print this overview~2n',[]). print_param(Name,Value,Text,Dom) :- diff --git a/packages/yap-lbfgs/yap_lbfgs.c b/packages/yap-lbfgs/yap_lbfgs.c index 70713f420..01a17ebb1 100644 --- a/packages/yap-lbfgs/yap_lbfgs.c +++ b/packages/yap-lbfgs/yap_lbfgs.c @@ -24,11 +24,11 @@ // These constants describe the internal state -#define OPTIMIZER_STATUS_NONE 0 -#define OPTIMIZER_STATUS_INITIALIZED 1 -#define OPTIMIZER_STATUS_RUNNING 2 -#define OPTIMIZER_STATUS_CB_EVAL 3 -#define OPTIMIZER_STATUS_CB_PROGRESS 4 +#define LBFGS_STATUS_NONE 0 +#define LBFGS_STATUS_INITIALIZED 1 +#define LBFGS_STATUS_RUNNING 2 +#define LBFGS_STATUS_CB_EVAL 3 +#define LBFGS_STATUS_CB_PROGRESS 4 X_API void init_lbfgs_predicates( void ) ; @@ -44,53 +44,39 @@ static lbfgsfloatval_t evaluate( ) { YAP_Term call; - YAP_Term v, a1; YAP_Bool result; - YAP_Int s1; + lbfgsfloatval_t rc; + + YAP_Term t[6], t2[2]; - YAP_Term t[5], t2[2]; - - t[0] = v = YAP_MkVarTerm(); + t[0] = YAP_MkIntTerm((YAP_Int)&rc); + t[0] = YAP_MkApplTerm(ffloats, 1, t); t[1] = YAP_MkIntTerm((YAP_Int)x); t[1] = YAP_MkApplTerm(ffloats, 1, t+1); t[2] = YAP_MkIntTerm((YAP_Int)g_tmp); t[2] = YAP_MkApplTerm(ffloats, 1, t+2); t[3] = YAP_MkIntTerm(n); t[4] = YAP_MkFloatTerm(step); + t[5] = YAP_MkIntTerm((YAP_Int)instance); t2[0] = tuser; - t2[1] = YAP_MkApplTerm(fevaluate, 5, t); + t2[1] = YAP_MkApplTerm(fevaluate, 6, t); call = YAP_MkApplTerm( fmodule, 2, t2 ); - s1 = YAP_InitSlot(v); - //optimizer_status=OPTIMIZER_STATUS_CB_EVAL; - result=YAP_RunGoal(call); - //optimizer_status=OPTIMIZER_STATUS_RUNNING; + // s1 = YAP_InitSlot(v); + //lbfgs_status=LBFGS_STATUS_CB_EVAL; + result=YAP_RunGoalOnce(call); + //lbfgs_status=LBFGS_STATUS_RUNNING; if (result==FALSE) { printf("ERROR: the evaluate call failed in YAP.\n"); // Goal did not succeed - YAP_ShutdownGoal( false ); return FALSE; } - a1 = YAP_GetFromSlot( s1 ); - - lbfgsfloatval_t rc; - if (YAP_IsFloatTerm(a1)) { - rc = (lbfgsfloatval_t) YAP_FloatOfTerm(a1); - } else if (YAP_IsIntTerm(a1)) { - rc = (lbfgsfloatval_t) YAP_IntOfTerm(a1); - } else { - fprintf(stderr, "ERROR: The evaluate call back function did not return a number as first argument.\n"); - rc = false; - - } - - YAP_ShutdownGoal( false ); return rc; } @@ -132,15 +118,14 @@ static int progress( call = YAP_MkApplTerm( fmodule, 2, t2 ); s1 = YAP_InitSlot(v); - //optimizer_status=OPTIMIZER_STATUS_CB_PROGRESS; - result=YAP_RunGoal(call); - //optimizer_status=OPTIMIZER_STATUS_RUNNING; + //lbfgs_status=LBFGS_STATUS_CB_PROGRESS; + result=YAP_RunGoalOnce(call); + //lbfgs_status=LBFGS_STATUS_RUNNING; YAP_Term o = YAP_GetFromSlot( s1 ); - YAP_ShutdownGoal( false ); if (result==FALSE) { - printf("ERROR: the progress call failed in YAP.\n"); + printf("ERROR: the progress call failed in YAP.\n"); // Goal did not succeed return -1; } @@ -154,7 +139,7 @@ static int progress( return 1; } -/** @pred optimizer_initialize(+N,+Module,+Evaluate,+Progress) +/** @pred lbfgs_initialize(+N,+Module,+Evaluate,+Progress) Create space to optimize a function with _N_ variables (_N_ has to be integer). @@ -169,7 +154,7 @@ to evaluate the function math _F_, Example ~~~~ -optimizer_initialize(1,user,evaluate,progress,e,g) +lbfgs_initialize(1,user,evaluate,progress,e,g) ~~~~ @@ -179,107 +164,227 @@ value _F_. _N_ is the size of the parameter vector (the value which was used to initialize LBFGS) and _Step_ is the current state of the line search. The call back predicate can access the current values of -`x[i]` by calling `optimizer_get_x(+I,-Xi)`. Finally, the call back +`x[i]` by calling `lbfgs_get_x(+I,-Xi)`. Finally, the call back predicate has to calculate the gradient of _F_ -and set its value by calling `optimizer_set_g(+I,+Gi)` for every `1<=I<=N`. +and set its value by calling `lbfgs_set_g(+I,+Gi)` for every `1<=I<=N`. The progress call back predicate has to be of the type `progress(+F,+X_Norm,+G_Norm,+Step,+N,+Iteration,+LS,-Continue)`. It is called after every iteration. The call back predicate can access the current values of _X_ and of the gradient by calling -`optimizer_get_x(+I,-Xi)` and `optimizer_get_g`(+I,-Gi)` +`lbfgs_get_x(+I,-Xi)` and `lbfgs_get_g`(+I,-Gi)` respectively. However, it must not call the setter predicates for +/** @pred lbfgs_get_parameter(+Name,-Value) Get the current Value for Name */ -static YAP_Bool optimizer_get_parameter( void ) { +static YAP_Bool lbfgs_get_parameter( void ) { YAP_Term t1 = YAP_ARG1; YAP_Term t2 = YAP_ARG2; lbfgs_parameter_t *param = (lbfgs_parameter_t *) YAP_IntOfTerm(YAP_ARG3); @@ -465,7 +570,7 @@ static YAP_Bool optimizer_get_parameter( void ) { return YAP_Unify(t2,YAP_MkFloatTerm(param->max_step)); } else if ((strcmp(name, "ftol") == 0)) { return YAP_Unify(t2,YAP_MkFloatTerm(param->ftol)); - } else if ((strcmp(name, "gtol") == 0)) { + } else if ((strcmp(name, "gtol") == 0)) { return YAP_Unify(t2,YAP_MkFloatTerm(param->gtol)); } else if ((strcmp(name, "xtol") == 0)) { return YAP_Unify(t2,YAP_MkFloatTerm(param->xtol)); @@ -487,7 +592,7 @@ static YAP_Bool optimizer_get_parameter( void ) { X_API void init_lbfgs_predicates( void ) { - fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 5); + fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6); fprogress = YAP_MkFunctor(YAP_LookupAtom("progress"), 10); fmodule = YAP_MkFunctor(YAP_LookupAtom(":"), 2); ffloats = YAP_MkFunctor(YAP_LookupAtom("floats"), 1); @@ -497,10 +602,12 @@ X_API void init_lbfgs_predicates( void ) // lbfgs_parameter_init(¶m); - YAP_UserCPredicate("optimizer_reserve_memory",optimizer_initialize,4); - YAP_UserCPredicate("optimizer_run",optimizer_run,6); - YAP_UserCPredicate("optimizer_free_memory",optimizer_finalize,3); + YAP_UserCPredicate("lbfgs_grab",lbfgs_grab,2); + YAP_UserCPredicate("lbfgs",p_lbfgs, 5); + YAP_UserCPredicate("lbfgs_release",lbfgs_release,1); - YAP_UserCPredicate("optimizer_set_parameter",optimizer_set_parameter,3); - YAP_UserCPredicate("optimizer_get_parameter",optimizer_get_parameter,3); + YAP_UserCPredicate("lbfgs_defaults",lbfgs_parameters,1); + YAP_UserCPredicate("lbfgs_release_parameters",lbfgs_release_parameters,1); + YAP_UserCPredicate("lbfgs_set_parameter",lbfgs_set_parameter,3); + YAP_UserCPredicate("lbfgs_get_parameter",lbfgs_get_parameter,3); } From 4f292cb521c0983bc92bb93a12055b89ac65faae Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 5 Oct 2018 10:27:03 +0100 Subject: [PATCH 2/3] usabiity --- C/exec.c | 2 +- H/YapFlags.h | 1 + pl/debug.yap | 31 +++++++++++++------------------ pl/errors.yap | 3 ++- pl/qly.yap | 6 +++--- pl/spy.yap | 10 +++++----- 6 files changed, 25 insertions(+), 28 deletions(-) diff --git a/C/exec.c b/C/exec.c index 64045c8d9..92b341905 100755 --- a/C/exec.c +++ b/C/exec.c @@ -327,7 +327,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) { /* I cannot use the standard macro here because otherwise I would dereference the argument and might skip a svar */ - if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) { + if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) { return CallMetaCall(t0, mod0 PASS_REGS); } pt = RepAppl(t) + 1; diff --git a/H/YapFlags.h b/H/YapFlags.h index e9decab9c..0a81832c6 100644 --- a/H/YapFlags.h +++ b/H/YapFlags.h @@ -354,6 +354,7 @@ static inline bool verboseMode(void) { return GLOBAL_Flags[VERBOSE_FLAG].at != TermSilent; } + static inline void setVerbosity(Term val) { GLOBAL_Flags[VERBOSE_FLAG].at = val; } diff --git a/pl/debug.yap b/pl/debug.yap index df53eec52..501fdc93f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -298,24 +298,22 @@ be lost. * @param _Mod_:_Goal_ is the goal to be examined. * @return `call(Goal)` */ +%% '$trace'([Mod|G]) :- +%% '$stop_creeping'(_), +% set_prolog_flag(debug, true), +%% !, +%% '$execute_nonstop'(G,Mod). '$trace'([Mod|G]) :- - '$stop_creeping'(_), - current_prolog_flag(debug, false), - !, - '$execute_nonstop'(G,Mod). -'$trace'([Mod|G]) :- - CP is '$last_choice_pt', - '$trace_query'(G, Mod, CP, G, EG), - gated_call( - '$debugger_input', - EG, - E, - '$continue_debugging'(E) - ). + CP is '$last_choice_pt', + '$trace_query'(G, Mod, CP, G, EG), + gated_call( + '$debugger_input', + EG, + E, + '$continue_debugging'(E) + ). -'$continue_debugging'(_) :- !, - current_prolog_flag(debug, false). '$continue_debugging'(exit) :- !, '$creep'. '$continue_debugging'(answer) :- !, '$creep'. '$continue_debugging'(fail) :- !, '$creep'. @@ -694,9 +692,6 @@ be lost. CP is '$last_choice_point', Goal. -'$port'(_P,_G,_Module,_L,_Determinic, _Info ) :- %%> debugging done - current_prolog_flag(debug, false), - !. '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap '__NB_getval__'('$debug_status',state(leap,Border,_), fail), GoalNumber > Border, diff --git a/pl/errors.yap b/pl/errors.yap index 27819fb48..0eff2f61a 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -94,7 +94,8 @@ error_handler(Error, Level) :- '$LoopError'(Error, Level). '$LoopError'(_, _) :- - flush_output(user_output), + stop_low_level_trace, + flush_output(user_output), flush_output(user_error), fail. '$LoopError'(Error, Level) :- !, diff --git a/pl/qly.yap b/pl/qly.yap index 70b5c4163..209f002c3 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -558,11 +558,11 @@ Restores a previously saved state of YAP contaianing a qly file _F_. */ qload_file( F0 ) :- - ( current_prolog_flag(verbose_load, false) + ( current_prolog_flag(verbose_load, true) -> - Verbosity = silent - ; Verbosity = informational + ; + Verbosity = silent ), StartMsg = loading_module, EndMsg = module_loaded, diff --git a/pl/spy.yap b/pl/spy.yap index d03331ce7..08da105f4 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -241,13 +241,13 @@ Switches on the debugger and enters tracing mode. */ trace :- - '$init_debugger', + '$init_debugger', fail. trace :- - '__NB_setval__'('$trace',on), - '$start_debugging'(on), - print_message(informational,debug(trace)), - '$creep'. + '__NB_setval__'('$trace',on), + '$start_debugging'(on), + print_message(informational,debug(trace)), + '$creep'. /** @pred notrace From 6d0b702d1c016166d2c51333209125eebef72545 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 7 Oct 2018 14:27:01 +0100 Subject: [PATCH 3/3] small fixes --- C/c_interface.c | 191 +++++---- C/cdmgr.c | 2 +- include/YapInterface.h | 17 +- os/iopreds.c | 1 - packages/ProbLog/problog_lbfgs.yap | 116 +++--- packages/yap-lbfgs/ex1.pl | 6 +- packages/yap-lbfgs/lbfgs.pl | 23 +- packages/yap-lbfgs/yap_lbfgs.c | 607 ++++++++++++++--------------- 8 files changed, 473 insertions(+), 490 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 40695bafa..ca0fb9e39 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -218,6 +218,11 @@ X_API YAP_Term YAP_A(int i) { return (Deref(XREGS[i])); } +X_API YAP_Term YAP_SetA(int i, YAP_Term t) { + CACHE_REGS + return (Deref(XREGS[i])); +} + X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); } X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) { @@ -288,23 +293,23 @@ X_API Term YAP_MkIntTerm(Int n) { } X_API Term YAP_MkStringTerm(const char *n) { - CACHE_REGS - Term I; - BACKUP_H(); + CACHE_REGS + Term I; + BACKUP_H(); - I = MkStringTerm(n); - RECOVER_H(); - return I; + I = MkStringTerm(n); + RECOVER_H(); + return I; } -X_API Term YAP_MkCharPTerm( char *n) { - CACHE_REGS - Term I; - BACKUP_H(); +X_API Term YAP_MkCharPTerm(char *n) { + CACHE_REGS + Term I; + BACKUP_H(); - I = MkStringTerm(n); - RECOVER_H(); - return I; + I = MkStringTerm(n); + RECOVER_H(); + return I; } X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) { @@ -1352,8 +1357,8 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); } * @param bufsize bu * * @return - */ X_API char * -YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { + */ +X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { CACHE_REGS BACKUP_MACHINE_REGS(); seq_tv_t inp, out; @@ -1464,7 +1469,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) { else tv = (Term)0; LOCAL_ErrorMessage = NULL; - while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1, GLOBAL_MaxPriority))) { + while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1, + GLOBAL_MaxPriority))) { if (LOCAL_ErrorMessage) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!Yap_dogc(0, NULL PASS_REGS)) { @@ -1492,7 +1498,7 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) { return 0L; } LOCAL_ErrorMessage = NULL; - RECOVER_H(); + RECOVER_H(); return 0; } else { break; @@ -1731,7 +1737,9 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { CACHE_REGS PredEntry *pe = ape; bool out; - // fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + // fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p + // Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, + // LOCAL_CurSlot); BACKUP_MACHINE_REGS(); LOCAL_ActiveError->errorNo = YAP_NO_ERROR; @@ -1748,12 +1756,14 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { // slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2), // LOCAL_CurSlot); dgi->b = LCL0 - (CELL *)B; - dgi->h = HR-H0; - dgi->tr = (CELL*)TR-LCL0; - //fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", - // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + dgi->h = HR - H0; + dgi->tr = (CELL *)TR - LCL0; + // fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", + // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); out = Yap_exec_absmi(true, false); - // fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + // fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p + // Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, + // LOCAL_CurSlot); dgi->b = LCL0 - (CELL *)B; if (out) { dgi->EndSlot = LOCAL_CurSlot; @@ -1768,13 +1778,13 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { CACHE_REGS - choiceptr myB, myB0; + choiceptr myB, myB0; bool out; BACKUP_MACHINE_REGS(); myB = (choiceptr)(LCL0 - dgi->b); myB0 = (choiceptr)(LCL0 - dgi->b0); - CP = myB->cp_cp; + CP = myB->cp_cp; /* sanity check */ if (B >= myB0) { return false; @@ -1783,8 +1793,8 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { // get rid of garbage choice-points B = myB; } - //fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", - // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + // fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", + // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); P = FAILCODE; /* make sure we didn't leave live slots when we backtrack */ ASP = (CELL *)B; @@ -1792,7 +1802,7 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { out = run_emulator(PASS_REGS1); if (out) { dgi->EndSlot = LOCAL_CurSlot; - dgi->b = LCL0-(CELL *)B; + dgi->b = LCL0 - (CELL *)B; } else { LOCAL_CurSlot = dgi->CurSlot; // ignore any slots created within the called goal @@ -1801,9 +1811,8 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { return out; } -static void completeInnerCall( bool on_cut, yamop *old_CP, yamop *old_P) -{ - if (on_cut) { +static void completeInnerCall(bool on_cut, yamop *old_CP, yamop *old_P) { + if (on_cut) { P = old_P; ENV = (CELL *)ENV[E_E]; CP = old_CP; @@ -1821,45 +1830,47 @@ static void completeInnerCall( bool on_cut, yamop *old_CP, yamop *old_P) SET_ASP(ENV, E_CB * sizeof(CELL)); // make sure the slots are ok. } - } X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) { CACHE_REGS - choiceptr myB, handler; + choiceptr myB, handler; - // fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + // fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d + // P=%p CP=%p Slots=%d\n", + // successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP, + // LOCAL_CurSlot); BACKUP_MACHINE_REGS(); myB = (choiceptr)(LCL0 - dgi->b); - if (LOCAL_PrologMode & AsyncIntMode) { - Yap_signal(YAP_FAIL_SIGNAL); - } - handler = B; - while (handler - && LCL0-LOCAL_CBorder > (CELL *)handler - //&& handler->cp_ap != NOCODE - && handler->cp_b != NULL - && handler != myB - ) { - if (handler < myB ) { - handler->cp_ap = TRUSTFAILCODE; - } - B = handler; - handler = handler->cp_b; - if (successful) { - Yap_TrimTrail(); - } else if (!(LOCAL_PrologMode & AsyncIntMode)) { - P=FAILCODE; - Yap_exec_absmi(true, YAP_EXEC_ABSMI); + if (LOCAL_PrologMode & AsyncIntMode) { + Yap_signal(YAP_FAIL_SIGNAL); } + handler = B; + while (handler && + LCL0 - LOCAL_CBorder > (CELL *)handler + //&& handler->cp_ap != NOCODE + && handler->cp_b != NULL && handler != myB) { + if (handler < myB) { + handler->cp_ap = TRUSTFAILCODE; + } + B = handler; + handler = handler->cp_b; + if (successful) { + Yap_TrimTrail(); + } else if (!(LOCAL_PrologMode & AsyncIntMode)) { + P = FAILCODE; + Yap_exec_absmi(true, YAP_EXEC_ABSMI); + } } if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } - P=dgi->p; + P = dgi->p; CP = dgi->cp; RECOVER_MACHINE_REGS(); - // fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); + // fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p + // Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, + // CP, LOCAL_CurSlot); return TRUE; } @@ -1875,7 +1886,7 @@ X_API Int YAP_RunGoal(Term t) { LOCAL_PrologMode = UserCCallMode; // should we catch the exception or pass it through? // We'll pass it through - RECOVER_MACHINE_REGS(); + RECOVER_MACHINE_REGS(); LOCAL_CurSlot = cslot; return out; } @@ -1958,7 +1969,7 @@ X_API Int YAP_RunGoalOnce(Term t) { CSlot = Yap_StartSlots(); LOCAL_PrologMode = UserMode; // Yap_heap_regs->yap_do_low_level_trace=true; - out = Yap_RunTopGoal(t, true); + out = Yap_RunTopGoal(t, true); LOCAL_PrologMode = oldPrologMode; // Yap_CloseSlots(CSlot); if (!(oldPrologMode & UserCCallMode)) { @@ -2114,14 +2125,16 @@ X_API void YAP_ClearExceptions(void) { Yap_ResetException(worker_id); } -X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) { +X_API int YAP_InitConsult(int mode, const char *fname, char **full, + int *osnop) { CACHE_REGS int sno; BACKUP_MACHINE_REGS(); const char *fl = NULL; int lvl = push_text_stack(); if (mode == YAP_BOOT_MODE) { - mode = YAP_CONSULT_MODE; } + mode = YAP_CONSULT_MODE; + } if (fname == NULL || fname[0] == '\0') { fl = Yap_BOOTFILE; } @@ -2132,26 +2145,27 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) *full = NULL; return -1; } else { - *full = pop_output_text_stack(lvl,fl); + *full = pop_output_text_stack(lvl, fl); } } else { - pop_text_stack(lvl); + pop_text_stack(lvl); } lvl = push_text_stack(); - char *d = Malloc(strlen(fl)+1); - strcpy(d,fl); - bool consulted = (mode == YAP_CONSULT_MODE); + char *d = Malloc(strlen(fl) + 1); + strcpy(d, fl); + bool consulted = (mode == YAP_CONSULT_MODE); Term tat = MkAtomTerm(Yap_LookupAtom(d)); - sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)), LOCAL_encoding); - if (sno < 0 || - !Yap_ChDir(dirname((char *)d))) { - pop_text_stack(lvl); - *full = NULL; - return -1; - } LOCAL_PrologMode = UserMode; + sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)), + LOCAL_encoding); + if (sno < 0 || !Yap_ChDir(dirname((char *)d))) { + pop_text_stack(lvl); + *full = NULL; + return -1; + } + LOCAL_PrologMode = UserMode; - Yap_init_consult(consulted, pop_output_text_stack__(lvl,fl)); + Yap_init_consult(consulted, pop_output_text_stack__(lvl, fl)); RECOVER_MACHINE_REGS(); UNLOCK(GLOBAL_Stream[sno].streamlock); return sno; @@ -2179,16 +2193,19 @@ X_API void YAP_EndConsult(int sno, int *osnop, const char *full) { BACKUP_MACHINE_REGS(); Yap_CloseStream(sno); int lvl = push_text_stack(); - char *d = Malloc(strlen(full)+1); - strcpy(d,full); + char *d = Malloc(strlen(full) + 1); + strcpy(d, full); Yap_ChDir(dirname(d)); if (osnop >= 0) Yap_AddAlias(AtomLoopStream, *osnop); Yap_end_consult(); - __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d", - CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, full, *osnop, sno); - // LOCAL_CurSlot); - pop_text_stack(lvl); + __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d", + CurrentModule == 0 + ? "prolog" + : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, + full, *osnop, sno); + // LOCAL_CurSlot); + pop_text_stack(lvl); RECOVER_MACHINE_REGS(); } @@ -2215,7 +2232,13 @@ X_API Term YAP_ReadFromStream(int sno) { X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) { BACKUP_MACHINE_REGS(); - Term t = Yap_read_term(sno,MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition,1),1,&pos), TermNil)), true); + Term t = Yap_read_term( + sno, + MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs), + MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1), + 1, &pos), + TermNil)), + true); RECOVER_MACHINE_REGS(); return t; } @@ -2275,7 +2298,7 @@ X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze, BACKUP_MACHINE_REGS(); b = Yap_TermToBuffer(t, flags); - strncpy(buf, b, sze-1); + strncpy(buf, b, sze - 1); buf[sze] = 0; RECOVER_MACHINE_REGS(); return true; @@ -2315,7 +2338,7 @@ X_API bool YAP_CompileClause(Term t) { } RECOVER_MACHINE_REGS(); if (!ok) { - return NULL; + return NULL; } return ok; } @@ -2540,12 +2563,12 @@ X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) { X_API char *YAP_cwd(void) { CACHE_REGS - char *buf = Yap_AllocCodeSpace(FILENAME_MAX+1); + char *buf = Yap_AllocCodeSpace(FILENAME_MAX + 1); int len; if (!Yap_getcwd(buf, FILENAME_MAX)) return FALSE; len = strlen(buf); - buf = Yap_ReallocCodeSpace(buf,len+1); + buf = Yap_ReallocCodeSpace(buf, len + 1); return buf; } diff --git a/C/cdmgr.c b/C/cdmgr.c index 6abf93b94..8b9fd55cb 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -85,7 +85,7 @@ static void InitConsultStack(void) { LOCAL_ConsultCapacity = InitialConsultCapacity; LOCAL_ConsultBase = LOCAL_ConsultSp = LOCAL_ConsultLow + LOCAL_ConsultCapacity; -s +} void Yap_ResetConsultStack(void) { CACHE_REGS diff --git a/include/YapInterface.h b/include/YapInterface.h index dd7f2c250..06b151205 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -102,6 +102,9 @@ extern YAP_Term YAP_A(int); #define YAP_ARG15 YAP_A(15) #define YAP_ARG16 YAP_A(16) +X_API +extern YAP_Term YAP_SetA(int, YAP_Term); + /* YAP_Bool IsVarTerm(YAP_Term) */ extern X_API YAP_Bool YAP_IsVarTerm(YAP_Term); @@ -268,7 +271,6 @@ extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, YAP_UserCPred, YAP_Arity, YAP_Arity); - /* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), int arity, int extra) */ @@ -371,7 +373,7 @@ extern X_API YAP_Term YAP_CopyTerm(YAP_Term t); /* bool YAP_CompileClause(YAP_Term) -@short compile the clause _Cl_; on failure it may call the exception handler. */ +@short compile the clause _Cl_; on failure it may call the exception handler. */ extern X_API bool YAP_CompileClause(YAP_Term Cl); extern X_API int YAP_NewExo(YAP_PredEntryPtr ap, size_t data, void *user_di); @@ -383,8 +385,7 @@ extern X_API int YAP_AssertTuples(YAP_PredEntryPtr pred, const YAP_Term *ts, extern X_API void YAP_Init(YAP_init_args *); /* int YAP_FastInit(const char *) */ -extern X_API void YAP_FastInit(char saved_state[], int argc, - char *argv[]); +extern X_API void YAP_FastInit(char saved_state[], int argc, char *argv[]); #ifndef _PL_STREAM_H // if we don't know what a stream is, just don't assume nothing about the @@ -402,7 +403,8 @@ extern X_API YAP_Term YAP_ReadFromStream(int s); /// read a Prolog clause from a Prolog opened stream $s$. Similar to /// YAP_ReadFromStream() but takes /// default options from read_clause/3. -extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term); +extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, + YAP_Term); extern X_API void YAP_Write(YAP_Term t, FILE *s, int); @@ -411,7 +413,8 @@ extern X_API FILE *YAP_TermToStream(YAP_Term t); extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf, int *previous_sno); -extern X_API void YAP_EndConsult(int s, int *previous_sno, const char *previous_cwd); +extern X_API void YAP_EndConsult(int s, int *previous_sno, + const char *previous_cwd); extern X_API void YAP_Exit(int); @@ -477,7 +480,6 @@ extern X_API void YAP_SetOutputMessage(void); extern X_API int YAP_StreamToFileNo(YAP_Term); - /** * Utility routine to Obtain a pointer to the YAP representation of a stream. * @@ -486,7 +488,6 @@ extern X_API int YAP_StreamToFileNo(YAP_Term); */ extern X_API void *YAP_RepStreamFromId(int sno); - extern X_API void YAP_CloseAllOpenStreams(void); extern X_API void YAP_FlushAllStreams(void); diff --git a/os/iopreds.c b/os/iopreds.c index 25770e00a..03f22576d 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1307,7 +1307,6 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, st->status |= Popen_Stream_f; pop_text_stack(i); } else { - pop_text_stack(i); Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open"); } } diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index fc04eaa84..bfc3728d4 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -19,61 +19,61 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % 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. @@ -81,34 +81,34 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % 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) @@ -127,7 +127,7 @@ % % 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 @@ -138,13 +138,13 @@ % 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 @@ -152,7 +152,7 @@ % 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 @@ -160,7 +160,7 @@ % 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 @@ -168,21 +168,21 @@ % 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 @@ -192,7 +192,7 @@ % 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 @@ -308,7 +308,7 @@ check_examples :- throw(error(examples)) ); true ), - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check example probabilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -342,7 +342,7 @@ check_examples :- user:example(ID,QueryB,_,_), QueryA \= QueryB ) ; - + ( user:test_example(ID,QueryA,_,_), user:test_example(ID,QueryB,_,_), @@ -362,7 +362,7 @@ check_examples :- ); true ). %======================================================================== -%= +%= %======================================================================== reset_learning :- @@ -413,7 +413,7 @@ do_learning_intern(Iterations,Epsilon) :- NextIteration is CurrentIteration+1, assertz(current_iteration(NextIteration)), EndIteration is CurrentIteration+Iterations-1, - + format_learning(1,'~nIteration ~d of ~d~n',[CurrentIteration,EndIteration]), logger_set_variable(iteration,CurrentIteration), logger_start_timer(duration), @@ -422,7 +422,7 @@ do_learning_intern(Iterations,Epsilon) :- gradient_descent, problog_flag(log_frequency,Log_Frequency), - + ( ( Log_Frequency>0, 0 =:= CurrentIteration mod Log_Frequency) -> @@ -431,7 +431,7 @@ do_learning_intern(Iterations,Epsilon) :- ), % update_values, - + ( last_mse(Last_MSE) -> @@ -443,7 +443,7 @@ do_learning_intern(Iterations,Epsilon) :- MSE_Diff is abs(Last_MSE-Current_MSE) ); ( logger_get_variable(mse_trainingset,Current_MSE), - assertz(last_mse(Current_MSE)), + assertz(last_mse(Current_MSE)), MSE_Diff is Epsilon+1 ) ), @@ -463,7 +463,7 @@ do_learning_intern(Iterations,Epsilon) :- !, logger_stop_timer(duration), - + logger_write_data, @@ -489,17 +489,17 @@ init_learning :- !. init_learning :- check_examples, - + % empty_output_directory, logger_write_header, format_learning(1,'Initializing everything~n',[]), - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check, if continuous facts are used. - % if yes, switch to problog_exact + % if yes, switch to problog_exact % continuous facts are not supported yet. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_default_gradient_method, @@ -536,7 +536,7 @@ init_learning :- format_learning(3,'~q training examples~n',[TrainingExampleCount]), - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % build BDD script for every example %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -560,7 +560,7 @@ empty_bdd_directory. set_default_gradient_method :- - problog_flag(continuous_facts, true), + problog_flag(continuous_facts, true), !, problog_flag(init_method,OldMethod), format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]), @@ -612,12 +612,12 @@ init_one_query(QueryID,Query,Type) :- -> rb_new(H0), maplist_to_hash(MapList, H0, Hash), - Tree \= [], tree_to_grad(Tree, Hash, [], Grad) - ; - Bdd = bdd(-1,[],[]), - Grad=[] + % ; + % Bdd = bdd(-1,[],[]), + % Grad=[] ), + write('.'), recordz(QueryID,bdd(Dir, Grad, MapList),_) ; problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> @@ -682,7 +682,7 @@ node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :- rb_lookup(X,Id,H), (L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL), (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR). - + run_sp([], _, P0, P0). run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- P is EP*PL+ (1.0-EP)*PR, @@ -793,7 +793,7 @@ mse_testset :- format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), format(Handle,"% Iteration, train/test, QueryID, Query, GroundTruth, Prediction %~n",[]), format(Handle,"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%~n",[]), - + format_learning(2,'MSE_Test ',[]), update_values, bb_put(llh_test_queries,0.0), @@ -888,10 +888,8 @@ gradient_descent :- N1 is N-1, forall(tunable_fact(FactID,GroundTruth), (X[FactID] <== 0.5)), problog_flag(sigmoid_slope,Slope), - lbfgs_run(Solver,BestFA), - BestF <== BestFA[0], - format('~2nOptimization done~nWe found a minimum ~4f -.~2n',[BestF]), + lbfgs_run(Solver,BestF), + format('~2nOptimization done~nWe found a minimum ~4f.~n',[BestF]), forall(tunable_fact(FactID,GroundTruth), set_tunable(FactID,GroundTruth,X)), lbfgs_finalize(Solver). @@ -917,9 +915,12 @@ bind_maplist([Node-Theta|MapList], Slope, X) :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % start calculate gradient %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -user:evaluate(L, X,Grad,N,_,_) :- +user:evaluate(L, X0,Grad,N,_,_) :- Handle = user_error, problog_flag(sigmoid_slope,Slope), + forall(between(0,N1,I), + (V is random, X[I] <== V) %, sigmoid(X[I],Slope,Probs[I]) ) + ) Probs = X, %<== array[N] of floats, N1 is N-1, forall(between(0,N1,I), @@ -931,7 +932,7 @@ user:evaluate(L, X,Grad,N,_,_) :- ), sum_list(LLs,LLH_Training_Queries), forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID])), - L[0] <== LLH_Training_Queries. + L = LLH_Training_Queries. compute_grad(N, X, Grad, Probs, Slope, Handle, LL) :- user:example(QueryID,Query,QueryProb,Type), @@ -957,7 +958,7 @@ gradientpair(_BDD,_Slope,_BDDProb, _Grad). user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- problog_flag(sigmoid_slope,Slope), X0 <== X[0], - X1 <== X[1], + X1 <== X[1], format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0 ,X1,FX,X_Norm,G_Norm,Step,Ls]). @@ -973,7 +974,7 @@ init_flags :- problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), - problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), + problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general), problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler), problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler), @@ -1009,4 +1010,3 @@ init_logger :- :- initialization(init_flags). :- initialization(init_logger). - diff --git a/packages/yap-lbfgs/ex1.pl b/packages/yap-lbfgs/ex1.pl index 55730d0c5..b42306e46 100644 --- a/packages/yap-lbfgs/ex1.pl +++ b/packages/yap-lbfgs/ex1.pl @@ -44,13 +44,11 @@ progress(FX,X,G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- demo :- format('Optimizing the function f(x0) = sin(x0)~n',[]), - lbfgs_initialize(1,X,0,Solver), - - + lbfgs_initialize(1,X,FX,Solver), StartX is random*10, format('We start the search at the random position x0=~5f~2n',[StartX]), X[0] <== StartX, - lbfgs_run(Solver,BestF,Status), + lbfgs_run(Solver,BestF), BestX0 <== X[0], lbfgs_finalize(Solver), format('~2nOptimization done~nWe found a minimum at diff --git a/packages/yap-lbfgs/lbfgs.pl b/packages/yap-lbfgs/lbfgs.pl index 93b9c677f..d8e285700 100644 --- a/packages/yap-lbfgs/lbfgs.pl +++ b/packages/yap-lbfgs/lbfgs.pl @@ -71,7 +71,7 @@ if you port it to another system, ... please send me an email. ### Usage The module lbfgs provides the following predicates after you loaded -it by +it by ~~~~ :-use_module(library(lbfgs)). ~~~~ @@ -119,7 +119,7 @@ demo :- StartX is random*10, format('We start the search at the random position x0=~5f~2n',[StartX]), X[0] <== StartX, - + lbfgs_run(Solver,BestF,Status), BestX0 <== X[0], lbfgs_finalize(Solver), @@ -151,7 +151,6 @@ yes @{ */ -:- dynamic initialized/0. :- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates'). @@ -178,17 +177,15 @@ lbfgs_initialize(N,X,U,t(N,X,U,Params)) :- lbfgs_grab(N,X). % install call back predicates in the user module which call - % the predicates given by the arguments + % the predicates given by the arguments /** @pred lbfgs_finalize/0 Clean up the memory. */ lbfgs_finalize(t(N,X,U,Params)) :- - initialized, lbfgs_release(X) , - lbfgs_release_parameters(Params) , - retractall(initialized). + lbfgs_release_parameters(Params) . /** @pred lbfgs_run/2 Do the work. @@ -205,14 +202,14 @@ of libLBFGS for the meaning of each parameter. ~~~~ ?- lbfgs_parameters. ========================================================================================== -Type Name Value Description +Type Name Value Description ========================================================================================== int m 6 The number of corrections to approximate the inverse hessian matrix. -float epsilon 1e-05 Epsilon for convergence test. +float epsilon 1e-05 Epsilon for convergence test. int past 0 Distance for delta-based convergence test. -float delta 1e-05 Delta for convergence test. +float delta 1e-05 Delta for convergence test. int max_iterations 0 The maximum number of iterations -int linesearch 0 The line search algorithm. +int linesearch 0 The line search algorithm. int max_linesearch 40 The maximum number of trials for the line search. float min_step 1e-20 The minimum step of the line search routine. float max_step 1e+20 The maximum step of the line search. @@ -223,12 +220,12 @@ float orthantwise_c 0.0 Coefficient for the L1 norm of varia int orthantwise_start 0 Start index for computing the L1 norm of the variables. int orthantwise_end -1 End index for computing the L1 norm of the variables. ========================================================================================== -~~~~ +~~~~ */ lbfgs_parameters :- lbfgs_defaults(Params), lbfgs_parameters(t(_X,_,_,Params)). - + lbfgs_parameters(t(_,_,_,Params)) :- lbfgs_get_parameter(m,M ,Params), lbfgs_get_parameter(epsilon,Epsilon ,Params), diff --git a/packages/yap-lbfgs/yap_lbfgs.c b/packages/yap-lbfgs/yap_lbfgs.c index 01a17ebb1..79cc14ab3 100644 --- a/packages/yap-lbfgs/yap_lbfgs.c +++ b/packages/yap-lbfgs/yap_lbfgs.c @@ -1,7 +1,7 @@ -#include #include "YapInterface.h" #include #include +#include /* This file is part of YAP-LBFGS. @@ -21,89 +21,72 @@ along with YAP-LBFGS. If not, see . */ - - // These constants describe the internal state -#define LBFGS_STATUS_NONE 0 +#define LBFGS_STATUS_NONE 0 #define LBFGS_STATUS_INITIALIZED 1 -#define LBFGS_STATUS_RUNNING 2 -#define LBFGS_STATUS_CB_EVAL 3 +#define LBFGS_STATUS_RUNNING 2 +#define LBFGS_STATUS_CB_EVAL 3 #define LBFGS_STATUS_CB_PROGRESS 4 -X_API void init_lbfgs_predicates( void ) ; +X_API void init_lbfgs_predicates(void); YAP_Functor fevaluate, fprogress, fmodule, ffloats; YAP_Term tuser; -static lbfgsfloatval_t evaluate( - void *instance, - const lbfgsfloatval_t *x, - lbfgsfloatval_t *g_tmp, - const int n, - const lbfgsfloatval_t step - ) -{ +static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x, + lbfgsfloatval_t *g_tmp, const int n, + const lbfgsfloatval_t step) { YAP_Term call; YAP_Bool result; - lbfgsfloatval_t rc; - + lbfgsfloatval_t rc; + YAP_Term v; YAP_Term t[6], t2[2]; - t[0] = YAP_MkIntTerm((YAP_Int)&rc); - t[0] = YAP_MkApplTerm(ffloats, 1, t); + t[0] = v = YAP_MkVarTerm(); t[1] = YAP_MkIntTerm((YAP_Int)x); - t[1] = YAP_MkApplTerm(ffloats, 1, t+1); + t[1] = YAP_MkApplTerm(ffloats, 1, t + 1); t[2] = YAP_MkIntTerm((YAP_Int)g_tmp); - t[2] = YAP_MkApplTerm(ffloats, 1, t+2); + t[2] = YAP_MkApplTerm(ffloats, 1, t + 2); t[3] = YAP_MkIntTerm(n); t[4] = YAP_MkFloatTerm(step); t[5] = YAP_MkIntTerm((YAP_Int)instance); t2[0] = tuser; - t2[1] = YAP_MkApplTerm(fevaluate, 6, t); + t2[1] = YAP_MkApplTerm(fevaluate, 6, t); + call = YAP_MkApplTerm(fmodule, 2, t2); - call = YAP_MkApplTerm( fmodule, 2, t2 ); + int sl = YAP_InitSlot(v); + // lbfgs_status=LBFGS_STATUS_CB_EVAL; + result = YAP_RunGoalOnce(call); + // lbfgs_status=LBFGS_STATUS_RUNNING; - - // s1 = YAP_InitSlot(v); - //lbfgs_status=LBFGS_STATUS_CB_EVAL; - result=YAP_RunGoalOnce(call); - //lbfgs_status=LBFGS_STATUS_RUNNING; - - if (result==FALSE) { + if (result == FALSE) { printf("ERROR: the evaluate call failed in YAP.\n"); // Goal did not succeed - return FALSE; + return FALSE; } - + rc = YAP_FloatOfTerm(YAP_GetFromSlot(sl)); + YAP_RecoverSlots(1, sl); return rc; } -static int progress( - void *instance, - const lbfgsfloatval_t *local_x, - const lbfgsfloatval_t *local_g, +static int progress(void *instance, const lbfgsfloatval_t *local_x, + const lbfgsfloatval_t *local_g, - const lbfgsfloatval_t fx, - const lbfgsfloatval_t xnorm, - const lbfgsfloatval_t gnorm, - const lbfgsfloatval_t step, - int n, - int k, - int ls - ) -{ + const lbfgsfloatval_t fx, const lbfgsfloatval_t xnorm, + const lbfgsfloatval_t gnorm, const lbfgsfloatval_t step, + int n, int k, int ls) { YAP_Term call; YAP_Bool result; YAP_Int s1; - YAP_Term t[10],t2[2], v; + YAP_Term t[10], t2[2], v; t[0] = YAP_MkFloatTerm(fx); t[1] = YAP_MkIntTerm((YAP_Int)local_x); - t[1] = YAP_MkApplTerm(ffloats, 1, t+1); + t[1] = YAP_MkApplTerm(ffloats, 1, t + 1); t[2] = YAP_MkIntTerm((YAP_Int)local_g); - t[2] = YAP_MkApplTerm(ffloats, 1, t+2); + t[2] = YAP_MkApplTerm(ffloats, 1, t + 2); t[3] = YAP_MkFloatTerm(xnorm); t[4] = YAP_MkFloatTerm(gnorm); t[5] = YAP_MkFloatTerm(step); @@ -113,29 +96,30 @@ static int progress( t[9] = v = YAP_MkVarTerm(); t2[0] = tuser; - t2[1] = YAP_MkApplTerm( fprogress, 10, t); + t2[1] = YAP_MkApplTerm(fprogress, 10, t); - call = YAP_MkApplTerm( fmodule, 2, t2 ); + call = YAP_MkApplTerm(fmodule, 2, t2); s1 = YAP_InitSlot(v); - //lbfgs_status=LBFGS_STATUS_CB_PROGRESS; - result=YAP_RunGoalOnce(call); - //lbfgs_status=LBFGS_STATUS_RUNNING; + // lbfgs_status=LBFGS_STATUS_CB_PROGRESS; + result = YAP_RunGoalOnce(call); + // lbfgs_status=LBFGS_STATUS_RUNNING; - YAP_Term o = YAP_GetFromSlot( s1 ); + YAP_Term o = YAP_GetFromSlot(s1); - if (result==FALSE) { + if (result == FALSE) { printf("ERROR: the progress call failed in YAP.\n"); // Goal did not succeed - return -1; + return -1; } if (YAP_IsIntTerm(o)) { int v = YAP_IntOfTerm(o); - return (int)v; + return (int)v; } - fprintf(stderr, "ERROR: The progress call back function did not return an integer as last argument\n"); + fprintf(stderr, "ERROR: The progress call back function did not return an " + "integer as last argument\n"); return 1; } @@ -190,424 +174,405 @@ value will terminate the optimization process. * @Arg[X0]: user data * @Arg[FX]: status */ -static YAP_Bool p_lbfgs(void) -{ - YAP_Term t1 = YAP_ARG1; - int n; +static YAP_Bool p_lbfgs(void) { + YAP_Term t1 = YAP_ARG1, t; + int n, sl; lbfgsfloatval_t *x; lbfgsfloatval_t fx; - if (! YAP_IsIntTerm(t1)) { + if (!YAP_IsIntTerm(t1)) { return false; } - n=YAP_IntOfTerm(t1); + n = YAP_IntOfTerm(t1); - if (n<1) { + if (n < 1) { return FALSE; } - x = ( lbfgsfloatval_t*) YAP_IntOfTerm(YAP_ArgOfTerm(1,YAP_ARG2)); - lbfgs_parameter_t* param = ( lbfgs_parameter_t*) YAP_IntOfTerm(YAP_ARG3); - void* ui = ( void*) YAP_IntOfTerm(YAP_ARG4); - { - YAP_Term t = YAP_MkIntTerm((YAP_Int)&fx); - if (!YAP_Unify(YAP_ARG5,YAP_MkApplTerm(ffloats,1,&t))) - return false; - } - signal(SIGFPE, SIG_IGN); - int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param); - if (ret == 0) - return true; - const char *s; - switch(ret) { - case LBFGS_CONVERGENCE: - case LBFGS_STOP: - return true; + sl = YAP_InitSlot(YAP_ARG6); + + x = (lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, YAP_ARG2)); + lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3); + void *ui = (void *)YAP_IntOfTerm(YAP_ARG4); + int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param); + t = YAP_GetFromSlot(sl); + YAP_Unify(t, YAP_MkFloatTerm(fx)); + YAP_RecoverSlots(1, sl); + if (ret == 0) + return true; + const char *s; + switch (ret) { + case LBFGS_CONVERGENCE: + case LBFGS_STOP: + return true; /** The initial variables already minimize the objective function. */ - case LBFGS_ALREADY_MINIMIZED: - s = "The initial variables already minimize the objective function."; - break; - case LBFGSERR_UNKNOWNERROR: - s = "Unknownerror"; - break; - case LBFGSERR_LOGICERROR: - s = "logic error."; - break; - - case LBFGSERR_OUTOFMEMORY: - s = "out of memory"; - break; - case LBFGSERR_CANCELED: - s = "canceled."; - break; - case LBFGSERR_INVALID_N: - s = "Invalid number of variables specified."; - break; - - case LBFGSERR_INVALID_N_SSE: - s = "Invalid number of variables (for SSE) specified."; - break; - - case LBFGSERR_INVALID_X_SSE: - s = "The array x must be aligned to 16 (for SSE)."; - break; - case LBFGSERR_INVALID_EPSILON: - s = "Invalid parameter lbfgs_parameter_t::epsilon specified."; - break; - case LBFGSERR_INVALID_TESTPERIOD: - s = "Invalid parameter lbfgs_parameter_t::past specified."; - break; - case LBFGSERR_INVALID_DELTA: - s = "Invalid parameter lbfgs_parameter_t::delta specified."; - break; - case LBFGSERR_INVALID_LINESEARCH: - s = "Invalid parameter lbfgs_parameter_t::linesearch specified."; - break; - case LBFGSERR_INVALID_MINSTEP: - s = "Invalid parameter lbfgs_parameter_t::max_step specified."; - break; - case LBFGSERR_INVALID_MAXSTEP: - s = "Invalid parameter lbfgs_parameter_t::max_step specified."; - break; - case LBFGSERR_INVALID_FTOL: - s = "Invalid parameter lbfgs_parameter_t::ftol specified."; - break; - case LBFGSERR_INVALID_WOLFE: - s = "Invalid parameter lbfgs_parameter_t::wolfe specified."; - break; - case LBFGSERR_INVALID_GTOL: - s = "Invalid parameter lbfgs_parameter_t::gtol specified."; - break; - case LBFGSERR_INVALID_XTOL: - s = "Invalid parameter lbfgs_parameter_t::xtol specified."; - break; - case LBFGSERR_INVALID_MAXLINESEARCH: - s = "Invalid parameter lbfgs_parameter_t::max_linesearch specified."; - break; - case LBFGSERR_INVALID_ORTHANTWISE: - s = "Invalid parameter lbfgs_parameter_t::orthantwise_c specified."; - break; - case LBFGSERR_INVALID_ORTHANTWISE_START: - s = "Invalid parameter lbfgs_parameter_t::orthantwise_start specified."; - break; - case LBFGSERR_INVALID_ORTHANTWISE_END: - s = "Invalid parameter lbfgs_parameter_t::orthantwise_end specified."; - break; - case LBFGSERR_OUTOFINTERVAL: - s = "The line-search step went out of the interval of uncertainty."; - break; - - case LBFGSERR_INCORRECT_TMINMAX: - s = "A logic error occurred; alternatively, the interval of uncertaity became too small."; -break; - case LBFGSERR_ROUNDING_ERROR: - s = "A rounding error occurred; alternatively, no line-search s"; -break; - case LBFGSERR_MINIMUMSTEP: - s = "The line-search step became smaller than lbfgs_parameter_t::min_step."; -break; - case LBFGSERR_MAXIMUMSTEP: - s = "The line-search step became larger than lbfgs_parameter_t::max_step."; -break; - case LBFGSERR_MAXIMUMLINESEARCH: - s = "The line-search routine reaches the maximum number of evaluations."; -break; - case LBFGSERR_MAXIMUMITERATION: - s = "The algorithm routine reaches the maximum number of iterations lbfgs_parameter_t::xtol."; + case LBFGS_ALREADY_MINIMIZED: + s = "The initial variables already minimize the objective function."; break; - case LBFGSERR_WIDTHTOOSMALL: + case LBFGSERR_UNKNOWNERROR: + s = "Unknownerror"; + break; + case LBFGSERR_LOGICERROR: + s = "logic error."; + break; + + case LBFGSERR_OUTOFMEMORY: + s = "out of memory"; + break; + case LBFGSERR_CANCELED: + s = "canceled."; + break; + case LBFGSERR_INVALID_N: + s = "Invalid number of variables specified."; + break; + + case LBFGSERR_INVALID_N_SSE: + s = "Invalid number of variables (for SSE) specified."; + break; + + case LBFGSERR_INVALID_X_SSE: + s = "The array x must be aligned to 16 (for SSE)."; + break; + case LBFGSERR_INVALID_EPSILON: + s = "Invalid parameter lbfgs_parameter_t::epsilon specified."; + break; + case LBFGSERR_INVALID_TESTPERIOD: + s = "Invalid parameter lbfgs_parameter_t::past specified."; + break; + case LBFGSERR_INVALID_DELTA: + s = "Invalid parameter lbfgs_parameter_t::delta specified."; + break; + case LBFGSERR_INVALID_LINESEARCH: + s = "Invalid parameter lbfgs_parameter_t::linesearch specified."; + break; + case LBFGSERR_INVALID_MINSTEP: + s = "Invalid parameter lbfgs_parameter_t::max_step specified."; + break; + case LBFGSERR_INVALID_MAXSTEP: + s = "Invalid parameter lbfgs_parameter_t::max_step specified."; + break; + case LBFGSERR_INVALID_FTOL: + s = "Invalid parameter lbfgs_parameter_t::ftol specified."; + break; + case LBFGSERR_INVALID_WOLFE: + s = "Invalid parameter lbfgs_parameter_t::wolfe specified."; + break; + case LBFGSERR_INVALID_GTOL: + s = "Invalid parameter lbfgs_parameter_t::gtol specified."; + break; + case LBFGSERR_INVALID_XTOL: + s = "Invalid parameter lbfgs_parameter_t::xtol specified."; + break; + case LBFGSERR_INVALID_MAXLINESEARCH: + s = "Invalid parameter lbfgs_parameter_t::max_linesearch specified."; + break; + case LBFGSERR_INVALID_ORTHANTWISE: + s = "Invalid parameter lbfgs_parameter_t::orthantwise_c specified."; + break; + case LBFGSERR_INVALID_ORTHANTWISE_START: + s = "Invalid parameter lbfgs_parameter_t::orthantwise_start specified."; + break; + case LBFGSERR_INVALID_ORTHANTWISE_END: + s = "Invalid parameter lbfgs_parameter_t::orthantwise_end specified."; + break; + case LBFGSERR_OUTOFINTERVAL: + s = "The line-search step went out of the interval of uncertainty."; + break; + + case LBFGSERR_INCORRECT_TMINMAX: + s = "A logic error occurred; alternatively, the interval of uncertaity " + "became too small."; + break; + case LBFGSERR_ROUNDING_ERROR: + s = "A rounding error occurred; alternatively, no line-search s"; + break; + case LBFGSERR_MINIMUMSTEP: + s = "The line-search step became smaller than lbfgs_parameter_t::min_step."; + break; + case LBFGSERR_MAXIMUMSTEP: + s = "The line-search step became larger than lbfgs_parameter_t::max_step."; + break; + case LBFGSERR_MAXIMUMLINESEARCH: + s = "The line-search routine reaches the maximum number of evaluations."; + break; + case LBFGSERR_MAXIMUMITERATION: + s = "The algorithm routine reaches the maximum number of iterations " + "lbfgs_parameter_t::xtol."; + break; + case LBFGSERR_WIDTHTOOSMALL: s = "Relative width of the interval of uncertainty is at m"; break; - case LBFGSERR_INVALIDPARAMETERS: + case LBFGSERR_INVALIDPARAMETERS: s = "A logic error (negative line-search step) occurred."; break; + } + fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s); - } - fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s); - -return true; + return true; } +static YAP_Bool lbfgs_grab(void) { + int n = YAP_IntOfTerm(YAP_ARG1); - -static YAP_Bool lbfgs_grab (void) -{ - int n=YAP_IntOfTerm(YAP_ARG1); - - if (n<1) { + if (n < 1) { return FALSE; } - lbfgsfloatval_t * x = lbfgs_malloc(n); + lbfgsfloatval_t *x = lbfgs_malloc(n); YAP_Term t = YAP_MkIntTerm((YAP_Int)x); - return YAP_Unify(YAP_ARG2,YAP_MkApplTerm(ffloats,1,&t)); + return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t)); +} - } +static YAP_Bool lbfgs_parameters(void) { + lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t)); + lbfgs_parameter_init(x); + return YAP_Unify(YAP_ARG1, YAP_MkIntTerm((YAP_Int)x)); +} +static YAP_Bool lbfgs_release_parameters(void) { + free((void *)YAP_IntOfTerm(YAP_ARG1)); + return true; +} - - static YAP_Bool lbfgs_parameters( void ) - { - lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t)); - lbfgs_parameter_init(x); - return YAP_Unify(YAP_ARG1,YAP_MkIntTerm((YAP_Int)x)); - - } - - static YAP_Bool lbfgs_release_parameters( void ) - { - free((void *)YAP_IntOfTerm(YAP_ARG1)); - return true; - - } - -static YAP_Bool lbfgs_release( void ) { +static YAP_Bool lbfgs_release(void) { /* if (lbfgs_status == LBFGS_STATUS_NONE) { */ /* printf("Error: Lbfgs is not initialized.\n"); */ /* return FALSE; */ /* } */ /* if (lbfgs_status == LBFGS_STATUS_INITIALIZED) { */ - lbfgs_free((lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1,(YAP_ARG1)))); - - return TRUE; + lbfgs_free((lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, (YAP_ARG1)))); + + return TRUE; /* return FALSE; */ - } - - +} /** @pred lbfgs_set_parameter(+Name,+Value,+Parameters) Set the parameter Name to Value. Only possible while the lbfgs is not running. */ -static YAP_Bool lbfgs_set_parameter( void ) { +static YAP_Bool lbfgs_set_parameter(void) { YAP_Term t1 = YAP_ARG1; YAP_Term t2 = YAP_ARG2; - lbfgs_parameter_t *param = (lbfgs_parameter_t *) YAP_IntOfTerm(YAP_ARG3); - /* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status != LBFGS_STATUS_INITIALIZED){ */ - /* printf("ERROR: Lbfgs is running right now. Please wait till it is finished.\n"); */ + lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3); + /* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status != + * LBFGS_STATUS_INITIALIZED){ */ + /* printf("ERROR: Lbfgs is running right now. Please wait till it is + * finished.\n"); */ /* return FALSE; */ /* } */ - - if (! YAP_IsAtomTerm(t1)) { + if (!YAP_IsAtomTerm(t1)) { return FALSE; } - const char* name=YAP_AtomName(YAP_AtomOfTerm(t1)); + const char *name = YAP_AtomName(YAP_AtomOfTerm(t1)); if ((strcmp(name, "m") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->m = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "epsilon") == 0)) { + } else if ((strcmp(name, "epsilon") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->epsilon=v; - } else if ((strcmp(name, "past") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + param->epsilon = v; + } else if ((strcmp(name, "past") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->past = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "delta") == 0)) { + } else if ((strcmp(name, "delta") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->delta=v; - } else if ((strcmp(name, "max_iterations") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + param->delta = v; + } else if ((strcmp(name, "max_iterations") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->max_iterations = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "linesearch") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + } else if ((strcmp(name, "linesearch") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->linesearch = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "max_linesearch") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + } else if ((strcmp(name, "max_linesearch") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->max_linesearch = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "min_step") == 0)) { + } else if ((strcmp(name, "min_step") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->min_step=v; - } else if ((strcmp(name, "max_step") == 0)) { + param->min_step = v; + } else if ((strcmp(name, "max_step") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->max_step=v; - } else if ((strcmp(name, "ftol") == 0)) { + param->max_step = v; + } else if ((strcmp(name, "ftol") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->ftol=v; - } else if ((strcmp(name, "gtol") == 0)) { + param->ftol = v; + } else if ((strcmp(name, "gtol") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->gtol=v; - } else if ((strcmp(name, "xtol") == 0)) { + param->gtol = v; + } else if ((strcmp(name, "xtol") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->xtol=v; - } else if ((strcmp(name, "orthantwise_c") == 0)) { + param->xtol = v; + } else if ((strcmp(name, "orthantwise_c") == 0)) { lbfgsfloatval_t v; if (YAP_IsFloatTerm(t2)) { - v=YAP_FloatOfTerm(t2); + v = YAP_FloatOfTerm(t2); } else if (YAP_IsIntTerm(t2)) { - v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); + v = (lbfgsfloatval_t)YAP_IntOfTerm(t2); } else { return FALSE; } - param->orthantwise_c=v; - } else if ((strcmp(name, "orthantwise_start") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + param->orthantwise_c = v; + } else if ((strcmp(name, "orthantwise_start") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->orthantwise_start = YAP_IntOfTerm(t2); - } else if ((strcmp(name, "orthantwise_end") == 0)) { - if (! YAP_IsIntTerm(t2)) { - return FALSE; + } else if ((strcmp(name, "orthantwise_end") == 0)) { + if (!YAP_IsIntTerm(t2)) { + return FALSE; } param->orthantwise_end = YAP_IntOfTerm(t2); } else { - printf("ERROR: The parameter %s is unknown.\n",name); - return FALSE; + printf("ERROR: The parameter %s is unknown.\n", name); + return FALSE; } return TRUE; } - /** @pred lbfgs_get_parameter(+Name,-Value) Get the current Value for Name */ -static YAP_Bool lbfgs_get_parameter( void ) { +static YAP_Bool lbfgs_get_parameter(void) { YAP_Term t1 = YAP_ARG1; YAP_Term t2 = YAP_ARG2; - lbfgs_parameter_t *param = (lbfgs_parameter_t *) YAP_IntOfTerm(YAP_ARG3); + lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3); - if (! YAP_IsAtomTerm(t1)) { + if (!YAP_IsAtomTerm(t1)) { return FALSE; } - const char* name=YAP_AtomName(YAP_AtomOfTerm(t1)); + const char *name = YAP_AtomName(YAP_AtomOfTerm(t1)); if ((strcmp(name, "m") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->m)); - } else if ((strcmp(name, "epsilon") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->epsilon)); - } else if ((strcmp(name, "past") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->past)); - } else if ((strcmp(name, "delta") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->delta)); - } else if ((strcmp(name, "max_iterations") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->max_iterations)); - } else if ((strcmp(name, "linesearch") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->linesearch)); - } else if ((strcmp(name, "max_linesearch") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->max_linesearch)); - } else if ((strcmp(name, "min_step") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->min_step)); - } else if ((strcmp(name, "max_step") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->max_step)); - } else if ((strcmp(name, "ftol") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->ftol)); - } else if ((strcmp(name, "gtol") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->gtol)); - } else if ((strcmp(name, "xtol") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->xtol)); - } else if ((strcmp(name, "orthantwise_c") == 0)) { - return YAP_Unify(t2,YAP_MkFloatTerm(param->orthantwise_c)); - } else if ((strcmp(name, "orthantwise_start") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->orthantwise_start)); - } else if ((strcmp(name, "orthantwise_end") == 0)) { - return YAP_Unify(t2,YAP_MkIntTerm(param->orthantwise_end)); + return YAP_Unify(t2, YAP_MkIntTerm(param->m)); + } else if ((strcmp(name, "epsilon") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->epsilon)); + } else if ((strcmp(name, "past") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->past)); + } else if ((strcmp(name, "delta") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->delta)); + } else if ((strcmp(name, "max_iterations") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->max_iterations)); + } else if ((strcmp(name, "linesearch") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->linesearch)); + } else if ((strcmp(name, "max_linesearch") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->max_linesearch)); + } else if ((strcmp(name, "min_step") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->min_step)); + } else if ((strcmp(name, "max_step") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->max_step)); + } else if ((strcmp(name, "ftol") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->ftol)); + } else if ((strcmp(name, "gtol") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->gtol)); + } else if ((strcmp(name, "xtol") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->xtol)); + } else if ((strcmp(name, "orthantwise_c") == 0)) { + return YAP_Unify(t2, YAP_MkFloatTerm(param->orthantwise_c)); + } else if ((strcmp(name, "orthantwise_start") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_start)); + } else if ((strcmp(name, "orthantwise_end") == 0)) { + return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_end)); } - printf("ERROR: The parameter %s is unknown.\n",name); + printf("ERROR: The parameter %s is unknown.\n", name); return false; } - - - - -X_API void init_lbfgs_predicates( void ) -{ +X_API void init_lbfgs_predicates(void) { fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6); fprogress = YAP_MkFunctor(YAP_LookupAtom("progress"), 10); fmodule = YAP_MkFunctor(YAP_LookupAtom(":"), 2); ffloats = YAP_MkFunctor(YAP_LookupAtom("floats"), 1); tuser = YAP_MkAtomTerm(YAP_LookupAtom("user")); - //Initialize the parameters for the L-BFGS optimization. + // Initialize the parameters for the L-BFGS optimization. // lbfgs_parameter_init(¶m); + YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2); + YAP_UserCPredicate("lbfgs", p_lbfgs, 5); + YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1); - YAP_UserCPredicate("lbfgs_grab",lbfgs_grab,2); - YAP_UserCPredicate("lbfgs",p_lbfgs, 5); - YAP_UserCPredicate("lbfgs_release",lbfgs_release,1); - - YAP_UserCPredicate("lbfgs_defaults",lbfgs_parameters,1); - YAP_UserCPredicate("lbfgs_release_parameters",lbfgs_release_parameters,1); - YAP_UserCPredicate("lbfgs_set_parameter",lbfgs_set_parameter,3); - YAP_UserCPredicate("lbfgs_get_parameter",lbfgs_get_parameter,3); + YAP_UserCPredicate("lbfgs_defaults", lbfgs_parameters, 1); + YAP_UserCPredicate("lbfgs_release_parameters", lbfgs_release_parameters, 1); + YAP_UserCPredicate("lbfgs_set_parameter", lbfgs_set_parameter, 3); + YAP_UserCPredicate("lbfgs_get_parameter", lbfgs_get_parameter, 3); }