http://genie.sis.pitt.edu/

http://www.kb-creative.net/programming/tclSMILE.dll

Sample Scripts edit

 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

 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 edit

    #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_ */

    #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;
    }

    # 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)

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References