Related
I am learning to work with bnlearn and I keep running into the following error in the last line of my code below:
Error in custom.fit(dag, cpt) : wrong number of conditional probability distributions
What am I doing wrong?
modelstring(dag)= "[s][r][nblw|r][nblg|nblw][mlw|s:r][f|s:r:mlw][mlg|mlw:f]
[mlgr|mlg:nblg]"
###View DAG Specifics
dag
arcs(dag)
nodes(dag)
# Create Levels
State <- c("State0", "State1")
##Create probability distributions given; these are all 2d b/c they have 1 or 2 nodes
cptS <- matrix(c(0.6, 0.4), ncol=2, dimnames=list(NULL, State))
cptR <- matrix(c(0.7, 0.3), ncol=2, dimnames=list(NULL, State))
cptNBLW <- matrix(c(0.95, 0.05, 0.05, 0.95), ncol=2, dimnames=list(NULL, "r"= State))
cptNBLG <- matrix(c(0.9, 0.099999999999999998, 0.2, 0.8), ncol=2, dimnames=list(NULL,
"nblw"=State))
cptMLG <- matrix(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),ncol=2,nrow = 2,
dimnames=list("mlw"= State, "f"=State))
cptMLGR <- matrix(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45),ncol=2,nrow = 2,
dimnames=list("mlg"= State, "nblg"=State))
cptMLW <-matrix(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), ncol=2,nrow = 2,byrow = TRUE,
dimnames=list("r"= State, "s"=State))
# Build 3-d matrices( becuase you have 3 nodes, you can't use the matrix function; you
have to build it from scratch)
cptF <- c(0.05, 0.95, 0.4, 0.6, 0.9, 0.1, 0.99, 0.01, 0.9, 0.1, 0.95, 0.05, 0.95, 0.05, 0.99,
0.01)
dim(cptF) <- c(2, 2, 2, 2)
dimnames(cptF) <- list("s"=State, "r"=State, "mlw"=State)
###Create CPT Table
cpt <- list(s = cptS, r = cptR, mlw = cptMLW,nblw= cptNBLW,
mlg= cptMLG, nblg= cptNBLG, mlgr= cptMLGR)
# Construct BN network with Conditional Probability Table
S.net <- custom.fit(dag,cpt)
Reference: https://rpubs.com/sarataheri/bnlearnCGM
You have several errors in your CPT definitions. Primarily, you need to make sure that:
the number of probabilities supplied are equal to the product of the number of states in the child and parent nodes,
that the number of dimensions of the matrix/array is equal to the number of parent nodes plus one, for the child node,
the child node should be given in the first dimension when the node dimension is greater than one.
the names given in the dimnames arguments (e.g. the names in dimnames=list(ThisName = ...)) should match the names that were defined in the DAG, in your case with modelstring and in my answer with model2network. (So my earlier suggestion of using dimnames=list(cptNBLW = ...) should be dimnames=list(nblw = ...) to match how node nblw was declared in the model string)
You also did not add node f into your cpt list.
Below is your code with comments where things have been changed. (I have commented out the offending lines and added ones straight after)
library(bnlearn)
dag <- model2network("[s][r][nblw|r][nblg|nblw][mlw|s:r][mlg|mlw:f][mlgr|mlg:nblg][f|s:r:mlw]")
State <- c("State0", "State1")
cptS <- matrix(c(0.6, 0.4), ncol=2, dimnames=list(NULL, State))
cptR <- matrix(c(0.7, 0.3), ncol=2, dimnames=list(NULL, State))
# add child node into first slot of dimnames
cptNBLW <- matrix(c(0.95, 0.05, 0.05, 0.95), ncol=2, dimnames=list(nblw=State, "r"= State))
cptNBLG <- matrix(c(0.9, 0.099999999999999998, 0.2, 0.8), ncol=2, dimnames=list(nblg=State,"nblw"=State))
# Use a 3d array and not matrix, and add child node into dimnames
# cptMLG <- matrix(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),ncol=2,nrow = 2, dimnames=list("mlw"= State, "f"=State))
cptMLG <- array(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),dim=c(2,2,2), dimnames=list(mlg = State, "mlw"= State, "f"=State))
# cptMLGR <- matrix(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45),ncol=2,nrow = 2, dimnames=list("mlg"= State, "nblg"=State))
cptMLGR <- array(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45), dim=c(2,2,2), dimnames=list(mlgr=State, "mlg"= State, "nblg"=State))
# cptMLW <-matrix(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), ncol=2,nrow = 2,byrow = TRUE, dimnames=list("r"= State, "s"=State))
cptMLW <-array(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), dim=c(2,2,2), dimnames=list(mlw=State, "r"= State, "s"=State))
# add child into first slot of dimnames
cptF <- c(0.05, 0.95, 0.4, 0.6, 0.9, 0.1, 0.99, 0.01, 0.9, 0.1, 0.95, 0.05, 0.95, 0.05, 0.99, 0.01)
dim(cptF) <- c(2, 2, 2, 2)
dimnames(cptF) <- list("f" = State, "s"=State, "r"=State, "mlw"=State)
# add missing node f into list
cpt <- list(s = cptS, r = cptR, mlw = cptMLW,nblw= cptNBLW, mlg= cptMLG, nblg= cptNBLG, mlgr= cptMLGR, f=cptF)
# Construct BN network with Conditional Probability Table
S.net <- custom.fit(dag, dist=cpt)
I am using the below R code to simulate time series data, moving average of order 1 to be precise. I am varying 3 variables which are:
N = Number of elements in the series c(15L, 20L, 30L, 50L, 100L)
SD = standard deviation c(1, 2, 3, 4, 5) ^ 2
theta = the \theta value c(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)
I have 5 data.frames which you will see as .csv files in your R working directory. Each data.frame has 35 columns that I want properly labeled.
MWE
N <- c(15L, 20L, 30L, 50L, 100L)
SD = c(1, 2, 3, 4, 5) ^ 2
theta = c(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)
res <- vector('list', length(N))
names(res) <- paste('N', N, sep = '_')
set.seed(123L)
for (i in seq_along(N)){
res[[i]] <- vector('list', length(SD))
names(res[[i]]) <- paste('SD', SD, sep = '_')
ma <- matrix(NA_real_, nrow = N[i], ncol = length(theta))
for (j in seq_along(SD)){
wn <- rnorm(N[i], mean = 0, sd = SD[j])
ma[1:2, ] <- wn[1:2]
for (k in 3:N[i]){
ma[k, ] <- wn[k - 1L] * theta + wn[k]
}
colnames(ma) <- paste('ma_theta', theta, sep = '_')
res[[i]][[j]] <- ma
}
}
res1 <- lapply(res, function(dat) do.call(cbind, dat))
sapply(names(res1), function(nm) write.csv(res1[[nm]],
file = paste0(nm, ".csv"), row.names = FALSE, quote = FALSE))
I want columnname to be label not only with respect to theta alone but also with SD.
I want the columnname to be labelled like the below. I do not want 2 or more columns to have the same label. I want ma_SD_1... to (with theta=(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)) be exhausted before ma_SD_4... (with theta=(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)) before ma_SD_9... (with theta=(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)) before ma_SD_16... (with theta=(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)) before ma_SD_25... (with theta=(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)).
ma_SD_1_theta_0.2, ma_SD_1_theta_0.4, ma_SD_1_theta_0.6, ma_SD_1_theta_0.8, ma_SD_1_theta_0.9, ma_SD_1_theta_0.95, ma_SD_1_theta_0.99
ma_SD_4_theta_0.2, ma_SD_4_theta_0.4, ma_SD_4_theta_0.6, ma_SD_4_theta_0.8, ma_SD_4_theta_0.9, ma_SD_4_theta_0.95, ma_SD_4_theta_0.99
ma_SD_9_theta_0.2, ma_SD_9_theta_0.4, ma_SD_9_theta_0.6, ma_SD_9_theta_0.8, ma_SD_9_theta_0.9, ma_SD_9_theta_0.95, ma_SD_9_theta_0.99
ma_SD_1_theta_0.2, ma_SD_16_theta_0.4, ma_SD_16_theta_0.6, ma_SD_16_theta_0.8, ma_SD_16_theta_0.9, ma_SD_16_theta_0.95, ma_SD_16_theta_0.99
This should do it as you are iterating (using j) over the SD:
colnames(ma) <- paste('ma_SD',SD[j],'theta', theta, sep = '_')
How can I adapt the size of the following plots with regard to their length of the x-axis?
The width of the plots should refer to the length of their respective section of the x-axis. The height should be the same for all plots.
The function you want is base graphics function help("layout").
First I will make up a dataset, since you have not posted one. I will not draw the regression lines, just the points.
Data creation code.
fun <- function(X, A) {
apply(X, 1, function(.x){
xx <- seq(.x[1], .x[2], length.out = 100)
y <- A[1]*xx + A[2] + rnorm(100, 0, 25)
list(xx, y)
})}
Coef <- matrix(c(0.24, 0.54,
0.75, 0.54,
0.33, 2.17,
0.29, 3.3,
0.29, 4.41), byrow = TRUE, ncol = 2)
X <- matrix(c(0.1, 0.49,
0.5, 2.49,
2.5, 3.9,
4.0, 5.9,
6.0, 12.0), byrow = TRUE, ncol = 2)
set.seed(1234)
res <- fun(X, Coef)
The problem.
Define a layout matrix with each plot in a sequence from first to 5th. And the widths given by the X ranges.
layout_mat <- matrix(c(1, 2, 3, 4, 5), 1, 5, byrow = TRUE)
w <- apply(X, 1, diff)
l <- layout(layout_mat, widths = w)
layout.show(l)
Now make some room for the axis annotation, saving the default graphics parameters, and plot the 5 graphs.
om <- par(mar = c(3, 0.1, 0.1, 0.1),
oma = c(3, 2, 0.1, 0.1))
for(i in 1:5) plot(res[[i]][[1]], res[[i]][[2]])
par(om)
is there a way to generate a random sample from a higher order markov chain? I used the package clickstream to estimate a 2nd order markov chain and i'm now trying to generate a sample from it. I understand how to do this from a transition matrix with the randomClickstreams function but that would only work for a 1st order markov chain.
Here's a reproducible example where we generate a sample from a transition matrix and then fit a 2nd order markov chain on the sample:
trans_mat <- matrix(c(0, 0.2, 0.7, 0, 0.1,
0.2, 0, 0.5, 0, 0.3,
0.1, 0.1, 0.1, 0.7, 0,
0, 0.4, 0.2, 0.1, 0.3,
0, 0 , 0 , 0, 1), nrow = 5)
cls <- randomClickstreams(states = c("P1", "P2", "P3", "P4", "end"),
startProbabilities = c(0.5, 0.5, 0, 0, 0),
transitionMatrix = trans_mat,
meanLength = 20, n = 1000)
# fit 2nd order markov chain:
mc <- fitMarkovChain(clickstreamList = cls, order = 2,
control = list(optimizer = "quadratic"))
This is made of 2 transition matrices and 2 lambda parameters:
How can i then use these elements to create a random sample of say 10000 journeys?
I have three reference vectors
a ( 0, 0, 1 )
b ( 0, 1, 0 )
c ( 1, 0, 0 )
and will have measurements such as
x( 0, 0.5, 0.3 )
which I want to plot in a 2D figure as a triangle, who edges would correspond to a, b and c.
In Matlab there is a straighforward function to do that
http://fr.mathworks.com/help/matlab/ref/triangulation.cartesiantobarycentric.html?s_tid=gn_loc_drop
does anyone know an equivalent in R or should I implement the maths?
Sure, you can go back and forth between cartesian and barycentric.
Bary to Cart:
library(geometry)
## Define simplex in 2D (i.e. a triangle)
X <- rbind(
c( 0, 0, 1 ),
c( 0, 1, 0 ),
c( 1, 0, 0 ))
## Cartesian cooridinates of points
beta <- rbind(c( 0, 0.5, 0.3 ),
c(0.1, 0.8, 0.1),
c(0.1, 0.8, 0.1))
## Plot triangle and points
trimesh(rbind(1:3), X)
text(X[,1], X[,2], 1:3) # Label vertices
P <- bary2cart(X, beta)
Cart to Bary:
## Define simplex in 2D (i.e. a triangle)
X <- rbind(c(0, 0),
c(0, 1),
c(1, 0))
## Cartesian cooridinates of points
P <- rbind(c(0.5, 0.5),
c(0.1, 0.8))
## Plot triangle and points
trimesh(rbind(1:3), X)
text(X[,1], X[,2], 1:3) # Label vertices
points(P)
cart2bary(X, P)