EKB: SMILE is a C++ library for developing and using Bayesian Networks. SMILE was developed by Decision Systems Laboratory, which also offers the GeNIe Bayes network software. GeNIe and SMILE (as a compiled library) can be downloaded for free with modest restrictions. The GeNIe/SMILE web site is at http://genie.sis.pitt.edu/ .
I was using GeNIe in a project and needed to do a lot of calculations with the network we'd created. That isn't easy to do in GeNIe (there's no batch mode), so I wrote a Tcl interface for a subset of the SMILE library. It's implemented in C (using Dev-C++) and compiled into a Windows DLL. Since it includes C code to link to Tcl and C++ code for the library, it uses the C++ compiler g++. The DLL can be downloaded from http://www.kb-creative.net/programming/tclSMILE.dll .
In lieu of a documented interface (sorry...) I'm offering a couple of sample scripts which should hopefully show the idea of how this library works. Then at the end I'm posting the code for the DLL. (Pretty uninspired code -- a big switch/case statement.)
Note: For reasons that weren't entirely clear (to me or the SMILE developer), the DLL works with the old ".dsl" file format, but not the new XML ".xdsl" format for SMILE/GeNIe. Since GeNIe will save down, this shouldn't be a big problem.
This is from the SMILE tutorial:
load tclsmile.dll
dslnet create theNet
set success [dslnet addnode theNet Success {Success Failure}]
set forecast [dslnet addnode theNet Forecast {Good Moderate Poor}]
dslnet setprobs theNet $success {0.2 0.8}
dslnet addarc theNet $success $forecast
dslnet setCPT theNet $forecast {0.4 0.4 0.2 0.1 0.3 0.6}
dslnet setevidence theNet $forecast 1
dslnet updatebeliefs theNet
tk_messageBox -message [dslnet beliefs theNet $success]
dslnet writefile theNet "test.dsl"
dslnet clearallevidence theNet
dslnet delete theNetThis shows how to go from the text IDs to the integer handles that are used to refer to nodes:
load tclsmile.dll
dslnet create BN
dslnet readfile BN "test.dsl"
foreach ID {Variable1 Variable2 Variable3 Variable4 Variable5} {
set hndl($ID) [dslnet findnode BN $ID]
}
# First make sure the network is all calculated
dslnet updatebeliefs BN
# Look at the values for one of the variables (a list)
puts [dslnet beliefs BN $hndl(Variable1)]
# Now set the value of one of the variables and recalculate
dslnet setevidence BN $hndl(Variable2) 0
dslnet updatebeliefs BN
puts [dslnet beliefs BN $hndl(Variable1)]Header "tclsmile_lib.h"
#ifndef _DLL_H_
#define _DLL_H_
/*###################################
#
# Types
#
###################################*/
// These are trivial for now, to allow future growth
typedef struct DSLnet {
DSL_network *net;
} DSLnet;
typedef struct DSLstate {
Tcl_HashTable hash;
} DSLstate;
/*###################################
#
# Exported procedures
#
###################################*/
#ifdef __cplusplus
extern "C" {
#endif
int DLLEXPORT Tclsmile_Init(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif
/*###################################
#
# Internal functions
#
###################################*/
void DSLcleanup(ClientData data);
static int dslnet_Cmd(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]);
#endif /* _DLL_H_ */C++ file "tclsmile_lib.cpp"
#include <cstdlib>
#include <iostream>
#include <windows.h>
#include <tcl.h>
#include <smile.h>
#include "tclsmile_lib.h"
/**
*
*/
int DLLEXPORT Tclsmile_Init (Tcl_Interp *interp) {
DSLstate *stateptr;
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == 0L) {
Tcl_AddErrorInfo(interp, "This extension must be run with a stubs-enabled interpreter");
return TCL_ERROR;
}
// Set so that xdsl format can be used -- NOT CURRENTLY WORKING; HAVE CONTACTED DEVELOPER
// EnableXdslFormat();
/* */
stateptr = (DSLstate *)ckalloc(sizeof(DSLstate));
Tcl_InitHashTable(&stateptr->hash, TCL_STRING_KEYS);
Tcl_CreateObjCommand(interp, "dslnet", dslnet_Cmd,
(ClientData)stateptr, DSLcleanup);
return TCL_OK;
}
/**
*/
void
DSLcleanup(ClientData data)
{
DSLstate *stateptr = (DSLstate *)data;
DSLnet *netptr;
Tcl_HashEntry *entryptr;
Tcl_HashSearch search;
entryptr = Tcl_FirstHashEntry(&stateptr->hash, &search);
while (entryptr != NULL) {
netptr = (DSLnet*) Tcl_GetHashValue(entryptr);
Tcl_DeleteHashEntry(entryptr);
delete netptr->net;
/* */
entryptr = Tcl_FirstHashEntry(&stateptr->hash, &search);
}
ckfree((char *)stateptr);
}
/**
*
*/
static int dslnet_Cmd(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) {
DSLstate *stateptr = (DSLstate *)data;
DSLnet *netptr;
Tcl_HashEntry *entryptr;
Tcl_Obj **ObjArray;
Tcl_Obj *ListPtr, *ObjPtr;
DSL_stringArray names;
DSL_doubleArray probs;
DSL_sysCoordinates *syscoords;
DSL_Dmatrix *matptr;
int newhash, node1, node2;
int i, j, k, m, n;
double sum, dval;
double eps = 1.0e-7;
char *string;
char errstring[100];
/* */
char *subCmds[] = {
"create", "addnode", "setprobs", "addarc", "setCPT", "writefile",
"readfile", "delete", "clearevidence", "getevidence", "setevidence",
"clearallevidence", "updatebeliefs", "beliefs", "findnode", NULL
};
enum CmdIx {
CreateIx, AddNodeIx, SetProbsIx, AddArcIx, SetCPTIx, WriteFileIx,
ReadFileIx, DeleteIx, ClearEvIx, GetEvIx, SetEvIx, ClearAllEvIx, UpdateBeliefsIx,
BeliefsIx, FindNodeIx
};
int result, index;
/* */
if (objc == 1 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], (const char **) subCmds,
"option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
/* */
if (((index == CreateIx || index == DeleteIx || index == ClearAllEvIx ||
index == UpdateBeliefsIx) &&
(objc != 3)) ||
((index == WriteFileIx || index == GetEvIx || index == ClearEvIx ||
index == BeliefsIx || index == ReadFileIx || index == FindNodeIx) &&
(objc != 4)) ||
((index == AddNodeIx || index == SetProbsIx || index == AddArcIx ||
index == SetCPTIx || index == SetEvIx) &&
(objc != 5))) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
/* */
if (index == CreateIx) {
string = Tcl_GetString(objv[2]);
entryptr = Tcl_CreateHashEntry(&stateptr->hash, string, &newhash);
netptr = (DSLnet *)ckalloc(sizeof(DSLnet));
netptr->net = new DSL_network();
netptr->net->SetDefaultBNAlgorithm(DSL_ALG_BN_LAURITZEN);
netptr->net->SetDefaultIDAlgorithm(DSL_ALG_ID_COOPERSOLVING);
Tcl_SetHashValue(entryptr, (ClientData)netptr);
Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1);
return TCL_OK;
}
// Find the network from its name (2nd arg for all commands)
entryptr = Tcl_FindHashEntry(&stateptr->hash,
Tcl_GetString(objv[2]));
if (entryptr == NULL) {
Tcl_AppendResult(interp, "Unknown network: ",
Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
}
netptr = (DSLnet *)Tcl_GetHashValue(entryptr);
switch (index) {
case DeleteIx:
Tcl_DeleteHashEntry(entryptr);
delete netptr->net;
break;
case WriteFileIx:
// Get filename
string = Tcl_GetString(objv[3]);
n = netptr->net->WriteFile(string, DSL_DSL_FORMAT);
if (n < 0) {
// Get index of the last error in list of errors
n = netptr->net->ErrorHandler().GetNumberOfErrors() - 1;
Tcl_AddErrorInfo(interp, netptr->net->ErrorHandler().GetErrorMessage(n));
return TCL_ERROR;
}
break;
case ReadFileIx:
// Get filename
string = Tcl_GetString(objv[3]);
n = netptr->net->ReadFile(string, DSL_DSL_FORMAT);
if (n < 0) {
// Get index of the last error in list of errors
n = netptr->net->ErrorHandler().GetNumberOfErrors() - 1;
Tcl_AddErrorInfo(interp, netptr->net->ErrorHandler().GetErrorMessage(n));
return TCL_ERROR;
}
break;
case AddNodeIx:
// Get node name
string = Tcl_GetString(objv[3]);
node1 = netptr->net->AddNode(DSL_CPT, string);
Tcl_SetIntObj(Tcl_GetObjResult(interp), node1);
if (Tcl_ListObjGetElements(interp, objv[4], &n, &ObjArray) == TCL_ERROR) {
return TCL_ERROR;
}
for (i = 0; i < n; i++) {
names.Add(Tcl_GetString(ObjArray[i]));
}
netptr->net->GetNode(node1)->Definition()->SetNumberOfOutcomes(names);
break;
case SetProbsIx:
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
if (Tcl_ListObjGetElements(interp, objv[4], &n, &ObjArray) == TCL_ERROR) {
return TCL_ERROR;
}
probs.SetSize(n);
sum = 0;
for (i = 0; i < n; i++) {
Tcl_GetDoubleFromObj(interp, ObjArray[i], &dval);
probs[i] = dval;
sum += dval;
}
if (sum > 1.0 + eps || sum < 1.0 - eps) {
Tcl_AddErrorInfo(interp, "Probabilities must sum to 1.0");
return TCL_ERROR;
}
netptr->net->GetNode(node1)->Definition()->SetDefinition(probs);
break;
case AddArcIx:
// Get node ids
Tcl_GetIntFromObj(interp, objv[3], &node1);
Tcl_GetIntFromObj(interp, objv[4], &node2);
netptr->net->AddArc(node1,node2);
break;
case SetCPTIx:
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
if (Tcl_ListObjGetElements(interp, objv[4], &n, &ObjArray) == TCL_ERROR) {
return TCL_ERROR;
}
syscoords = new DSL_sysCoordinates(*netptr->net->GetNode(node1)->Definition());
k = netptr->net->GetNode(node1)->Definition()->GetNumberOfOutcomes();
m = n/k;
if (n % k) {
Tcl_AddErrorInfo(interp, "Inconsistent number of CPT entries");
delete syscoords;
return TCL_ERROR;
}
for (i = 0; i < m; i++) {
sum = 0;
for (j = 0; j < k; j++) {
Tcl_GetDoubleFromObj(interp, ObjArray[k * i + j], &dval);
syscoords->UncheckedValue() = dval;
syscoords->Next();
sum += dval;
}
if (sum > 1.0 + eps || sum < 1.0 - eps) {
Tcl_AddErrorInfo(interp, "Probabilities must sum to 1.0");
delete syscoords;
return TCL_ERROR;
}
}
delete syscoords;
break;
case ClearEvIx:
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
netptr->net->GetNode(node1)->Value()->ClearEvidence();
break;
case GetEvIx:
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
n = netptr->net->GetNode(node1)->Value()->ClearEvidence();
if (n == DSL_OUT_OF_RANGE) {
n = -1;
}
Tcl_SetIntObj(Tcl_GetObjResult(interp), n);
break;
case SetEvIx:
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
// Get value
Tcl_GetIntFromObj(interp, objv[4], &n);
n = netptr->net->GetNode(node1)->Value()->SetEvidence(n);
break;
case ClearAllEvIx:
n = netptr->net->ClearAllEvidence();
break;
case UpdateBeliefsIx:
netptr->net->UpdateBeliefs();
break;
case BeliefsIx:
// Create an empty list
ListPtr = Tcl_NewListObj(0, NULL);
// Get node id
Tcl_GetIntFromObj(interp, objv[3], &node1);
if (netptr->net->GetNode(node1)->Value()->IsValueValid()) {
n = netptr->net->GetNode(node1)->Value()->GetSize();
matptr = netptr->net->GetNode(node1)->Value()->GetMatrix();
for (i = 0; i < n; i++) {
dval = matptr->Subscript(i);
Tcl_ListObjAppendElement(interp, ListPtr, Tcl_NewDoubleObj(dval));
}
}
Tcl_SetObjResult(interp, ListPtr);
break;
case FindNodeIx:
// Get ID
string = Tcl_GetString(objv[3]);
n = netptr->net->FindNode(string);
if (n == DSL_OUT_OF_RANGE) {
sprintf(errstring, "Node does not exist with ID '%s'", string);
Tcl_AddErrorInfo(interp, errstring);
return TCL_ERROR;
}
Tcl_SetIntObj(Tcl_GetObjResult(interp), n);
break;
default: assert("Invalid command");
}
return TCL_OK;
}
BOOL APIENTRY DllMain (HINSTANCE hInst /* Library instance handle. */ ,
DWORD reason /* Reason this function is being called. */ ,
LPVOID reserved /* Not used. */ )
{
switch (reason)
{
case DLL_PROCESS_ATTACH:
break;
case DLL_PROCESS_DETACH:
break;
case DLL_THREAD_ATTACH:
break;
case DLL_THREAD_DETACH:
break;
}
/* Returns TRUE on success, FALSE on failure */
return TRUE;
}Makefile
# Project: tclSMILE
# Makefile created by Dev-C++ 4.9.9.2
CPP = g++.exe
CC = gcc.exe
WINDRES = windres.exe
RES =
OBJ = tclsmile_lib.o $(RES)
LINKOBJ = tclsmile_lib.o $(RES)
LIBS = -L"C:/Dev-Cpp/lib" -L"C:/development/lib" -L"C:/Tcl/lib" --no-export-all-symbols --add-stdcall-alias C:/Tcl/lib/tclstub84.lib C:/development/lib/smile/libsmilexml.a C:/development/lib/smile/libsmile.a
INCS = -I"C:/Dev-Cpp/include" -I"C:/Tcl/include" -I"C:/development/lib/smile"
CXXINCS = -I"C:/Dev-Cpp/lib/gcc/mingw32/3.4.2/include" -I"C:/Dev-Cpp/include/c++/3.4.2/backward" -I"C:/Dev-Cpp/include/c++/3.4.2/mingw32" -I"C:/Dev-Cpp/include/c++/3.4.2" -I"C:/Dev-Cpp/include" -I"C:/Tcl/include" -I"C:/development/lib/smile"
BIN = tclSMILE.dll
CXXFLAGS = $(CXXINCS) -DBUILDING_DLL=1 -DUSE_TCL_STUBS
CFLAGS = $(INCS) -DBUILDING_DLL=1 -DUSE_TCL_STUBS
RM = rm -f
.PHONY: all all-before all-after clean clean-custom
all: all-before tclSMILE.dll all-after
clean: clean-custom
${RM} $(OBJ) $(BIN)
DLLWRAP=dllwrap.exe
DEFFILE=libtclSMILE.def
STATICLIB=libtclSMILE.a
$(BIN): $(LINKOBJ)
$(DLLWRAP) --output-def $(DEFFILE) --driver-name c++ --implib $(STATICLIB) $(LINKOBJ) $(LIBS) -o $(BIN)
tclsmile_lib.o: tclsmile_lib.cpp
$(CPP) -c tclsmile_lib.cpp -o tclsmile_lib.o $(CXXFLAGS)
arjen - 2018-01-07 10:30:51
I just noticed that the SMILE library is now owned by BayesFusion LLC - it is therefore no longer Open Source, except for academic use. So it goes.