Merge pull request #5 from ralmond/working

More Basic Network Functions

ChangeLog

@@ -1,3 +1,14 @@
+2020-03-08  Russell Almond  <ralmond@Cherry>
+
+	* R/Warehouses.R (WarehouseCopy, is.legal.name, as.legal.name)
+	(is.valid): Added these methods, to support independence form
+	RNetica in EABN.  
+
+2020-02-24  Russell Almond  <ralmond@Cherry>
+
+	* R/Statistic.R (StatName): Changed name from name, so as to not
+	clash with Proc4::name.
+
 2019-10-03  Russell Almond  <ralmond@Limu>
 
 	* R/Manifest.R (BuildNetManifest): Fixed error with null pathnames.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Peanut
-Version: 0.8-2
-Date: 2019/12/11
+Version: 0.8-3
+Date: 2020/03/09
 Title: Parameterized Bayesian Networks, Abstract Classes
 Author: Russell Almond
 Maintainer: Russell Almond <ralmond@fsu.edu>

NAMESPACE

@@ -106,14 +106,16 @@ exportClasses(PnetWarehouse,PnodeWarehouse)
 export(ClearWarehouse,WarehouseManifest,"WarehouseManifest<-",
        WarehouseData,WarehouseSupply,WarehouseFetch,
        WarehouseMake,WarehouseFree, WarehouseUnpack,
-       WarehouseInventory,
-       is.PnodeWarehouse,is.PnetWarehouse)
+       WarehouseInventory,WarehouseCopy,
+       is.PnodeWarehouse,is.PnetWarehouse,
+       is.legal.name,as.legal.name,is.valid)
 exportMethods(ClearWarehouse,
               WarehouseManifest,"WarehouseManifest<-",
        WarehouseData,WarehouseFetch,WarehouseSupply,
-       WarehouseMake,WarehouseFree,
+       WarehouseMake,WarehouseFree,WarehouseCopy,
        WarehouseInventory,
-       is.PnodeWarehouse,is.PnetWarehouse)
+       is.PnodeWarehouse,is.PnetWarehouse,
+       is.legal.name,as.legal.name,is.valid)
 
 
 
@@ -133,8 +135,8 @@ export(CompensatoryGadget,OffsetGadget,RegressionGadget,DPCGadget)
 
 ## Statistics
 exportClass(Statistic)
-export(name, Statistic, calcStat, PnodeMargin, PnodeEAP, PnodeSD, PnodeMedian,
-       PnodeMode)
-exportMethods(calcStat, name)
+export(StatName, Statistic, calcStat, PnodeMargin, PnodeEAP, PnodeSD,
+       PnodeMedian, PnodeMode)
+exportMethods(calcStat, StatName)
 
 export(flog.try)

R/QOmegaMat.R

@@ -846,7 +846,7 @@ Omega2Pnet <- function(OmegaMat,pn,nodewarehouse,
         flog.error("Parents %s of node %s don't have levels set.",
                    paste(parnames[napar],collapse=", "),ndn)
         stop("Parent",paste(parnames[napar],collapse=", "),
-             "of node", nodename, "don't have levels set.")
+             "of node", ndn, "don't have levels set.")
       }
       BuildTable(node)
 

R/Statistic.R

@@ -15,8 +15,8 @@ setMethod("show","Statistic",function(object) {
   cat(toString(object),"\n")
 })
 
-setGeneric("name",function(x) standardGeneric("name"))
-setMethod("name","Statistic", function(x) x@name)
+setGeneric("StatName",function(x) standardGeneric("StatName"))
+setMethod("StatName","Statistic", function(x) x@name)
 
 setGeneric("calcStat",function (stat,net) standardGeneric("calcStat"))
 setMethod("calcStat",c("Statistic"),

R/Warehouses.R

@@ -64,3 +64,21 @@ is.PnetWarehouse <- function (obj) {
   is(obj,"PnetWarehouse")
 }
 setGeneric("is.PnetWarehouse")
+
+WarehouseCopy <- function (warehouse,obj,newname)
+    UseMethod("WarehouseCopy")
+setGeneric("WarehouseCopy")
+
+is.legal.name <- function (warehouse,name)
+  UseMethod("is.legal.name")
+setGeneric("is.legal.name")
+
+as.legal.name <- function (warehouse,name)
+  UseMethod("as.legal.name")
+setGeneric("as.legal.name")
+
+is.valid <- function (warehouse,object)
+  UseMethod("is.valid")
+setGeneric("is.valid")
+
+

inst/auxdata/Mini-PP-Statistics.csv

@@ -0,0 +1,4 @@
+Name,Fun,Node
+Physics_EAP,PnodeEAP,Physics
+EnergyTransfer_EAP,PnodeEAP,EnergyTransfer
+Physics_Margin,PnodeMargin,Physics

man/Pnet-class.Rd

@@ -93,6 +93,16 @@
     }
   }
 
+}
+\section{Pwned}{
+
+  R really doesn't want me to do this.  I'm just having a lot of
+  difficulty creating a class that extends something from a different
+  package.
+
+  For now, need to use \code{"ANY"} instead of \code{"Pnet"} and then do
+  explicit type checking with  \code{\link{is.Pnet}}.
+
 }
 \author{
   Russell Almond

man/PnetWarehouse-class.Rd

@@ -2,11 +2,12 @@
 \Rdversion{1.1}
 \docType{class}
 \alias{PnetWarehouse-class}
+\alias{PnetWarehouse}
 
 \title{Class \code{"PnetWarehouse"}}
 \description{
 
-  A \code{\link{Warehouse}} objects which holds and builds
+  A \code{\link{Warehouse}} object 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
@@ -165,6 +166,8 @@ Nethouse <- BNWarehouse(manifest=netman1,session=sess,key="Name")
 CM <- WarehouseSupply(Nethouse, "miniPP_CM")
 EM <- WarehouseSupply(Nethouse, "PPcompEM")
 
+
+
 DeleteNetwork(list(CM,EM))
 stopSession(sess)
 }

man/PnodeEvidence.Rd

@@ -27,7 +27,7 @@ PnodeEvidence(node) <- value
 
   Currently, \code{Peanut} supports two ways of representing nodes,
   discrete and continuous (see \code{\link{isPnodeContinuous}}).
-  The current \code{\link[PNetica]{Pnetica-package}} implemenation
+  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

man/PnodePostWeight.Rd

@@ -23,7 +23,7 @@ PnodePostWeight(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
+  (an element of code{\link{PnodePriorWeight}(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
@@ -72,7 +72,7 @@ PnodePostWeight(node)
 \author{Russell Almond}
 \seealso{
   \code{\link{PnodePriorWeight}}, \code{\link{GEMfit}},
-  \code{\link{calcExpTables}}, \code{\link{maxAllTablesParams}}
+  \code{\link{calcExpTables}}, \code{\link{maxAllTableParams}}
 
 }
 \examples{

man/PnodeWarehouse-class.Rd

@@ -2,6 +2,7 @@
 \Rdversion{1.1}
 \docType{class}
 \alias{PnodeWarehouse-class}
+\alias{PnodeWarehouse}
 
 \title{Class \code{"PnodeWarehouse"}}
 \description{

man/Statistic-class.Rd

@@ -3,8 +3,9 @@
 \docType{class}
 \alias{Statistic-class}
 \alias{calcStat,Statistic-method}
-\alias{name,Statistic-method}
-
+\alias{StatName}
+\alias{StatName,Statistic-method}
+\alias{show,Statistic-method}
 \title{Class \code{"Statistic"}}
 \description{
 
@@ -40,7 +41,7 @@ Objects are created using the function \code{\link{Statistic}(fun, node,
     \item{calcStat}{\code{signature(stat = "Statistic", net)}: This method
       (a) finds the nodes referenced in \code{node}, (b) applies
       \code{fun} (using \code{do.call} to \code{net} and the actual nodes.}
-    \item{name}{\code{signature(x = "Statistic")}: Returns the name of
+    \item{StatName}{\code{signature(x = "Statistic")}: Returns the name of
       the statistic.}
     \item{show}{\code{signature(objet = "Statistic")}: Returns a
       printable representation of the statistic.}

man/Warehouse.Rd

@@ -6,6 +6,7 @@
 \alias{WarehouseMake}
 \alias{WarehouseFree}
 \alias{ClearWarehouse}
+\alias{is.valid}
 \alias{is.PnodeWarehouse}
 \alias{is.PnetWarehouse}
 \title{
@@ -25,6 +26,7 @@ WarehouseFetch(warehouse, name)
 WarehouseMake(warehouse, name)
 WarehouseFree(warehouse, name)
 ClearWarehouse(warehouse)
+is.valid(warehouse,object)
 is.PnetWarehouse(obj)
 is.PnodeWarehouse(obj)
 }
@@ -36,8 +38,9 @@ is.PnodeWarehouse(obj)
     that for net warehouses, the key is usually has length one, but for
     node warehouses, this usuall has the form (\var{model},\var{node}). 
   }
-  \item{obj}{An object whose type is to be determined.
-  }
+  \item{obj}{An object whose type is to be determined.}
+  \item{object}{An object to be tested to see if it a valid object from
+    this warehouse.}
 }
 \details{
 
@@ -64,7 +67,7 @@ is.PnodeWarehouse(obj)
   from the cache, and clear the cache.  Note that these may our may not
   make sense with the implementation.  (In the current
   \link[PNetica]{PNetica-package} implementation, the cache is
-  maintained by the underlying \link[RNetica]{RNetica-package} objects,
+  maintained by the underlying \link[RNetica]{RNetica} objects,
   and hence it doesn't make sense to free an object without deleting
   it.)
 
@@ -93,23 +96,37 @@ is.PnodeWarehouse(obj)
   A Pnode warehouse should return true when the generic function
   \code{is.PnodeWarehouse()} is called.
 
+  The function \code{is.valid} checks to see if the object is of a type
+  mananged by the warehouse, and that it has valid data.  In particular,
+  the \code{\link[RNetica]{RNetica}} package uses pointers to objects in Netica
+  space (as might other implementations).  The \code{is.valid()}
+  function checks that the current \code{\link{Pnet}} and
+  \code{\link{Pnode}} object point to valid objects in the external heap
+  if this is applicable to the application.
+
+
   The warehouse object is an abstract class, and implementing classes
   need to provide methods for the generic functions
   \code{WarehouseFetch()}, \code{WarehouseMake()},
   \code{WarehouseFree()}, \code{WarehouseData()},
-  \code{WarehouseManifest()}, and \code{ClearWarehouse()} as well as one
+  \code{WarehouseManifest()}, \code{\link{WarehouseCopy}()},
+  \code{\link{is.legal.name}()},\code{\link{as.legal.name}()},
+  \code{is.valid()}
+  and \code{ClearWarehouse()} as well as one
   of the generic functions \code{is.PnetWarehouse} or
   \code{is.PnodeWarehouse}.
 
   There are two reference implementations in
   \code{\link[PNetica]{BNWarehouse}} and
   \code{\link[PNetica]{NNWarehouse}} (network and node warehouses
   respectively).  Both of these take advantage of the fact that the
-  session and network objects in \code{\link[RNetica]{RNetica-package}}
+  session and network objects in \code{\link[RNetica]{RNetica}}
   have built in environments which cache the networks and nodes
   respectively.  The \code{\link[RGAutils]{Warehouse-class}} object is a
   generic implementation that also may be of some use to potential
   implementors. 
+
+
 
 }
 \value{
@@ -156,6 +173,9 @@ of persistent storage and object persistance and uniqueness necessary
 }
 \seealso{
 
+  Other warehouse functions:
+  \code{\link{WarehouseCopy}}, \code{\link{is.legal.name}}
+
   These functions support the manifest process.
   \code{\link{WarehouseManifest}()}, \code{\link{WarehouseData}()} 
 
@@ -219,6 +239,11 @@ for (n in 1:nrow(nodeman1)) {
   }
 }
 
+WarehouseFree(Nethouse,PnetName(EM1))
+stopifnot(!is.valid(Nethouse,EM1))
+
+
+
 stopSession(sess)
 
 }}

man/WarehouseCopy.Rd

@@ -0,0 +1,99 @@
+\name{WarehouseCopy}
+\alias{WarehouseCopy}
+\alias{WarehouseCopy,default-method}
+\title{Copies and object in the warehouse}
+\description{
+
+  The creates an object with a new name that shares the appropriate
+  properties with the original object.  How this is handled depends on
+  the type of objects conatined in the Warehouse.  The new object is
+  placed in the warehouse inventory, although not in the manifest.
+
+}
+\usage{
+WarehouseCopy(warehouse, obj, newname)
+}
+\arguments{
+  \item{warehouse}{A \code{\link{Warehouse}} object.}
+  \item{obj}{An object generated from the warehouse.}
+  \item{newname}{A new name for the warehouse object.}
+}
+\details{
+
+  For the \code{\link{PnetWarehouse}}, this is essentially a copy net
+  function. The \code{newname} is the name of the new network, and it
+  will be an error if this is the same as the name of an existing network.
+
+  For the \code{\link{PnodeWarehouse}}, this is essentially a copy node
+  function.  Note that in this case, the new name must be a character
+  vector with two element: the new net name, and the new node name.  If
+  the new net name is not the same as the net containing the \code{obj}
+  argument, then the node will be copied into the new net.  If it is the
+  same, then a new node will be added to the existing net.  Note that at
+  least one part of the name (the net name or the node name) must be
+  different. 
+
+}
+\value{
+
+  A new object of the same type as \code{obj}, that is a new object
+  managed by the \code{warehouse}.
+
+}
+\author{Russell Almond}
+\seealso{
+  \code{\link{Warehouse}}, \code{\link{WarehouseFree}}
+}
+\examples{
+
+\dontrun{## Requires implementation
+library(PNetica)
+
+sess <- NeticaSession()
+startSession(sess)
+
+## BNWarehouse is the PNetica Net Warehouse.
+## This provides an example network manifest.
+table.dir <- file.path(library(help="Peanut")$path, "auxdata")
+net.dir <- file.path(library(help="PNetica")$path, "testnets")
+
+netman1 <- read.csv(file.path(table.dir,"Mini-PP-Nets.csv"),
+                    row.names=1, stringsAsFactors=FALSE)
+Nethouse <- BNWarehouse(manifest=netman1,session=sess,key="Name",
+                       address=net.dir)
+
+CM <- WarehouseSupply(Nethouse, "miniPP_CM")
+SM1 <- WarehouseCopy(Nethouse, CM, "Student1")
+
+stopifnot(length(NetworkAllNodes(CM))==length(NetworkAllNodes(SM1)))
+
+## This expression provides an example Node manifest
+nodeman1 <- read.csv(file.path(table.dir,"Mini-PP-Nodes.csv"),
+                     row.names=1,stringsAsFactors=FALSE)
+Nodehouse <- NNWarehouse(manifest=nodeman1,
+                         key=c("Model","NodeName"),
+                         session=sess)
+NNodes <- length(NetworkAllNodes(CM))
+
+IterD <- NetworkAllNodes(CM)$IterativeD
+
+## Copy within net.
+Explain <- WarehouseCopy(Nodehouse,IterD,c("miniPP_CM","Explanation"))
+stopifnot(PnodeName(Explain)=="Explanation",
+          PnetName(PnodeNet(Explain))=="miniPP_CM",
+          all.equal(PnodeStates(IterD),PnodeStates(Explain)))
+
+
+## Copy betwee nets.
+Explain1 <- WarehouseCopy(Nodehouse,Explain,c("Student1","Explanation"))
+stopifnot(PnodeName(Explain1)=="Explanation",
+          PnetName(PnodeNet(Explain1))=="Student1",
+          all.equal(PnodeStates(IterD),PnodeStates(Explain1)))
+
+
+
+
+}
+}
+\keyword{ objects }
+\keyword{ manip }