[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.

----
**Sample Scripts**

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 theNet

This 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)]

----
***The C++ Interface**

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"

    /*
     * Tclsmile_Init --
     *
     *      Create a hashtable of DSL nets for each interpreter
     *
     */

    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();
       
       /*
        * Allocate and initialize the hash table. Associate the
        * state with the command by using the ClientData.
        */
        
       stateptr = (DSLstate *)ckalloc(sizeof(DSLstate));
       Tcl_InitHashTable(&stateptr->hash, TCL_STRING_KEYS);
       Tcl_CreateObjCommand(interp, "dslnet", dslnet_Cmd, 
             (ClientData)stateptr, DSLcleanup);
       return TCL_OK;
    }

    /*
     * DSLcleanup --
     *     This is called when the dslnet command is destroyed.
     *
     *     This walks the hash table and deletes the nets it
    *      contains. Then it deallocates the hash table.
     */

    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;
          /*
           * Get the first entry again, not the "next" one,
           * because we just modified the hash table.
           */
          entryptr = Tcl_FirstHashEntry(&stateptr->hash, &search);
       }
       ckfree((char *)stateptr);
    }

    /*
     * dslnet_Cmd --
     *
     *      This implements the main command, which has these
     *      subcommands:
     *         create name
     *         addnode name label {list of value labels}
     *            - Returns an integer handle
     *         setprobs name node {list of probabilities}
     *            - Must sum to one
     *         addarc name start end
     *         setCPT name node {list of probabilities}
     *            - Each (count of probs)/(num of values of result) sum to 1
     *         writefile name fname
     *         delete name
     *
     *   Results:
     *      A standard Tcl command result.
     */
     
    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];
       /*
        * The subCmds array defines the allowed values for the
        * first argument. These are mapped to values in the
        * CmdIx enumeration by Tcl_GetIndexFromObj.
        */
       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;
       
       /*
        * 1) Get the command
        */
       
       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;
       }
       
       /*
        * 2) Vet the command by number of args
        */
       
       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;
       }
       
       /*
        * 3) Implement the command
        */
       
       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)


----
!!!!!!
%| [Category Package] |%
!!!!!!