From 0810afa28139e5a268354f200cf865ff0296d7d3 Mon Sep 17 00:00:00 2001 From: ralmond Date: Sun, 5 Jan 2020 18:03:33 +0000 Subject: [PATCH] Big backfill & Doc cleanup. --- DESCRIPTION | 7 +- NAMESPACE | 9 +- R/BNgenerics.R | 22 ++++ R/Manifest.R | 2 +- R/Pnets.R | 15 +++ R/QOmegaMat.R | 2 +- R/Warehouses.R | 2 + R/shinyNode.R | 2 +- TODO | 9 +- inst/auxdata/Mini-PP-Nodes.csv | 20 +-- man/BNgenerics.Rd | 89 ------------- man/BuildNodeManifest.Rd | 22 ++-- man/BuildTable.Rd | 7 +- man/GEMfit.Rd | 39 +++--- man/NodeGadget.Rd | 12 +- man/Omega2Pnet.Rd | 2 + man/Peanut-package.Rd | 28 ++-- man/Pnet-class.Rd | 112 ++++++++++++++++ man/Pnet.Rd | 11 +- man/Pnet2Omega.Rd | 7 + man/Pnet2Qmat.Rd | 24 ++++ man/PnetAdjoin.Rd | 16 +-- man/PnetCompile.Rd | 103 +++++++++++++++ man/PnetName.Rd | 23 ++++ man/PnetPathname.Rd | 2 +- man/PnetPnodes.Rd | 11 +- man/PnetPriorWeight.Rd | 11 +- man/PnetSerialize.Rd | 37 +++++- man/PnetWarehouse-class.Rd | 174 ++++++++++++++++++++++++ man/Pnode-class.Rd | 152 +++++++++++++++++++++ man/PnodeBetas.Rd | 11 +- man/PnodeEvidence.Rd | 129 ++++++++++++++++++ man/PnodeLink.Rd | 10 +- man/PnodeLinkScale.Rd | 10 +- man/PnodeLnAlphas.Rd | 10 +- man/PnodeName.Rd | 25 +++- man/PnodeParentTvals.Rd | 11 +- man/PnodeParents.Rd | 12 +- man/PnodePostWeight.Rd | 123 +++++++++++++++++ man/PnodeProbs.Rd | 116 ++++++++++++++++ man/PnodeQ.Rd | 14 +- man/PnodeRules.Rd | 10 +- man/PnodeStateValues.Rd | 2 +- man/PnodeStates.Rd | 8 ++ man/PnodeStats.Rd | 8 +- man/PnodeWarehouse-class.Rd | 234 +++++++++++++++++++++++++++++++++ man/Statistic-class.Rd | 3 + man/Statistic.Rd | 5 +- man/Warehouse.Rd | 4 +- man/WarehouseManifest.Rd | 6 + man/calcExpTables.Rd | 16 +-- man/calcPnetLLike.Rd | 12 +- man/flog.try.Rd | 85 ++++++++++++ man/isPnodeContinuous.Rd | 9 +- man/maxAllTableParams.Rd | 14 +- 55 files changed, 1604 insertions(+), 255 deletions(-) delete mode 100644 man/BNgenerics.Rd create mode 100644 man/Pnet-class.Rd create mode 100644 man/PnetCompile.Rd create mode 100644 man/PnetWarehouse-class.Rd create mode 100644 man/Pnode-class.Rd create mode 100644 man/PnodeEvidence.Rd create mode 100644 man/PnodePostWeight.Rd create mode 100644 man/PnodeProbs.Rd create mode 100644 man/PnodeWarehouse-class.Rd create mode 100644 man/flog.try.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d10616d..763ba85 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,11 @@ Package: Peanut -Version: 0.7-1 -Date: 2019/10/21 +Version: 0.8-2 +Date: 2019/12/11 Title: Parameterized Bayesian Networks, Abstract Classes Author: Russell Almond Maintainer: Russell Almond -Depends: R (>= 3.0), CPTtools (>= 0.5), methods, shiny (>= 1.1), shinyjs, futile.logger +Depends: R (>= 3.0), CPTtools (>= 0.5), methods, futile.logger +Imports: shiny (>= 1.1), shinyjs, utils Description: This provides support of learning conditional probability tables parameterized using CPTtools License: Artistic-2.0 URL: http://pluto.coe.fsu.edu/RNetica diff --git a/NAMESPACE b/NAMESPACE index 828322a..b59211d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,7 +15,9 @@ export(is.Pnet, as.Pnet, Pnet, BuildAllTables, is.Pnode, as.Pnode, Pnode, PnodeNet, PnodeQ, "PnodeQ<-", + PnodeProbs, "PnodeProbs<-", PnodePriorWeight, "PnodePriorWeight<-", + PnodePostWeight, PnodeRules, "PnodeRules<-", PnodeLink, "PnodeLink<-", PnodeLnAlphas, "PnodeLnAlphas<-", @@ -52,6 +54,7 @@ S3method(PnodeParentTvals, default) ## BN generics. +exportClasses(Pnet,Pnode) export(PnodeName, "PnodeName<-", PnodeTitle, "PnodeTitle<-", PnodeDescription, "PnodeDescription<-", @@ -70,7 +73,7 @@ export(PnodeName, "PnodeName<-", PnetDescription, "PnetDescription<-", PnetFindNode, PnetMakeStubNodes, PnetRemoveStubNodes,PnetAdjoin, - PnetDetach, + PnetDetach, PnetCompile, PnetSerialize, PnetUnserialize, unserializePnet ) exportMethods(PnodeName, "PnodeName<-", @@ -84,13 +87,14 @@ exportMethods(PnodeName, "PnodeName<-", PnodeStateBounds, "PnodeStateBounds<-", PnodeParents, "PnodeParents<-", PnodeParentNames, PnodeNumParents, isPnodeContinuous, + PnodeEvidence,"PnodeEvidence<-", PnetName, "PnetName<-", PnetTitle, "PnetTitle<-", PnetHub, "PnetHub<-", PnetPathname, "PnetPathname<-", PnetDescription, "PnetDescription<-", PnetMakeStubNodes, PnetRemoveStubNodes, - PnetAdjoin, PnetDetach, + PnetAdjoin, PnetDetach, PnetCompile, PnetFindNode) ## Manifests @@ -98,6 +102,7 @@ exportMethods(PnodeName, "PnodeName<-", export(BuildNetManifest,BuildNodeManifest) ## Warehouses +exportClasses(PnetWarehouse,PnodeWarehouse) export(ClearWarehouse,WarehouseManifest,"WarehouseManifest<-", WarehouseData,WarehouseSupply,WarehouseFetch, WarehouseMake,WarehouseFree, WarehouseUnpack, diff --git a/R/BNgenerics.R b/R/BNgenerics.R index 0467add..cc811e6 100644 --- a/R/BNgenerics.R +++ b/R/BNgenerics.R @@ -1,3 +1,11 @@ +################################ +## Generic objects. These are implemented as class unions, so that +## they can added to by implementing classes. + +setClassUnion("Pnode","NULL") +setClassUnion("Pnet","NULL") + + ### ## These are functions which it is pretty safe to assume that every ## Bayes net package has. We can put them here to make generics so @@ -89,6 +97,14 @@ isPnodeContinuous <- function (node) UseMethod("isPnodeContinuous") setGeneric("isPnodeContinuous") +PnodeEvidence <- function (node) + UseMethod("PnodeEvidence") +setGeneric("PnodeEvidence") + +"PnodeEvidence<-" <- function (node,value) + UseMethod("PnodeEvidence<-") +setGeneric("PnodeEvidence<-") + #### Parents @@ -108,6 +124,8 @@ PnodeNumParents <- function (node) UseMethod("PnodeNumParents") setGeneric("PnodeNumParents") + +############################################################### ## Pnets PnetName <- function (net) UseMethod("PnetName") @@ -178,5 +196,9 @@ PnetUnserialize <- function (serial) { unserializePnet(factory,serial) } +PnetCompile <- function(net) + UseMethod("PnetCompile") +setGeneric("PnetCompile") + diff --git a/R/Manifest.R b/R/Manifest.R index 023ff70..9675b51 100644 --- a/R/Manifest.R +++ b/R/Manifest.R @@ -101,7 +101,7 @@ BuildNodeManifest <- function (Pnodelist) { if (isPnodeContinuous(nd)) { StateValue <- c(StateValue,rep(NA_real_,k)) bnds <- PnodeStateBounds(nd) - LowerBound <- c(UpperBound,bnds[,1L]) + LowerBound <- c(LowerBound,bnds[,1L]) UpperBound <- c(UpperBound,bnds[,2L]) } else { if (!is.null(PnodeStateValues(nd))) { diff --git a/R/Pnets.R b/R/Pnets.R index 9b48bae..22b7d63 100644 --- a/R/Pnets.R +++ b/R/Pnets.R @@ -262,6 +262,21 @@ setGeneric("PnodePriorWeight") } setGeneric("PnodePriorWeight<-") +PnodePostWeight <- function (node) { + UseMethod("PnodePostWeight") +} +setGeneric("PnodePostWeight") + +PnodeProbs <- function (node) { + UseMethod("PnodeProbs") +} +setGeneric("PnodeProbs") + +"PnodeProbs<-" <- function (node,value) { + UseMethod("PnodeProbs<-") +} +setGeneric("PnodeProbs<-") + PnodeParentTvals <- function (node) { UseMethod("PnodeParentTvals") } diff --git a/R/QOmegaMat.R b/R/QOmegaMat.R index 4b6aa9a..3af1b9e 100644 --- a/R/QOmegaMat.R +++ b/R/QOmegaMat.R @@ -844,7 +844,7 @@ Omega2Pnet <- function(OmegaMat,pn,nodewarehouse, napar <- sapply(PnodeParentTvals(node),function(x) any(is.na(x))) if (any(napar)) { flog.error("Parents %s of node %s don't have levels set.", - paste(parnames[napar],collapse=", "),nodename) + paste(parnames[napar],collapse=", "),ndn) stop("Parent",paste(parnames[napar],collapse=", "), "of node", nodename, "don't have levels set.") } diff --git a/R/Warehouses.R b/R/Warehouses.R index 2145f5e..1fd4888 100644 --- a/R/Warehouses.R +++ b/R/Warehouses.R @@ -1,3 +1,5 @@ +setClassUnion("PnodeWarehouse","NULL") +setClassUnion("PnetWarehouse","NULL") ClearWarehouse <- function (warehouse) diff --git a/R/shinyNode.R b/R/shinyNode.R index 71cff36..3adbec0 100644 --- a/R/shinyNode.R +++ b/R/shinyNode.R @@ -767,6 +767,6 @@ DPCGadget <- function(pnode, color="steelblue") { } ########################################## -## Shiny breaks the show command +## Shinyjs breaks the show command show <- methods::show diff --git a/TODO b/TODO index e5ec292..c0821d0 100644 --- a/TODO +++ b/TODO @@ -1,13 +1,8 @@ * checking for missing documentation entries ... WARNING Undocumented code objects: - ‘WarehouseInventory’ ‘WarehouseUnpack’ - ‘flog.try’ ‘name’ -Undocumented S4 methods: - generic 'WarehouseSupply' and siglist 'ANY' -Functions or methods with usage in documentation object 'Pnet' but not in code: - Pnet.ANY - + PnodePostWeight ‘name’ + https://docs.google.com/spreadsheets/d/{key}/gviz/tq?tqx=out:csv&sheet={sheet_name} https://docs.google.com/spreadsheets/d/1UoIfFQn5TUwDBDWqxBEQxkwJbUHHjlo7WDCebvzx9j8/edit?usp=sharing \ No newline at end of file diff --git a/inst/auxdata/Mini-PP-Nodes.csv b/inst/auxdata/Mini-PP-Nodes.csv index d17670b..215e439 100644 --- a/inst/auxdata/Mini-PP-Nodes.csv +++ b/inst/auxdata/Mini-PP-Nodes.csv @@ -1,21 +1,21 @@ "","Model","NodeName","ModelHub","NodeTitle","NodeDescription","NodeLabels","Continuous","Nstates","StateName","StateTitle","StateDescription","StateValue","LowerBound","UpperBound" -"1","miniPP_CM","Physics","","Physics Understanding","General understanding of Newtonian mechanics.","pnodes,Proficiencies",FALSE,3,"High","Highest 1/3","Highest third of target population",0.967421566101701,NA,NA +"1","miniPP_CM","Physics","","Physics Understanding","General understanding of Newtonian mechanics.","Proficiencies,pnodes",FALSE,3,"High","Highest 1/3","Highest third of target population",0.967421566101701,NA,NA "2","miniPP_CM","Physics","","","","",NA,NA,"Medium","Middle 1/3","Middle Third of target Population",0,NA,NA "3","miniPP_CM","Physics","","","","",NA,NA,"Low","Lowest 1/3","Lowest third of target population",-0.967421566101701,NA,NA "4","miniPP_CM","IterativeD","","Use iterative design to solve a problem","Mass and GPE are directly related -Height and GPE are directly related","pnodes,LowLevel,Proficiencies",FALSE,3,"High","","Complete Mastery",0.967421566101701,NA,NA +Height and GPE are directly related","Proficiencies,pnodes,LowLevel",FALSE,3,"High","","Complete Mastery",0.967421566101701,NA,NA "5","miniPP_CM","IterativeD","","","","",NA,NA,"Medium","","Partial Mastery",0,NA,NA "6","miniPP_CM","IterativeD","","","","",NA,NA,"Low","","No Mastery",-0.967421566101701,NA,NA -"7","miniPP_CM","EnergyTransfer","","Energy can Transfer","Energy can transfer from one object to another.","pnodes,LowLevel,Proficiencies",FALSE,3,"High","","Can use to solve difficult problems",0.967421566101701,NA,NA +"7","miniPP_CM","EnergyTransfer","","Energy can Transfer","Energy can transfer from one object to another.","Proficiencies,pnodes,LowLevel",FALSE,3,"High","","Can use to solve difficult problems",0.967421566101701,NA,NA "8","miniPP_CM","EnergyTransfer","","","","",NA,NA,"Medium","","Can use to solve simple but not difficult problems",0,NA,NA "9","miniPP_CM","EnergyTransfer","","","","",NA,NA,"Low","","Can not solve simple problems.",-0.967421566101701,NA,NA "10","miniPP_CM","NTL","","Newton's Third Law","Force pairs act in opposite directions -Force pairs have equal magnitudes","pnodes,LowLevel,Proficiencies",FALSE,3,"High","","",0.967421566101701,NA,NA +Force pairs have equal magnitudes","Proficiencies,pnodes,LowLevel",FALSE,3,"High","","",0.967421566101701,NA,NA "11","miniPP_CM","NTL","","","","",NA,NA,"Medium","","",0,NA,NA "12","miniPP_CM","NTL","","","","",NA,NA,"Low","","",-0.967421566101701,NA,NA "13","miniPP_CM","POfMom","","Properties of momentum","Momentum is directly related to mass Momentum is directly related to velocity -Momentum is parallel to velocity","pnodes,LowLevel,Proficiencies",FALSE,3,"High","","",0.967421566101701,NA,NA +Momentum is parallel to velocity","Proficiencies,pnodes,LowLevel",FALSE,3,"High","","",0.967421566101701,NA,NA "14","miniPP_CM","POfMom","","","","",NA,NA,"Medium","","",0,NA,NA "15","miniPP_CM","POfMom","","","","",NA,NA,"Low","","",-0.967421566101701,NA,NA "Right","PPcompEM","CompensatoryObs","miniPP_CM","Compensatory Observable","A binary response which requires both parent variables for high probability of success.","onodes,Observables,pnodes",FALSE,2,"Right","","",NA,NA,NA @@ -25,11 +25,11 @@ Momentum is parallel to velocity","pnodes,LowLevel,Proficiencies",FALSE,3,"High" "Full","PPtwostepEM","TwoStepObs","miniPP_CM","Partial Credit observable","A partial credit response where each step requires different inputs.","onodes,Observables,pnodes",FALSE,3,"Full","Complete Solution","",NA,NA,NA "Partial","PPtwostepEM","TwoStepObs","","","","",NA,NA,"Partial","First step but not second","",NA,NA,NA "None","PPtwostepEM","TwoStepObs","","","","",NA,NA,"None","No attempt of failed first step","",NA,NA,NA -"one","PPdurAttEM","Attempts","miniPP_CM","Number of Attempts","The number of times level was started or restarted","onodes,Observables,pnodes",TRUE,4,"one","1","",NA,0.5,1.5 -"two","PPdurAttEM","Attempts","","","","",NA,NA,"two","2","",NA,1.5,2.5 -"three","PPdurAttEM","Attempts","","","","",NA,NA,"three","3","",NA,2.5,3.5 -"fourPlus","PPdurAttEM","Attempts","","","","",NA,NA,"fourPlus","4 or more","",NA,3.5,Inf -"Q1","PPdurAttEM","Duration","miniPP_CM","Time spent on level","Total time spent on level less time spent on learning supports","onodes,Observables,pnodes",TRUE,4,"Q1","0–30.190","",NA,0,30.19 +"one","PPdurAttEM","Attempts","miniPP_CM","Number of Attempts","The number of times level was started or restarted","pnodes,onodes,Observables",TRUE,4,"one","1","",NA,0.1,1.1 +"two","PPdurAttEM","Attempts","","","","",NA,NA,"two","2","",NA,1.1,2.1 +"three","PPdurAttEM","Attempts","","","","",NA,NA,"three","3","",NA,2.1,3.1 +"fourPlus","PPdurAttEM","Attempts","","","","",NA,NA,"fourPlus","4 or more","",NA,3.1,Inf +"Q1","PPdurAttEM","Duration","miniPP_CM","Time spent on level","Total time spent on level less time spent on learning supports","pnodes,onodes,Observables",TRUE,4,"Q1","0–30.190","",NA,0,30.19 "Q2","PPdurAttEM","Duration","","","","",NA,NA,"Q2","30.190–67.037","",NA,30.19,67.037 "Q3","PPdurAttEM","Duration","","","","",NA,NA,"Q3","67.037–154.893","",NA,67.037,154.893 "Q4","PPdurAttEM","Duration","","","","",NA,NA,"Q4","154.893—Inf","",NA,154.893,Inf diff --git a/man/BNgenerics.Rd b/man/BNgenerics.Rd deleted file mode 100644 index 07468ff..0000000 --- a/man/BNgenerics.Rd +++ /dev/null @@ -1,89 +0,0 @@ -\name{BNgenerics} -%\alias{PnodeName} -%\alias{PnodeStates} -\alias{PnodeNumStates} -%\alias{PnodeParents} -\alias{PnodeNumParents} -\alias{PnodeParentNames} - -\title{Aliases for generic Bayesian network functions.} -\description{ - These are all mostly self-explantory functions which almost any - Bayesian network implementation will support. These are alias of - these functions so that generic functions can be written using Peanut - which will support almost all Bayes net implementation. -} -\usage{ -PnodeName(node) -PnodeStates(node) -PnodeNumStates(node) -PnodeParents(node) -PnodeNumParents(node) -PnodeParentNames(node) -} -\arguments{ - \item{node}{A object of a type which could be a Pnode, athough it does - not necessarily need Pnode special properties.} -} -\details{ - - The general idea is to find a minimal set of common Bayes net - functions that any reasonable Bayes net package is likely to support - so that basic code can be written which is generic across Bayes net - packages. For example, if \code{nd} is a - \code{\link[RNetica]{NeticaNode}} object, then \code{PnodeName(nd)} is - a synonym for \code{\link[RNetica]{NodeName}(nd)}. However, using - \code{PnodeName(nd)} is more portable as it could expand to another - function if using a different Bayes net package. - - The goal is to be able to write simple loops based on things like - number of parents and number of states which are common to most - implementations. - - -} -\value{ - The expression \code{PnodeName(node)} returns a character scalar giving - the name of \code{node}. - - The expression \code{PnodeStates(node)} returns a character vector giving - the names of the states of \code{node}. - - The expression \code{PnodeNumStates(node)} returns an integer scalar giving - the number of states of \code{node}. - - The expression \code{PnodeParents(node)} returns a list giving - the parent objects. - - The expression \code{PnodeNumParents(node)} returns an integer scalar giving - the number of parents of \code{node}. - - The expression \code{PnodeStates(node)} returns a character vector giving - the names of the parents of \code{node}. - -} -\author{Russell Almond} -\examples{ -\dontrun{ -PnodeName.NeticaNode <- function (node) - NodeName(node) - -PnodeStates.NeticaNode <- function (node) - NodeStates(node) - -PnodeNumStates.NeticaNode <- function (node) - NodeNumStates(node) - -PnodeParents.NeticaNode <- function (node) - NodeParents(node) - -PnodeParentNames.NeticaNode <- function (node) - sapply(NodeParents(node),NodeName) - -PnodeNumParents.NeticaNode <- function (node) - length(NodeParents(node)) - -} -} -\keyword{ attribute } - diff --git a/man/BuildNodeManifest.Rd b/man/BuildNodeManifest.Rd index a15da92..a88f70d 100644 --- a/man/BuildNodeManifest.Rd +++ b/man/BuildNodeManifest.Rd @@ -125,13 +125,13 @@ BuildNodeManifest(Pnodelist) are used instead.} \item{LowerBound}{This servers as the lower bound for each partition of the continuous variagle. \code{-Inf} is a legal value for the - first row.} + first or last row.} \item{UpperBound}{This is only used for continuous variables, and the value only is needed for one of the states. This servers as the upper bound of range each state. Note the upper bound needs to match the lower bounds of the next state. \code{Inf} - is a legal value for the last row.} - + is a legal value for the first or last row.} + } \section{Continuous Variables}{ @@ -192,6 +192,8 @@ nodeman1 <- read.csv(file.path(library(help="Peanut")$path, "auxdata", \dontrun{ library(PNetica) ## Requires PNetica +sess <- NeticaSession() +startSession(sess) netpath <- file.path(library(help="PNetica")$path, "testnets") netnames <- paste(c("miniPP-CM","PPcompEM","PPconjEM","PPtwostepEM", @@ -210,13 +212,15 @@ for (n in 1:length(EMs)) { BuildNodeManifest(lapply(NetworkAllNodes(EMs[[n]]), as.Pnode))) } -## Exclude node labels from this test, as they could appear in arbitrary order -stopifnot(all.equal(nodeman[,-6],nodeman1[,-6])) -## Note: This test might fail because of node order. Need to improve it. -nl <- strsplit(nodeman$NodeLabels,",") -nl1 <- strsplit(nodeman1$NodeLabels,",") -stopifnot(all(mapply(setequal,nl,nl1))) +## Need to ensure that labels are in cannonical order only for the +## purpose of testing +nodeman[,6] <- sapply(strsplit(nodeman[,6],","), + function(l) paste(sort(l),collapse=",")) +nodeman1[,6] <- sapply(strsplit(nodeman1[,6],","), + function(l) paste(sort(l),collapse=",")) + +stopifnot(all.equal(nodeman,nodeman1)) ## This is the node warehouse for PNetica Nodehouse <- NNWarehouse(manifest=nodeman1, diff --git a/man/BuildTable.Rd b/man/BuildTable.Rd index 5010e6f..4aaafdd 100644 --- a/man/BuildTable.Rd +++ b/man/BuildTable.Rd @@ -73,12 +73,15 @@ BuildAllTables(net, debug=FALSE) } \seealso{ - \code{\link{Pnode}}, \code{\link{PnodeQ}}, + \code{\link{Pnode}}, \code{\link{PnodeProbs}}, \code{\link{PnodeQ}}, \code{\link{PnodePriorWeight}}, \code{\link{PnodeRules}}, \code{\link{PnodeLink}}, \code{\link{PnodeLnAlphas}}, \code{\link{PnodeAlphas}}, \code{\link{PnodeBetas}}, \code{\link{PnodeLinkScale}},\code{\link{GetPriorWeight}}, \code{\link[CPTtools]{calcDPCTable}} + + In many implementations, it will be necessary to run + \code{\link{PnetCompile}} after building the tables. } \examples{ @@ -88,7 +91,7 @@ BuildAllTables(net, debug=FALSE) ## NodeExperience functions are part of the RNetica implementation. BuildTable.NeticaNode <- function (node) { - node[] <- calcDPCFrame(ParentStates(node),NodeStates(node), + node[] <- calcDPCFrame(ParentStates(node),PnodeStates(node), PnodeLnAlphas(node), PnodeBetas(node), PnodeRules(node),PnodeLink(node), PnodeLinkScale(node),PnodeQ(node), diff --git a/man/GEMfit.Rd b/man/GEMfit.Rd index 0770829..63d584d 100644 --- a/man/GEMfit.Rd +++ b/man/GEMfit.Rd @@ -182,36 +182,34 @@ irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, sep=.Platform$file.sep), session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) - + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") } casepath <- paste(library(help="PNetica")$path, "testdat","IRT10.2PL.200.items.cas", sep=.Platform$file.sep) -## Record which nodes in the casefile we should pay attention to -NetworkNodesInSet(irt10.base,"onodes") <- - NetworkNodesInSet(irt10.base,"observables") - BuildAllTables(irt10.base) -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement item1 <- irt10.items[[1]] priB <- PnodeBetas(item1) priA <- PnodeAlphas(item1) -priCPT <- NodeProbs(item1) +priCPT <- PnodeProbs(item1) gemout <- GEMfit(irt10.base,casepath,trace=TRUE) postB <- PnodeBetas(item1) postA <- PnodeAlphas(item1) -postCPT <- NodeProbs(item1) +postCPT <- PnodeProbs(item1) ## Posterior should be different stopifnot( @@ -222,21 +220,30 @@ stopifnot( ### The network that was used for data generation. irt10.true <- ReadNetworks(paste(library(help="PNetica")$path, "testnets","IRT10.2PL.true.dne", - sep=.Platform$file.sep)) + sep=.Platform$file.sep), + session=sess) irt10.true <- as.Pnet(irt10.true) ## Flag as Pnet, fields already set. -irt10.ttheta <- NetworkFindNode(irt10.true,"theta") +irt10.ttheta <- PnetFindNode(irt10.true,"theta") irt10.titems <- PnetPnodes(irt10.true) ## Flag titems as Pnodes for (i in 1:length(irt10.titems)) { irt10.titems[[i]] <- as.Pnode(irt10.titems[[i]]) + ## Add node to list of observed nodes + PnodeLabels(irt10.titems[[1]]) <- + union(PnodeLabels(irt10.titems[[1]]),"onodes") } -NetworkNodesInSet(irt10.true,"onodes") <- - NetworkNodesInSet(irt10.true,"observables") - -BuildAllTables(irt10.true) -CompileNetwork(irt10.true) ## Netica requirement +BuildAllTables(irt10.true) +PnetCompile(irt10.true) ## Netica requirement + +## See how close we are. +for (j in 1:length(irt10.titems)) { + cat("diff[",j,"] = ", + sum(abs(PnodeProbs(irt10.items[[j]])- + PnodeProbs(irt10.titems[[j]])))/ + length(PnodeProbs(irt10.items[[j]])), "\n") +} DeleteNetwork(irt10.base) diff --git a/man/NodeGadget.Rd b/man/NodeGadget.Rd index 2974917..d53a8d4 100644 --- a/man/NodeGadget.Rd +++ b/man/NodeGadget.Rd @@ -119,18 +119,18 @@ tNet <- CreateNetwork("TestNet",sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta2)) ## CompensatoryGadget partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set rules is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="partialCredit") @@ -172,6 +172,8 @@ PnodeLnAlphas(partial3) <- list(FullCredit=c(-.25,.25), partial3 <- DPCGadget(partial3) +DeleteNetwork(tNet) +stopSession(sess) } } \keyword{ manip } diff --git a/man/Omega2Pnet.Rd b/man/Omega2Pnet.Rd index 263da74..4d88d15 100644 --- a/man/Omega2Pnet.Rd +++ b/man/Omega2Pnet.Rd @@ -287,6 +287,7 @@ omegamat <- read.csv(paste(library(help="Peanut")$path, "auxdata", library(PNetica) ## Needs PNetica sess <- NeticaSession() startSession(sess) + curd <- getwd() netman1 <- read.csv(paste(library(help="Peanut")$path, "auxdata", @@ -310,6 +311,7 @@ CM1 <- Omega2Pnet(omegamat,CM,Nodehouse,override=TRUE,debug=TRUE) Om2 <- Pnet2Omega(CM1,NetworkAllNodes(CM1)) +DeleteNetwork(CM) stopSession(sess) setwd(curd) diff --git a/man/Peanut-package.Rd b/man/Peanut-package.Rd index 323ee31..630d9e6 100644 --- a/man/Peanut-package.Rd +++ b/man/Peanut-package.Rd @@ -74,24 +74,25 @@ Maintainer: \packageMaintainer{Peanut} \dontrun{ library(PNetica) ## Requires implementation - +sess <- NeticaSession() +startSession(sess) ## Building CPTs -tNet <- CreateNetwork("TestNet") +tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(NodeNumStates(theta1)) NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(NodeNumStates(theta2)) NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) partial3 <- Pnode(partial3,Q=TRUE, link="partialCredit") PnodePriorWeight(partial3) <- 10 @@ -125,27 +126,27 @@ BuildTable(partial4) irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, "testnets","IRT10.2PL.base.dne", - sep=.Platform$file.sep)) + sep=.Platform$file.sep), + session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) - + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") + } casepath <- paste(library(help="PNetica")$path, "testdat","IRT10.2PL.200.items.cas", sep=.Platform$file.sep) -## Record which nodes in the casefile we should pay attention to -NetworkNodesInSet(irt10.base,"onodes") <- - NetworkNodesInSet(irt10.base,"observables") - BuildAllTables(irt10.base) -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement item1 <- irt10.items[[1]] priB <- PnodeBetas(item1) @@ -157,4 +158,5 @@ gemout <- GEMfit(irt10.base,casepath) DeleteNetwork(irt10.base) DeleteNetwork(tNet) +stopSession(sess) }} diff --git a/man/Pnet-class.Rd b/man/Pnet-class.Rd new file mode 100644 index 0000000..652b7e5 --- /dev/null +++ b/man/Pnet-class.Rd @@ -0,0 +1,112 @@ +\name{Pnet-class} +\Rdversion{1.1} +\docType{class} +\alias{Pnet-class} + +\title{Class \code{"Pnet"}} +\description{ + + This is a virtual class. Classes implementing the Pnet protocol + should attach themselves using \code{\link[methods]{setIs}}. + + Note that \code{NULL} is always considered a member so that + uninitialized in containers. + +} +\section{Objects from the Class}{ + + A virtual Class: No objects may be created from it. + + Classes can register as belonging to this abstract class. The trick + for doing this is: + \code{ + setIs("NetClass","Pnet") + } + + Currently \code{\link[RNetica]{NeticaBN}} is an example of an object + of this class (but requires the \code{PNetica} package to provide all + of the required functionality). + +} +\section{Methods}{ + No methods defined with class "Pnet" in the signature; + however, the following generic functions are available: + + \describe{ + \item{\link{PnetName}}{\code{signature(net = "Pnet")}: Fetches network name. + } + \item{\link{PnetName<-}}{\code{signature(net = "Pnet", value="character")}: + Sets network name. + } + \item{\link{PnetTitle}}{\code{signature(net = "Pnet")}: Fetches network title. + } + \item{\link{PnetTitle<-}}{\code{signature(net = "Pnet", + value="character")}: Sets network title. + } + \item{\link{PnetHub}}{\code{signature(net = "Pnet")}: Fetches name of hub + (Proficiency model) if this is a spoke network (Evidence model). + } + \item{\link{PnetHub<-}}{\code{signature(net = "Pnet", value)}: Sets name of + hub model. + } + \item{\link{PnetPathname}}{\code{signature(net = "Pnet")}: Fetches name of + file in which network is saved. + } + \item{\link{PnetPathname<-}}{\code{signature(net = "Pnet", value)}: Sets name + of file in which network is saved. + } + \item{\link{PnetDescription}}{\code{signature(net = "Pnet")}: Fetches + documentation string for network. + } + \item{\link{PnetDescription<-}}{\code{signature(net = "Pnet", + value="character")}: Sets documentation string for network. + } + \item{\link{PnetFindNode}}{\code{signature(net = "Pnet", + name="character")}: Finds a node by name. + } + \item{\link{PnetMakeStubNodes}}{\code{signature(net = "Pnet", nodes = + "list")}: Copies nodes from hub model into spoke model. + + } + \item{\link{PnetRemoveStubNodes}}{\code{signature(net = "Pnet", nodes = + "list")}: Removes copied nodes from hub model. + } + \item{\link{PnetAdjoin}}{\code{signature(hub = "Pnet", spoke = "Pnet")}: + Attaches spoke to hub, matching stub nodes in spoke with their + counterparts in the hub. + } + \item{\link{PnetDetach}}{\code{signature(motif = "Pnet", spoke = "Pnet")}: + Removes the spoke from the motif (combined hub and spoke). + } + \item{\link{PnetCompile}}{\code{signature(net = "Pnet")}: Performs + topological transformations on the net to make it ready for + inference. + } + \item{\link{PnetSerialize}}{\code{signature(net = "Pnet")}: Saves the net + to a string which can be stored in a database. + } + \item{\link{PnetUnserialize}}{\code{signature(serial = "character")}: + Reverses the above procedure. + } + \item{\link{unserializePnet}}{\code{signature(factory, data)}: this is an + improved version of unserialize that assumes a store of networks. + } + } + +} +\author{ + Russell Almond +} +\seealso{ + + \code{\link{Pnet}}. + + The class \code{\link[RNetica]{NeticaBN}} implements this protocol. +} +\examples{ +showClass("Pnet") +\dontrun{ + setIs("NeticaBN","Pnet") +} +} +\keyword{classes} diff --git a/man/Pnet.Rd b/man/Pnet.Rd index 859b527..2a4bcb9 100644 --- a/man/Pnet.Rd +++ b/man/Pnet.Rd @@ -161,16 +161,16 @@ IRT10.2PL <- CreateNetwork("IRT10_2PL",session=sess) theta <- NewDiscreteNode(IRT10.2PL,"theta", c("VH","High","Mid","Low","VL")) -NodeLevels(theta) <- effectiveThetas(NodeNumStates(theta)) -NodeProbs(theta) <- rep(1/NodeNumStates(theta),NodeNumStates(theta)) +PnodeStateValues(theta) <- effectiveThetas(PnodeNumStates(theta)) +PnodeProbs(theta) <- rep(1/PnodeNumStates(theta),PnodeNumStates(theta)) J <- 10 ## Number of items items <- NewDiscreteNode(IRT10.2PL,paste("item",1:J,sep=""), c("Correct","Incorrect")) for (j in 1:J) { - NodeParents(items[[j]]) <- list(theta) - NodeLevels(items[[j]]) <- c(1,0) - NodeSets(items[[j]]) <- c("observables") + PnodeParents(items[[j]]) <- list(theta) + PnodeStateValues(items[[j]]) <- c(1,0) + PnodeLabels(items[[j]]) <- c("observables") } ## Convert into a Pnet @@ -190,6 +190,7 @@ is.Pnet(IRT10.2PL) WriteNetworks(IRT10.2PL,"IRT10.2PL.true.dne") DeleteNetwork(IRT10.2PL) +stopSession(sess) } } diff --git a/man/Pnet2Omega.Rd b/man/Pnet2Omega.Rd index 504d8c2..66aac45 100644 --- a/man/Pnet2Omega.Rd +++ b/man/Pnet2Omega.Rd @@ -249,6 +249,13 @@ CM1 <- Omega2Pnet(omegamat,CM,Nodehouse,override=TRUE,debug=TRUE) Om2 <- Pnet2Omega(CM1,NetworkAllNodes(CM1)) +class(omegamat) <- c("OmegMat","data.frame") # To match Pnet2Omega output. +omegamat$PriorWeight <- rep("10",nrow(omegamat)) + +stopifnot(all.equal(omegamat,Om2)) + + +DeleteNetwork(CM) stopSession(sess) setwd(curd) diff --git a/man/Pnet2Qmat.Rd b/man/Pnet2Qmat.Rd index e26175a..2d8e7dc 100644 --- a/man/Pnet2Qmat.Rd +++ b/man/Pnet2Qmat.Rd @@ -389,6 +389,30 @@ obs <-unlist(sapply(list(sess$nets$PPcompEM,sess$nets$PPconjEM, Q2 <- Pnet2Qmat(obs,NetworkAllNodes(CM)) +## adjust Q1 to match Q2 +Q1 <- Q1[,-1] ## Drop unused first column. +class(Q1) <- c("Qmat", "data.frame") +# Force them into the same order +Q1 <- Q1[order(Q1$Model,Q1$Node),] +Q2 <- Q2[order(Q2$Model,Q2$Node),] +row.names(Q1) <- NULL +row.names(Q2) <- NULL + + +## Force all NA columns into the right type +Q1$LinkScale <- as.numeric(Q1$LinkScale) +Q1$A.Physics <- as.numeric(Q1$A.Physics) +Q1$A.IterativeD <- as.numeric(Q1$A.IterativeD) +Q1$B.Physics <- as.numeric(Q1$B.Physics) +Q1$B.NTL <- as.numeric(Q1$B.NTL) + +## Fix fancy quotes added by some spreadsheets +Q1$Rules <- gsub(intToUtf8(c(91,0x201C,0x201D,93)),"\"",Q1$Rules) + +## Insert Default Prior Weights +Q1$PriorWeight <- ifelse(is.na(Q1$NStates),"","10") +all.equal(Q1,Q2) + stopSession(sess) setwd(curd) diff --git a/man/PnetAdjoin.Rd b/man/PnetAdjoin.Rd index 50940a2..2c37e7e 100644 --- a/man/PnetAdjoin.Rd +++ b/man/PnetAdjoin.Rd @@ -127,25 +127,25 @@ EM1 <- ReadNetworks(file.path(library(help="PNetica")$path, "testnets", Phys <- PnetFindNode(PM,"Physics") ## Prior probability for high level node -CompileNetwork(PM) -bel1 <- NodeBeliefs(Phys) +PnetCompile(PM) +bel1 <- PnodeMargin(PM, Phys) ## Adjoin the networks. EM1.obs <- PnetAdjoin(PM,EM1) -CompileNetwork(PM) +PnetCompile(PM) ## Enter a finding -NodeFinding(EM1.obs[[1]]) <- "Right" +PnodeEvidence(EM1.obs[[1]]) <- "Right" ## Posterior probability for high level node -bel2 <- NodeBeliefs(Phys) +bel2 <- PnodeMargin(PM,Phys) PnetDetach(PM,EM1) -CompileNetwork(PM) +PnetCompile(PM) ## Findings are unchanged -bel2a <- NodeBeliefs(Phys) -stopifnot(all.equal(bel2,bel2a)) +bel2a <- PnodeMargin(PM,Phys) +stopifnot(all.equal(bel2,bel2a,tol=1e-6)) DeleteNetwork(list(PM,EM1)) stopSession(sess) diff --git a/man/PnetCompile.Rd b/man/PnetCompile.Rd new file mode 100644 index 0000000..474746c --- /dev/null +++ b/man/PnetCompile.Rd @@ -0,0 +1,103 @@ +\name{PnetCompile} +\alias{PnetCompile} +\title{Compiles a Parameterized Bayesian Network} +\description{ + + This + function requests that the Bayes net be compiled---transformed so that + inference can be carried out. + +} +\usage{ +PnetCompile(net) +} +\arguments{ + \item{net}{A \code{\linkS4class{Pnet}} object to be compiled.} +} +\details{ + + Many Bayesian network algorithm have two phases. The graph is built + as an acyclic directed graph. Before inference is carried out, the + graph is transformed into a structure called a \emph{Junction Tree}, + \emph{Tree of Cliques} or \emph{Markov Tree} (Almond, 1995). + + This function requests that implementation specific processing, + particularly, building the appropriate Markov Tree, be done for the + net, so that it can be placed in inference mode instead of editing + mode. + +} +\value{ + The compile \code{net} argument should be returned. +} +\references{ + + Almond, R. G. (1995). \emph{Graphical Belief Models}. Chapman and Hall. + +} +\author{Russell Almond} +\note{ + + It should be harmless to call this function on a net which is already + compiled. +} +\seealso{ + + The following functions will likely return errors if the \code{net} is + not compiled: + \code{\link{PnodeEvidence}}, \code{\link{calcStat}}, + \code{\link{PnodeMargin}}, \code{\link{PnodeEAP}}, + \code{\link{PnodeSD}}, \code{\link{PnodeMedian}}, + \code{\link{PnodeMode}}. + +} +\examples{ +\dontrun{ + +library(PNetica) ## Need a specific implementation +sess <- NeticaSession() +startSession(sess) + +irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, + "testnets","IRT10.2PL.base.dne", + sep=.Platform$file.sep),session=sess) +irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. +irt10.theta <- PnetFindNode(irt10.base,"theta") +irt10.items <- PnetPnodes(irt10.base) +## Flag items as Pnodes +for (i in 1:length(irt10.items)) { + irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) + +} +## Make some statistics +marginTheta <- Statistic("PnodeMargin","theta","Pr(theta)") +meanTheta <- Statistic("PnodeEAP","theta","EAP(theta)") +sdTheta <- Statistic("PnodeSD","theta","SD(theta)") +medianTheta <- Statistic("PnodeMedian","theta","Median(theta)") +modeTheta <- Statistic("PnodeMedian","theta","Mode(theta)") + + +BuildAllTables(irt10.base) +PnetCompile(irt10.base) ## Netica requirement + +calcStat(marginTheta,irt10.base) +calcStat(meanTheta,irt10.base) +calcStat(sdTheta,irt10.base) +calcStat(medianTheta,irt10.base) +calcStat(modeTheta,irt10.base) + +PnodeEvidence(irt10.items[[1]]) <- "Correct" + +calcStat(marginTheta,irt10.base) +calcStat(meanTheta,irt10.base) +calcStat(sdTheta,irt10.base) +calcStat(medianTheta,irt10.base) +calcStat(modeTheta,irt10.base) + + +DeleteNetwork(irt10.base) +stopSession(sess) +} +} +\keyword{ graphs } + diff --git a/man/PnetName.Rd b/man/PnetName.Rd index 8018f62..bf7bcfb 100644 --- a/man/PnetName.Rd +++ b/man/PnetName.Rd @@ -39,10 +39,31 @@ The name of the network as a character vector of length 1. The setter method returns the modified object. +} +\section{True Names}{ + + True names are the names in the secret ancient lanugage which hold + power over an object (Le Guin, 1968). + + Actually, this is a difficulty with implementations that place + restrictions on the name of a network or node. In particular, Netica + restricts node names to alphanumeric characters and limits the length. + This may make it difficult to match nodes by name with other parts of + the system which do not have this restriction. In this case the + object may have both a \emph{true name}, which is returned by + \code{PnodeName} and an internal \emph{use name} which is used by the + implementation. + + } \author{ Russell Almond } +\references{ + + Le Guin, U. K. (1968). \emph{A Wizard of Earthsea.} Parnassus Press. + +} \seealso{ \code{\link{Pnet}}, \code{\link{PnetTitle}()} } @@ -58,6 +79,8 @@ stopifnot(PnetName(net)=="funNet") PnetName(net)<-"SomethingElse" stopifnot(PnetName(net)=="SomethingElse") +DeleteNetwork(net) +stopSession(sess) } } diff --git a/man/PnetPathname.Rd b/man/PnetPathname.Rd index 8421a3e..4f16fd2 100644 --- a/man/PnetPathname.Rd +++ b/man/PnetPathname.Rd @@ -42,7 +42,7 @@ stopifnot(PnetPathname(PM)=="miniPP-CM.dne") PnetPathname(PM) <- "StudentModel1.dne" stopifnot(PnetPathname(PM)=="StudentModel1.dne") - +DeleteNetwork(PM) stopSession(sess) setwd(curd) diff --git a/man/PnetPnodes.Rd b/man/PnetPnodes.Rd index 3dc7a13..932791f 100644 --- a/man/PnetPnodes.Rd +++ b/man/PnetPnodes.Rd @@ -80,16 +80,16 @@ IRT10.2PL <- CreateNetwork("IRT10_2PL",session=sess) theta <- NewDiscreteNode(IRT10.2PL,"theta", c("VH","High","Mid","Low","VL")) -NodeLevels(theta) <- effectiveThetas(NodeNumStates(theta)) -NodeProbs(theta) <- rep(1/NodeNumStates(theta),NodeNumStates(theta)) +PnodeStateValues(theta) <- effectiveThetas(PnodeNumStates(theta)) +NodeProbs(theta) <- rep(1/PnodeNumStates(theta),PnodeNumStates(theta)) J <- 10 ## Number of items items <- NewDiscreteNode(IRT10.2PL,paste("item",1:J,sep=""), c("Correct","Incorrect")) for (j in 1:J) { - NodeParents(items[[j]]) <- list(theta) - NodeLevels(items[[j]]) <- c(1,0) - NodeSets(items[[j]]) <- c("observables") + PnodeParents(items[[j]]) <- list(theta) + PnodeStateValues(items[[j]]) <- c(1,0) + PnodeLabels(items[[j]]) <- c("observables") } ## Convert into a Pnet IRT10.2PL <- Pnet(IRT10.2PL,priorWeight=10,pnode=items[2:J]) @@ -109,6 +109,7 @@ stopifnot( length(PnetPnodes(IRT10.2PL)) == J ) DeleteNetwork(IRT10.2PL) +stopSession(sess) } } \keyword{ attrib } diff --git a/man/PnetPriorWeight.Rd b/man/PnetPriorWeight.Rd index 7a920cf..62cbfe8 100644 --- a/man/PnetPriorWeight.Rd +++ b/man/PnetPriorWeight.Rd @@ -102,16 +102,16 @@ IRT10.2PL <- CreateNetwork("IRT10_2PL",session=sess) theta <- NewDiscreteNode(IRT10.2PL,"theta", c("VH","High","Mid","Low","VL")) -NodeLevels(theta) <- effectiveThetas(NodeNumStates(theta)) -NodeProbs(theta) <- rep(1/NodeNumStates(theta),NodeNumStates(theta)) +PnodeStateValues(theta) <- effectiveThetas(PnodeNumStates(theta)) +PnodeProbs(theta) <- rep(1/PnodeNumStates(theta),PnodeNumStates(theta)) J <- 10 ## Number of items items <- NewDiscreteNode(IRT10.2PL,paste("item",1:J,sep=""), c("Correct","Incorrect")) for (j in 1:J) { - NodeParents(items[[j]]) <- list(theta) - NodeLevels(items[[j]]) <- c(1,0) - NodeSets(items[[j]]) <- c("observables") + PnodeParents(items[[j]]) <- list(theta) + PnodeStateValues(items[[j]]) <- c(1,0) + PnodeLabels(items[[j]]) <- c("observables") } ## Convert into a Pnet @@ -147,6 +147,7 @@ stopifnot( ) DeleteNetwork(IRT10.2PL) +stopSession(sess) } } \keyword{ attrib } diff --git a/man/PnetSerialize.Rd b/man/PnetSerialize.Rd index 23d0341..623a02a 100644 --- a/man/PnetSerialize.Rd +++ b/man/PnetSerialize.Rd @@ -2,6 +2,7 @@ \alias{PnetSerialize} \alias{PnetUnserialize} \alias{unserializePnet} +\alias{WarehouseUnpack} \title{Writes/restores network from a string.} \description{ The \code{PnetSerialize} method writes the network to a string and @@ -14,12 +15,16 @@ PnetSerialize(net) PnetUnserialize(serial) unserializePnet(factory,data) +WarehouseUnpack(warehouse, serial) } \arguments{ \item{net}{A \code{\link{Pnet}} to be serialized.} \item{factory}{A character scalar containing the name of a global variable which contains a factory object capable of recreating the network from the data.} + \item{warehouse}{A object of the type + \code{\linkS4class{PnetWarehouse}} which will contain a link to the + appropriate factory.} \item{serial}{A list containing at least three elements. One is the name of the network. One is the \code{data} element which contains the serialized data as a raw vector. The third @@ -29,7 +34,6 @@ unserializePnet(factory,data) \item{data}{A list containing at least two elements. One is the name of the network. One is the \code{data} element which contains the serialized data as a raw vector.} - } \details{ @@ -134,8 +138,18 @@ startSession(sess) collect <- mongo("studentModels","test", "mongodb://127.0.0.1:27017/test") ## Or "mongodb://user:pwd@127.0.0.1:27017/test" -sm.net <- ReadNetworks(file.path(library(help="PNetica")$path, "testnets", - "miniPP-CM.dne"), session=sess) + +## An example network manifest. +netman1 <- read.csv(paste(library(help="Peanut")$path, "auxdata", + "Mini-PP-Nets.csv", sep=.Platform$file.sep), + row.names=1, stringsAsFactors=FALSE) +netpath <- file.path(library(help="PNetica")$path, "testnets") +netman1$Pathname <- file.path(netpath,netman1$Pathname) + +Nethouse <- BNWarehouse(manifest=netman1,session=sess,key="Name") + +pm.net <- WarehouseSupply(Nethouse, "miniPP_CM") +sm.net <- CopyNetworks(pm.net,"Student1") sm.ser <- PnetSerialize(sm.net) ## base 64 encode the data to make it easier to store. @@ -148,15 +162,26 @@ collect$replace(paste('{"name":"',sm.ser$name,'"}'), ## Use iterator method to find, so we get in list rather than data frame ## representation. -it <- collect$iterate(sprintf('{"name":"\%s"}',PnetName(sm.net)),limit=1) +it <- collect$iterate(sprintf('{"name":"\%s"}',"Student1"),limit=1) sm1.ser <- it$one() ## Decode back to the raw vector. sm1.ser$data <- base64_dec(sm1.ser$data) -sm1 <- unserializePnet(sess,sm1.ser) +DeleteNetwork(sm.net) +sm1 <- WarehouseUnpack(Nethouse,sm1.ser) +stopifnot(PnetName(sm1)=="Student1") + +DeleteNetwork(sm1) +sm1a <- unserializePnet(sess,sm1.ser) +stopifnot(PnetName(sm1a)=="Student1") + +DeleteNetwork(sm1a) +#Unserialize needs a reference to the "factory" (in this case session.). sm1.ser$factory <- "sess" -sm1a <- PnetUnserialize(sm1.ser) +sm1b <- PnetUnserialize(sm1.ser) +stopifnot(PnetName(sm1b)=="Student1") +stopSession(sess) } } \keyword{ IO } diff --git a/man/PnetWarehouse-class.Rd b/man/PnetWarehouse-class.Rd new file mode 100644 index 0000000..c26e0a3 --- /dev/null +++ b/man/PnetWarehouse-class.Rd @@ -0,0 +1,174 @@ +\name{PnetWarehouse-class} +\Rdversion{1.1} +\docType{class} +\alias{PnetWarehouse-class} + +\title{Class \code{"PnetWarehouse"}} +\description{ + + A \code{\link{Warehouse}} objects which holds and builds + \code{\linkS4class{Pnet}} objects. In particular, its + \code{\link{WarehouseManifest}} contains a network manifest (see + \code{\link{BuildNetManifest}}) which contains information about how + to either load the networks from the file system, or build them on + demand. + +} +\section{Objects from the Class}{ + A virtual Class: No objects may be created from it. + + Classes can register as belonging to this abstract class. The trick + for doing this is: + \code{ + setIs("NethouseClass","PnetWarehouse") + } + + Currently \code{\link[PNetica]{BNWarehouse}} is an example of an object + of this class. + +} +\section{Methods}{ + + \describe{ + + \item{\link{WarehouseSupply}}{\code{signature(warehouse = + "PnetWarehouse", name = "character")}. This finds a network + with the appropriate name. If one does not exist, it is created + by reading it from the pathname specified in the manifest. If + no file exists at the pathname, a new blank network with the + properities specified in the manifest is created.} + + \item{\link{WarehouseFetch}}{\code{signature(warehouse = + "PnetWarehouse", name = "character")}. This fetches the network + with the given name, or returns \code{NULL} if it has not been + built.} + + \item{\link{WarehouseMake}}{\code{signature(warehouse = + "PnetWarehouse", name = "character")}. This loads the network + from a file or builds the network using the data in the Manifest.} + + \item{\link{WarehouseFree}}{\code{signature(warehouse = + "PnetWarehouse", name = "character")}. This removes the network + from the warehouse inventory.} + + \item{\link{ClearWarehouse}}{\code{signature(warehouse = + "PnetWarehouse")}. This removes all networks + from the warehouse inventory.} + + \item{\link{is.PnetWarehouse}}{\code{signature(obj = + "PnetWarehouse")}. This returns \code{TRUE}.} + + \item{\link{WarehouseManifest}}{\code{signature(warehouse = + "PnetWarehouse")}. This returns the data frame with + instructions on how to build networks. (see Details)} + + \item{\link{WarehouseManifest<-}}{\code{signature(warehouse = + "PnetWarehouse", value="data.frame")}. This sets the data + frame with instructions on how to build networks.(see Details)} + + \item{\link{WarehouseData}}{\code{signature(warehouse = + "PnetWarehouse", name="character")}. This returns the portion + of the data frame with instructions on how to build a particular + network. (see Details)} + + \item{\link{WarehouseUnpack}}{\code{signature(warehouse = + "PnetWarehouse", serial="list")}. This restores a serialized + network, in particular, it is used for saving network state across + sessions. See \code{\link{PnetSerialize}} for an example.} + + } +} +\details{ + + The \code{PnetWarehouse} either supplies prebuilt nets or builds them + from the instructions found in the manifest. In particular, the + function \code{WarehouseSupply} will attempt to: + \enumerate{ + \item{Find an existing network with \code{name}.} + \item{Try to read the network from the location given in the + \code{Pathname} column of the manifest.} + \item{Build a blank network, using the metadata in the manifest.} + } + + The manifest is an object of type \code{\link[base]{data.frame}} where + the columns have the values show below. The key is the \dQuote{Name} + column which should be unique for each row. The \var{name} argument to + \code{WarehouseData} should be a character scalar corresponding to + name, and it will return a \code{data.frame} with a single row. + + \describe{ + \item{Name}{A character value giving the name of the network. This + should be unique for each row and normally must conform to variable + naming conventions. Corresponds to the function \code{\link{PnetName}}.} + \item{Title}{An optional character value giving a longer human readable name + for the netowrk. Corresponds to the function \code{\link{PnetTitle}}.} + \item{Hub}{If this model is incomplete without being joined to another + network, then the name of the hub network. Otherwise an empty + character vector. Corresponds to the function \code{\link{PnetHub}}.} + \item{Pathname}{The location of the file from which the network should + be read or to which it should be written. Corresponds to the function + \code{\link{PnetPathname}}.} + \item{Description}{An optional character value documenting the purpose + of the network. Corresponds to the function + \code{\link{PnetDescription}}.} + } + + The function \code{\link{BuildNetManifest}} will build a manifest for + an existing collection of networks. + +} +\author{ + Russell Almond +} +\note{ + + In the \code{PNetica} implementation, the + \code{\link[PNetica]{BNWarehouse}} implementatation contains an + embedded \code{\link[RNetica]{NeticaSession}} object. When + \code{WarehouseSupply} is called, it attempts to satisfy the demand by + trying in order: + \enumerate{ + \item{Search for the named network in the active networks in the + session.} + \item{If not found in the session, it will attempt to load the + network from the \code{Pathname} field in the manifest.} + \item{If the network is not found and there is not file at the + target pathename, a new blank network is built and the appropriate + fields are set from the metadata.} + } + +} +\seealso{ + + \code{\link{Warehouse}}, \code{\link{WarehouseManifest}}, + \code{\link{BuildNetManifest}} + + Implementation in the \code{PNetica} package: + \code{\link[PNetica]{BNWarehouse}}, + \code{\link[PNetica]{MakePnet.NeticaBN}} + +} +\examples{ +\dontrun{ +library(PNetica) ## Example requires PNetica + +sess <- NeticaSession() +startSession(sess) + +## BNWarehouse is the PNetica Net Warehouse. +## This provides an example network manifest. +netman1 <- read.csv(paste(library(help="Peanut")$path, "auxdata", + "Mini-PP-Nets.csv", sep=.Platform$file.sep), + row.names=1, stringsAsFactors=FALSE) +Nethouse <- BNWarehouse(manifest=netman1,session=sess,key="Name") + +CM <- WarehouseSupply(Nethouse, "miniPP_CM") +EM <- WarehouseSupply(Nethouse, "PPcompEM") + +DeleteNetwork(list(CM,EM)) +stopSession(sess) +} +} +\keyword{classes} +\keyword{graphs} + diff --git a/man/Pnode-class.Rd b/man/Pnode-class.Rd new file mode 100644 index 0000000..1fc0585 --- /dev/null +++ b/man/Pnode-class.Rd @@ -0,0 +1,152 @@ +\name{Pnode-class} +\Rdversion{1.1} +\docType{class} +\alias{Pnode-class} + +\title{Class \code{"Pnode"}} +\description{ + This is a virtual class. Classes implementing the Pnet protocol + should attach themselves using \code{\link[methods]{setIs}}. + + Note that \code{NULL} is always considered a member so that + uninitialized in containers. +} +\section{Objects from the Class}{ + A virtual Class: No objects may be created from it. + + Classes can register as belonging to this abstract class. The trick + for doing this is: + \code{ + setIs("NodeClass","Pnode") + } + + Currently \code{\link[RNetica]{NeticaNode}} is an example of an object + of this class (but requires the \code{PNetica} package to provide all + of the required functionality). + +} +\section{Methods}{ + No methods defined with class "Pnode" in the signature; + however, the following generic functions are available: + + \describe{ + \item{\link{PnodeName}}{\code{signature(node = "Pnode")}: Fetches node name. + } + \item{\link{PnodeName<-}}{\code{signature(node = "Pnode", value="character")}: + Sets node name. + } + \item{\link{PnodeTitle}}{\code{signature(node = "Pnode")}: Fetches node title. + } + \item{\link{PnodeTitle<-}}{\code{signature(node = "Pnode", + value="character")}: Sets node title. + } + \item{\link{PnodeDescription}}{\code{signature(node = "Pnode")}: Fetches + documentation string for node. + } + \item{\link{PnodeDescription<-}}{\code{signature(node = "Pnode", + value="character")}: Sets documentation string for node. + } + \item{\link{PnodeLabels}}{\code{signature(node = "Pnode")}: Fetches a + vector of lables assigned to this node. + } + \item{\link{PnodeLabels<-}}{\code{signature(node = "Pnode", value = + "character")}: Sets vector of labels assigned to this node. + hub model. + } + \item{\link{PnodeNumStates}}{\code{signature(node = "Pnode")}: Fetches + length of vector of states available for this node. + } + \item{\link{PnodeStates}}{\code{signature(node = "Pnode")}: Fetches vector + of states available for this node. + } + \item{\link{PnodeStates<-}}{\code{signature(node = "Pnode", value)}: Sets + vector of states for this node. + } + \item{\link{PnodeStateTitles}}{\code{signature(node = "Pnode")}: Fetches vector + of states available for this node. + } + \item{\link{PnodeStateTitles<-}}{\code{signature(node = "Pnode", value)}: Sets + vector of states for this node. + } + \item{\link{PnodeStateDescriptions}}{\code{signature(node = "Pnode")}: Fetches vector + of states available for this node. + } + \item{\link{PnodeStateDescriptions<-}}{\code{signature(node = "Pnode", + value)}: Sets vector of states for this node. + } + \item{\link{PnodeStateValues}}{\code{signature(node = "Pnode")}: Fetches vector + of numeric values associated with states for this node. + } + \item{\link{PnodeStateValues<-}}{\code{signature(node = "Pnode", value)}: Sets + vector of numeric values associated with states for this node. + } + \item{\link{PnodeStateBounds}}{\code{signature(node = "Pnode")}: Fetches + matrix of upper and lower bounds for discritized states of a + continuous node. + } + \item{\link{PnodeStateBounds<-}}{\code{signature(node = "Pnode", + value)}: Sets matrix of upper and lower bounds for discritized + states of a continuous node. + } + \item{\link{PnodeParents}}{\code{signature(node = "Pnode")}: Fetches a + list of the nodes parents. + } + \item{\link{PnodeParents<-}}{\code{signature(node = "Pnode", value = + "list")}: Sets a list of the nodes parents. + } + \item{\link{PnodeParentNames}}{\code{signature(node = "Pnode")}: Lists the + names of the parents. + } + \item{\link{PnodeNumParents}}{\code{signature(node = "Pnode")}: The length + of the parent vector. + } + \item{\link{isPnodeContinuous}}{\code{signature(node = "Pnode")}: Copies nodes from hub model into spoke model. + } + \item{\link{PnodeProbs}}{\code{signature(node = "Pnode")}: Fetchs the + conditional probability table for the node.} + \item{\link{PnodeProbs<-}}{\code{signature(node = "Pnode", value = + "array")}: Sets the conditional probability table for the node.} + \item{\link{PnodeEvidence}}{\code{signature(node = "Pnode")}: Fetches the + current instantiated evidence for this node. + } + \item{\link{PnodeEvidence<-}}{\code{signature(node = "Pnode", value)}: Sets + the instantiated evidence for this node. + } + \item{\link{PnodeMargin}}{\code{signature(node = "Pnode")}: Computes the vector + of marginal beliefs associated with the state of this node given the + evidence. + } + \item{\link{PnodeEAP}}{\code{signature(node = "Pnode")}: Computes the + expected value of a node given the evidence. This assumes node + states are assigned numeric values. + } + \item{\link{PnodeSD}}{\code{signature(node = "Pnode")}: Computes the + standard deviation of a node given the evidence. This assumes node + states are assigned numeric values. + } + \item{\link{PnodeMedian}}{\code{signature(node = "Pnode")}: Computes the + median of a node given the evidence. This assumes node + states are ordered. + } + \item{\link{PnodeMedian}}{\code{signature(node = "Pnode")}: Computes the + most likely state of a node given the evidence. + } + } + +} +\author{ + Russell Almond +} +\seealso{ + \code{\link{Pnode}}. + + The class \code{\link[RNetica]{NeticaNode}} implements this protocol. + +} +\examples{ +showClass("Pnode") +\dontrun{ + setIs("NeticaNode","Pnode") +} +} +\keyword{classes} diff --git a/man/PnodeBetas.Rd b/man/PnodeBetas.Rd index 17893cb..9c211bc 100644 --- a/man/PnodeBetas.Rd +++ b/man/PnodeBetas.Rd @@ -182,16 +182,16 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set rules is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="gradedResponse") @@ -248,6 +248,7 @@ BuildTable(partial3) DeleteNetwork(tNet) +stopSession(sess) } } \keyword{ attrib } diff --git a/man/PnodeEvidence.Rd b/man/PnodeEvidence.Rd new file mode 100644 index 0000000..1e5cc1c --- /dev/null +++ b/man/PnodeEvidence.Rd @@ -0,0 +1,129 @@ +\name{PnodeEvidence} +\alias{PnodeEvidence} +\alias{PnodeEvidence<-} +\title{Accesses the value to which a given node has been instantiated.} +\description{ + + Inference is a Bayesian network involves setting the state of a + particular node to one of its possible states, either because the + state has been observed, or because it has been hypothesized. This + processis is often called \emph{instantiaion}. This function returns + the value (state) to which the node has been instantiated, or in the + setter form set it. Depending on the implementation logic, the beliefs may + be immediately updated or be updated on demand. + +} +\usage{ +PnodeEvidence(node) +PnodeEvidence(node) <- value +} +\arguments{ + \item{node}{A \code{\linkS4class{Pnode}} object whose instantiated + value will be accessed.} + \item{value}{The value that the node will be instantiated to, see + details.} +} +\details{ + + Currently, \code{Peanut} supports two ways of representing nodes, + discrete and continuous (see \code{\link{isPnodeContinuous}}). + The current \code{\link[PNetica]{Pnetica-package}} implemenation + discritizes continuous nodes, using the \code{\link{PnodeStateBounds}} + to map real numbers to states of the observables. Functions + implementing these generic functions may treat these values + differently. + + The behavior depends on the class of the \code{value} argument: + \describe{ + \item{character or factor}{The character of factor should represent + a state of the node. The node will be instantiated to that + state.} + \item{numeric scalar}{For continuous nodes, the node will be + instantiated to that value. For discritized continuous nodes, the + node will be instantiated to the state in which the value lies + (see \code{\link{PnodeStateBounds}}).} + \item{difftime scalar}{The value is first converted to a numeric + value with units of seconds. This can be overridden in the + implementation.} + \item{numeric vector of length \code{\link{PnodeNumStates}}}{The + number should represent likelihoods, and this will enter + appropriate virual evidence for the node.} + \item{NULL}{This will retract any existing evidence associated with + the node.} + } +} +\value{ + + The getter function \code{PnodeEvidence} will return one of the value forms + described in details. If the node is not instantiated, it will return + \code{NULL}. + + The setter function \code{PnodeEvidence<-} returns the node argument + invisibly. + +} +\author{Russell Almond} +\note{ + + The current options for this function make a lot of sense with + Netica. There may be other modes that are not covered for other + implementations. + +} +\seealso{ + + The function \code{\link{PnetCompile}} usually needs to be run before + this function has meaning. + + The functions \code{\link{PnodeStates}} and + \code{\link{PnodeStateBounds}} define the legal values for the value + argument. + +} +\examples{ +\dontrun{ + +library(PNetica) ## Need a specific implementation +sess <- NeticaSession() +startSession(sess) + +irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, + "testnets","IRT10.2PL.base.dne", + sep=.Platform$file.sep),session=sess) +irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. +irt10.theta <- PnetFindNode(irt10.base,"theta") +irt10.items <- PnetPnodes(irt10.base) +## Flag items as Pnodes +for (i in 1:length(irt10.items)) { + irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) + +} + +BuildAllTables(irt10.base) +PnetCompile(irt10.base) ## Netica requirement + +stopifnot (is.na(PnodeEvidence(irt10.items[[1]]))) + +PnodeEvidence(irt10.items[[1]]) <- "Correct" +stopifnot(PnodeEvidence(irt10.items[[1]])=="Correct") + +PnodeEvidence(irt10.items[[1]]) <- NULL +stopifnot (is.na(PnodeEvidence(irt10.items[[1]]))) + +PnodeEvidence(irt10.items[[1]]) <- c(Correct=.6,Incorrect=.3) +stopifnot(all.equal(PnodeEvidence(irt10.items[[1]]), + c(Correct=.6,Incorrect=.3), + tol=3*sqrt(.Machine$double.eps) )) + +foo <- NewContinuousNode(irt10.base,"foo") + +stopifnot(is.na(PnodeEvidence(foo))) + +PnodeEvidence(foo) <- 1 +stopifnot(PnodeEvidence(foo)==1) + +DeleteNetwork(irt10.base) +stopSession(sess) +} +} +\keyword{ graphs } diff --git a/man/PnodeLink.Rd b/man/PnodeLink.Rd index a30b4a5..6fb503d 100644 --- a/man/PnodeLink.Rd +++ b/man/PnodeLink.Rd @@ -131,16 +131,16 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set link is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="gradedResponse") diff --git a/man/PnodeLinkScale.Rd b/man/PnodeLinkScale.Rd index 364c7a2..2395bef 100644 --- a/man/PnodeLinkScale.Rd +++ b/man/PnodeLinkScale.Rd @@ -97,16 +97,16 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) partial3 <- Pnode(partial3,rules="Compensatory", link="gradedResponse") PnodePriorWeight(partial3) <- 10 diff --git a/man/PnodeLnAlphas.Rd b/man/PnodeLnAlphas.Rd index fb1946e..424cdd2 100644 --- a/man/PnodeLnAlphas.Rd +++ b/man/PnodeLnAlphas.Rd @@ -204,16 +204,16 @@ tNet <- CreateNetwork("TestNet",sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set rules is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="partialCredit") diff --git a/man/PnodeName.Rd b/man/PnodeName.Rd index 309de66..05b912b 100644 --- a/man/PnodeName.Rd +++ b/man/PnodeName.Rd @@ -34,11 +34,31 @@ PnodeName(node)<- value The name of the node as a character vector of length 1. The setter method returns the \code{node} argument. +} +\section{True Names}{ + + True names are the names in the secret ancient lanugage which hold + power over an object (Le Guin, 1968). + + Actually, this is a difficulty with implementations that place + restrictions on the name of a network or node. In particular, Netica + restricts node names to alphanumeric characters and limits the length. + This may make it difficult to match nodes by name with other parts of + the system which do not have this restriction. In this case the + object may have both a \emph{true name}, which is returned by + \code{PnodeName} and an internal \emph{use name} which is used by the + implementation. + + } \author{ Russell Almond } +\references{ + Le Guin, U. K. (1968). \emph{A Wizard of Earthsea.} Parnassus Press. + +} \seealso{ \code{\link{Pnode}}, \code{\link{PnetFindNode}()}, \code{\link{PnodeTitle}()}, @@ -55,9 +75,12 @@ pnode <- NewDiscreteNode(net,"play") stopifnot(PnodeName(pnode)=="play") stopifnot(PnetFindNode(net,"play")==pnode) -NodeName(pnode)<-"work" +PnodeName(pnode)<-"work" stopifnot(PnetFindNode(net,"work")==pnode) +PnodeName(pnode) <- "Non-Netica Name" +stopifnot(PnetFindNode(net,"Non-Netica Name")==pnode) + DeleteNetwork(net) stopSession(sess) } diff --git a/man/PnodeParentTvals.Rd b/man/PnodeParentTvals.Rd index 11e338d..2e464c4 100644 --- a/man/PnodeParentTvals.Rd +++ b/man/PnodeParentTvals.Rd @@ -136,17 +136,17 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) ## This next function sets the effective thetas for theta1 -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("High","Mid","Low")) ## This next function sets the effective thetas for theta2 -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set rules is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="partialCredit") @@ -156,6 +156,7 @@ do.call("expand.grid",PnodeParentTvals(partial3)) DeleteNetwork(tNet) +stopSession(sess) } } \keyword{ attrib } diff --git a/man/PnodeParents.Rd b/man/PnodeParents.Rd index 71f189f..4e5da09 100644 --- a/man/PnodeParents.Rd +++ b/man/PnodeParents.Rd @@ -1,6 +1,8 @@ \name{PnodeParents} \alias{PnodeParents} \alias{PnodeParents<-} +\alias{PnodeNumParents} +\alias{PnodeParentNames} \title{ Gets or sets the parents of a parameterized node.} \description{ @@ -13,6 +15,8 @@ \usage{ PnodeParents(node) PnodeParents(node) <- value +PnodeNumParents(node) +PnodeParentNames(node) } \arguments{ \item{node}{ @@ -44,12 +48,18 @@ PnodeParents(node) <- value } \value{ - A list of \code{\link{Pnode}} objects representing the + \code{PnodeParents} list of \code{\link{Pnode}} objects representing the parents in the order that they will be used to establish dimensions for the conditional probability table. The setting variant returns the modified \var{child} object. + The expression \code{PnodeNumParents(node)} returns an integer scalar giving + the number of parents of \code{node}. + + The expression \code{PnodeParentNames(node)} is a shortcut fo + \code{sapply(PnodeParents(node), PnodeName)}. + } \author{ Russell Almond diff --git a/man/PnodePostWeight.Rd b/man/PnodePostWeight.Rd new file mode 100644 index 0000000..3d19de5 --- /dev/null +++ b/man/PnodePostWeight.Rd @@ -0,0 +1,123 @@ +\name{PnodePostWeight} +\alias{PnodePostWeight} +\title{Fetches the posterior weight associated with a node} +\description{ + + Before running \code{\link{GEMfit}}, nodes are given a + prior weight (\code{\link{PnodePriorWeight}}) indicating how much + weight should be given to the prior distribution. After running + the \code{\link{calcExpTables}} step, there will be a posterior weight + giving the total weight of the prior plus data. + +} +\usage{ +PnodePostWeight(node) +} +\arguments{ + \item{node}{A \code{\linkS4class{Pnode}} object.} +} +\details{ + + Let \eqn{s} be a configuration of the parent variables, which + corresponds to a row of the CPT of \code{node} + (\code{\link{PnodeProbs}(node)}). Let \eqn{\bold{p}_s = (p_{s,1}, + \ldots, p_{s,K})} be the corresponding row of the conditional + probability table and let \eqn{n_s} be the corresponding prior weight + (an element of code{\link{NodePriorWeight}(node)}). The corresponding + row of the effective Dirichlet prior for that row is \eqn{\alpha_s = + (\alpha_{s,1}, \ldots, \alpha_{s,K})}, where + \eqn{\alpha_{s,1}=p_{s,1}n_s}. Note that the matrix \eqn{\bold{P}} and + the vector \eqn{\bold{n}} (stacking the conditional probability + vectors and the prior weights) are sufficient statistics for the + conditional probability distribution of \code{node}. + + The function \code{\link{calcExpTables}} does the E-step (and some of + the M-step) of the \code{\link{GEMfit}} algorithm. Its output is new + values for the sufficient statistics, \eqn{\tilde{\bold{P}}} and + \eqn{\tilde{\bold{n}}}. At this point, the function + \code{\link{PnodeProbs}} should return \eqn{\tilde{\bold{P}}} + (although possibly as an array rather than a matrix) and + \code{PnodePostWeight(node)} returns \eqn{\tilde{\bold{n}}}. + + Although the \code{PnodePostWeight(node)} is used in the next step, + \code{\link{maxAllTableParams}}, it is not retained for the next round + of the \code{\link{GEMfit}} algorithm, instead the + \code{PnodePriorWeight(node)} is used for the next time + \code{\link{calcExpTables}} is run. + + Often, \code{\link{PnodePriorWeight}(node)} is set to a scalar, + indicating that every row should be given the same weight, e.g., + \code{10}. In this case, \code{PnodePostWeight(node)} will usually be + vector valued as different numbers of data points correspond to each + row of the CPT. Furthermore, unless the parent variables are fully + observed, the \code{PnodePostWeight(node)} are unlikely to be integer + valued even if the prior weights are integers. However, the posterior + weights should always be at least as large as the prior weights. + +} +\value{ + A vector of numeric values corresponding to the rows of the CPT of + \code{node}. An error may be produced if \code{\link{calcExpTables}} + has not yet been run. +} +\references{ + + Almond, R. G. (2015) An IRT-based parameterization for conditional + probability tables. In Agosta, J. M. and Carvalho, R. N. (Eds.) + \emph{Proceedings of the Twelfth UAI Bayesian Modeling Application + Workshop (BMAW 2015).} \emph{CEUR Workshop Proceedings,} \bold{1565}, + 14--23. \url{http://ceur-ws.org/Vol-1565/bmaw2015_paper4.pdf}. + +} +\author{Russell Almond} +\seealso{ + \code{\link{PnodePriorWeight}}, \code{\link{GEMfit}}, + \code{\link{calcExpTables}}, \code{\link{maxAllTablesParams}} + +} +\examples{ +\dontrun{ +library(PNetica) ## Need a specific implementation +sess <- NeticaSession() +startSession(sess) + +irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, + "testnets","IRT10.2PL.base.dne", + sep=.Platform$file.sep), + session=sess) +irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. +irt10.theta <- PnetFindNode(irt10.base,"theta") +irt10.items <- PnetPnodes(irt10.base) +## Flag items as Pnodes +for (i in 1:length(irt10.items)) { + irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") +} +PnetCompile(irt10.base) ## Netica requirement + +casepath <- paste(library(help="PNetica")$path, + "testdat","IRT10.2PL.200.items.cas", + sep=.Platform$file.sep) + +item1 <- irt10.items[[1]] + +priorcounts <- sweep(PnodeProbs(item1),1,GetPriorWeight(item1),"*") + +calcExpTables(irt10.base,casepath) + +postcounts <- sweep(PnodeProbs(item1),1,PnodePostWeight(item1),"*") + +## Posterior row sums should always be larger. +stopifnot( + all(apply(postcounts,1,sum) >= apply(priorcounts,1,sum)) +) + +DeleteNetwork(irt10.base) +stopSession(sess) + +} +} +\keyword{ graph } + diff --git a/man/PnodeProbs.Rd b/man/PnodeProbs.Rd new file mode 100644 index 0000000..afc582d --- /dev/null +++ b/man/PnodeProbs.Rd @@ -0,0 +1,116 @@ +\name{PnodeProbs} +\alias{PnodeProbs} +\alias{PnodeProbs<-} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{ Gets or sets the conditional probability table associated with a + Netica node. +} +\description{ + + A complete Bayesian networks defines a conditional probability + distribution for a node given its parents. If all the nodes are + discrete, this comes in the form of a conditional probability table a + multidimensional array whose first several dimensions follow the + parent variable and whose last dimension follows the child variable. + +} +\usage{ +PnodeProbs(node) +PnodeProbs(node) <- value +} +\arguments{ + \item{node}{ + An active, discrete \code{\linkS4class{Pnode}} whose conditional + probability table is to be accessed. + } + \item{value}{ + The new conditional probability table. See details for the expected + dimensions. + } +} +\details{ + + Let \code{node} be the node of interest and \code{parent\var{1}}, + \code{parent\var{2}}, ..., \code{parent\var{p}}, where \eqn{p} is + the number of parents. Let \code{\var{pdim} = + sapply(\link{PnodeParents}(\var{node}), + \link{PnodeNumStates})} be a vector with the number of states for each parent. + A parent configuration is defined by assigning each of the parent + values to one of its possible states. Each parent configuration + defines a (conditional) probability distribution over the possible + states of \var{node}. + + The result of \code{PnodeProbs(\var{node})} will be an array with dimensions + \code{c(\var{pdim}, PnodeNumStates(\var{node}))}. The first \eqn{p} + dimensions will be named according to the + \code{\link{PnodeParentNames}(\var{node})}. The + last dimension will be named according to the node itself. The + \code{dimnames} for the resulting array will correspond to the state + names. + + In the \code{CPTtools} package, this known as the + \code{\link[CPTtools]{CPA}} format, and tools exist to convert between + this form an a two dimensional matrix, or \code{\link[CPTtools]{CPF}} + format. + + The setter form expects an array of the same dimensions as an + argument, although it does not need to have the dimnames set. + +} +\value{ + + A conditional probability array of class + \code{c("\link{CPA}","array")}. See \code{\link[CPTtools]{CPA}}. + +} +\author{Russell Almond} +\note{ + + All of this assumes that these are discrete nodes, that is + \code{\link{isPnodeContinuous}(node)} will return false for both + \code{node} and all of the parents, or that the continuous nodes have + been discritized through the use of \code{\link{PnodeStateBounds}}. + +} +\seealso{ + \code{\linkS4class{Pnode}}, + \code{\link{BuildTable}}, \code{\link[CPTtools]{CPA}}, + \code{\link[CPTtools]{CPF}}, \code{\link[CPTtools]{normalize}()}, + \code{\link{PnodeParents}()}, + \code{\link{PnodeStates}()} + +} + +\examples{ + +\dontrun{ ## Requires implementation +sess <- NeticaSession() +startSession(sess) +abc <- CreateNetwork("ABC", session=sess) +A <- NewDiscreteNode(abc,"A",c("A1","A2","A3","A4")) +B <- NewDiscreteNode(abc,"B",c("B1","B2","B3")) +C <- NewDiscreteNode(abc,"C",c("C1","C2")) + +PnodeParents(A) <- list() +PnodeParents(B) <- list(A) +PnodeParents(C) <- list(A,B) + +PnodeProbs(A)<-c(.1,.2,.3,.4) +PnodeProbs(B) <- normalize(matrix(1:12,4,3)) +PnodeProbs(C) <- normalize(array(1:24,c(A=4,B=3,C=2))) + +Aprobs <- PnodeProbs(A) +Bprobs <- PnodeProbs(B) +Cprobs <- PnodeProbs(C) +stopifnot( + CPTtools::is.CPA(Aprobs), + CPTtools::is.CPA(Bprobs), + CPTtools::is.CPA(Cprobs) +) + +DeleteNetwork(abc) +stopSession(sess) +} +} +\keyword{ interface } +\keyword{ model } diff --git a/man/PnodeQ.Rd b/man/PnodeQ.Rd index 40f6589..efabcab 100644 --- a/man/PnodeQ.Rd +++ b/man/PnodeQ.Rd @@ -103,16 +103,16 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) partial3 <- Pnode(partial3,Q=TRUE, link="partialCredit") PnodePriorWeight(partial3) <- 10 @@ -135,7 +135,7 @@ BuildTable(partial3) partial4 <- NewDiscreteNode(tNet,"partial4", c("Score4","Score3","Score2","Score1")) -NodeParents(partial4) <- list(theta1,theta2) +PnodeParents(partial4) <- list(theta1,theta2) partial4 <- Pnode(partial4, link="partialCredit") PnodePriorWeight(partial4) <- 10 @@ -151,7 +151,7 @@ PnodeLnAlphas(partial4) <- list(Score4=c(.25,.25), BuildTable(partial4) DeleteNetwork(tNet) - +stopSession(sess) }} \keyword{ attrib } diff --git a/man/PnodeRules.Rd b/man/PnodeRules.Rd index fc1f9c2..f801097 100644 --- a/man/PnodeRules.Rd +++ b/man/PnodeRules.Rd @@ -137,16 +137,16 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) -NodeProbs(theta1) <- rep(1/NodeNumStates(theta1),NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(PnodeNumStates(theta1)) +PnodeProbs(theta1) <- rep(1/PnodeNumStates(theta1),PnodeNumStates(theta1)) theta2 <- NewDiscreteNode(tNet,"theta2", c("VH","High","Mid","Low","VL")) -NodeLevels(theta2) <- effectiveThetas(NodeNumStates(theta2)) -NodeProbs(theta2) <- rep(1/NodeNumStates(theta2),NodeNumStates(theta2)) +PnodeStateValues(theta2) <- effectiveThetas(PnodeNumStates(theta2)) +PnodeProbs(theta2) <- rep(1/PnodeNumStates(theta2),PnodeNumStates(theta2)) partial3 <- NewDiscreteNode(tNet,"partial3", c("FullCredit","PartialCredit","NoCredit")) -NodeParents(partial3) <- list(theta1,theta2) +PnodeParents(partial3) <- list(theta1,theta2) ## Usual way to set rules is in constructor partial3 <- Pnode(partial3,rules="Compensatory", link="partialCredit") diff --git a/man/PnodeStateValues.Rd b/man/PnodeStateValues.Rd index dbab8d1..afa491e 100644 --- a/man/PnodeStateValues.Rd +++ b/man/PnodeStateValues.Rd @@ -69,7 +69,7 @@ lnet <- CreateNetwork("LeveledNet", session=sess) vnode <- NewDiscreteNode(lnet,"volt_switch",c("Off","Reverse","Forwards")) stopifnot( length(PnodeStateValues(vnode))==3, - names(PnodeStateValues(vnode)) == NodeStates(vnode), + names(PnodeStateValues(vnode)) == PnodeStates(vnode), all(is.na(PnodeStateValues(vnode))) ) diff --git a/man/PnodeStates.Rd b/man/PnodeStates.Rd index 1a579a7..05fdbc6 100644 --- a/man/PnodeStates.Rd +++ b/man/PnodeStates.Rd @@ -1,6 +1,7 @@ \name{PnodeStates} \alias{PnodeStates} \alias{PnodeStates<-} +\alias{PnodeNumStates} \title{ Accessor for states of a parameterized node. } \description{ @@ -15,6 +16,7 @@ \usage{ PnodeStates(node) PnodeStates(node) <- value +PnodeNumStates(node) } \arguments{ \item{node}{ @@ -46,6 +48,9 @@ PnodeStates(node) <- value of this function invisibly returns the \var{node} object. + The expression \code{PnodeNumStates(node)} returns an integer scalar giving + the number of states of \code{node}. + } \note{ @@ -77,12 +82,15 @@ stopifnot( PnodeStates(nodel2) <- c("True","False") stopifnot( + PnodeNumStates(nodel2) == 2L, PnodeStates(nodel2)==c("True","False") ) + nodel3 <- NewDiscreteNode(anet,"ThreeLevelNode",c("High","Med","Low")) stopifnot( + PnodeNumStates(nodel3) == 3L, PnodeStates(nodel3)==c("High","Med","Low"), PnodeStates(nodel3)[2]=="Med" ) diff --git a/man/PnodeStats.Rd b/man/PnodeStats.Rd index 276bb40..20ae01b 100644 --- a/man/PnodeStats.Rd +++ b/man/PnodeStats.Rd @@ -66,6 +66,9 @@ PnodeMode(net, node) \code{\link{Statistic}} \code{\link{calcStat}} + + These statistics will likely produce errors unless + \code{\link{PnetCompile}} has been run first. } \examples{ \dontrun{ @@ -78,7 +81,7 @@ irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, "testnets","IRT10.2PL.base.dne", sep=.Platform$file.sep),session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { @@ -94,7 +97,7 @@ modeTheta <- Statistic("PnodeMedian","theta","Mode(theta)") BuildAllTables(irt10.base) -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement calcStat(marginTheta,irt10.base) calcStat(meanTheta,irt10.base) @@ -103,6 +106,7 @@ calcStat(medianTheta,irt10.base) calcStat(modeTheta,irt10.base) DeleteNetwork(irt10.base) +stopSession(sess) } } \keyword{ graphs } diff --git a/man/PnodeWarehouse-class.Rd b/man/PnodeWarehouse-class.Rd new file mode 100644 index 0000000..8f6b97e --- /dev/null +++ b/man/PnodeWarehouse-class.Rd @@ -0,0 +1,234 @@ +\name{PnodeWarehouse-class} +\Rdversion{1.1} +\docType{class} +\alias{PnodeWarehouse-class} + +\title{Class \code{"PnodeWarehouse"}} +\description{ + + A \code{\link{Warehouse}} objects which holds and builds + \code{\linkS4class{Pnode}} objects. In particular, its + \code{\link{WarehouseManifest}} contains a node manifest (see + \code{\link{BuildNodeManifest}}) which contains information about how + to build the nodes if they are not present. Note that the key of the + node manifest is the name of both the network and the node. + +} +\section{Objects from the Class}{ + A virtual Class: No objects may be created from it. + + Classes can register as belonging to this abstract class. The trick + for doing this is: + \code{ + setIs("NodehouseClass","PnodeWarehouse") + } + + Currently \code{\link[PNetica]{NNWarehouse}} is an example of an object + of this class. + +} +\section{Methods}{ + + Note that for all of these methods, the \code{name} should be a vector + of two elements, the network name and the node name. Thus each network + defines its own namespace for variables. + + \describe{ + + \item{\link{WarehouseSupply}}{\code{signature(warehouse = + "PnodeWarehouse", name = "character")}. This finds a node with + the appropriate name in the specified network. If one does not + exist, it is created using the metadata in the manifest.} + + \item{\link{WarehouseFetch}}{\code{signature(warehouse = + "PnodeWarehouse", name = "character")}. This fetches the node + with the given name in the named network, or returns \code{NULL} + if it has not been built.} + + \item{\link{WarehouseMake}}{\code{signature(warehouse = + "PnodeWarehouse", name = "character")}. This creates the node + using the meta-data in the Manifest.} + + \item{\link{WarehouseFree}}{\code{signature(warehouse = + "PnodeWarehouse", name = "character")}. This removes the node + from the warehouse inventory.} + + \item{\link{ClearWarehouse}}{\code{signature(warehouse = + "PnodeWarehouse")}. This removes all nodes + from the warehouse inventory.} + + \item{\link{is.PnodeWarehouse}}{\code{signature(obj = + "PnodeWarehouse")}. This returns \code{TRUE}.} + + \item{\link{WarehouseManifest}}{\code{signature(warehouse = + "PnodeWarehouse")}. This returns the data frame with + instructions on how to build nodes. (see Details)} + + \item{\link{WarehouseManifest<-}}{\code{signature(warehouse = + "PnodeWarehouse", value="data.frame")}. This sets the data + frame with instructions on how to build nodes.(see Details)} + + \item{\link{WarehouseData}}{\code{signature(warehouse = + "PnodeWarehouse", name="character")}. This returns the portion + of the data frame with instructions on how to build a particular + node. This is generally one row for each state of the node. + (see Details)} + + } + + +} +\details{ + + The \code{PnetWarehouse} either supplies prebuilt nodes or builds them + from the instructions found in the manifest. Nodes exist inside + networks, so the key for a node is a pair \code{(Model,NodeName)}. + Thus, two nodes in different networks can have identical names. + + The function \code{WarehouseSupply} will attempt to: + \enumerate{ + \item{Find an existing node with name \code{NodeName} in a network + with name \code{Model}.} + \item{Build a new node in the named network using the metadata in + the manifest.} + } + + The manifest is an object of type \code{\link[base]{data.frame}} where + the columns have the values show below. The key is the combination of + the \dQuote{Model} and \dQuote{NodeName} columns. There should be one + row with this combination of variables for each state of the + variable. In particular, the number of rows should equal the value of + the \code{Nstates} column in the first row with that model--variable + combination. The \dQuote{StateName} column should be unique for each + row. + + The arguments to \code{WarehouseData} should be a character vector of + length two, \code{(Model,NodeName)}. It will return a + \code{data.frame} with one row for each state of the variable. + + \describe{ + + \item{\bold{Node-level Key Fields}}{:} + \item{Model}{A character value giving the name of the Bayesian network + to which this node belongs. Corresponds to the value of + \code{\link{PnodeNet}}. } + \item{NodeName}{A character value giving the name of the node. All + rows with the same value in the model and node name columns are + assumed to reference the same node. Corresponds to the value of + \code{\link{PnodeName}}.} + + \item{\bold{Node-level Fields}}{:} + \item{ModelHub}{If this is a spoke model (meant to be attached to a + hub) then this is the name of the hub model (i.e., the name of the + proficiency model corresponding to an evidence model). Corresponds to + the value of \code{\link{PnetHub}(PnodeNet(\var{node}))}.} + \item{NodeTitle}{A character value containing a slightly longer + description of the node, unlike the name this is not generally + restricted to variable name formats. Corresponds to the value of + \code{\link{PnodeTitle}}.} + \item{NodeDescription}{A character value describing the node, meant + for human consumption (documentation). Corresponds to the value of + \code{\link{PnodeDescription}}.} + \item{NodeLabels}{A comma separated list of identifiers of sets which + this node belongs to. Used to identify special subsets of nodes + (e.g., high-level nodes or observeable nodes). Corresponds to the + value of \code{\link{PnodeLabels}}.} + + \item{\bold{State-level Key Fields}}{:} + \item{Continuous}{A logical value. If true, the variable will be + continuous, with states corresponding to ranges of values. If false, + the variable will be discrete, with named states.} + \item{Nstates}{The number of states. This should be an integer + greater than or equal to 2. Corresponds to the value of + \code{\link{PnodeNumStates}}.} + \item{StateName}{The name of the state. This should be a string value + and it should be different for every row within the subset of rows + corresponding to a single node. Corresponds to the value of + \code{\link{PnodeStates}}.} + + \item{\bold{State-level Fields}}{:} + \item{StateTitle}{A longer name not subject to variable naming + restrictions. Corresponds to the value of + \code{\link{PnodeStateTitles}}.} + \item{StateDescription}{A human readable description of the state + (documentation). Corresponds to the value of + \code{\link{PnodeStateDescriptions}}.} + \item{StateValue}{A real numeric value assigned to this state. + \code{\link{PnodeStateValues}}. Note that this has different meaning + for discrete and continuous variables. For discrete variables, this + associates a numeric value with each level, which is used in + calculating the \code{\link{PnodeEAP}} and \code{\link{PnodeSD}} + functions. In the continuous case, this value is ignored and the + midpoint between the \dQuote{LowerBounds} and \dQuote{UpperBounds} + are used instead.} + \item{LowerBound}{This servers as the lower bound for each partition + of the continuous variagle. \code{-Inf} is a legal value for the + first or last row.} + \item{UpperBound}{This is only used for continuous variables, and the + value only is needed for one of the states. This servers as the + upper bound of range each state. Note the upper + bound needs to match the lower bounds of the next state. \code{Inf} + is a legal value for the first or last row.} + } + + +} +\author{Russell Almond} + +\note{ + + The test for matching upper and lower bounds is perhaps too strict. + In particular, if the upper and lower bounds mismatch by the least + significant digit (e.g., a rounding difference) they will not match. + This is a frequent cause of errors. + +} +\seealso{ + \code{\link{Warehouse}}, \code{\link{WarehouseManifest}}, + \code{\link{BuildNodeManifest}} + + Implementation in the \code{PNetica} package: + \code{\link[PNetica]{NNWarehouse}}, + \code{\link[PNetica]{MakePnode.NeticaNode}} +} +\examples{ +showClass("PnodeWarehouse") +\dontrun{ +library(PNetica) ## Requires PNetica +sess <- NeticaSession() +startSession(sess) + +## This expression provides an example Node manifest +nodeman1 <- read.csv(file.path(library(help="Peanut")$path, "auxdata", + "Mini-PP-Nodes.csv"), + row.names=1,stringsAsFactors=FALSE) + +nodeman1 <- read.csv(paste(library(help="Peanut")$path, "auxdata", + "Mini-PP-Nodes.csv", sep=.Platform$file.sep), + row.names=1,stringsAsFactors=FALSE) + +## Network and node warehouse, to create networks and nodes on demand. +Nethouse <- BNWarehouse(manifest=netman1,session=sess,key="Name") + +Nodehouse <- NNWarehouse(manifest=nodeman1, + key=c("Model","NodeName"), + session=sess) + +CM <- WarehouseSupply(Nethouse,"miniPP_CM") +WarehouseSupply(Nethouse,"PPdurAttEM") + + +WarehouseData(Nodehouse,c("miniPP_CM","Physics")) +WarehouseSupply(Nodehouse,c("miniPP_CM","Physics")) + +WarehouseData(Nodehouse,c("PPdurAttEM","Attempts")) +WarehouseSupply(Nodehouse,c("PPdurAttEM","Attempts")) + +WarehouseData(Nodehouse,c("PPdurAttEM","Duration")) +WarehouseSupply(Nodehouse,c("PPdurAttEM","Duration")) + + + +} +} +\keyword{classes} diff --git a/man/Statistic-class.Rd b/man/Statistic-class.Rd index 53822bf..0554391 100644 --- a/man/Statistic-class.Rd +++ b/man/Statistic-class.Rd @@ -42,6 +42,8 @@ Objects are created using the function \code{\link{Statistic}(fun, node, \code{fun} (using \code{do.call} to \code{net} and the actual nodes.} \item{name}{\code{signature(x = "Statistic")}: Returns the name of the statistic.} + \item{show}{\code{signature(objet = "Statistic")}: Returns a + printable representation of the statistic.} } } \references{ @@ -102,6 +104,7 @@ calcStat(medianTheta,irt10.base) calcStat(modeTheta,irt10.base) DeleteNetwork(irt10.base) +stopSession(sess) } } \keyword{classes} diff --git a/man/Statistic.Rd b/man/Statistic.Rd index 005092a..0159a1e 100644 --- a/man/Statistic.Rd +++ b/man/Statistic.Rd @@ -104,6 +104,8 @@ calcStat(stat, net) \code{\link{PnodeMargin}}, \code{\link{PnodeEAP}}, \code{\link{PnodeSD}}, \code{\link{PnodeMedian}}, \code{\link{PnodeMode}}. + These statistics will likely produce errors unless + \code{\link{PnetCompile}} has been run first. } @@ -119,7 +121,7 @@ irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, "testnets","IRT10.2PL.base.dne", sep=.Platform$file.sep),session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { @@ -144,6 +146,7 @@ calcStat(medianTheta,irt10.base) calcStat(modeTheta,irt10.base) DeleteNetwork(irt10.base) +stopSession(sess) } } \keyword{classes} diff --git a/man/Warehouse.Rd b/man/Warehouse.Rd index ed9e139..84842a3 100644 --- a/man/Warehouse.Rd +++ b/man/Warehouse.Rd @@ -1,6 +1,7 @@ \name{Warehouse} \alias{Warehouse} \alias{WarehouseSupply} +\alias{WarehouseSupply,ANY-method} \alias{WarehouseFetch} \alias{WarehouseMake} \alias{WarehouseFree} @@ -19,6 +20,7 @@ } \usage{ WarehouseSupply(warehouse, name) +\S4method{WarehouseSupply}{ANY}(warehouse, name) WarehouseFetch(warehouse, name) WarehouseMake(warehouse, name) WarehouseFree(warehouse, name) @@ -192,7 +194,7 @@ CM <- WarehouseSupply(Nethouse,"miniPP_CM") stopifnot(is.null(WarehouseFetch(Nethouse,"PPcompEM"))) EM1 <- WarehouseMake(Nethouse,"PPcompEM") -EMs <- lapply(c("PPcompEM","PPconjEM", "PPtwostepEM"), +EMs <- lapply(c("PPcompEM","PPconjEM", "PPtwostepEM", "PPdurAttEM"), function(nm) WarehouseSupply(Nethouse,nm)) ### Test Node Building with already loaded nets diff --git a/man/WarehouseManifest.Rd b/man/WarehouseManifest.Rd index 2d7fd34..88247b5 100644 --- a/man/WarehouseManifest.Rd +++ b/man/WarehouseManifest.Rd @@ -2,6 +2,7 @@ \alias{WarehouseManifest} \alias{WarehouseManifest<-} \alias{WarehouseData} +\alias{WarehouseInventory} \title{Manipulates the manifest for a warehouse} \description{ @@ -11,12 +12,15 @@ the objects managed by the warehouse on demand. The function \code{WarehouseManifest} access the entire manifest and \code{WarehouseData} extracts the warehouse data for a single item. + \code{WarehouseInventory} returns a list of objects which have already + been built. } \usage{ WarehouseManifest(warehouse) WarehouseManifest(warehouse) <- value WarehouseData(warehouse, name) +WarehouseInventory(warehouse) } \arguments{ \item{warehouse}{A \code{\link{Warehouse}} object} @@ -73,6 +77,8 @@ WarehouseData(warehouse, name) The setter function returns the \code{warehouse} object. + The function \code{WarehouseInventory} returns a data frame where each + row corresponds to the key of an object which has been built. } \references{ Almond, R. G. (presented 2017, August). Tabular views of Bayesian diff --git a/man/calcExpTables.Rd b/man/calcExpTables.Rd index 4eb0f20..da70187 100644 --- a/man/calcExpTables.Rd +++ b/man/calcExpTables.Rd @@ -118,28 +118,28 @@ irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, sep=.Platform$file.sep), session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") } -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement casepath <- paste(library(help="PNetica")$path, "testdat","IRT10.2PL.200.items.cas", sep=.Platform$file.sep) -## Record which nodes in the casefile we should pay attention to -NetworkNodesInSet(irt10.base,"onodes") <- - NetworkNodesInSet(irt10.base,"observables") item1 <- irt10.items[[1]] -priorcounts <- sweep(NodeProbs(item1),1,NodeExperience(item1),"*") +priorcounts <- sweep(PnodeProbs(item1),1,GetPriorWeight(item1),"*") calcExpTables(irt10.base,casepath) -postcounts <- sweep(NodeProbs(item1),1,NodeExperience(item1),"*") +postcounts <- sweep(PnodeProbs(item1),1,PnodePostWeight(item1),"*") ## Posterior row sums should always be larger. stopifnot( @@ -147,7 +147,7 @@ stopifnot( ) DeleteNetwork(irt10.base) - +stopSession(sess) } } diff --git a/man/calcPnetLLike.Rd b/man/calcPnetLLike.Rd index 2430608..3ece690 100644 --- a/man/calcPnetLLike.Rd +++ b/man/calcPnetLLike.Rd @@ -78,25 +78,25 @@ irt10.base <- ReadNetworks(paste(library(help="PNetica")$path, sep=.Platform$file.sep), session=sess) irt10.base <- as.Pnet(irt10.base) ## Flag as Pnet, fields already set. -irt10.theta <- NetworkFindNode(irt10.base,"theta") +irt10.theta <- PnetFindNode(irt10.base,"theta") irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") } -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement casepath <- paste(library(help="PNetica")$path, "testdat","IRT10.2PL.200.items.cas", sep=.Platform$file.sep) -## Record which nodes in the casefile we should pay attention to -NetworkNodesInSet(irt10.base,"onodes") <- - NetworkNodesInSet(irt10.base,"observables") llike <- calcPnetLLike(irt10.base,casepath) DeleteNetwork(irt10.base) - +stopSession(sess) } } \keyword{ graphs } diff --git a/man/flog.try.Rd b/man/flog.try.Rd new file mode 100644 index 0000000..29aa7ba --- /dev/null +++ b/man/flog.try.Rd @@ -0,0 +1,85 @@ +\name{flog.try} +\alias{flog.try} +\title{Trys to execute an expression with errors logged.} +\description{ + + This is a version of \code{\link[base]{try}} which logs errors using + the \code{\link[futile.logger]{flog.logger}} mechanism. + +} +\usage{ +flog.try(expr, context = deparse(substitute(expr)), loggername = flog.namespace(), tracelevel = c("WARN", "ERROR", "FATAL")) +} +\arguments{ + \item{expr}{An R expression to be executed. } + \item{context}{A character string defining what was operation is being + performed for use in the log message.} + \item{loggername}{A package name defining the logger to be used. See + \code{\link[futile.logger]{flog.namespace}}.} + \item{tracelevel}{A character vector. In response to signals of the + listed types, a stack trace will be sent to the log file.} +} +\details{ + + This function behaves like the \code{\link[base]{try}} function, + attempt to execute \code{expr}. If successful, the result is + returned, if not an object of class \code{try-error} is returned, so + that the calling function can figure out how to proceed. + + It has two important difference from \code{try}. The first is the + \code{context} argument which provides information about what was + happening when the error was generated. In a large problem, this can + provide vital debugging information, like the issue was with a + particular node in a graph. + + The second is that the error message and the stack trace are posted to + the logging stream using the \code{\link[futile.logger]{flog.logger}} + function. This makes the code easier to use in server processes. + +} +\value{ + + Either the result of running \code{expr} or an object of class + \code{try-error}. + +} +\author{Russell Almond} +\note{ + + I should move this to the RGAutils package as it is generally useful. + +} +\seealso{ + \code{\link[base]{try}}, \code{\link[futile.logger]{flog.logger}} + + The function \code{\link{maxAllTableParams}} shows an example of this + in use. +} +\examples{ + +\dontrun{ +maxAllTableParams <- function (net, Mstepit=5, + tol=sqrt(.Machine$double.eps), + debug=FALSE) { + Errs <- list() + netnm <- PnetName(net) + lapply(PnetPnodes(net), + function (nd) { + ndnm <- PnodeName(nd) + flog.debug("Updating params for node %s in net %s.",ndnm,netnm) + out <- flog.try(maxCPTParam(nd,Mstepit,tol), + context=sprintf("Updating params for node %s in net %s.", + ndnm, netnm)) + if (is(out,'try-error')) { + Errs <- c(Errs,out) + if (debug) recover() + } + }) + if (length(Errs) >0L) + stop("Errors encountered while updating parameters for ",netnm) + invisible(net) +} +} +} +\keyword{ language } +\keyword{ util } diff --git a/man/isPnodeContinuous.Rd b/man/isPnodeContinuous.Rd index df0ddd5..fd6ff19 100644 --- a/man/isPnodeContinuous.Rd +++ b/man/isPnodeContinuous.Rd @@ -61,6 +61,10 @@ PnodeStateBounds(node) <- value Right now, the value is the midpoint of the interval. This cause problems when converting to T-values. + The setter function is very strict about the upper and lower bounds + matching. Even a mismatch at the least significant digit will cause a + problem. + } \value{ @@ -89,7 +93,7 @@ tNet <- CreateNetwork("TestNet",session=sess) theta1 <- NewDiscreteNode(tNet,"theta1", c("VH","High","Mid","Low","VL")) -NodeLevels(theta1) <- effectiveThetas(NodeNumStates(theta1)) +PnodeStateValues(theta1) <- effectiveThetas(NodeNumStates(theta1)) stopifnot (!isPnodeContinuous(theta1)) ## This gives an error @@ -109,6 +113,9 @@ PnodeStates(theta0) PnodeStateBounds(theta0) PnodeStateValues(theta0) ## Note these are medians not mean wrt normal! +DeleteNetwork(tNet) +stopSession(sess) + } } \keyword{ manip } diff --git a/man/maxAllTableParams.Rd b/man/maxAllTableParams.Rd index 6aaa855..76d04c7 100644 --- a/man/maxAllTableParams.Rd +++ b/man/maxAllTableParams.Rd @@ -161,24 +161,23 @@ irt10.items <- PnetPnodes(irt10.base) ## Flag items as Pnodes for (i in 1:length(irt10.items)) { irt10.items[[i]] <- as.Pnode(irt10.items[[i]]) - + ## Add node to list of observed nodes + PnodeLabels(irt10.items[[1]]) <- + union(PnodeLabels(irt10.items[[1]]),"onodes") } casepath <- paste(library(help="PNetica")$path, "testdat","IRT10.2PL.200.items.cas", sep=.Platform$file.sep) -## Record which nodes in the casefile we should pay attention to -NetworkNodesInSet(irt10.base,"onodes") <- - NetworkNodesInSet(irt10.base,"observables") BuildAllTables(irt10.base) -CompileNetwork(irt10.base) ## Netica requirement +PnetCompile(irt10.base) ## Netica requirement item1 <- irt10.items[[1]] priB <- PnodeBetas(item1) priA <- PnodeAlphas(item1) -priCPT <- NodeProbs(item1) +priCPT <- PnodeProbs(item1) gemout <- GEMfit(irt10.base,casepath,trace=TRUE) @@ -189,7 +188,7 @@ maxAllTableParams(irt10.base) postB <- PnodeBetas(item1) postA <- PnodeAlphas(item1) BuildTable(item1) -postCPT <- NodeProbs(item1) +postCPT <- PnodeProbs(item1) ## Posterior should be different stopifnot( @@ -198,6 +197,7 @@ stopifnot( DeleteNetwork(irt10.base) +stopSession(sess) } }