Extract.NeticaNode {RNetica} | R Documentation |
Provides an efficient mechanism for extracting or setting portions of
large conditional probability tables. In particular, allows setting
many rows a CPT to the same value. The node[]
form is for
chance (probabilistic) nodes, the node[[]]
form is for
deterministic (functional) nodes. See
IsNodeDeterministic
.
## S4 method for signature 'NeticaNode' x[i, j,..., drop=FALSE] ## S4 method for signature 'NeticaNode' x[[i, j, ..., drop=FALSE]] ## S4 replacement method for signature 'NeticaNode' x[i, j, ...] <- value ## S4 replacement method for signature 'NeticaNode' x[[i, j, ...]] <- value EVERY_STATE
x |
An active, discrete |
i,j,... |
Indices specifying rows of the table to extract or
replace. If a single index, |
drop |
If true and a single row is selected, that row will be returned as a
numeric vector instead of a conditional probability frame
( |
value |
Either a numeric vector with length |
The function NodeProbs(node)
allows one to access the
entire conditional probability at once as a conditional probability
array (CPA
). Although the built-in R array replacement
mechanisms allow one to make various kinds of edits, it is relatively
inefficient. In particular, to set a single row of an array, the
entire table is read into R and then written back to Netica.
This function allows the syntax node[...]
to be used to
access only a portion of the table. There are many different ways
...
can be interpreted, which are described below.
In this access model the value EVERY_STATE
or the character
value "*"
has a special meaning of match every level of that
state variable. Netica supports this as a shortcut method for
specifying conditional probability tables with many similar
values. However, when reading the conditional probability tables from
Netica they are expanded and no attempt is made to collapse over
identical rows.
A second difference is that node[...]
returns the
conditional probability table in data frame (CPF
)
format. This is particularly convenient because that format does not
need to cover every parent configuration, thus it is ideal for holding
subset of the complete table.
A third difference is that if the last column of the conditional probabilities is not supplied, it will be computed. This is particularly handy for binary nodes.
Normally, the expression node[...]
produces a data frame
either in CPF
format, or with the probabilities replaced
by a single column of values. If drop==TRUE
, only the matrix of
probabilities or the vector of values will be returned. See also
numericPart
.
Deterministic nodes (see IsNodeDeterministic
) should be
accessed using the node[[...]]
form. In this form, the node
has a value table which maps a configuration of the parent values to a
value of the node. That will be a numeric value for continuous
nodes, and a factor for discrete variables. Note that Netica figures
out whether or not a node is deterministic on the fly. For that
reason, it is strongly recommended to use node[[...]]
to access
the value table, and node[...]
to access the CPT.
In using the form node[[...]] <- value
the value depends on
whether the node is continuous or discrete. For continuous nodes, the
node's value for a parent configuration (assuming all discrete or
discretized parents) can be set directly if value
is numeric.
(If value
is a factor or a string, it behaves like a discrete
node.). For a discrete node, value
can be a factor, string or
integer, incidating the state. This creates a deterministic conditional
probability table full of 1's and 0's.
The sections below describe the various indexing options.
For the form node[...]
the return value is a data frame in
the CPF
format giving the conditional probability
table.
For the form node[[...]]
, if the node is deterministic
(IsNodeDetermistic(node)==TRUE
) then the probabilities
will be replaced with a single column giving the value of the node.
If the node is discrete, then the value will be a factor. If the node
is continuous, then the value will be a real vector.
If drop==TRUE
then the return value will be a
matrix of probabilities (the last several columns of the data frame).
If the node is deterministic, then the result will instead be either a
factor (discrete node) or real vector (continuous node) giving the
value of the node for each parent configuration.
The forms node[...]<-value
and node[[...]]<-value
return node
invisibly.
This selection uses the syntax node[df]
or
node[df]<-value
, where df
is a data frame or a matrix.
It is assumed that the columns represent the variables, and the rows
represent the selected configurations of the parent variables.
In this configuration, the number of rows of df
and
value
should match (or the length of value
should equal
the number of rows if one of the special values is used). When the
value is being queried rather than set, the number of rows in the
result may be greater than the number of rows in df
because of
EVERY_STATE
expansion.
There are three different ways that df
could be represented:
It can be a data frame filled with factor variables whose levels correspond to the states of the corresponding parent node.
It can be a matrix or data frame of type character whose
values correspond to the state names of the corresponding parent
variables, or possibly the special value "*"
meaning that all
values of that parent should be matched.
It can be a matrix of data frame of integers whose values
correspond to the state indexes of the parent variables. In this case
the special value EVERY_STATE
can be supplied indicating that
all values should be matched. Otherwise, it should be a number
between 1 and the number of states of that variable, inclusive.
The number of columns in df
should be the same as the number of
parent variables for node
. If df
has column names, then
all columns should be named. In this case the parent variables will
be match by the NodeInputNames(node)
if they exist, or
the names of the parent variables if they do not (see
ParentStates(node)
for more details). Otherwise,
positional selection is used.
The second way that rows from the conditional probability table can be
selected is using an analogue of the selection mechanisms supported by
R for selecting cells from an array. Essentially, the rows of the
conditional probability table are treated as if they are the elements
of an array whose dimnames correspond to
ParentStates{node}
. In particular the number of
dimensions corresponds to the number of parent variables, and the
extent of each dimension corresponds to the number of states of the
corresponding parent variable.
In this selection mode, the length of ...
should correspond to
the number of parent variables (that is, there should be one fewer
comma, than parent variables). Each element can be one of three
things:
A character or factor vector selecting the appropriate states of the parent variable.
An integer vector selecting the appropriate states of the parent variable by position.
One of the special values EVERY_STATE
, "*"
or
blank indicating that all values of the appropriate variable should be
selected.
The order of the entries should be the same as the order of the parent
variables in NodeParents{node}
. The selection looks
very similar to selection using a data frame, where the data frame
consists of applying expand.grid(...)
.
Once again EVERY_STATE
or "*"
entries are treated
specially inside of Netica, which allows every matching row of the
table to be simultaneously set to the same probabilities.
Note that negative selections and logical selections are not currently supported.
As with R array index selection, the dimensions of the selection in
the ...
argument can be specified using named arguments. If
one of the elements of ...
is named, they all should be
named. The names should correspond to
ParentNames(node)
, that is the
NodeInputNames(node)
are used if available, and the
names of the parent nodes are used as a fallback.
As before the value for a parent variable can be set to a value or a
vector of possible values as either an integer, factor or character
value. The special values EVERY_STATE
and "*"
are
interpreted as before. If the value of a parent variable is
unspecified, this is equivalent to using the value
EVERY_STATE
.
If ...
is a single integer, it is treated as an index into the
possible configurations. These are defined by
expand.grid(ParentStates(node)
. Each index
refers to a row in that table. This is particularly meant for running
through loops on all values, although working with value as a data
frame or using NodeProbs
may be faster in those cases.
There is some ambiguity when there is a single parent variable about whether the array-type selection or the index was intended, but both are identical, so there should be no conflict.
NULL
selectionIf ...
is NULL
, that is if the calling expression looks
like node[]
then the intention is that all rows of the
conditional probability table are to be selected. This is the only
meaningful selection type if there are no parent variables. It also
provides a fast and convenient way to set all rows of the conditional
probability table to the same value (if value
) has a single
row, or to retrieve the complete conditional probability table in
CPF
format.
If value
is a data frame with both factor and numeric
variables, then it takes on a different meaning. In this case, the
factor variables are used as if they were the selection argument (the
...
) and the remaining numeric values the probabilities.
In general the replacement value should be a matrix. The number of
columns should match the number of states of node
(see below
for the behavior if the number of columns is one less than the number
of states). It should have the same number of rows as the number of
rows in the selection after any expansion has been applied for vector
valued arguments, but not counting the special values
EVERY_STATE
or "*"
(or blank entries in the list).
Netica has a special shortcut for EVERY_STATE
and all matching
rows are set to the same probability value. This means that the number
of rows in the value must match the selection counting the special
values as if they selected a single row. In particular, if
node
has one or more parent variables and value
is a
matrix with more than one row, node[] <- value
will generate a
error, because the selection has only one row (with every value set to
EVERY_STATE
).
When value
is an undimensioned vector, the function will do its
best to figure out if it should be treated as a row or a column
vector. In the case of unusual behavior, expressing value
as a
matrix should make the programmer's intention clear.
When a node is deterministic, that is all probabilities are 0 or
1, then it is meaningful to talk about the conditional value of
a node instead of the conditional probability table. The expression
node[[...]]
displays the conditional probability table in a
special way when the node is deterministic. In this case it displays
the value as a single variable giving the state of the child variable
given the configuration of the parents. In the case of discrete
nodes, this is a factor variable giving the state. In the case of
continuous nodes, this is a numeric vector giving the value.
The same conventions can be used in setting the conditional
probability of a node. In the expression node[[...]] <- value
if value
is a factor or character vector then the selected
configurations are set to deterministic probabilities with the
indicated value given probability of 1 and all others with
probability 0. It is possible to set some rows of a conditional
probability table to be deterministic and others to have unrestricted
probabilities, however, the deterministic rows will then print out as
unconstrained probabilities with 0 and 1 values.
Continuous nodes (nodes for which is.continuous(node) ==
TRUE
) use a variation of this system. Here the value is an arbitrary
numeric value. For this to be meaningful, it is assumed that all of
the parents of node
are either discrete or have been
discretized. The use of the node[[...]] <- value
is
particularly important for continuous nodes becuase it indicates that
value is a potential value of the node rather than a
probability.
Warning: Setting an unconditional discrete node to a constant value,
that is executing an expression like node[[]] <- value
is almost certainly a mistake. Probably what is intended by that
expression is NodeFinding(node) <- value
. In
particular, if the former expression is used and the later someone
attempts to set NodeFinding(node) <- value1
, where
value1 != value
, this will produce a contradiction
(probability zero event) and all kinds of error will follow.
If the number of columns in value
is one less than the number of
states in node
, then is assumed that the probability values
should be calculated for the last state via normalization, that is it
is assigned all of the remaining probability not assigned in the first
couple of columns. In particular, the value is internally translated
via the expression:
value <- cbind(value,1-apply(value,1,sum))
.
This is particularly useful when the node is binary (has exactly 2
states). Then the replacement only needs to specify the probability
for the first one. For example node[] <- .5
would set the
probability distribution of node
to the uniform distribution if
node
is binary.
There is some potential for confusion if value
is not specified
as a matrix. In particular, if the number of states of the child
value is one more than the number of configurations of the parents, it
is unclear whether this is an attempt to set the node value of a
discrete node or an unnormalized probability. It should be possible
by specifying value as a matrix or one row or one column to clarify
the intent.
RNetica version 0.7 changed the ways that the node[...]
and
node[[...]]
were handled, establishing that the former is
for manipulating conditional probability tables, and the latter for
manipulating value tables for deterministic nodes.
The return value of node[]
for a deterministic
node node has changed This now returns the conditional probability
table. Use node[[]]
to get the value table.
The use of node[[...]]
as a synnonym for
node[...,drop=TRUE]
is deprecated. (I'm not sure it was
working correctly).
The use of node[...]<- value
to set rows in a function table
for a discrete node is deprecated. Use node[[...]]<- value
instead.
An error where node[...]<- value
always treated continuous
nodes as deterministic is fixed. (Note that continuous nodes cannot
be treated as random unless they have been discretized.)
I have tried to anticipate most of the ways that somebody might want to index the conditional probability table, not to mention all of the peculiar ways that R overloads the extraction operator. Negative selections are not allowed. I have almost certainly missed some combinations, and some untested combinations might preform rather strangely. Undoubtedly somebody will come to rely on that strangeness and it will never get fixed.
Factor variables do not easily handle the use of "*"
as a
wildcard. To make this work, a construction like
factor(varstates, c(1:3,EVERY_STATE),
labels=c("a1","a2","a3","*"))
.
Internally R uses 1-based indexing and Netica uses 0-based indexing. RNetica makes the translation inside of the C layer, so these function should be called with R-style 1-based indexing.
I'm having weird race conditions when trying to set the value of
EVERY_STATE
(I can't figure out how to call the C function to
set its value after the C code is loaded but before the namespace is
exported. So for now the exported EVERY_STATE
is different
from the internal Netica value (which is RNetica:::EVERY_STATE
,
at least in the current implementation). This should not be a visible
change to the user.
This documentation file is longer than War and Peace.
Russell Almond
http://norsys.com/onLineAPIManual/index.html: GetNodeProbs_bn(), SetNodeProbs_bn(), GetNodeFuncState_bn(), SetNodeFuncState_bn(), GetNodeFuncReal_bn(), SetNodeFuncReal_bn(),
NeticaNode
, NodeParents()
,
NodeInputNames()
, NodeStates()
,
ParentStates()
, CPF
, CPA
,
IsNodeDeterministic
## Setup sess <- NeticaSession() startSession(sess) xnet <- CreateNetwork("X", session=sess) A <- NewDiscreteNode(xnet,"A",c("A1","A2","A3","A4")) Aalt <- NewDiscreteNode(xnet,"Aalt",c("A1","A2","A3","A4")) B <- NewDiscreteNode(xnet,"B",c("B1","B2","B3")) B2 <- NewDiscreteNode(xnet,"B2",c("B1","B2")) Balt <- NewDiscreteNode(xnet,"Balt",c("B1","B2","B3")) C2 <- NewDiscreteNode(xnet,"C2",c("C1","C2")) C3 <- NewDiscreteNode(xnet,"C3",c("C1","C2","C3")) C4 <- NewDiscreteNode(xnet,"C4",c("C1","C2","C3","C4")) Cont <- NewContinuousNode(xnet,"Cont") CC <- NewContinuousNode(xnet,"CC") CCC <- NewContinuousNode(xnet,"CCC") ### Tests for various setting modes. ## Null before we set any probabilities anything stopifnot( all(is.na(C2[])), length(C2[]) == 2, all(is.na(Cont[])), length(Cont[])==1 ) NodeProbs(C2) <- c(1,0) stopifnot( C2[[]]=="C1" ) ## This is just a demonstration of the syntax, in practice ## the expression NodeFinding(C2) <- "C2" is usually better. C2[[]] <- "C2" stopifnot( NodeProbs(C2)==c(0,1) ) C3[[]] <- 3 stopifnot( C3[[]] == "C3" ) ## Setting value of continuous node Cont[[]] <- 145.4 stopifnot( abs(Cont[[]] - 145.4) < .0001) ## Setting value with probabilities C2[] <- c(.3,.7) stopifnot( sum(abs(NodeProbs(C2)-c(.3,.7))) < .0001) C3[] <- c(1,2,1)/4 stopifnot( sum(abs(NodeProbs(C3)-c(.25,.5,.25))) < .0001) ## Automatic normalization C2[] <- .25 stopifnot( abs(sum(NodeProbs(C2)-c(.25,.75))) < .0001) C3[] <- c(1,1)/3 stopifnot( abs(sum(NodeProbs(C3)-1/3)) < .0001) ### Now some one parent cases AddLink(A,B) AddLink(A,B2) stopifnot( nrow(B[])==NodeNumStates(A), ncol(B[])==1+NodeNumStates(B), all(is.na(B[][,2:(1+NodeNumStates(B))])) ) NodeProbs(B) <- normalize(matrix(1:12,4)) Brow1 <- B[1] stopifnot( nrow(Brow1)==1,ncol(Brow1)==4, sum(abs(Brow1[,2:4]-c(1,5,9)/15))<.00001 ) Brow12 <- B[1:2] stopifnot( nrow(Brow12)==2,ncol(Brow12)==4, sum(abs(Brow12[2,2:4]-c(2,6,10)/18))<.00001 ) Brow4 <- B["A4"] stopifnot( nrow(Brow4)==1,ncol(Brow4)==4, sum(abs(Brow4[,2:4]-c(1,2,3)/6))<.00001 ) Brow34 <- B[c("A3","A4")] stopifnot( nrow(Brow34)==2,ncol(Brow34)==4, abs(sum(Brow4[1,2:4]-c(3,7,11)/21))<.00001 ) Ball <- B["*"] stopifnot( nrow(Ball)==4,ncol(Ball)==4 ) Ball <- B[EVERY_STATE] stopifnot( nrow(Ball)==4,ncol(Ball)==4 ) Brow24 <- B[data.frame(A=factor(c("A2","A4"),NodeStates(A)))] stopifnot( nrow(Brow24)==2,ncol(Brow24)==4, sum(abs(Brow24[2,2:4]-c(1,2,3)/6))<.00001 ) ## Set all rows to the same value. B[] <- matrix(c(1,1,1)/3,1) stopifnot( abs(NodeProbs(B)-1/3)<.0001 ) B[EVERY_STATE] <- matrix(c(1,2,1)/4,1) stopifnot( abs(NodeProbs(B)[3,]-c(.25,.5,.25))<.0001 ) B["*"] <- matrix(c(1,2,3)/6,1) stopifnot( abs(NodeProbs(B)[2,]-c(1/6,1/3,.5))<.0001 ) ## Setting to exact values B2[[1:2]] <- "B1" B2[[3]] <- "B2" B2[[4]] <- "B2" B2tab <- B2[[]] stopifnot( IsNodeDeterministic(B2), nrow(B2tab)==4,ncol(B2tab)==2, B2tab[,2] == c("B1","B1","B2","B2"), as.integer(B2tab[,2]) == c(1,1,2,2) ) ## Setting one value to non-deterministic changes the way the table is ## displayed. B2[2] <- c(.5,.5) B2tab <- B2[] stopifnot( !IsNodeDeterministic(B2), nrow(B2tab)==4,ncol(B2tab)==3, sum(abs(B2tab[2,2:3]- c(.5,.5))) < .001, B2tab[1,2:3] == c(1,0), B2[3,drop=TRUE] == c(0,1) ) ## Self-normalizing setting ## Not run: ## This will generate an error because it is trying to set all four ## configurations to the same value but it is given four values. B2[] <- c(.1,.2,.3,.4) ## End(Not run) B2[1:4] <- c(.1,.2,.3,.4) stopifnot( sum(abs(NodeProbs(B2)[,2]-c(.9,.8,.7,.6))) < .001 ) B2[1:2] <- .5 ## Set both values to the same thing B2[3:4] <- c(.6,.7) ## set to normalizing probs stopifnot( sum(abs(NodeProbs(B2)[,2]-c(.5,.5,.4,.3))) < .001 ) ## Beware! This next form assumes you are setting the rows to the same ## thing. B2[3:4] <- c(.2,.8) ## Ambiguous instructions stopifnot( sum(abs(NodeProbs(B2)[,2]-c(.5,.5,.8,.8))) < .001 ) ## Using a matrix makes intent clear B2[3:4] <- matrix(c(.2,.8),2) ## set to normalizing probs stopifnot( sum(abs(NodeProbs(B2)[,2]-c(.5,.5,.8,.2))) < .001 ) ## Data frame as value ## First do a blank extraction to get general shape. B2frame <- B2[] ## Now manipulate it however B2frame[,2:3] <- 1:8 ## And set it back B2[] <- normalize(B2frame) stopifnot( sum(abs(NodeProbs(B2)[,1]-c(1/6,2/8,3/10,4/12))) <.001 ) B2frame1 <-B2frame[B2frame$A=="A3",] B2frame1[,2:3] <- c(4,6)/10 B2[] <- B2frame1 ## Only row 3 affected stopifnot( sum(abs(NodeProbs(B2)[,1]-c(1/6,2/8,4/10,4/12))) <.001 ) ## Continuous node with one discrete parent AddLink(A,Cont) ##Notice how old value is replicated stopifnot( nrow(Cont[[]]) ==4, ncol(Cont[[]]) == 2, abs(Cont[[]][,2]-145.4) <.0001, abs(Cont[[3,drop=TRUE]]-145.4) <.0001 ) AddLink(A,CC) stopifnot( nrow(CC[]) ==4, ncol(CC[]) == 2, is.na(CC[][,2]) ) Cont[[]] <- 7 stopifnot( abs(Cont[[,drop=TRUE]]-7) <.0001 ) Cont[[2]] <- 3.2 stopifnot( abs(Cont[[,drop=TRUE]]-c(7,3.2,7,7)) <.0001 ) Cont[[1:2]] <- 0 Cont[[3:4]] <- c(8,1) stopifnot( abs(Cont[[,drop=TRUE]]-c(0,0,8,1)) <.0001, abs(Cont[[3:4,drop=TRUE]]-c(8,1)) < .0001 ) ## Two parent case AddLink(A,C2) AddLink(B,C2) C2[] <- c(.5,.5) stopifnot( nrow(C2[])==12, ncol(C2[])==4, sum(abs(numericPart(C2[])-.5)) < .0001 ) AddLink(A,C4) AddLink(B,C4) stopifnot( nrow(C4[])==12, ncol(C4[])==6, all(is.na(C4[,drop=TRUE])) ) NodeProbs(C4) <- normalize(array(1:48,c(4,3,4))) ## Data Frame/matrix Selection dfsel <- data.frame(A=factor(c("A2","A3"),levels=NodeStates(A)), B=factor(c("B1","B3"),levels=NodeStates(B))) C21.33 <- C4[dfsel] stopifnot( nrow(C21.33)==2, ncol(C21.33)==6, C21.33[1,1] == "A2", C21.33[2,2] == "B3", abs(C21.33[1,3]-2/80) < .0001, abs(C21.33[2,4]-23/116) < .0001 ) dfselbak <- data.frame(B=factor(c("B3","B2"),levels=NodeStates(B)), A=factor(c("A1","A4"),levels=NodeStates(A))) C13.42 <- C4[dfselbak] stopifnot( nrow(C13.42)==2, ncol(C13.42)==6, C13.42[1,1] == "A1", C13.42[2,2] == "B2", abs(C13.42[1,3]-9/108) < .0001, abs(C13.42[2,4]-20/104) < .0001 ) C2[dfsel] <- matrix(c(.7,.6,.3,.4),2) C2[dfselbak] <- c(.9,.1) stopifnot( sum(abs(numericPart(C2[])[,1] - c(.5,.7,.5,.5, .5,.5,.5,.9, .9,.5,.6,.5))) < .0001 ) ## Test for error with using variables in selection inside of a ## function. testSel <- function(node,sel1,sel2, val) { localselvar <- data.frame(sel1,sel2) names(localselvar) <- ParentNames(node) node[localselvar] node[localselvar]<-val invisible(node) } testSel(C2,factor(c("A2","A3"),levels=NodeStates(A)), factor(c("B1","B3"),levels=NodeStates(B)), matrix(c(.7,.6,.3,.4),2)) ## Array-like selection stopifnot( sum(abs(numericPart(C4[2,3])-c(10,22,34,46)/112))<.0001, sum(abs(numericPart(C4[B=2,A=4])-c(8,20,32,44)/104))<.0001 ) C1.23 <- C4[1,2:3] stopifnot( nrow(C1.23)==2, ncol(C1.23)==6, sum(abs(C1.23[,3] - c(5/92 ,9/108))) <.0001 ) C2[] <- .5 C2[1,2:3] <- .99 stopifnot( sum(abs(numericPart(C2[])[,1] - c(.5,.5,.5,.5, .99,.5,.5,.5, .99,.5,.5,.5))) < .0001 ) C1.23 <- C4["A1",c("B2","B3")] stopifnot( nrow(C1.23)==2, ncol(C1.23)==6, sum(abs(C1.23[,3] - c(5/92 ,9/108))) <.0001 ) C2[] <- .5 C2["A1",c("B2","B3")] <- .99 stopifnot( sum(abs(C2[,drop=TRUE][,1] - c(.5,.5,.5,.5, .99,.5,.5,.5, .99,.5,.5,.5))) < .0001 ) C34.12 <- C4[3:4,1:2] stopifnot( nrow(C34.12)==4, ncol(C34.12)==6, sum(abs(C34.12[,3] - c(3/84,4/88, 7/100, 8/104))) <.0001 ) C2[] <- .5 C2[3:4,1:2] <- .99 stopifnot( sum(abs(C2[][,3] - c(.5,.5,.99,.99, .5,.5,.99,.99, .5,.5,.5,.5))) < .0001 ) ## Wildcards C1. <- C4[1,EVERY_STATE] stopifnot( nrow(C1.) == 3, ncol(C1.)==6, sum(abs(C1.[,3] -c(1/76, 5/92, 9/108))) < .0001 ) C2[] <-.5 C2[1,EVERY_STATE] <- "C1" stopifnot( sum(abs(C2[][,3] - c(1,.5,.5,.5, 1,.5,.5,.5, 1,.5,.5,.5))) < .0001 ) C.2 <- C4[EVERY_STATE,2] stopifnot( nrow(C.2) == 4, ncol(C.2)==6, sum(abs(C.2[,3] -c(5/92, 6/96, 7/100, 8/104))) < .0001 ) C2[] <-.5 C2[[EVERY_STATE,2]] <- "C2" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(.5,.5,.5,.5, 0,0,0,0, .5,.5,.5,.5))) < .0001 ) C1. <- C4["A1","*"] stopifnot( nrow(C1.) == 3, ncol(C1.)==6, sum(abs(C1.[,3] -c(1/76, 5/92, 9/108))) < .0001 ) C2[] <-.5 C2[["A1","*"]] <- "C1" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(1,.5,.5,.5, 1,.5,.5,.5, 1,.5,.5,.5))) < .0001 ) C.2 <- C4["*","B2"] stopifnot( nrow(C.2) == 4, ncol(C.2)==6, sum(abs(C.2[,3] -c(5/92, 6/96, 7/100, 8/104))) < .0001 ) C2[] <-.5 C2[["*","B2"]] <- "C2" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(.5,.5,.5,.5, 0,0,0,0, .5,.5,.5,.5))) < .0001 ) ## Missing parent values C1. <- C4[1,] stopifnot( nrow(C1.) == 3, ncol(C1.)==6, sum(abs(C1.[,3] -c(1/76, 5/92, 9/108))) < .0001 ) C2[] <-.5 C2[[1,]] <- "C1" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(1,.5,.5,.5, 1,.5,.5,.5, 1,.5,.5,.5))) < .0001 ) C.2 <- C4[,2] stopifnot( nrow(C.2) == 4, ncol(C.2)==6, sum(abs(C.2[,3] -c(5/92, 6/96, 7/100, 8/104))) < .0001 ) C2[] <-.5 C2[[,2]] <- "C2" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(.5,.5,.5,.5, 0,0,0,0, .5,.5,.5,.5))) < .0001 ) C1. <- C4[A=1] stopifnot( nrow(C1.) == 3, ncol(C1.)==6, sum(abs(C1.[,3] -c(1/76, 5/92, 9/108))) < .0001 ) C2[] <-.5 C2[[A=1]] <- "C1" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(1,.5,.5,.5, 1,.5,.5,.5, 1,.5,.5,.5))) < .0001 ) C.2 <- C4[B="B2"] stopifnot( nrow(C.2) == 4, ncol(C.2)==6, sum(abs(C.2[,3] -c(5/92, 6/96, 7/100, 8/104))) < .0001 ) C2[] <-.5 C2[[B="B2"]] <- "C2" stopifnot( sum(abs(C2[drop=TRUE][,1] - c(.5,.5,.5,.5, 0,0,0,0, .5,.5,.5,.5))) < .0001 ) ## Data frame as value dfset <- data.frame(A=factor(c("A2","A3"),levels=NodeStates(A)), B=factor(c("B1","B3"),levels=NodeStates(B)), C.C1=c(1,0), C.C2=c(0,1)) C2[] <- .5 C2[] <- dfset stopifnot( sum(abs(C2[][,3] - c(.5,1,.5,.5, .5,.5,.5,.5, .5,.5,0,.5))) < .0001 ) ## Continuous Child node AddLink(B2,Cont) stopifnot( nrow(Cont[[]])==8, ncol(Cont[[]])==3, sum(abs(Cont[[drop=TRUE]]-c(0,0,8,1))) < .0001 ) AddLink(A,CCC) AddLink(B,CCC) stopifnot( nrow(CCC[])==12, ncol(CCC[])==3, all(is.na(CCC[][,3])) ) Cont[[]] <- 0 Cont[[1,1]] <- 1.1 Cont[[2:3,2]] <- c(2.2,3.2) Cont[["A4","*"]] <- 4 ## Not run: ## Can't set to multiple values when using * selection. Cont[["A4","*"]] <- c(4.1,4.2) ## Generates an error ## End(Not run) stopifnot( sum(abs(Cont[[drop=TRUE]]-c(1.1,0,0,4,0,2.2,3.2,4))) < .0001, abs(Cont[["A1","B1",drop=TRUE]]-1.1) <.0001, sum(abs(Cont[[B=2,A=2:3,drop=TRUE]]-c(2.2,3.2))) < .0001, sum(abs(Cont[[A=4,drop=TRUE]] -4)) < .0001 ) ## Set by integer count ## 12 rows in A*B combinations for (i in 1:12) { CCC[[i]] <- i C2[i] <- i/100 } stopifnot( sum(abs(CCC[[drop=TRUE]]-t(matrix(1:24,3,4)))) <.0001, sum(abs(C2[drop=TRUE][,1]-t(matrix(1:24/100,3,4)))) <.001 ) for (i in 1:12) { stopifnot( abs(CCC[[i,drop=TRUE]] - i) <.0001, abs(C2[i,drop=TRUE][1] - i/100) <.0001 ) } ### Try some things with three parents, just to make sure that works ### too. C2tab <- C2[drop=TRUE] AddLink(C3,C2) C2.1tab <- C2[,,"C1",drop=TRUE] stopifnot(all.equal(C2tab,C2.1tab), all.equal(C2tab,C2[,,"C1",drop=TRUE]), all.equal(C2tab,C2[C="C3",drop=TRUE])) stopifnot(all(abs(C2["A1","B1","C1",drop=TRUE]-NodeProbs(C2)[1,1,1,])<.0001), all.equal(C2["A1",,],C2[A="A1"]), all.equal(C2[,"B2",],C2[B="B2"]), all.equal(C2["A1","B2",],C2[B="B2",A="A1"])) DeleteNetwork(xnet) stopSession(sess)