ifix

C/errors.c

@@ -524,6 +524,7 @@ static char tmpbuf[YAP_BUF_SIZE];
 
 #define BEGIN_ERRORS()                                                         \
   static Term mkerrort(yap_error_number e, Term culprit, Term info) {          \
+    if (!e || !info) return TermNil; \
     switch (e) {
 
 #define E0(A, B)                                                               \
@@ -1066,7 +1067,9 @@ static Int get_exception(USES_REGS1) {
         (i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) {
       t = i->errorRawTerm;
     } else if (i->culprit != NULL) {
-      t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit, TermNil),
+      Term culprit = Yap_BufferToTerm(i->culprit, TermNil);
+      if (culprit == 0) culprit = TermNil;
+      t = mkerrort(i->errorNo,culprit ,
                    MkSysError(i));
     } else {
       t = mkerrort(i->errorNo, TermNil, MkSysError(i));

os/iopreds.c

@@ -1161,11 +1161,10 @@ bool Yap_initStream(int sno, FILE *fd, const char *name, const char *io_mode,
     st->encoding = encoding;
   }
 
-  name = Yap_guessFileName(fd, sno, YAP_FILENAME_MAX);
+  st->name = Yap_guessFileName(fd, sno, YAP_FILENAME_MAX);
-  if (!name)
+  if (!st->name)
     Yap_Error(SYSTEM_ERROR_INTERNAL, file_name,
               "Yap_guessFileName failed: opening a file without a name");
-  st->name = Yap_LookupAtom(name);
   st->user_name = file_name;
   st->file = fd;
   st->linepos = 0;

os/streams.c

@@ -315,30 +315,34 @@ bool Yap_SetCurInpPos(
   return true;
 }
 
-char *Yap_guessFileName(FILE *file, int sno, size_t max) {
+Atom Yap_guessFileName(FILE *file, int sno, size_t max) {
   size_t maxs = Yap_Max(1023, max-1);
-  int i = push_text_stack();
-  char *nameb = Malloc(maxs + 1);
   if (!file) {
-    strncpy(nameb, "memory buffer", maxs);
+    Atom at = Yap_LookupAtom("mem");
-
+    return at;
-    return pop_output_text_stack(i,nameb);
   }
   int f = fileno(file);
   if (f < 0) {
-    strcpy(nameb, "???");
+    Atom at = Yap_LookupAtom("fmem");
-    return pop_output_text_stack(i,nameb);
+    return at;
   }
 
+  int i = push_text_stack();
 #if __linux__
-  char *path = Malloc(1024);
+  char *path = Malloc(1024), *nameb =  Malloc(maxs+1);
-  if (snprintf(path, 1023, "/proc/self/fd/%d", f) &&
+  size_t len;
-      readlink(path, nameb, maxs)) {
+  if ((len = snprintf(path, 1023, "/proc/self/fd/%d", f)) >= 0 &&
-    return pop_output_text_stack(i,nameb);
+      (len = readlink(path, nameb, maxs)) > 0) {
+    nameb[len] = '\0';
+    Atom at = Yap_LookupAtom(nameb);
+     pop_text_stack(i);
+     return at;
   }
 #elif __APPLE__
   if (fcntl(f, F_GETPATH, nameb) != -1) {
-    return pop_output_text_stack(i,nameb);
+    Atom at = Yap_LookupAtom(nameb);
+     pop_text_stack(i);
+     return at;
   }
 #else
   TCHAR *path = Malloc(MAX_PATH + 1);
@@ -351,7 +355,9 @@ char *Yap_guessFileName(FILE *file, int sno, size_t max) {
     for (i = 0; i < strlen(path); i++)
       ptr += put_utf8(ptr, path[i]);
     *ptr = '\0';
-    return pop_output_text_stack(i,nameb);
+    Atom at = Yap_LookupAtom(nameb);
+     pop_text_stack(i);
+     return at;
   }
 #endif
   if (!StreamName(sno)) {
@@ -359,7 +365,7 @@ char *Yap_guessFileName(FILE *file, int sno, size_t max) {
     return NULL;
   }
   pop_text_stack(i);
-  return RepAtom(AtomOfTerm(StreamName(sno)))->StrOfAE;
+  return AtomOfTerm(StreamName(sno));
 }
 
 static Int representation_error(int sno, Term t2 USES_REGS) {

os/yapio.h

@@ -126,7 +126,7 @@ extern X_API Term Yap_BufferToTermWithPrioBindings(const  char *s, Term opts, Te
                                  int prio);
 extern FILE *Yap_GetInputStream(Term t, const char *m);
 extern FILE *Yap_GetOutputStream(Term t, const char *m);
-extern char *Yap_guessFileName(FILE *f, int sno, size_t max);
+extern Atom Yap_guessFileName(FILE *f, int sno, size_t max);
 extern void Yap_plwrite(Term t, struct stream_desc *mywrite, int max_depth,
                         int flags, int priority);
 

packages/ProbLog/CMakeLists.txt

@@ -5,6 +5,7 @@ set (PROGRAMS
   dtproblog.yap 
   aproblog.yap 
   problog_learning.yap
+  problog_lbfgs.yap
   problog_learning_lbdd.yap
   )
 

packages/ProbLog/problog_lbfgs.yap

@@ -1,4 +1,4 @@
-%xb%%% -*- Mode: Prolog; -*-
+%%% -*- Mode: Prolog; -*-
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %
@@ -285,6 +285,7 @@ save_model:-
 %=
 %========================================================================
 
+
 check_examples :-
 	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 	% Check example IDs
@@ -602,7 +603,8 @@ init_one_query(QueryID,Query,Type) :-
 	->
 	 format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID])
 	 ;
-	  b_setval(problog_required_keep_ground_ids,false),
+	 b_setval(problog_required_keep_ground_ids,false),
+	 (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true),
 	  problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))),
 	  Query =.. [_,X,Y]
 	  ->
@@ -915,13 +917,10 @@ bind_maplist([Node-Theta|MapList], Slope, X) :-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % start calculate gradient
 	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-user:evaluate(L, X0,Grad,N,_,_) :-
+user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
     Handle = user_error,
     problog_flag(sigmoid_slope,Slope),
-		forall(between(0,N1,I),
+    Probs = X,
-	   (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),
 	   (Grad[I] <== 0.0) %, sigmoid(X[I],Slope,Probs[I]) )
@@ -931,12 +930,10 @@ user:evaluate(L, X0,Grad,N,_,_) :-
 	    LLs
 	   ),
     sum_list(LLs,LLH_Training_Queries),
-	forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID])),
+	forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID],writeln(FactID:(W->Z)))).
-    L = 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),
@@ -947,8 +944,8 @@ gradientpair(BDD,Slope,BDDProb, QueryProb, Grad) :-
     qgradient(BDD, Slope, FactID, GradValue),
     % writeln(FactID),
     G0 <== Grad[FactID],
-    GN is G0-GradValue*(QueryProb-BDDProb),
+writeln(    GN is G0-GradValue*(QueryProb-BDDProb)),    GN is G0-GradValue*(QueryProb-BDDProb),
-    %writeln(FactID:(G0->GN)),
+    writeln(FactID:(G0->GN)),
     Grad[FactID] <== GN.
 gradientpair(_BDD,_Slope,_BDDProb, _Grad).
 

packages/ProbLog/problog_learning_lbdd.yap

@@ -624,7 +624,6 @@ init_one_query(QueryID,Query,Type) :-
         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 	% if BDD file does not exist, call ProbLog
 	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-	  writeln(QueryID),
 	(
 	 recorded(QueryID, _, _)
 	->
@@ -659,7 +658,6 @@ init_one_query(QueryID,Query,Type) :-
 	  maplist_to_hash(MapList, H0, Hash),
 	  Tree \= [],
 	  %put_code(0'.),
-	  writeln(QueryID),
 	  tree_to_grad(Tree, Hash, [], Grad),
 	 recordz(QueryID,bdd(Dir, Grad, MapList),_)
 	).
@@ -739,7 +737,6 @@ gradient(QueryID, l, Slope) :-
 	bind_maplist(MapList),
 	run_sp(Tree, Slope, 1.0, Prob0),
 	(Dir == 1 -> Prob0 = Prob ;  Prob is 1.0-Prob0),
-%writeln(QueryID:Prob),
 	assert(query_probability_intern(QueryID,Prob)),
 	fail.
 gradient(_QueryID, l, _).

packages/yap-lbfgs/lbfgs.pl

@@ -156,10 +156,8 @@ yes
 
 
 /** @pred lbfgs_initialize(+N, -SolverInfo)
-The same as before, except that the user module is the default
-value.
 
-Example
+Do initial memory allocation and a reference to a descriptor.
 ~~~~
 lbfgs_initialize(1, Block)
 ~~~~~
@@ -169,26 +167,25 @@ lbfgs_initialize(N,X,t(N,X,U,Params)) :-
 
 lbfgs_initialize(N,X,U,t(N,X,U,Params)) :-
     lbfgs_defaults(Params),
-	integer(N),
+    integer(N),
-	N>0,
+    N>0,
-
+    lbfgs_grab(N,X).
-	% check whether there are such call back functions
-
-	lbfgs_grab(N,X).
 
 	% install call back predicates in the user module which call
 	% the predicates given by the arguments
 
 
-/** @pred  lbfgs_finalize/0
+/** @pred  lbfgs_finalize(+State)
+
 Clean up the memory.
 */
 lbfgs_finalize(t(N,X,U,Params)) :-
 	lbfgs_release(X) ,
 	lbfgs_release_parameters(Params) .
 
-/** @pred  lbfgs_run/2
+/** @pred  lbfgs_run(+State, -FinalOutput)
-Do the work.
+
+run the algorithm. output the final score of the function being optimised
 */
 lbfgs_run(t(N,X,U,Params),FX) :-
     lbfgs(N,X, Params, U, FX).