Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3
This commit is contained in:
Tiago Gomes
commit
265766277f
@ -478,7 +478,8 @@ X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *));
|
||||
X_API Term STD_PROTO(YAP_Read, (IOSTREAM *));
|
||||
X_API void STD_PROTO(YAP_Write, (Term, IOSTREAM *, int));
|
||||
X_API Term STD_PROTO(YAP_CopyTerm, (Term));
|
||||
X_API Term STD_PROTO(YAP_WriteBuffer, (Term, char *, unsigned int, int));
|
||||
X_API int STD_PROTO(YAP_WriteBuffer, (Term, char *, size_t, int));
|
||||
X_API char *STD_PROTO(YAP_WriteDynamicBuffer, (Term, char *, size_t, size_t *, int *, int));
|
||||
X_API char *STD_PROTO(YAP_CompileClause, (Term));
|
||||
X_API void STD_PROTO(YAP_PutValue, (Atom,Term));
|
||||
X_API Term STD_PROTO(YAP_GetValue, (Atom));
|
||||
@ -2799,13 +2800,33 @@ YAP_CopyTerm(Term t)
|
||||
return tn;
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YAP_WriteBuffer(Term t, char *buf, unsigned int sze, int flags)
|
||||
X_API int
|
||||
YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags)
|
||||
{
|
||||
int enc;
|
||||
size_t length;
|
||||
char *b;
|
||||
|
||||
BACKUP_MACHINE_REGS();
|
||||
t = Yap_TermToString(t, buf, sze, flags);
|
||||
if ((b = Yap_TermToString(t, buf, sze, &length, &enc, flags)) != buf) {
|
||||
if (b) free(b);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return FALSE;
|
||||
}
|
||||
RECOVER_MACHINE_REGS();
|
||||
return t;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API char *
|
||||
YAP_WriteDynamicBuffer(Term t, char *buf, size_t sze, size_t *lengthp, int *encp, int flags)
|
||||
{
|
||||
int enc;
|
||||
char *b;
|
||||
|
||||
BACKUP_MACHINE_REGS();
|
||||
b = Yap_TermToString(t, buf, sze, lengthp, encp, flags);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return b;
|
||||
}
|
||||
|
||||
X_API char *
|
||||
@ -3165,7 +3186,7 @@ YAP_Init(YAP_init_args *yap_init)
|
||||
Yap_AttsSize = 2048*sizeof(CELL);
|
||||
if (restore_result == DO_ONLY_CODE) {
|
||||
/* first, initialise the saved state */
|
||||
Term t_goal = MkAtomTerm(AtomStartupSavedState);
|
||||
Term t_goal = MkAtomTerm(AtomInitProlog);
|
||||
YAP_RunGoalOnce(t_goal);
|
||||
Yap_InitYaamRegs();
|
||||
/* reset stacks */
|
||||
|
||||
19
C/iopreds.c
19
C/iopreds.c
@ -1090,6 +1090,24 @@ Yap_InitBackIO (void)
|
||||
{
|
||||
}
|
||||
|
||||
/* used to test writebuffer
|
||||
static Int
|
||||
p_write_string( USES_REGS1 )
|
||||
{
|
||||
Term in = Deref(ARG1);
|
||||
char *s;
|
||||
size_t length;
|
||||
int encoding;
|
||||
char buf[256];
|
||||
|
||||
if ((s = Yap_TermToString( in, NULL, 0, &length, &encoding, 0)))
|
||||
fprintf(stderr,"%ld %s\n",length, s);
|
||||
if ((s = Yap_TermToString( in, buf, 256, &length, &encoding, 0)))
|
||||
fprintf(stderr,"%ld %s\n",length, s);
|
||||
return TRUE;
|
||||
}
|
||||
*/
|
||||
|
||||
|
||||
void
|
||||
Yap_InitIOPreds(void)
|
||||
@ -1101,6 +1119,7 @@ Yap_InitIOPreds(void)
|
||||
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
|
||||
Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
|
||||
/* test predicate Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag); */
|
||||
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
|
||||
65
C/pl-yap.c
65
C/pl-yap.c
@ -836,7 +836,72 @@ PL_get_chars(term_t t, char **s, unsigned flags)
|
||||
{ return PL_get_nchars(t, NULL, s, flags);
|
||||
}
|
||||
|
||||
char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags);
|
||||
|
||||
char *
|
||||
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags)
|
||||
{
|
||||
CACHE_REGS
|
||||
Int l;
|
||||
|
||||
Yap_StartSlots( PASS_REGS1 );
|
||||
l = Yap_InitSlot(t);
|
||||
|
||||
{ IOENC encodings[3];
|
||||
IOENC *enc;
|
||||
char *r, buf[256];
|
||||
|
||||
encodings[0] = ENC_ISO_LATIN_1;
|
||||
encodings[1] = ENC_WCHAR;
|
||||
encodings[2] = ENC_UNKNOWN;
|
||||
|
||||
for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
|
||||
{
|
||||
int64_t size;
|
||||
IOSTREAM *fd;
|
||||
|
||||
if (s) {
|
||||
r = s;
|
||||
} else {
|
||||
r = buf;
|
||||
}
|
||||
fd = Sopenmem(&r, &sz, "w");
|
||||
fd->encoding = *enc;
|
||||
if ( PL_write_term(fd, l, 1200, flags) &&
|
||||
Sputcode(EOS, fd) >= 0 &&
|
||||
Sflush(fd) >= 0 )
|
||||
{ *encoding = *enc;
|
||||
size = Stell64(fd);
|
||||
if ( *enc == ENC_ISO_LATIN_1 )
|
||||
{
|
||||
*length = size-1;
|
||||
} else
|
||||
{
|
||||
*length = (size/sizeof(pl_wchar_t))-1;
|
||||
}
|
||||
/* found, just check if using local space */
|
||||
if (r == buf) {
|
||||
char *bf = malloc(*length+1);
|
||||
if (!bf)
|
||||
return NULL;
|
||||
strncpy(bf,buf,*length+1);
|
||||
r = bf;
|
||||
}
|
||||
/* go away */
|
||||
Yap_CloseSlots( PASS_REGS1 );
|
||||
return r;
|
||||
} else
|
||||
{ Sclose(fd);
|
||||
}
|
||||
}
|
||||
/* failed */
|
||||
if ( r != s && r != buf ) {
|
||||
Sfree(r);
|
||||
}
|
||||
}
|
||||
Yap_CloseSlots( PASS_REGS1 );
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
X_API int
|
||||
|
||||
11
C/qlyr.c
11
C/qlyr.c
@ -999,9 +999,13 @@ p_read_module_preds( USES_REGS1 )
|
||||
}
|
||||
|
||||
static void
|
||||
ReInitCatch(void)
|
||||
ReInitProlog(void)
|
||||
{
|
||||
Term t = Yap_MkNewApplTerm(PredHandleThrow->FunctorOfPred, PredHandleThrow->ArityOfPE);
|
||||
Term t = MkAtomTerm(AtomInitProlog);
|
||||
#if defined(YAPOR) || defined(TABLING)
|
||||
Yap_init_root_frames();
|
||||
#endif /* YAPOR || TABLING */
|
||||
Yap_InitYaamRegs();
|
||||
YAP_RunGoalOnce(t);
|
||||
}
|
||||
|
||||
@ -1030,7 +1034,7 @@ p_read_program( USES_REGS1 )
|
||||
Sclose( stream );
|
||||
/* back to the top level we go */
|
||||
Yap_CloseSlots(PASS_REGS1);
|
||||
ReInitCatch();
|
||||
ReInitProlog();
|
||||
Yap_RestartYap( 3 );
|
||||
return TRUE;
|
||||
}
|
||||
@ -1044,7 +1048,6 @@ Yap_Restore(char *s, char *lib_dir)
|
||||
return -1;
|
||||
read_module(stream);
|
||||
Sclose( stream );
|
||||
ReInitCatch();
|
||||
return DO_ONLY_CODE;
|
||||
}
|
||||
|
||||
|
||||
@ -135,6 +135,7 @@
|
||||
AtomId = Yap_LookupAtom("id");
|
||||
AtomInf = Yap_LookupAtom("inf");
|
||||
AtomInitGoal = Yap_FullLookupAtom("$init_goal");
|
||||
AtomInitProlog = Yap_FullLookupAtom("$init_prolog");
|
||||
AtomInStackExpansion = Yap_LookupAtom("in stack expansion");
|
||||
AtomInput = Yap_LookupAtom("input");
|
||||
AtomInstantiationError = Yap_LookupAtom("instantiation_error");
|
||||
|
||||
@ -135,6 +135,7 @@
|
||||
AtomId = AtomAdjust(AtomId);
|
||||
AtomInf = AtomAdjust(AtomInf);
|
||||
AtomInitGoal = AtomAdjust(AtomInitGoal);
|
||||
AtomInitProlog = AtomAdjust(AtomInitProlog);
|
||||
AtomInStackExpansion = AtomAdjust(AtomInStackExpansion);
|
||||
AtomInput = AtomAdjust(AtomInput);
|
||||
AtomInstantiationError = AtomAdjust(AtomInstantiationError);
|
||||
|
||||
@ -268,6 +268,8 @@
|
||||
#define AtomInf Yap_heap_regs->AtomInf_
|
||||
Atom AtomInitGoal_;
|
||||
#define AtomInitGoal Yap_heap_regs->AtomInitGoal_
|
||||
Atom AtomInitProlog_;
|
||||
#define AtomInitProlog Yap_heap_regs->AtomInitProlog_
|
||||
Atom AtomInStackExpansion_;
|
||||
#define AtomInStackExpansion Yap_heap_regs->AtomInStackExpansion_
|
||||
Atom AtomInput_;
|
||||
|
||||
@ -278,11 +278,11 @@ int STD_PROTO(Yap_GetCharForSIGINT,(void));
|
||||
Int STD_PROTO(Yap_StreamToFileNo,(Term));
|
||||
Term STD_PROTO(Yap_OpenStream,(FILE *,char *,Term,int));
|
||||
Term STD_PROTO(Yap_StringToTerm,(char *,Term *));
|
||||
Term STD_PROTO(Yap_TermToString,(Term,char *,unsigned int,int));
|
||||
int STD_PROTO(Yap_GetFreeStreamD,(void));
|
||||
int STD_PROTO(Yap_GetFreeStreamDForReading,(void));
|
||||
char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, int *encoding, int flags);
|
||||
int Yap_GetFreeStreamD(void);
|
||||
int Yap_GetFreeStreamDForReading(void);
|
||||
|
||||
Term STD_PROTO(Yap_WStringToList,(wchar_t *));
|
||||
Term Yap_WStringToList(wchar_t *);
|
||||
Term STD_PROTO(Yap_WStringToListOfAtoms,(wchar_t *));
|
||||
Atom STD_PROTO(Yap_LookupWideAtom,(wchar_t *));
|
||||
|
||||
|
||||
@ -714,6 +714,7 @@ all: startup.yss
|
||||
@ENABLE_REAL@ (cd packages/real; $(MAKE))
|
||||
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE))
|
||||
@ENABLE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE))
|
||||
@ENABLE_LIBARCHIVE@ @INSTALL_DLLS@ (cd packages/archive; $(MAKE))
|
||||
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE))
|
||||
@ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE))
|
||||
@ENABLE_CPLINT@ (cd packages/cplint; $(MAKE))
|
||||
@ -785,6 +786,7 @@ install_unix: startup.yss libYap.a
|
||||
@ENABLE_SEMWEB@ @INSTALL_DLLS@ (cd packages/semweb; $(MAKE) install)
|
||||
@ENABLE_SGML@ @INSTALL_DLLS@ (cd packages/sgml; $(MAKE) install)
|
||||
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) @ZLIB_INSTALL@)
|
||||
@ENABLE_LIBARCHIVE@ @INSTALL_DLLS@ (cd packages/archive; $(MAKE) install)
|
||||
@ENABLE_CLPBN_BP@ @INSTALL_DLLS@ (cd packages/CLPBN/horus; $(MAKE) install)
|
||||
@ENABLE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE) install)
|
||||
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE) install)
|
||||
|
||||
176
configure.in
176
configure.in
@ -657,6 +657,7 @@ AC_CHECK_TOOL(MPI_CC,mpicc,${CC})
|
||||
AC_PATH_PROG(INSTALL_INFO,install-info,true,$PATH:/sbin:/usr/sbin:/usr/etc:/usr/local/sbin)
|
||||
AC_PATH_PROG(SHELL,sh)
|
||||
|
||||
|
||||
dnl Check for libraries.
|
||||
dnl mingw does not get along well with libm
|
||||
dnl cygnus and mingw32 also need wsock32 to use sockets.
|
||||
@ -725,16 +726,29 @@ else
|
||||
AC_CHECK_LIB(nss_files,main)
|
||||
AC_CHECK_LIB(nss_dns,main)
|
||||
AC_CHECK_LIB(resolv,main)
|
||||
if test "$prefix" != "NONE"; then
|
||||
if test -d "${prefix}/lib64" -a "$YAP_TARGET" = amd64; then
|
||||
LDFLAGS="$LDFLAGS -L${prefix}/lib64"
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L${prefix}/lib"
|
||||
CPPFLAGS="$CPPFLAGS -I${prefix}/include"
|
||||
fi
|
||||
if test "$exec_prefix" != "NONE"; then
|
||||
if test -d "${exec_prefix}/lib64" -a "$YAP_TARGET" = amd64; then
|
||||
LDFLAGS="$LDFLAGS -L${exec_prefix}/lib64"
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L${exec_prefix}/lib"
|
||||
fi
|
||||
fi
|
||||
|
||||
if test "$yap_cv_readline" != "no"
|
||||
then
|
||||
AC_CHECK_LIB([ncurses], [main],[
|
||||
LIBS="$LIBS -lncurses"
|
||||
LDFLAGS="$LDFLAGS -lncurses"
|
||||
])
|
||||
AC_CHECK_LIB([readline], [main],[
|
||||
AC_DEFINE([HAVE_LIBREADLINE], [1],[Define if you have libreadline])
|
||||
LIBS="$LIBS -lreadline"
|
||||
LIBS="$LDFLAGS -lreadline"
|
||||
],
|
||||
[if test "x$with_readline" != xcheck; then
|
||||
AC_MSG_FAILURE(
|
||||
@ -951,6 +965,12 @@ else
|
||||
fi
|
||||
AC_SUBST(ENABLE_PRISM)
|
||||
|
||||
if test -e "$srcdir"/packages/archive/Makefile.in; then
|
||||
ENABLE_LIBARCHIVE=""
|
||||
else
|
||||
ENABLE_LIBARCHIVE="@# "
|
||||
fi
|
||||
|
||||
if test "$use_chr" = no; then
|
||||
ENABLE_CHR="@# "
|
||||
elif test -e "$srcdir"/packages/chr/Makefile.in; then
|
||||
@ -1038,20 +1058,20 @@ elif test -e "$srcdir"/packages/jpl/Makefile.in; then
|
||||
else
|
||||
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib"
|
||||
fi
|
||||
JAVACFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/win32"
|
||||
JPLCFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/win32"
|
||||
;;
|
||||
*darwin*)
|
||||
LIBS="$LIBS -framework JavaVM"
|
||||
JAVALIBS="-L/System/Library/Frameworks/JavaVM.framework/Libraries -Wl,-framework,JavaVM"
|
||||
JAVACFLAGS="-I/System/Library/Frameworks/JavaVM.framework/Headers"
|
||||
JPLCFLAGS="-I/System/Library/Frameworks/JavaVM.framework/Headers"
|
||||
;;
|
||||
*)
|
||||
case "$target_os" in
|
||||
*linux*)
|
||||
JAVACFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/linux"
|
||||
JPLCFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/linux"
|
||||
;;
|
||||
*solaris*)
|
||||
JAVACFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/solaris"
|
||||
JPLCFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/solaris"
|
||||
;;
|
||||
esac
|
||||
JAVALIBS="-L$JAVA_HOME/jre/lib/$YAP_TARGET -L$JAVA_HOME/jre/lib/$YAP_TARGET/client -L$JAVA_HOME/jre/lib/$YAP_TARGET/server -Wl,-R,$JAVA_HOME/jre/lib/$YAP_TARGET -ljava -lverify -ljvm "
|
||||
@ -1607,39 +1627,6 @@ AC_SUBST(ENABLE_CPLINT)
|
||||
AC_SUBST(INSTALL_ENV)
|
||||
AC_SUBST(PRE_INSTALL_ENV)
|
||||
|
||||
dnl zlib
|
||||
if test "$ENABLE_ZLIB" = ""
|
||||
then
|
||||
|
||||
AC_CHECK_LIB(z, zlibVersion,
|
||||
ZLIBS="-lz"
|
||||
ZLIB=yes,
|
||||
ZLIB=no)
|
||||
|
||||
if test "$ZLIB" = yes; then
|
||||
ZLIB_TARGETS="zlib4pl.$SO"
|
||||
ZLIB_PLTARGETS='zlib.pl'
|
||||
ZLIB_INSTALL=install
|
||||
else
|
||||
ZLIB_TARGETS=nolib
|
||||
ZLIB_INSTALL=nolib
|
||||
cat << EOF
|
||||
##################################################################
|
||||
# ERROR: Could not find library zlib (-lz). Dropped library(zlib)
|
||||
# Library zlib is available from http://www.zlib.net/
|
||||
# Most Unix/Linux distributions are shipped with binaries. Make
|
||||
# sure to have the development library installed.
|
||||
##################################################################
|
||||
EOF
|
||||
fi
|
||||
|
||||
AC_SUBST(ZLIBS)
|
||||
AC_SUBST(ZLIB_TARGETS)
|
||||
AC_SUBST(ZLIB_PLTARGETS)
|
||||
AC_SUBST(ZLIB_INSTALL)
|
||||
|
||||
fi
|
||||
|
||||
dnl Checks for header files.
|
||||
AC_HEADER_STDC
|
||||
AC_HEADER_SYS_WAIT
|
||||
@ -1725,6 +1712,7 @@ fi
|
||||
AC_SUBST(M4)
|
||||
AC_SUBST(M4GENHDRS)
|
||||
|
||||
CMDEXT=sh
|
||||
dnl SWI compatibility, I don't know why just use host...
|
||||
changequote(,)dnl
|
||||
if test "x$ARCH" = "x"; then
|
||||
@ -1743,6 +1731,8 @@ fi
|
||||
changequote([,])dnl
|
||||
AC_SUBST(ARCH)
|
||||
|
||||
CMDEXT=sh
|
||||
|
||||
dnl System stuff for dynamic linking.
|
||||
dnl
|
||||
dnl Exports:
|
||||
@ -1804,13 +1794,16 @@ AC_SUBST(MPI_OBJS)
|
||||
AC_SUBST(MPI_LIBS)
|
||||
AC_SUBST(INSTALL_COMMAND)
|
||||
AC_SUBST(INSTALLCLP)
|
||||
AC_SUBST(JPLCFLAGS)
|
||||
AC_SUBST(JPLLIBS)
|
||||
AC_SUBST(JAVALIBS)
|
||||
AC_SUBST(JAVACFLAGS)
|
||||
AC_SUBST(JPLCFLAGS)
|
||||
AC_SUBST(LAMOBJS)
|
||||
AC_SUBST(MAX_WORKERS)
|
||||
AC_SUBST(STATIC_MODE)
|
||||
AC_SUBST(ENABLE_WINCONSOLE)
|
||||
AC_SUBST(EXTRA_INCLUDES_FOR_WIN32)
|
||||
AC_SUBST(CMDEXT)
|
||||
|
||||
AC_SUBST(ENABLE_CUDD)
|
||||
AC_SUBST(ENABLE_BDDLIB)
|
||||
@ -2281,6 +2274,104 @@ else
|
||||
ENABLE_MINISAT=""
|
||||
fi
|
||||
|
||||
dnl zlib
|
||||
if test "$ENABLE_ZLIB" = ""
|
||||
then
|
||||
|
||||
AC_CHECK_LIB(z, zlibVersion,
|
||||
ZLIBS="-lz"
|
||||
ZLIB=yes,
|
||||
ZLIB=no)
|
||||
|
||||
if test "$ZLIB" = yes; then
|
||||
ZLIB_TARGETS="zlib4pl.$SO"
|
||||
ZLIB_PLTARGETS='zlib.pl'
|
||||
ZLIB_INSTALL=install
|
||||
else
|
||||
ZLIB_TARGETS=nolib
|
||||
ZLIB_INSTALL=nolib
|
||||
cat << EOF
|
||||
##################################################################
|
||||
# ERROR: Could not find library zlib (-lz). Dropped library(zlib)
|
||||
# Library zlib is available from http://www.zlib.net/
|
||||
# Most Unix/Linux distributions are shipped with binaries. Make
|
||||
# sure to have the development library installed.
|
||||
##################################################################
|
||||
EOF
|
||||
fi
|
||||
|
||||
AC_SUBST(ZLIBS)
|
||||
AC_SUBST(ZLIB_TARGETS)
|
||||
AC_SUBST(ZLIB_PLTARGETS)
|
||||
AC_SUBST(ZLIB_INSTALL)
|
||||
|
||||
fi
|
||||
|
||||
dnl zlib
|
||||
if test "$ENABLE_LIBARCHIVE" = ""
|
||||
then
|
||||
OLD_LIBS=$LIBS
|
||||
|
||||
AC_CHECK_HEADER(archive.h,
|
||||
[ AC_DEFINE([HAVE_ARCHIVE_H], 1,
|
||||
[Define to 1 if you have <archive.h>.])
|
||||
ARCHIVEH=yes
|
||||
],
|
||||
ARCHIVEH=no)
|
||||
|
||||
if test "$ARCHIVEH" = yes; then
|
||||
AC_CHECK_LIB(archive, archive_read_new,
|
||||
ARCHIVE_LIBS="-larchive"
|
||||
ARCHIVELIB=yes,
|
||||
ARCHIVELIB=no)
|
||||
fi
|
||||
|
||||
AC_CHECK_FUNCS(archive_read_support_compression_bzip2 \
|
||||
archive_read_support_compression_compress \
|
||||
archive_read_support_compression_gzip \
|
||||
archive_read_support_compression_lzma \
|
||||
archive_read_support_compression_none \
|
||||
archive_read_support_compression_xz)
|
||||
|
||||
AC_CHECK_FUNCS(archive_read_support_format_ar \
|
||||
archive_read_support_format_cpio \
|
||||
archive_read_support_format_empty \
|
||||
archive_read_support_format_iso9660 \
|
||||
archive_read_support_format_mtree \
|
||||
archive_read_support_format_raw \
|
||||
archive_read_support_format_tar \
|
||||
archive_read_support_format_zip)
|
||||
|
||||
if test "$ARCHIVELIB" = yes; then
|
||||
ARCHIVE_TARGETS="archive4pl.$SO"
|
||||
ARCHIVE_PLTARGETS=archive.pl
|
||||
else
|
||||
ARCHIVE_TARGETS=nolib
|
||||
cat << EOF
|
||||
##################################################################
|
||||
# ERROR: Could not find library archive (-larchive). Dropped
|
||||
# library(archive). Library archive is available from
|
||||
# http://code.google.com/p/libarchive/
|
||||
#
|
||||
# Most Unix/Linux distributions are shipped with binaries. Make
|
||||
# sure to have the development library installed. E.g.
|
||||
#
|
||||
# Debian/Ubuntu/Mint: aptitude install libarchive-dev
|
||||
# Fedora/... yum install libarchive-devel
|
||||
# MacOS (Macports): port install libarchive
|
||||
##################################################################
|
||||
EOF
|
||||
|
||||
fi
|
||||
|
||||
AC_SUBST(ARCHIVE_LIBS)
|
||||
AC_SUBST(ARCHIVE_TARGETS)
|
||||
AC_SUBST(ARCHIVE_PLTARGETS)
|
||||
|
||||
fi
|
||||
|
||||
AC_SUBST(ENABLE_LIBARCHIVE)
|
||||
|
||||
mkdir -p library/lammpi
|
||||
mkdir -p library/matrix
|
||||
mkdir -p library/matlab
|
||||
@ -2340,6 +2431,7 @@ mkdir -p packages/semweb
|
||||
mkdir -p packages/sgml
|
||||
mkdir -p packages/xml
|
||||
mkdir -p packages/zlib
|
||||
mkdir -p packages/archive
|
||||
|
||||
AC_CONFIG_FILES([Makefile])
|
||||
AC_CONFIG_FILES([GPL/Makefile])
|
||||
@ -2418,6 +2510,10 @@ if test "$ENABLE_ZLIB" = ""; then
|
||||
AC_CONFIG_FILES([packages/zlib/Makefile])
|
||||
fi
|
||||
|
||||
if test "$ENABLE_LIBARCHIVE" = ""; then
|
||||
AC_CONFIG_FILES([packages/archive/Makefile])
|
||||
fi
|
||||
|
||||
|
||||
if test "$ENABLE_CUDD" = ""; then
|
||||
AC_CONFIG_FILES([packages/bdd/Makefile])
|
||||
|
||||
41
docs/yap.tex
41
docs/yap.tex
@ -9651,12 +9651,21 @@ applying the predicate @var{Pred} to all list elements on which
|
||||
Calls @var{Pred} on all elements of @code{List} and collects a result in
|
||||
@var{X} and @var{Y}.
|
||||
|
||||
@item foldl3(:@var{Pred}, +@var{List}, ?@var{X0}, ?@var{X}, ?@var{Y0}, ?@var{Y}, ?@var{Z0}, ?@var{Z})
|
||||
@item foldl2(:@var{Pred}, +@var{List}, ?@var{List1}, ?@var{X0}, ?@var{X}, ?@var{Y0}, ?@var{Y})
|
||||
@findex foldl2/7
|
||||
@snindex foldl2/7
|
||||
@cnindex foldl2/7
|
||||
Calls @var{Pred} on all elements of @code{List} and collects a result in
|
||||
@var{X} and @var{Y}.
|
||||
|
||||
@item foldl3(:@var{Pred}, +@var{List1}, ?@var{List2}, ?@var{X0},
|
||||
?@var{X}, ?@var{Y0}, ?@var{Y}, ?@var{Z0}, ?@var{Z})
|
||||
|
||||
@findex foldl3/6
|
||||
@snindex foldl3/6
|
||||
@cnindex foldl3/6
|
||||
Calls @var{Pred} on all elements of @code{List} and collects a result in
|
||||
@var{X}, @var{Y} and @var{Z}.
|
||||
Calls @var{Pred} on all elements of @code{List} and collects a
|
||||
result in @var{X}, @var{Y} and @var{Z}.
|
||||
|
||||
@item scanl(:@var{Pred}, +@var{List}, +@var{V0}, ?@var{Values})
|
||||
@findex scanl/4
|
||||
@ -17725,14 +17734,28 @@ characters. The term is written according to a mask of the following
|
||||
flags in the @code{flag} argument: @code{YAP_WRITE_QUOTED},
|
||||
@code{YAP_WRITE_HANDLE_VARS}, @code{YAP_WRITE_USE_PORTRAY}, and @code{YAP_WRITE_IGNORE_OPS}.
|
||||
|
||||
@item @code{void} YAP_WriteBuffer(@code{YAP_Term} @var{t}, @code{char *}
|
||||
@var{buff}, @code{unsigned int}
|
||||
@item @code{int} YAP_WriteBuffer(@code{YAP_Term} @var{t}, @code{char *}
|
||||
@var{buff}, @code{size_t}
|
||||
@var{size}, @code{int} @var{flags})
|
||||
@findex YAP_WriteBuffer/4
|
||||
Write a YAP_Term @var{t} to buffer @var{buff} with size @var{size}. The
|
||||
term is written according to a mask of the following flags in the
|
||||
@code{flag} argument: @code{YAP_WRITE_QUOTED},
|
||||
@code{YAP_WRITE_HANDLE_VARS}, and @code{YAP_WRITE_IGNORE_OPS}.
|
||||
Write a YAP_Term @var{t} to buffer @var{buff} with size
|
||||
@var{size}. The term is written
|
||||
according to a mask of the following flags in the @code{flag}
|
||||
argument: @code{YAP_WRITE_QUOTED}, @code{YAP_WRITE_HANDLE_VARS},
|
||||
@code{YAP_WRITE_USE_PORTRAY}, and @code{YAP_WRITE_IGNORE_OPS}. The
|
||||
function will fail if it does not have enough space in the buffer.
|
||||
|
||||
@item @code{char *} YAP_WriteDynamicBuffer(@code{YAP_Term} @var{t}, @code{char *}
|
||||
@var{buff}, @code{size_t}
|
||||
@var{size}, @code{size_t}
|
||||
@var{*lengthp}, @code{size_t}
|
||||
@var{*encodingp}, @code{int} @var{flags})
|
||||
@findex YAP_WriteDynamicBuffer/6
|
||||
Write a YAP_Term @var{t} to buffer @var{buff} with size
|
||||
@var{size}. The code will allocate an extra buffer if @var{buff} is
|
||||
@code{NULL} or if @code{buffer} does not have enough room. The
|
||||
variable @code{lengthp} is assigned the size of the resulting buffer,
|
||||
and @code{encodingp} will receive the type of encoding (currently only @code{PL_ENC_ISO_LATIN_1} and @code{PL_ENC_WCHAR} are supported)
|
||||
|
||||
@item @code{void} YAP_InitConsult(@code{int} @var{mode}, @code{char *} @var{filename})
|
||||
@findex YAP_InitConsult/2
|
||||
|
||||
@ -329,7 +329,7 @@ extern X_API YAP_Term PROTO(YAP_Read,(void *));
|
||||
extern X_API void PROTO(YAP_Write,(YAP_Term,void *,int));
|
||||
|
||||
/* void YAP_WriteBufffer(YAP_Term,char *,unsgined int,int) */
|
||||
extern X_API void PROTO(YAP_WriteBuffer,(YAP_Term,char *,unsigned int,int));
|
||||
extern X_API int PROTO(YAP_WriteBuffer,(YAP_Term,char *,size_t,int));
|
||||
|
||||
/* void YAP_Term(YAP_Term) */
|
||||
extern X_API YAP_Term PROTO(YAP_CopyTerm,(YAP_Term));
|
||||
|
||||
@ -255,6 +255,21 @@ typedef enum
|
||||
YAPC_COMPILE_ALL /* compile all predicates */
|
||||
} yapc_exec_mode;
|
||||
|
||||
/********* encoding ***********************/
|
||||
|
||||
typedef enum
|
||||
{ PL_ENC_UNKNOWN = 0, /* invalid/unknown */
|
||||
PL_ENC_OCTET, /* raw 8 bit input */
|
||||
PL_ENC_ASCII, /* US-ASCII (0..127) */
|
||||
PL_ENC_ISO_LATIN_1, /* ISO Latin-1 (0..256) */
|
||||
PL_ENC_ANSI, /* default (multibyte) codepage */
|
||||
PL_ENC_UTF8,
|
||||
PL_ENC_UNICODE_BE, /* big endian unicode file */
|
||||
PL_ENC_UNICODE_LE, /* little endian unicode file */
|
||||
PL_ENC_WCHAR /* pl_wchar_t */
|
||||
} PL_IOENC;
|
||||
|
||||
|
||||
/********* YAP C-Flags ***********************/
|
||||
|
||||
typedef enum
|
||||
|
||||
@ -2868,22 +2868,6 @@ Yap_read_term(term_t t, IOSTREAM *st, term_t *excep, term_t vs)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
|
||||
{
|
||||
CACHE_REGS
|
||||
IOSTREAM *stream = Sopen_string(NULL, s, sz, "w");
|
||||
int out;
|
||||
|
||||
if (!stream)
|
||||
return FALSE;
|
||||
Yap_StartSlots( PASS_REGS1 );
|
||||
out = PL_write_term(stream, Yap_InitSlot(t PASS_REGS), 1200, 0);
|
||||
Yap_CloseSlots( PASS_REGS1 );
|
||||
Sclose(stream);
|
||||
return out;
|
||||
}
|
||||
|
||||
extern atom_t fileNameStream(IOSTREAM *s);
|
||||
extern Atom Yap_FileName(IOSTREAM *s);
|
||||
|
||||
|
||||
@ -140,6 +140,7 @@ A IOMode N "io_mode"
|
||||
A Id N "id"
|
||||
A Inf N "inf"
|
||||
A InitGoal F "$init_goal"
|
||||
A InitProlog F "$init_prolog"
|
||||
A InStackExpansion N "in stack expansion"
|
||||
A Input N "input"
|
||||
A InstantiationError N "instantiation_error"
|
||||
|
||||
@ -57,6 +57,7 @@ CLPBN_PROGRAMS= \
|
||||
$(CLPBN_SRCDIR)/horus_lifted.yap \
|
||||
$(CLPBN_SRCDIR)/jt.yap \
|
||||
$(CLPBN_SRCDIR)/matrix_cpt_utils.yap \
|
||||
$(CLPBN_SRCDIR)/numbers.yap \
|
||||
$(CLPBN_SRCDIR)/pgrammar.yap \
|
||||
$(CLPBN_SRCDIR)/table.yap \
|
||||
$(CLPBN_SRCDIR)/topsort.yap \
|
||||
|
||||
@ -65,7 +65,8 @@
|
||||
:- use_module('clpbn/bdd',
|
||||
[bdd/3,
|
||||
init_bdd_solver/4,
|
||||
run_bdd_solver/3
|
||||
run_bdd_solver/3,
|
||||
call_bdd_ground_solver/6
|
||||
]).
|
||||
|
||||
%% :- use_module('clpbn/bnt',
|
||||
@ -306,7 +307,7 @@ write_out(jt, GVars, AVars, DiffVars) :-
|
||||
write_out(bdd, GVars, AVars, DiffVars) :-
|
||||
bdd(GVars, AVars, DiffVars).
|
||||
write_out(bp, _GVars, _AVars, _DiffVars) :-
|
||||
writeln('interface not supported anymore').
|
||||
writeln('interface not supported any longer').
|
||||
%bp(GVars, AVars, DiffVars).
|
||||
write_out(gibbs, GVars, AVars, DiffVars) :-
|
||||
gibbs(GVars, AVars, DiffVars).
|
||||
@ -318,13 +319,15 @@ write_out(fove, GVars, AVars, DiffVars) :-
|
||||
% call a solver with keys, not actual variables
|
||||
call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
|
||||
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
|
||||
call_ground_solver(bdd, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
|
||||
call_bdd_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
|
||||
call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
|
||||
% traditional solver
|
||||
b_hash_new(Hash0),
|
||||
foldl(gvar_in_hash, GVars, Hash0, HashI),
|
||||
foldl(key_to_var, Keys, AllVars, HashI, Hash1),
|
||||
foldl(evidence_to_v, Evidence, _EVars, Hash1, Hash),
|
||||
writeln(Keys:AllVars),
|
||||
%writeln(Keys:AllVars),
|
||||
maplist(factor_to_dist(Hash), Factors),
|
||||
% evidence
|
||||
retract(use_parfactors(on)),
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
%
|
||||
%
|
||||
% generate explicit CPTs
|
||||
%
|
||||
:- module(clpbn_aggregates, [
|
||||
@ -6,7 +6,8 @@
|
||||
cpt_average/6,
|
||||
cpt_average/7,
|
||||
cpt_max/6,
|
||||
cpt_min/6
|
||||
cpt_min/6,
|
||||
avg_factors/5
|
||||
]).
|
||||
|
||||
:- use_module(library(clpbn), [{}/1]).
|
||||
@ -25,14 +26,22 @@
|
||||
matrix_to_list/2,
|
||||
matrix_set/3]).
|
||||
|
||||
:- use_module(library('clpbn/dists'),
|
||||
:- use_module(library(clpbn/dists),
|
||||
[
|
||||
add_dist/6,
|
||||
get_dist_domain_size/2]).
|
||||
|
||||
:- use_module(library('clpbn/matrix_cpt_utils'),
|
||||
:- use_module(library(clpbn/matrix_cpt_utils),
|
||||
[normalise_CPT_on_lines/3]).
|
||||
|
||||
:- use_module(library(pfl),
|
||||
[skolem/2,
|
||||
add_ground_factor/5]).
|
||||
|
||||
:- use_module(library(bhash)).
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
check_for_agg_vars([], []).
|
||||
check_for_agg_vars([V|Vs0], [V|Vs1]) :-
|
||||
clpbn:get_atts(V, [key(K), dist(Id,Parents)]), !,
|
||||
@ -49,6 +58,87 @@ simplify_dist(avg(Domain), V, Key, Parents, Vs0, VsF) :- !,
|
||||
clpbn:put_atts(V, [dist(Id,Ps)]).
|
||||
simplify_dist(_, _, _, _, Vs0, Vs0).
|
||||
|
||||
%
|
||||
avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
|
||||
% we keep ev as a list
|
||||
skolem(Key, Domain),
|
||||
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
|
||||
|
||||
% there are 4 cases:
|
||||
% no evidence on top node
|
||||
% evidence on top node compatible with values of parents
|
||||
% evidence on top node *entailed* by values of parents (so there is no real connection)
|
||||
% evidence incompatible with parents
|
||||
query_evidence(Key, EvHash, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
|
||||
b_hash_lookup(Key, Ev, EvHash), !,
|
||||
normalise_CPT_on_lines(MAT0, MAT1, L1),
|
||||
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
|
||||
query_evidence(_, _, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
|
||||
|
||||
hash_ev(K=V, Es0, Es) :-
|
||||
b_hash_insert(Es0, K, V, Es).
|
||||
|
||||
find_ev(Ev, Key, RemKeys, RemKeys, Ev0, EvF) :-
|
||||
b_hash_lookup(Key, V, Ev), !,
|
||||
EvF is Ev0+V.
|
||||
find_ev(_Evs, Key, RemKeys, [Key|RemKeys], Ev, Ev).
|
||||
|
||||
|
||||
% +Vars -> Keys without ev
|
||||
% +all keys
|
||||
% +domain to project to
|
||||
% +ouput key
|
||||
% +sum of evidence
|
||||
% +softness
|
||||
% +final CPT
|
||||
% - New Parents
|
||||
% + - list of new keys
|
||||
%
|
||||
avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, Vars, Vs, Vs, Id) :-
|
||||
length(Domain, SDomain),
|
||||
int_power(Vars, SDomain, 1, TabSize),
|
||||
TabSize =< 256,
|
||||
/* case gmp is not there !! */
|
||||
TabSize > 0, !,
|
||||
average_cpt(Vars, OVars, Domain, TotEvidence, Softness, CPT),
|
||||
matrix_to_list(CPT, Mat),
|
||||
add_ground_factor(bayes, Domain, [Key|OVars], Mat, Id).
|
||||
avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, [V1,V2], Vs, [V1,V2|NewVs], Id) :-
|
||||
length(Vars,L),
|
||||
LL1 is L//2,
|
||||
LL2 is L-LL1,
|
||||
list_split(LL1, Vars, L1, L2),
|
||||
Min = 0,
|
||||
length(Domain,Max1), Max is Max1-1,
|
||||
intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
|
||||
intermediate_table(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
|
||||
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT),
|
||||
matrix_to_list(CPT, Mat),
|
||||
add_ground_factor(bayes, Domain, [Key,V1,V2], Mat, Id).
|
||||
|
||||
intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !.
|
||||
intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !,
|
||||
If is I0+1,
|
||||
extra_key_factor(Op, 2, [V1,V2], V, Key, Softness, I0).
|
||||
intermediate_table(N, Op, L, V, Key, Softness, I0, If, Vs, [V1,V2|NewVs]) :-
|
||||
LL1 is N//2,
|
||||
LL2 is N-LL1,
|
||||
list_split(LL1, L, L1, L2),
|
||||
I1 is I0+1,
|
||||
intermediate_table(LL1, Op, L1, V1, Key, Softness, I1, I2, Vs, Vs1),
|
||||
intermediate_table(LL2, Op, L2, V2, Key, Softness, I2, If, Vs1, NewVs),
|
||||
extra_key_factor(Op, N, [V1,V2], V, Key, Softness, I0).
|
||||
|
||||
extra_key_factor(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :-
|
||||
Lower is Min*N,
|
||||
Upper is Max*N,
|
||||
generate_list(Lower, Upper, Nbs),
|
||||
sum_cpt([V1,V2], Nbs, Softness, CPT),
|
||||
V = 'AVG'(I,Key),
|
||||
add_ground_factor(bayes, Nbs, [V,V1,V2], CPT, Id),
|
||||
assert(pfl:currently_defined(V)),
|
||||
assert(pfl:f(bayes, Id, [V,V1,V2])).
|
||||
|
||||
cpt_average(AllVars, Key, Els0, Tab, Vs, NewVs) :-
|
||||
cpt_average(AllVars, Key, Els0, 1.0, Tab, Vs, NewVs).
|
||||
|
||||
@ -155,9 +245,6 @@ generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
|
||||
generate_tmp_random(min(Domain,CPT), _, [V1,V2], V, Key, I) :-
|
||||
generate_var('MIN'(I,Key), Domain, CPT, [V1,V2], V).
|
||||
|
||||
generate_var(VKey, Domain, CPT, Parents, VKey) :-
|
||||
clpbn:use_parfactors(on), !,
|
||||
pfl:add_ground_factor(bayes, Domain, [VKey|Parents], CPT).
|
||||
generate_var(VKey, Domain, CPT, Parents, V) :-
|
||||
{ V = VKey with tab(Domain, CPT, Parents) }.
|
||||
|
||||
@ -282,6 +369,10 @@ fill_in_min(_,_).
|
||||
|
||||
|
||||
get_vdist_size(V, Sz) :-
|
||||
var(V), !,
|
||||
clpbn:get_atts(V, [dist(Dist,_)]),
|
||||
get_dist_domain_size(Dist, Sz).
|
||||
get_vdist_size(V, Sz) :-
|
||||
skolem(V, Dom),
|
||||
length(Dom, Sz).
|
||||
|
||||
|
||||
@ -23,7 +23,8 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
|
||||
init_bdd_solver/4,
|
||||
run_bdd_solver/3,
|
||||
finalize_bdd_solver/1,
|
||||
check_if_bdd_done/1
|
||||
check_if_bdd_done/1,
|
||||
call_bdd_ground_solver/6
|
||||
]).
|
||||
|
||||
|
||||
@ -63,6 +64,10 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
|
||||
|
||||
:- use_module(library(matrix)).
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- use_module(library(clpbn/numbers)).
|
||||
|
||||
:- dynamic network_counting/1.
|
||||
|
||||
:- attribute order/1.
|
||||
@ -73,6 +78,39 @@ bdds(bdd).
|
||||
|
||||
check_if_bdd_done(_Var).
|
||||
|
||||
call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
|
||||
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
|
||||
clpbn_bind_vals([QueryVars], Solutions, Output).
|
||||
|
||||
call_bdd_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
|
||||
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
|
||||
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
|
||||
run_solver(QueryKeys, Solutions, BDD).
|
||||
|
||||
init_bdd(FactorIds, EvidenceIds, Hash, Id, bdd(Term, Leaves, Tops, Hash, Id)) :-
|
||||
sort_keys(FactorIds, AllVars, Leaves),
|
||||
rb_new(OrderVs0),
|
||||
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
|
||||
rb_new(Vars0),
|
||||
rb_new(Pars0),
|
||||
rb_new(Ev0),
|
||||
foldl(evtotree,EvidenceIds,Ev0,Ev),
|
||||
rb_new(Fs0),
|
||||
foldl(ftotree,FactorIds,Fs0,Fs),
|
||||
init_tops(Leaves,Tops),
|
||||
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
|
||||
|
||||
order_key( Id, I0, I, OrderVs0, OrderVs) :-
|
||||
I is I0+1,
|
||||
rb_insert(OrderVs0, Id, I0, OrderVs).
|
||||
|
||||
evtotree(K=V,Ev0,Ev) :-
|
||||
rb_insert(Ev0, K, V, Ev).
|
||||
|
||||
ftotree(F, Fs0, Fs) :-
|
||||
F = f([K|_Parents],_,_,_),
|
||||
rb_insert(Fs0, K, F, Fs).
|
||||
|
||||
bdd([[]],_,_) :- !.
|
||||
bdd([QueryVars], AllVars, AllDiffs) :-
|
||||
init_bdd_solver(_, AllVars, _, BayesNet),
|
||||
@ -90,6 +128,7 @@ init_bdd_solver(_, AllVars0, _, bdd(Term, Leaves, Tops)) :-
|
||||
init_tops(Leaves,Tops),
|
||||
get_vars_info(AllVars, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
|
||||
|
||||
|
||||
order_vars([], _).
|
||||
order_vars([V|AllVars], I0) :-
|
||||
put_atts(V, [order(I0)]),
|
||||
@ -101,6 +140,19 @@ init_tops([],[]).
|
||||
init_tops(_.Leaves,_.Tops) :-
|
||||
init_tops(Leaves,Tops).
|
||||
|
||||
sort_keys(AllFs, AllVars, Leaves) :-
|
||||
dgraph_new(Graph0),
|
||||
foldl(add_node, AllFs, Graph0, Graph),
|
||||
dgraph_leaves(Graph, Leaves),
|
||||
dgraph_top_sort(Graph, AllVars).
|
||||
|
||||
add_node(f([K|Parents],_,_,_), Graph0, Graph) :-
|
||||
dgraph_add_vertex(Graph0, K, Graph1),
|
||||
foldl(add_edge(K), Parents, Graph1, Graph).
|
||||
|
||||
add_edge(K, K0, Graph0, Graph) :-
|
||||
dgraph_add_edge(Graph0, K0, K, Graph).
|
||||
|
||||
sort_vars(AllVars0, AllVars, Leaves) :-
|
||||
dgraph_new(Graph0),
|
||||
build_graph(AllVars0, Graph0, Graph),
|
||||
@ -121,6 +173,32 @@ add_parents(V0.Parents, V, Graph0, GraphF) :-
|
||||
dgraph_add_edge(Graph0, V0, V, GraphI),
|
||||
add_parents(Parents, V, GraphI, GraphF).
|
||||
|
||||
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
|
||||
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
|
||||
{ rb_lookup(V, F, Fs) }, !,
|
||||
{ F = f([V|Parents], _, _, DistId) },
|
||||
%{writeln(v:DistId:Parents)},
|
||||
[DIST],
|
||||
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
|
||||
get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
|
||||
|
||||
get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
|
||||
reorder_keys(Parents0, OrderVs, Parents, Map),
|
||||
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
|
||||
writeln(v),
|
||||
unbound_parms(Parms, ParmVars),
|
||||
F = f(_,[Size|_],_,_),
|
||||
check_key(V, Size, DIST, Vs, Vs1),
|
||||
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
|
||||
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
|
||||
writeln(ps:Parents),
|
||||
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
|
||||
cross_product(Values, Ev, PVars, ParmVars, Formula0),
|
||||
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
|
||||
writeln(ev:Evs),
|
||||
get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs).
|
||||
%, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
|
||||
|
||||
get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> [].
|
||||
get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) -->
|
||||
{ clpbn:get_atts(V, [dist(DistId, Parents)]) }, !,
|
||||
@ -160,20 +238,25 @@ get_var_info(V, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
|
||||
%
|
||||
% position zero is output
|
||||
%
|
||||
reorder_vars(Vs, OVs, Map) :-
|
||||
add_pos(Vs, 1, PVs),
|
||||
reorder_keys(Vs, Order, OVs, Map) :-
|
||||
foldl(add_key_pos(Order), Vs, PVs, 1, _),
|
||||
keysort(PVs, SVs),
|
||||
remove_key(SVs, OVs, Map).
|
||||
maplist(remove_key,SVs, OVs, Map).
|
||||
|
||||
add_pos([], _, []).
|
||||
add_pos([V|Vs], I0, [K-(I0,V)|PVs]) :-
|
||||
add_key_pos(Order, V, K-(I0,V), I0, I) :-
|
||||
rb_lookup(V, K, Order),
|
||||
I is I0+1.
|
||||
|
||||
reorder_vars(Vs, OVs, Map) :-
|
||||
foldl(add_pos, Vs, PVs, 1, _),
|
||||
keysort(PVs, SVs),
|
||||
maplist(remove_key, SVs, OVs, Map).
|
||||
|
||||
add_pos(V, K-(I0,V), I0, I) :-
|
||||
get_atts(V,[order(K)]),
|
||||
I is I0+1,
|
||||
add_pos(Vs, I, PVs).
|
||||
I is I0+1.
|
||||
|
||||
remove_key([], [], []).
|
||||
remove_key([_-(I,V)|SVs], [V|OVs], [I|Map]) :-
|
||||
remove_key(SVs, OVs, Map).
|
||||
remove_key(_-(I,V), V, I).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
@ -499,6 +582,23 @@ to_disj2([V,V1|Vs], V0, Out) :-
|
||||
to_disj2([V1|Vs], V0+V, Out).
|
||||
|
||||
|
||||
%
|
||||
% look for parameters in the rb-tree, or add a new.
|
||||
% distid is the key
|
||||
%
|
||||
check_key_p(DistId, _, Map, Parms, ParmVars, Ps, Ps) :-
|
||||
rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !.
|
||||
check_key_p(DistId, f(_, Sizes, Parms0, _DistId), Map, Parms, ParmVars, Ps, PsF) :-
|
||||
swap_parms(Parms0, Sizes, [0|Map], Parms1),
|
||||
length(Parms1, L0),
|
||||
get_dist_domain_size(DistId, Size),
|
||||
L1 is L0 div Size,
|
||||
L is L0-L1,
|
||||
initial_maxes(L1, Multipliers),
|
||||
copy(L, Multipliers, NextMults, NextMults, Parms1, Parms, ParmVars),
|
||||
%writeln(t:Size:Parms0:Parms:ParmVars),
|
||||
rb_insert(Ps, DistId-Map, theta(Parms, ParmVars), PsF).
|
||||
|
||||
%
|
||||
% look for parameters in the rb-tree, or add a new.
|
||||
% distid is the key
|
||||
@ -580,6 +680,19 @@ get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
|
||||
INFO = info(V, _Parent, _Ev, Values, _, _, _),
|
||||
get_parents(Parents, PVars, Vs1, Vs).
|
||||
|
||||
get_key_parent(Fs, V, Values, Vs0, Vs) :-
|
||||
INFO = info(V, _Parent, _Ev, Values, _, _, _),
|
||||
rb_lookup(V, f(_, [Size|_], _, _), Fs),
|
||||
check_key(V, Size, INFO, Vs0, Vs).
|
||||
|
||||
check_key(V, _, INFO, Vs, Vs) :-
|
||||
rb_lookup(V, INFO, Vs), !.
|
||||
check_key(V, Size, INFO, Vs0, Vs) :-
|
||||
length(Values, Size),
|
||||
length(Ev, Size),
|
||||
INFO = info(V, _Tree, Ev, Values, _Formula, _, _),
|
||||
rb_insert(Vs0, V, INFO, Vs).
|
||||
|
||||
%
|
||||
% construct the formula, this is the key...
|
||||
%
|
||||
@ -602,7 +715,7 @@ expand([H|L1], LN) -->
|
||||
expand(L1, LN).
|
||||
|
||||
concatenate_all(_H, []) --> [].
|
||||
concatenate_all(H, L.LN) -->
|
||||
concatenate_all(H, [L|LN]) -->
|
||||
[[H|L]],
|
||||
concatenate_all(H, LN).
|
||||
|
||||
@ -684,6 +797,22 @@ skim_for_theta([[P|Other]], not(P), [Other], _) :- !.
|
||||
skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :-
|
||||
skim_for_theta(More, Ps, Left, New ).
|
||||
|
||||
get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :-
|
||||
rb_lookup(Evs, V, Pos), !,
|
||||
zero_pos(0, Pos, Ev),
|
||||
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
|
||||
get_outs(F0, F, SendOut, Outs).
|
||||
% hidden deterministic node, can be removed.
|
||||
%% get_key_evidence(V, _, DistId, _Tree, Ev, F0, [], _Leaves, _Finals) :-
|
||||
%% deterministic(V, DistId),
|
||||
%% !,
|
||||
%% one_list(Ev),
|
||||
%% eval_outs(F0).
|
||||
%% no evidence !!!
|
||||
get_key_evidence(V, _, _, Tree, _Values, F0, F1, Leaves, Finals) :-
|
||||
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
|
||||
get_outs(F0, F1, SendOut, Outs).
|
||||
|
||||
get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
|
||||
clpbn:get_atts(V, [evidence(Pos)]), !,
|
||||
zero_pos(0, Pos, Ev),
|
||||
@ -737,10 +866,18 @@ eval_outs((V=F).Outs) :-
|
||||
V = NF,
|
||||
eval_outs(Outs).
|
||||
|
||||
run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :-
|
||||
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
|
||||
findall(LPs,
|
||||
(member(Q, QIds),
|
||||
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
|
||||
LLPs), writeln(LLPs).
|
||||
|
||||
run_bdd_solver([[V]], LPs, bdd(Term, _Leaves, Nodes)) :-
|
||||
build_out_node(Nodes, Node),
|
||||
findall(Prob, get_prob(Term, Node, V, Prob),TermProbs),
|
||||
sumlist(TermProbs, Sum),
|
||||
writeln(LPs:TermProbs),
|
||||
normalise(TermProbs, Sum, LPs).
|
||||
|
||||
build_out_node([_Top], []).
|
||||
|
||||
@ -30,6 +30,9 @@
|
||||
defined_in_factor/2,
|
||||
skolem/2]).
|
||||
|
||||
:- use_module(library(clpbn/aggregates), [
|
||||
avg_factors/5]).
|
||||
|
||||
:- use_module(library(clpbn/dists), [
|
||||
dist/4]).
|
||||
|
||||
@ -101,35 +104,12 @@ collect(Keys, Factors) :-
|
||||
findall(K, currently_defined(K), Keys),
|
||||
findall(f(FType,FId,FKeys), f(FType,FId,FKeys), Factors).
|
||||
|
||||
ground_all_keys([], _).
|
||||
ground_all_keys([V|GVars], AllKeys) :-
|
||||
clpbn:get_atts(V,[key(Key)]),
|
||||
\+ ground(Key), !,
|
||||
member(Key, AllKeys),
|
||||
ground_all_keys(GVars, AllKeys).
|
||||
ground_all_keys([_V|GVars], AllKeys) :-
|
||||
ground_all_keys(GVars, AllKeys).
|
||||
|
||||
|
||||
keys([], []).
|
||||
keys([Var|QueryVars], [Key|QueryKeys]) :-
|
||||
clpbn:get_atts(Var,[key(Key)]),
|
||||
keys(QueryVars, QueryKeys).
|
||||
|
||||
initialize_evidence([]).
|
||||
initialize_evidence([V|EVars]) :-
|
||||
clpbn:get_atts(V, [key(K)]),
|
||||
ground(K),
|
||||
queue_in(K),
|
||||
initialize_evidence(EVars).
|
||||
|
||||
|
||||
%
|
||||
% gets key K, and collects factors that define it
|
||||
queue_in(K) :-
|
||||
queue(K), !.
|
||||
queue_in(K) :-
|
||||
writeln(+K),
|
||||
%writeln(+K),
|
||||
assert(queue(K)),
|
||||
fail.
|
||||
queue_in(_).
|
||||
@ -139,8 +119,6 @@ propagate :-
|
||||
do_propagate(K).
|
||||
propagate.
|
||||
|
||||
do_propagate(agg(_)) :- !,
|
||||
propagate.
|
||||
do_propagate(K) :-
|
||||
%writeln(-K),
|
||||
\+ currently_defined(K),
|
||||
@ -152,9 +130,7 @@ do_propagate(K) :-
|
||||
true
|
||||
;
|
||||
throw(error(no_defining_factor(K)))
|
||||
)
|
||||
,
|
||||
writeln(Ks),
|
||||
),
|
||||
member(K1, Ks),
|
||||
\+ currently_defined(K1),
|
||||
queue_in(K1),
|
||||
@ -163,18 +139,19 @@ do_propagate(_K) :-
|
||||
propagate.
|
||||
|
||||
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
|
||||
( Ks = [K,agg(Els)]
|
||||
%writeln(+Ks),
|
||||
( Ks = [K,Els], var(Els)
|
||||
->
|
||||
NKs=[K|Els]
|
||||
once(run(Constraints)),
|
||||
avg_factors(K, Els, 0.0, NewKeys, NewId),
|
||||
NKs = [K|NewKeys]
|
||||
;
|
||||
NKs = Ks
|
||||
once(run(Constraints)),
|
||||
NKs = Ks,
|
||||
Id = NewId
|
||||
),
|
||||
run(Constraints), !,
|
||||
\+ f(Type, Id, NKs),
|
||||
assert(f(Type, Id, NKs)).
|
||||
|
||||
fetch_list((A,agg(B)), A, B).
|
||||
|
||||
\+ f(Type, NewId, NKs),
|
||||
assert(f(Type, NewId, NKs)).
|
||||
|
||||
run([Goal|Goals]) :-
|
||||
call(user:Goal),
|
||||
|
||||
@ -36,6 +36,7 @@ warning :-
|
||||
|
||||
|
||||
set_solver(ve) :- set_clpbn_flag(solver,ve).
|
||||
set_solver(bdd) :- set_clpbn_flag(solver,bdd).
|
||||
set_solver(jt) :- set_clpbn_flag(solver,jt).
|
||||
set_solver(gibbs) :- set_clpbn_flag(solver,gibbs).
|
||||
set_solver(fove) :- set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, fove).
|
||||
@ -43,7 +44,7 @@ set_solver(lbp) :- set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver,
|
||||
set_solver(hve) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, ve).
|
||||
set_solver(bp) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, bp).
|
||||
set_solver(cbp) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, cbp).
|
||||
set_solver(S) :- throw(error('unknow solver ', S)).
|
||||
set_solver(S) :- throw(error('unknown solver ', S)).
|
||||
|
||||
|
||||
set_horus_flag(K,V) :- cpp_set_horus_flag(K,V).
|
||||
|
||||
@ -40,14 +40,17 @@
|
||||
:- use_module(library('clpbn/aggregates'),
|
||||
[check_for_agg_vars/2]).
|
||||
|
||||
:- use_module(library(clpbn/numbers)).
|
||||
|
||||
:- use_module(library(charsio),
|
||||
[term_to_atom/2]).
|
||||
|
||||
:- use_module(library(pfl),
|
||||
[skolem/2,
|
||||
get_pfl_parameters/2
|
||||
[skolem/2
|
||||
]).
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
@ -59,119 +62,36 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Outpu
|
||||
call_horus_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
|
||||
clpbn_bind_vals([QueryVars], Solutions, Output).
|
||||
|
||||
call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidence, Solutions) :-
|
||||
attributes:all_attvars(AVars),
|
||||
keys(AVars, AllKeys),
|
||||
b_hash_new(Hash0),
|
||||
keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1),
|
||||
call_horus_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
|
||||
get_factors_type(Factors, Type),
|
||||
evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds),
|
||||
%writeln(evidence:Evidence:EvidenceIds),
|
||||
factors_to_ids(Factors, Hash2, Hash3, Id2, Id3, FactorIds),
|
||||
%writeln(queryKeys:QueryKeys), writeln(''),
|
||||
%% writeln(type:Type), writeln(''),
|
||||
%% writeln(allKeys:AllKeys), writeln(''),
|
||||
sort(AllKeys,SKeys), %% writeln(allSortedKeys:SKeys), writeln(''),
|
||||
keys_to_ids(SKeys, Id3, Id4, Hash3, Hash4),
|
||||
%b_hash:b_hash_to_list(Hash1,_L4), writeln(h1:_L4),
|
||||
%writeln(factors:Factors), writeln(''),
|
||||
%writeln(factorIds:FactorIds), writeln(''),
|
||||
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
|
||||
%writeln(evidence:Evidence), writeln(''),
|
||||
%writeln(evidenceIds:EvidenceIds), writeln(''),
|
||||
%writeln(factorIds:FactorIds), writeln(''),
|
||||
cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network),
|
||||
get_vars_information(AllKeys, StatesNames),
|
||||
terms_to_atoms(AllKeys, KeysAtoms),
|
||||
maplist(get_var_information, AllKeys, StatesNames),
|
||||
maplist(term_to_atom, AllKeys, KeysAtoms),
|
||||
%writeln(s1:KeysAtoms:KeysAtoms:StatesNames),
|
||||
cpp_set_vars_information(KeysAtoms, StatesNames),
|
||||
%writeln(network:(Type, FactorIds, EvidenceIds, Network)), writeln(''),
|
||||
run_solver(ground(Network,Hash4,Id4), QueryKeys, Solutions),
|
||||
cpp_free_ground_network(Network).
|
||||
|
||||
|
||||
keys([], []).
|
||||
keys([V|AVars], [K|AllKeys]) :-
|
||||
clpbn:get_atts(V,[key(K)]), !,
|
||||
keys(AVars, AllKeys).
|
||||
keys([_V|AVars], AllKeys) :-
|
||||
keys(AVars, AllKeys).
|
||||
|
||||
|
||||
run_solver(ground(Network,Hash,Id), QueryKeys, Solutions) :-
|
||||
%get_dists_parameters(DistIds, DistsParams),
|
||||
%cpp_set_factors_params(Network, DistsParams),
|
||||
list_of_keys_to_ids(QueryKeys, Hash, _, Id, _, QueryIds),
|
||||
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
|
||||
%writeln(queryKeys:QueryKeys), writeln(''),
|
||||
%writeln(queryIds:QueryIds), writeln(''),
|
||||
% writeln(queryIds:QueryIds), writeln(''),
|
||||
cpp_run_ground_solver(Network, QueryIds, Solutions).
|
||||
|
||||
|
||||
keys_to_ids([], Id, Id, Hash, Hash).
|
||||
keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
|
||||
b_hash_lookup(Key, _, Hash0), !,
|
||||
keys_to_ids(AllKeys, I0, I, Hash0, Hash).
|
||||
keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
|
||||
b_hash_insert(Hash0, Key, I0, HashI),
|
||||
I1 is I0+1,
|
||||
keys_to_ids(AllKeys, I1, I, HashI, Hash).
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
get_factors_type([f(bayes, _, _)|_], bayes) :- ! .
|
||||
get_factors_type([f(markov, _, _)|_], markov) :- ! .
|
||||
|
||||
|
||||
list_of_keys_to_ids([], H, H, I, I, []).
|
||||
list_of_keys_to_ids([List|Extra], Hash0, Hash, I0, I, [IdList|More]) :-
|
||||
List = [_|_], !,
|
||||
list_of_keys_to_ids(List, Hash0, Hash1, I0, I1, IdList),
|
||||
list_of_keys_to_ids(Extra, Hash1, Hash, I1, I, More).
|
||||
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [Id|QueryIds]) :-
|
||||
b_hash_lookup(Key, Id, Hash0), !,
|
||||
list_of_keys_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
|
||||
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [I0|QueryIds]) :-
|
||||
b_hash_insert(Hash0, Key, I0, Hash1),
|
||||
I1 is I0+1,
|
||||
list_of_keys_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
|
||||
|
||||
|
||||
factors_to_ids([], H, H, I, I, []).
|
||||
factors_to_ids([f(_, DistId, Keys)|Fs], Hash0, Hash, I0, I, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
|
||||
list_of_keys_to_ids(Keys, Hash0, Hash1, I0, I1, Ids),
|
||||
pfl:get_pfl_parameters(DistId, CPT),
|
||||
get_ranges(Keys, Ranges),
|
||||
factors_to_ids(Fs, Hash1, Hash, I1, I, NFs).
|
||||
|
||||
|
||||
get_ranges([],[]).
|
||||
get_ranges(K.Ks, Range.Rs) :- !,
|
||||
skolem(K,Domain),
|
||||
length(Domain,Range),
|
||||
get_ranges(Ks, Rs).
|
||||
|
||||
|
||||
evidence_to_ids([], H, H, I, I, []).
|
||||
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [Id=Ev|QueryIds]) :-
|
||||
b_hash_lookup(Key, Id, Hash0), !,
|
||||
evidence_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
|
||||
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [I0=Ev|QueryIds]) :-
|
||||
b_hash_insert(Hash0, Key, I0, Hash1),
|
||||
I1 is I0+1,
|
||||
evidence_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
|
||||
|
||||
|
||||
get_vars_information([], []).
|
||||
get_vars_information(Key.QueryKeys, Domain.StatesNames) :-
|
||||
pfl:skolem(Key, Domain),
|
||||
get_vars_information(QueryKeys, StatesNames).
|
||||
|
||||
|
||||
terms_to_atoms([], []).
|
||||
terms_to_atoms(K.Ks, Atom.As) :-
|
||||
term_to_atom(K,Atom),
|
||||
terms_to_atoms(Ks,As).
|
||||
get_var_information(Key, Domain) :-
|
||||
skolem(Key, Domain).
|
||||
|
||||
|
||||
finalize_horus_ground_solver(bp(Network, _)) :-
|
||||
|
||||
60
packages/CLPBN/clpbn/numbers.yap
Normal file
60
packages/CLPBN/clpbn/numbers.yap
Normal file
@ -0,0 +1,60 @@
|
||||
|
||||
:- module(clpbn_numbers,
|
||||
[
|
||||
keys_to_numbers/7,
|
||||
keys_to_numbers/9,
|
||||
lists_of_keys_to_ids/6
|
||||
]).
|
||||
|
||||
:- use_module(library(bhash)).
|
||||
:- use_module(library(maplist)).
|
||||
:- use_module(library(pfl),
|
||||
[skolem/2,
|
||||
get_pfl_cpt/5
|
||||
]).
|
||||
|
||||
%
|
||||
% convert key representation into numeric representation
|
||||
% (+keys, +all factors, +all evidence, -ConvTable, -NextId, -FactorsWithIds, -EvidenceWithIds)
|
||||
%
|
||||
keys_to_numbers(AllKeys, Factors, Evidence, Hash, Id4, FactorIds, EvidenceIds) :-
|
||||
b_hash_new(Hash0),
|
||||
keys_to_numbers(AllKeys, Factors, Evidence, Hash0, Hash, 0, Id4, FactorIds, EvidenceIds).
|
||||
|
||||
|
||||
keys_to_numbers(AllKeys, Factors, Evidence, Hash0, Hash4, Id0, Id4, FactorIds, EvidenceIds) :-
|
||||
foldl2(key_to_id, AllKeys, _Ids, Hash0, Hash1, Id0, Id1),
|
||||
foldl2(evidence_to_id, Evidence, EvidenceIds, Hash1, Hash2, Id1, Id2),
|
||||
foldl2(factor_to_id(Evidence), Factors, FactorIds, Hash2, Hash3, Id2, Id3),
|
||||
sort(AllKeys,SKeys), %% writeln(allSortedKeys:SKeys), writeln(''),
|
||||
foldl2(key_to_id, SKeys, _, Hash3, Hash4, Id3, Id4).
|
||||
|
||||
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash0, Hash, Id0, Id) :-
|
||||
foldl2(list_of_keys_to_ids, QueryKeys, QueryIds, Hash0, Hash, Id0, Id).
|
||||
|
||||
list_of_keys_to_ids(List, IdList, Hash0, Hash, I0, I) :-
|
||||
foldl2(key_to_id, List, IdList, Hash0, Hash, I0, I).
|
||||
|
||||
key_to_id(Key, Id, Hash0, Hash0, I0, I0) :-
|
||||
b_hash_lookup(Key, Id, Hash0), !.
|
||||
key_to_id(Key, I0, Hash0, Hash, I0, I) :-
|
||||
b_hash_insert(Hash0, Key, I0, Hash),
|
||||
I is I0+1.
|
||||
|
||||
factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :-
|
||||
get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT),
|
||||
foldl2(key_to_id, NKeys, Ids, Hash0, Hash, I0, I),
|
||||
maplist(get_range, Keys, Ranges).
|
||||
|
||||
get_range(K, Range) :-
|
||||
skolem(K,Domain),
|
||||
length(Domain,Range).
|
||||
|
||||
|
||||
evidence_to_id(Key=Ev, Id=Ev, Hash0, Hash0, I0, I0) :-
|
||||
b_hash_lookup(Key, Id, Hash0), !.
|
||||
evidence_to_id(Key=Ev, I0=Ev, Hash0, Hash, I0, I) :-
|
||||
b_hash_insert(Hash0, Key, I0, Hash),
|
||||
I is I0+1.
|
||||
|
||||
|
||||
@ -96,9 +96,8 @@ ve(LLVs,Vs0,AllDiffs) :-
|
||||
% Vmap is the map V->I
|
||||
%
|
||||
init_ve_solver(Qs, Vs0, _, state(IQs, LVIs, VMap, Bigraph, Ev)) :-
|
||||
check_for_agg_vars(Vs0, Vs1),
|
||||
% LVi will have a list of CLPBN variables
|
||||
init_influences(Vs1, Graph, TGraph),
|
||||
init_influences(Vs0, Graph, TGraph),
|
||||
maplist(init_ve_solver_for_question(Graph, TGraph), Qs, LVs),
|
||||
init_vmap(VMap0),
|
||||
lvars_to_numbers(LVs, LVIs, VMap0, VMap1),
|
||||
@ -112,7 +111,7 @@ init_ve_solver_for_question(G, RG, Vs, NVs) :-
|
||||
%
|
||||
% construct a bipartite graph with vars and factors
|
||||
% the nodes of the var graph just contain pointer to the factors
|
||||
% the nodes of the factors contain alist of variables and a matrix
|
||||
% the nodes of the factors contain a list of variables and a matrix
|
||||
% also provide a matrix with evidence
|
||||
%
|
||||
vars_to_bigraph(VMap, bigraph(VInfo, IF, Fs), Evs) :-
|
||||
@ -301,7 +300,7 @@ replace_factor(_F,_NF,OF, OF).
|
||||
|
||||
eliminate(QVs, digraph(Vs0, I, Fs0), Dist) :-
|
||||
find_best(Vs0, QVs, BestV, VFs), !,
|
||||
%writeln(best:BestV:QVs),
|
||||
%writeln(best:BestV:VFs),
|
||||
% delete all factors that touched the variable
|
||||
foldl2(del_fac, VFs, Fs0, Fs1, Vs0, Vs1),
|
||||
% delete current variable
|
||||
@ -325,11 +324,16 @@ best_var(QVs, I, _Node, Info, Info) :-
|
||||
!.
|
||||
% pick the variable with less factors
|
||||
best_var(_Qs, I, Node, i(ValSoFar,_,_), i(NewVal,I,Node)) :-
|
||||
length(Node, NewVal),
|
||||
foldl(szfac,Node,1,NewVal),
|
||||
%length(Node, NewVal),
|
||||
NewVal < ValSoFar,
|
||||
!.
|
||||
best_var(_, _I, _Node, Info, Info).
|
||||
|
||||
szfac(f(_,Vs,_), I0, I) :-
|
||||
length(Vs,L),
|
||||
I is I0*L.
|
||||
|
||||
% delete one factor, need to also touch all variables
|
||||
del_fac(f(I,FVs,_), Fs0, Fs, Vs0, Vs) :-
|
||||
rb_delete(Fs0, I, Fs),
|
||||
|
||||
@ -15,9 +15,7 @@ schema.yap: the PFL schema
|
||||
|
||||
tables: CPTs
|
||||
|
||||
|
||||
|
||||
|
||||
=============================================================================
|
||||
|
||||
professor_ability(p0,X).
|
||||
|
||||
|
||||
@ -29,9 +29,9 @@ bayes grade(C,S)::[a,b,c,d], int(S), diff(C) ; grade_table ; [registration(_,C,S
|
||||
|
||||
bayes satisfaction(C,S)::[h,m,l], abi(P), grade(C,S) ; sat_table ; [reg_satisfaction(C,S,P)].
|
||||
|
||||
bayes rat(C) :: [h,m,l], agg(Sats) ; avg ; [course_rat(C, Sats)].
|
||||
bayes rat(C) :: [h,m,l], Sats ; avg ; [course_rat(C, Sats)].
|
||||
|
||||
bayes rank(S) :: [a,b,c,d], agg(Grades) ; avg ; [student_ranking(S,Grades)].
|
||||
bayes rank(S) :: [a,b,c,d], Grades ; avg ; [student_ranking(S,Grades)].
|
||||
|
||||
|
||||
grade(Key, Grade) :-
|
||||
@ -44,8 +44,8 @@ reg_satisfaction(CKey, SKey, PKey) :-
|
||||
|
||||
course_rat(CKey, Sats) :-
|
||||
course(CKey, _),
|
||||
setof(satisfaction(CKey,SKey,PKey),
|
||||
reg_satisfaction(CKey, SKey, PKey),
|
||||
setof(satisfaction(CKey,SKey),
|
||||
PKey^reg_satisfaction(CKey, SKey, PKey),
|
||||
Sats).
|
||||
|
||||
student_ranking(SKey, Grades) :-
|
||||
|
||||
@ -21,6 +21,8 @@ total_students(256).
|
||||
%:- clpbn_horus:set_solver(fove).
|
||||
%:- clpbn_horus:set_solver(hve).
|
||||
:- clpbn_horus:set_solver(bp).
|
||||
:- clpbn_horus:set_solver(bdd).
|
||||
%:- clpbn_horus:set_solver(ve).
|
||||
%:- clpbn_horus:set_solver(cbp).
|
||||
|
||||
:- ensure_loaded(school32_data).
|
||||
|
||||
@ -4,25 +4,20 @@
|
||||
%
|
||||
|
||||
:- module(pfl, [
|
||||
factor/6,
|
||||
skolem/2,
|
||||
defined_in_factor/2,
|
||||
get_pfl_parameters/2, % given id return par factor parameter
|
||||
new_pfl_parameters/2, % given id set new parameters
|
||||
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
|
||||
get_factor_pvariable/2, % given id get any pvar
|
||||
add_ground_factor/4, %add a new bayesian variable (for now)
|
||||
op(550,yfx,@),
|
||||
op(550,yfx,::),
|
||||
op(1150,fx,bayes),
|
||||
op(1150,fx,markov)]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth0/3,
|
||||
append/3,
|
||||
member/2]).
|
||||
|
||||
:- dynamic factor/6, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
|
||||
op(550,yfx,@),
|
||||
op(550,yfx,::),
|
||||
op(1150,fx,bayes),
|
||||
op(1150,fx,markov),
|
||||
factor/6,
|
||||
skolem/2,
|
||||
defined_in_factor/2,
|
||||
get_pfl_cpt/5, % given id and keys, return new keys and cpt
|
||||
get_pfl_parameters/2, % given id return par factor parameter
|
||||
new_pfl_parameters/2, % given id set new parameters
|
||||
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
|
||||
get_factor_pvariable/2, % given id get any pvar
|
||||
add_ground_factor/5 %add a new bayesian variable (for now)
|
||||
]).
|
||||
|
||||
:- reexport(library(clpbn),
|
||||
[clpbn_flag/2 as pfl_flag,
|
||||
@ -31,6 +26,10 @@
|
||||
:- reexport(library(clpbn/horus),
|
||||
[set_solver/1]).
|
||||
|
||||
:- reexport(library(clpbn/aggregates),
|
||||
[avg_factors/5]).
|
||||
|
||||
|
||||
:- ( % if clp(bn) has done loading, we're top-level
|
||||
predicate_property(set_pfl_flag(_,_), imported_from(clpbn))
|
||||
->
|
||||
@ -42,6 +41,14 @@
|
||||
true
|
||||
).
|
||||
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth0/3,
|
||||
append/3,
|
||||
member/2]).
|
||||
|
||||
:- dynamic factor/6, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
|
||||
|
||||
user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(bayes,Id,FList,FV,Phi,Constraints)) :-
|
||||
!,
|
||||
term_variables(Formula, FreeVars),
|
||||
@ -70,11 +77,12 @@ Id@N :-
|
||||
fail.
|
||||
_Id@_N.
|
||||
|
||||
add_ground_factor(bayes, Domain, Vars, CPT) :-
|
||||
add_ground_factor(bayes, Domain, Vars, CPT, Id) :-
|
||||
Vars = [K|_],
|
||||
( skolem(K,_Domain) -> true ; assert(skolem(K, Domain)) ),
|
||||
new_id(Id),
|
||||
assert(factor(bayes, Id, Vars, [], CPT, true)).
|
||||
asserta(skolem_in(K, Id)),
|
||||
assert(factor(bayes, Id, Vars, [], CPT, [])).
|
||||
|
||||
defined_in_factor(Key, Factor) :-
|
||||
skolem_in(Key, Id),
|
||||
@ -104,6 +112,10 @@ new_id(Id) :-
|
||||
|
||||
process_args(V, _Id, _I0, _I ) --> { var(V) }, !,
|
||||
{ throw(error(instantiation_error,pfl:process_args)) }.
|
||||
process_args((Arg1,V), Id, I0, I ) --> { var(V) }, !,
|
||||
{ I is I0+1 },
|
||||
process_arg(Arg1, Id, I),
|
||||
[V].
|
||||
process_args((Arg1,Arg2), Id, I0, I ) --> !,
|
||||
process_args(Arg1, Id, I0, I1),
|
||||
process_args(Arg2, Id, I1, I).
|
||||
@ -161,10 +173,17 @@ add_evidence(Sk,Var) :-
|
||||
clpbn:put_atts(_V,[key(Sk),evidence(E)]).
|
||||
|
||||
|
||||
%% get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :-
|
||||
%% factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !,
|
||||
%% Keys = [Key|Parents],
|
||||
%% writeln(Key:Parents),
|
||||
%% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out).
|
||||
get_pfl_cpt(Id, Keys, _, Keys, Out) :-
|
||||
get_pfl_parameters(Id,Out).
|
||||
|
||||
get_pfl_parameters(Id,Out) :-
|
||||
factor(_Type,Id,_FList,_FV,Phi,_Constraints),
|
||||
%writeln(factor(_Type,Id,_FList,_FV,_Phi,_Constraints)),
|
||||
( is_list(Phi) -> Out = Phi ; call(user:Phi, Out) ).
|
||||
( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ).
|
||||
|
||||
|
||||
new_pfl_parameters(Id, NewPhi) :-
|
||||
|
||||
@ -51,6 +51,8 @@ CFLAGS=$(COFLAGS) $(CWFLAGS) $(CMFLAGS) $(CIFLAGS) $(PKGCFLAGS) @DEFS@
|
||||
LDSOFLAGS=@LDFLAGS@ @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
LDFLAGS=$(PKGLDFLAGS)
|
||||
|
||||
LIBPLEMBED=
|
||||
|
||||
MKINDEX=(cd $(srcdir) ; $(PL) -f none -g make -t halt)
|
||||
|
||||
.txt.tex:
|
||||
|
||||
@ -1 +1 @@
|
||||
Subproject commit 2d0bbe41cd30c569856ea27c0934ad8a96ce2352
|
||||
Subproject commit 270146c1f4117ebb58d20c2f06e58d7d23cbc9ca
|
||||
@ -1 +1 @@
|
||||
Subproject commit d3b6113d9ff5a90683415d2e888b5f71e4b453f1
|
||||
Subproject commit 8b75ad1bed7cbdbb51516fd2b00209357d91c8c7
|
||||
@ -1 +1 @@
|
||||
Subproject commit 0acc051973932430e71e4f57c8c92c7d6cd114a8
|
||||
Subproject commit 758eb8d7960684fe18e01cdff41013cce097f197
|
||||
98
pl/boot.yap
98
pl/boot.yap
@ -25,33 +25,40 @@ true :- true.
|
||||
'$init_system',
|
||||
'$do_live'.
|
||||
|
||||
'$init_prolog' :-
|
||||
'$init_system'.
|
||||
|
||||
'$do_live' :-
|
||||
repeat,
|
||||
'$current_module'(Module),
|
||||
( Module==user ->
|
||||
'$compile_mode'(_,0)
|
||||
;
|
||||
format(user_error,'[~w]~n', [Module])
|
||||
),
|
||||
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
|
||||
repeat,
|
||||
'$current_module'(Module),
|
||||
( Module==user ->
|
||||
'$compile_mode'(_,0)
|
||||
;
|
||||
format(user_error,'[~w]~n', [Module])
|
||||
),
|
||||
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
|
||||
|
||||
|
||||
'$init_system' :-
|
||||
% do catch as early as possible
|
||||
(
|
||||
'$access_yap_flags'(15, 0),
|
||||
'$access_yap_flags'(22, 0),
|
||||
\+ '$uncaught_throw'
|
||||
->
|
||||
'$version'
|
||||
;
|
||||
true
|
||||
),
|
||||
(
|
||||
'$access_yap_flags'(22, 0) ->
|
||||
set_value('$verbose',on)
|
||||
;
|
||||
set_value('$verbose',off)
|
||||
),
|
||||
'$nb_getval'('$yap_inited', on, fail), !.
|
||||
'$init_system' :-
|
||||
nb_setval('$yap_inited', on),
|
||||
% do catch as early as possible
|
||||
(
|
||||
'$access_yap_flags'(15, 0),
|
||||
'$access_yap_flags'(22, 0),
|
||||
\+ '$uncaught_throw'
|
||||
->
|
||||
'$version'
|
||||
;
|
||||
true
|
||||
),
|
||||
(
|
||||
'$access_yap_flags'(22, 0) ->
|
||||
set_value('$verbose',on)
|
||||
;
|
||||
set_value('$verbose',off)
|
||||
),
|
||||
% '$init_preds', % needs to be done before library_directory
|
||||
% (
|
||||
% retractall(user:library_directory(_)),
|
||||
@ -61,13 +68,13 @@ true :- true.
|
||||
% ;
|
||||
% true
|
||||
% ),
|
||||
'$enter_system_mode',
|
||||
'$init_globals',
|
||||
'$swi_set_prolog_flag'(fileerrors, true),
|
||||
set_value('$gc',on),
|
||||
('$exit_undefp' -> true ; true),
|
||||
prompt1(' ?- '),
|
||||
'$debug_on'(false),
|
||||
'$enter_system_mode',
|
||||
'$init_globals',
|
||||
'$swi_set_prolog_flag'(fileerrors, true),
|
||||
set_value('$gc',on),
|
||||
('$exit_undefp' -> true ; true),
|
||||
prompt1(' ?- '),
|
||||
'$debug_on'(false),
|
||||
% simple trick to find out if this is we are booting from Prolog.
|
||||
% boot from a saved state
|
||||
(
|
||||
@ -160,23 +167,28 @@ true :- true.
|
||||
prompt1('?- '),
|
||||
prompt(_,'|: '),
|
||||
'$system_catch'('$raw_read'(user_input, Line), prolog, E,
|
||||
(print_message(error, E),
|
||||
( E = error(syntax_error(_), _)
|
||||
-> fail
|
||||
; throw(E)
|
||||
))),
|
||||
( current_predicate(_, user:rl_add_history(_))
|
||||
-> format(atom(CompleteLine), '~W~W',
|
||||
(print_message(error, E),
|
||||
( E = error(syntax_error(_), _)
|
||||
-> fail
|
||||
; throw(E)
|
||||
))),
|
||||
(
|
||||
current_predicate(_, user:rl_add_history(_))
|
||||
->
|
||||
format(atom(CompleteLine), '~W~W',
|
||||
[ Line, [partial(true)],
|
||||
'.', [partial(true)]
|
||||
]),
|
||||
call(user:rl_add_history(CompleteLine))
|
||||
; true
|
||||
;
|
||||
true
|
||||
),
|
||||
'$system_catch'(atom_to_term(Line, Goal, Bindings), prolog, E,
|
||||
( print_message(error, E),
|
||||
fail
|
||||
)), !.
|
||||
'$system_catch'(
|
||||
atom_to_term(Line, Goal, Bindings), prolog, E,
|
||||
( print_message(error, E),
|
||||
fail
|
||||
)
|
||||
), !.
|
||||
|
||||
|
||||
% reset alarms when entering top-level.
|
||||
|
||||
Reference in New Issue
Block a user