Related
I want to understand how my parallelization is working when there is a for-loop structure inside of the structure that I am parallelizing.
I have a routine called reg_simulation(), which generated 100 estimations (nrep=100) of linear regression, each of those using a different seed (seed <- seed + i).
Additionally, I wrapped up the reg_simulation() routine inside par_wrapper() to run it using different possible configurations of the data generating process. In particular, changing the number of observations (obs) and the error term variance (sigma). Finally, I parallelized this structure using pblapply.
Using the described setup, I am using a grid of obs = c(250, 500, 750, 1000, 2500) and
sigma = c(0.1, 0.2, 0.5, 0.8 , 1 ) meaning 5 values in each variable, leading to a 25 combinations of the two variables. However, I am running 100 times these 25 combinations.
Finally, here is my question:
My code is...
(a) Running in parallel 25 combinations but serially the 100 repetition inside of them.
(b) Running in parallel all the 2500 models.
If the answer is (a), please let me know how you arrived at such a conclusion because I haven't been sorted out yet, and probably it might imply that I should change my code structure.
Some additional comments: (1) The seed declaration on each iteration is important because it allows me to recover each possible combination of the data (e.g., iteration 78 (seed = 78), with sigma=0.1 and obs=1000) (2) I am using pblapply because I want to track my code simulations' progress.
Here the aforementioned routines:
reg_simulation()
reg_simulation<- function(obs = 1000,
sigma = 0.5,
nrep = 10 ,
seed = 0){
#seet seed
res <- vector("list", nrep)
# Forloop
for ( i in 1:nrep) {
#Changing seed each iteration
seed <- seed + i
#set seed
set.seed(seed)
#DGP
x1 <- rnorm(obs, 0 , sigma)
x2 <- rnorm(obs, 0 , sigma)
y <- 1 + 0.5* x1 + 1.5 * x2 + rnorm(obs, 0 , 1)
#Estimate OLS
ols <- lm(y ~ x1 + x2)
returnlist <- list(intercept = ols$coefficients[1],
beta1 = ols$coefficients[2],
beta2 = ols$coefficients[3],
seed = seed)
#save each iteration
res[[i]] <- returnlist
}
return(res)
}
par_wrapper()
### parallel wrapper
par_wrapper <- function(obs = c(250,500,750,1000,2500),
sigma = c(0.1, 0.2, 0.5, 0.8 , 1 ) ,
nrep = 10,
nClusters = 4)
{
require(parallel)
require(pbapply)
#grid of searching space
prs <- expand.grid(obs = obs,
sigma = sigma)
nprs <- nrow(prs)
rownames(prs) <- c(1:NROW(prs))
#Print number of combinations
print(prs)
#### ---- PARALLEL INIT ---- ####
## Parallel options
cl <- makeCluster(nClusters)
## Attaching necessary functions for internal computations
parallel::clusterExport(cl= cl,
list("reg_simulation"))
# pblapply
par_simres <- pblapply(cl = cl,
X = 1:nprs,
FUN = function(i){
reg_simulation(
sigma = prs$sigma[i],
obs = prs$obs[i],
nrep = nrep,
seed = 0)})
##exit cluster mode
stopCluster(cl)
return(par_simres)
}
Using the par_wrapper() function over a grid.
#using generated structure.
res_list <- par_wrapper(
obs = c(250,500,750,1000, 2500 ),
sigma = c(0.1, 0.2, 0.5, 0.8 , 1 ) ,
nrep = 100,
nClusters = 4)
Console output.
# obs sigma
# 1 250 0.1
# 2 500 0.1
# 3 750 0.1
# 4 1000 0.1
# 5 2500 0.1
# 6 250 0.2
# 7 500 0.2
# 8 750 0.2
# 9 1000 0.2
# 10 2500 0.2
# 11 250 0.5
# 12 500 0.5
# 13 750 0.5
# 14 1000 0.5
# 15 2500 0.5
# 16 250 0.8
# 17 500 0.8
# 18 750 0.8
# 19 1000 0.8
# 20 2500 0.8
# 21 250 1.0
# 22 500 1.0
# 23 750 1.0
# 24 1000 1.0
# 25 2500 1.0
# |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=01s
I am trying to build a regression or classification tree with some test data. My goal is to know how many terminal nodes/leaves my tree has and in which terminal node new data ends up.
I am using the tree library, because it has the option of getting the node each data point lands in as output by using predict(tree.model, data=df, type="where")
I created some sample data and tried this. But it seems that predict does not only output terminal nodes. When running my code, predict(...) has the factors 3 5 6 8 9. But the tree looks like
1) root 700 969.900 1 ( 0.487143 0.512857 )
2) B < 0.339751 346 104.300 0 ( 0.965318 0.034682 )
4) A < 0.747861 331 13.600 0 ( 0.996979 0.003021 ) *
5) A > 0.747861 15 17.400 1 ( 0.266667 0.733333 )
10) B < 0.139725 5 5.004 0 ( 0.800000 0.200000 ) *
11) B > 0.139725 10 0.000 1 ( 0.000000 1.000000 ) *
3) B > 0.339751 354 68.790 1 ( 0.019774 0.980226 )
6) A < 0.157866 8 6.028 0 ( 0.875000 0.125000 ) *
7) A > 0.157866 346 0.000 1 ( 0.000000 1.000000 ) *
(the "*" marks the terminal nodes).
Is there a possibility to only get terminal nodes? Preferably within the tree library.
Here is my full example code, the major part is only creating the sample data.
library(ggplot2)
library(hrbrthemes)
#generating some data to test######################################
set.seed(42)
#category A
x1s = rchisq(500, 5, ncp = 0)
y1s = 1/x1s +0.1*rchisq(500, 8, ncp = 0)
x1s = (x1s-min(x1s))/max(x1s)
y1s = (y1s-min(y1s))/max(y1s)
#category B
x2s = 15-rchisq(500, 5, ncp = 0)
y2s = 5-(2.5 -1/400*(x2s-15)^2 +0.1*rchisq(500, 8, ncp = 0))
x2s = (x2s-min(x2s))/max(x2s)
y2s = (y2s-min(y2s))/max(y2s)
xs = c(x1s, x2s)
ys = c(y1s, y2s)
type = c(0*(1:500), 0*(1:500)+1)
df = data.frame(type, xs, ys)
names(df) = c("category","A","B")
df$category = factor(df$category)
#plot the generated data##########################################
ggplot(df, aes(x=A, y=B, color=category)) + geom_point(shape=1)
#seperate in training and test data
alpha = 0.7
inTrain = sample(1:nrow(df), alpha*nrow(df))
train.set = df[inTrain,]
test.set = df[-inTrain, ]
####################################################################
#use tree to predict category
library(tree)
tree.model = tree(category ~ A + B, data = train.set)
factor(predict(tree.model, data = test.set, type="where"))
tree.model
After fitting a Tree with party::ctree() I want to create a table to characterise the branches.
I have fitted these variables
> summary(juridicos_segmentar)
actividad_economica
Financieras : 89
Gubernamental : 48
Sector Primario : 34
Sector Secundario:596
Sector Terciario :669
ingresos_cut
(-Inf,1.03e+08] :931
(1.03e+08,4.19e+08]:252
(4.19e+08,1.61e+09]:144
(1.61e+09, Inf] :109
egresos_cut
(-Inf,6e+07] :922
(6e+07,2.67e+08] :256
(2.67e+08,1.03e+09]:132
(1.03e+09, Inf] :126
patrimonio_cut
(-Inf,2.72e+08] :718
(2.72e+08,1.46e+09]:359
(1.46e+09,5.83e+09]:191
(5.83e+09, Inf] :168
op_ingreso_cut
(-Inf,3] :1308
(3,7] : 53
(7,22] : 44
(22, Inf]: 31
The first one is categorical and the others are ordinal and I fitted them to
another factor variable
> summary(as.factor(segmento))
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
27 66 30 39 36 33 39 15 84 70 271 247 101 34 100 74 47 25 48 50
I used the following code
library(party)
fit_jur <- ctree(cluster ~ .,
data=data.frame(juridicos_segmentar, cluster=as.factor(segmento)))
to get this tree
> fit_jur
Conditional inference tree with 31 terminal nodes
Response: cluster
Inputs: actividad_economica, ingresos_cut, egresos_cut, patrimonio_cut, op_ingreso_cut
Number of observations: 1436
1) actividad_economica == {Financieras}; criterion = 1, statistic = 4588.487
2) ingresos_cut <= (4.19e+08,1.61e+09]; criterion = 1, statistic = 62.896
3) egresos_cut <= (6e+07,2.67e+08]; criterion = 1, statistic = 22.314
4)* weights = 70
3) egresos_cut > (6e+07,2.67e+08]
5)* weights = 10
2) ingresos_cut > (4.19e+08,1.61e+09]
6)* weights = 9
plot of part of the tree
What I want is a table where every row is a path from the node to a leaf saying the prediction of the variable segmento and every column is the condition on the variable to split. Something alike this:
actividad economica ingresos (rango) egresos (rango) patrimonio (rango) operaciones de ingreso segmento
Sector Primario <=261.000.000 18
Sector Primario >261.000.000 20
The problem is there are several leaves to characterise and some time a variable appears several times in one path so I'd like to intersect the conditions, i.e. intersecting the ranges.
I've thought of data.tree::ToDataFrameTable but I've got no idea of how it works with party.
Thank you very much guys!
library(partykit)
fit_jur <- ctree(cluster ~ .,
data=data.frame(juridicos_segmentar, cluster=as.factor(segmento)))
pathpred <- function(object, ...)
{
## coerce to "party" object if necessary
if(!inherits(object, "party")) object <- as.party(object)
## get standard predictions (response/prob) and collect in data frame
rval <- data.frame(response = predict(object, type = "response", ...))
rval$prob <- predict(object, type = "prob", ...)
## get rules for each node
rls <- partykit:::.list.rules.party(object)
## get predicted node and select corresponding rule
rval$rule <- rls[as.character(predict(object, type = "node", ...))]
return(rval)
}
ct_pred_jur <- unique(pathpred(fit_jur)[c(1,3)])
write.csv2(ct_pred_jur,'parametrizacion_juridicos.csv')
thank you Achim Zeileis for pointing me in this direction, I couldn't intersect the rules in a same variable, i.e. evaluate the '&s'. That problem is still open.
You can convert both party class (from partykit) and BinaryTree (from party) to a data.tree, and use it for conversion to data frame and/or printing. For example like this:
library(party)
airq <- subset(airquality, !is.na(Ozone))
airct <- ctree(Ozone ~ ., data = airq,
controls = ctree_control(maxsurrogate = 3))
tree <- as.Node(airct)
df <- ToDataFrameTable(tree,
"pathString",
"label",
criterion = function(x) round(x$criterion$maxcriterion, 3),
statistic = function(x) round(max(x$criterion$statistic), 3)
)
df
This will print like so:
pathString label criterion statistic
1 1/2/3 weights = 10 0.000 0.000
2 1/2/4/5 weights = 48 0.936 6.141
3 1/2/4/6 weights = 21 0.891 5.182
4 1/7/8 weights = 30 0.675 3.159
5 1/7/9 weights = 7 0.000 0.000
Plotting:
#print subtree
subtree <- Clone(tree$`2`)
SetNodeStyle(subtree,
style = "filled,rounded",
shape = "box",
fillcolor = "GreenYellow",
fontname = "helvetica",
label = function(x) x$label,
tooltip = function(x) round(x$criterion$maxcriterion, 3))
plot(subtree)
And the result will look like this:
I am trying to use code for fully reproducible parallel models in caret but do not understand how to set the size of the vectors in the seed object. For gbm I have 4 tuning parameters with a total of 11 different levels, and I have 54 rows in my tuning grid. If I specify any value < 18 as the last value in the "for(i in 1:10)" line below, I get an error: "Bad seeds: the seed object should be a list of length 11 with 10 integer vectors of size 18 and the last list element having a single integer." Why 18? Also it runs without errors for values > 18 (e.g., 54) - why? Many thanks for the help. The following is based on http://topepo.github.io/caret/training.html, added some things.
library(mlbench)
data(Sonar)
str(Sonar[, 1:10])
library(caret)
library(doParallel)
set.seed(998)
inTraining <- createDataPartition(Sonar$Class, p = .75, list = FALSE)
training <- Sonar[ inTraining,]
testing <- Sonar[-inTraining,]
grid <- expand.grid(n.trees = seq(50,150,by=50), interaction.depth = seq(1,3,by=1),
shrinkage = seq(.09,.11,by=.01),n.minobsinnode=seq(8,10,by=2))
# set seed to run fully reproducible model in parallel mode using caret
set.seed(825)
seeds <- vector(mode = "list", length = 11) # length is = (n_repeats*nresampling)+1
for(i in 1:10) seeds[[i]]<- sample.int(n=1000, 11) # ...the number of tuning parameter...
seeds[[11]]<-sample.int(1000, 1) # for the last model
fitControl <- trainControl(method = "cv",number = 10,seeds=seeds)
# run model in parallel
cl <- makeCluster(detectCores())
registerDoParallel(cl)
gbmFit1 <- train(Class ~ ., data = training,method = "gbm",
trControl = fitControl,tuneGrid=grid,verbose = FALSE)
gbmFit1
I will address your question in two parts:
1 - Setting the seeds:
The code to do it as you stated :
set.seed(825)
seeds <- vector(mode = "list", length = 11)
for(i in 1:10) seeds[[i]]<- sample.int(n=1000, 54)
#for the last model
seeds[[11]]<-sample.int(1000, 1)
The 11 in seeds <- vector(mode = "list", length = 11) is (n_repeats*nresampling)+1, so in your case, you're using 10-fold CV, so 10+1 = 11. If you were using repeatedcv with number=10 and repeats = 5 you would replace the 11 by (5*10)+1 = 51.
The 10 in for(i in 1:10) is (n_repeats*nresampling). in your case it is 10 because you're using 10-fold CV. Similarly, if you were using repeatedcv with number=10 and repeats = 5 it would be for(i in 1:50).
The 54 in sample.int(n=1000, 54) is the number of tuning parameter combinations. In your case, you have 4 parameters with 3,3,3 and 2 values. So, it is 3*3*3*2 = 54. But, I remember I red somewhere that for gbm, the model is fit to the max(n.trees) in the grid, and the models with less trees are derived from it, this explains why caret calculates the seeds based on the interaction.depth * shrinkage * n.minobsinnode in your case 3 * 3 * 2 = 18 and not 3*3*3*2 = 54 as we will see later.
But if you were using a SVM model with a grid svmGrid <- expand.grid(sigma= 2^c(-25, -20, -15,-10, -5, 0), C= 2^c(0:5)) your value is 6 * 6 = 36
Remember, the goal of using seeds is to allow reproducible research by setting the seeds for the models fit at each resampling iteration.
The seeds[[11]]<-sample.int(1000, 1) is used to set the seed for the last (optimum) model fit to the complete dataset.
2 - Why you get an error if you specify a value < 18, but no error with a value >= 18
I was able to reproduce the same error on my machine:
Error in train.default(x, y, weights = w, ...) :
Bad seeds: the seed object should be a list of length 11 with 10 integer vectors of size 18 and the last list element having a single integer
So, by inspecting the train.default I was able to find its source. The error message is triggered by the stop in lines 7 to 10 based on the test badSeed in lines 4 and 5.
else {
if (!(length(trControl$seeds) == 1 && is.na(trControl$seeds))) {
numSeeds <- unlist(lapply(trControl$seeds, length))
4 badSeed <- (length(trControl$seeds) < length(trControl$index) +
5 1) || (any(numSeeds[-length(numSeeds)] < nrow(trainInfo$loop)))
if (badSeed)
7 stop(paste("Bad seeds: the seed object should be a list of length",
8 length(trControl$index) + 1, "with", length(trControl$index),
9 "integer vectors of size", nrow(trainInfo$loop),
10 "and the last list element having a", "single integer"))
}
}
The number 18 is coming from nrow(trainInfo$loop), so we need to find the value of trainInfo$loop. The object trainInfo is assigned a value trainInfo <- models$loop(tuneGrid) in line 3:
if (trControl$method != "none") {
if (is.function(models$loop) && nrow(tuneGrid) > 1) {
3 trainInfo <- models$loop(tuneGrid)
if (!all(c("loop", "submodels") %in% names(trainInfo)))
stop("The 'loop' function should produce a list with elements 'loop' and 'submodels'")
}
Now, we need to find the object models. It is assigned the value of models <- getModelInfo(method, regex = FALSE)[[1]] in line 2:
else {
2 models <- getModelInfo(method, regex = FALSE)[[1]]
if (length(models) == 0)
stop(paste("Model", method, "is not in caret's built-in library"))
}
Since we are using method = "gbm", we can see the value of getModelInfo("gbm", regex = FALSE)[[1]]$loop and inspect the result below:
> getModelInfo("gbm", regex = FALSE)[[1]]$loop
function(grid) {
3 loop <- ddply(grid, c("shrinkage", "interaction.depth", "n.minobsinnode"),
function(x) c(n.trees = max(x$n.trees)))
submodels <- vector(mode = "list", length = nrow(loop))
for(i in seq(along = loop$n.trees)) {
index <- which(grid$interaction.depth == loop$interaction.depth[i] &
grid$shrinkage == loop$shrinkage[i] &
grid$n.minobsinnode == loop$n.minobsinnode[i])
trees <- grid[index, "n.trees"]
submodels[[i]] <- data.frame(n.trees = trees[trees != loop$n.trees[i]])
}
list(loop = loop, submodels = submodels)
}
>
The loop (in line 3 above) is assigned the value:
loop <- ddply(grid, c("shrinkage", "interaction.depth", "n.minobsinnode"),
function(x) c(n.trees = max(x$n.trees)))`
Now, let's pass your grid with 54 rows to the line above and inspect the result:
> nrow(grid)
[1] 54
>
> loop <- ddply(grid, c("shrinkage", "interaction.depth", "n.minobsinnode"),
+ function(x) c(n.trees = max(x$n.trees)))
> loop
shrinkage interaction.depth n.minobsinnode n.trees
1 0.09 1 8 150
2 0.09 1 10 150
3 0.09 2 8 150
4 0.09 2 10 150
5 0.09 3 8 150
6 0.09 3 10 150
7 0.10 1 8 150
8 0.10 1 10 150
9 0.10 2 8 150
10 0.10 2 10 150
11 0.10 3 8 150
12 0.10 3 10 150
13 0.11 1 8 150
14 0.11 1 10 150
15 0.11 2 8 150
16 0.11 2 10 150
17 0.11 3 8 150
18 0.11 3 10 150
>
ahh!, we found it. The value 18 is coming from nrow(trainInfo$loop) which is coming from getModelInfo("gbm", regex = FALSE)[[1]]$loop shown above with just 18 rows.
Now, going back to the test that triggered the error:
badSeed <- (length(trControl$seeds) < length(trControl$index) +
1) || (any(numSeeds[-length(numSeeds)] < nrow(trainInfo$loop)))
The first part of the test (length(trControl$seeds) < length(trControl$index) + 1) is FALSE, but the second part (any(numSeeds[-length(numSeeds)] < nrow(trainInfo$loop))) is TRUE for all valuse less that 18 [coming from nrow(trainInfo$loop)], and FALSE for all valuse greater than 18. That's why the error is triggered for a value <18 and not for >=18. As I said above, the caret's calculates the seeds based on the interaction.depth * shrinkage * n.minobsinnode in your case 3 * 3 * 2 = 18 (a model is fit to the max(n.trees) and the others are derived from it, so there is no need for 54 integers).
Following up from this question (see for reproducible data frame) I want to run MCMCGLMM n times, where n is the number of randomisations. I have tried to construct a loop which runs all the chains, and saves them (to retrieve the posterior distributions of the randomised variable later) but I am encountering problems.
This is what the data frame looks like (when n = 5, hence R1-R5), A = response variable, L and V are random effect variables, B is a fixed effect, R1-R5 are random assignments of L with structure of V maintained:
ID L B V A R1 R2 R3 R4 R5
1 1_1_1 1 1 1 11.1 6 19 21 1 31
2 1_1_1 1 1 1 6.9 6 19 21 1 31
3 1_1_4 1 1 4 7.7 2 24 8 22 22
4 1_1_4 1 1 4 10.5 2 24 8 22 22
5 1_1_5 1 1 5 8.5 11 27 14 17 22
6 1_1_7 1 1 7 11.2 5 24 13 18 25
I can create the names I want to assign to my chains, and the names of the variable that changes with each run of the MCMC chain (R1-Rn):
n = 5
Rs = as.vector(rep(NA,n))
for(i in 1:n){
Rs[i] = paste("R",i, sep = "")
}
Rs
Output:
> Rs
[1] "R1" "R2" "R3" "R4" "R5"
I then tried this loop to produce 5 chains:
for(i in 1:n){
chains[i] = MCMCglmm(A ~1 + B,
random = as.formula(paste0("~" ,Rs[i], " + Vial")),
rcov = ~units,
nitt = 500,
thin = 2,
burnin = 50,
prior = prior2,
family = "gaussian",
start = list(QUASI = FALSE),
data = df)
}
Thanks Roland for helping to get the random effect to call properly, previously I was getting an error Error in buildZ(rmodel.terms[r] ... object Rs[i] not found- fixed by as.formula
But this stores all of the data in chains and seemingly only the $Sol components, but I need to be able to access the values within the VCV, specifically the posterior distributions of the R variables (e.g. summary(chainR1$VCV))
In summary: It seems I am making a mistake in how I assign the chain names, does anyone have a suggestion of how to do this, and save the posterior distributions or even the whole chain?
Using assign was a key point:
n = 10 #Number of chains to run
chainVCVdf = matrix(rep(NA, times = ((nitt-burnin)/thin)*n), ncol = n)
colnames(chainVCVdf)=c(rep("X", times = n))
for(i in 1:n){
assign("chainX",paste0("chain",Rs[i]))
chainX = MCMCglmm(A ~1 + B,
random = as.formula(paste0("~" ,Rs[i], " + V")),
rcov = ~units,
nitt = nitt,
thin = thin,
burnin = burnin,
prior = prior1,
family = "gaussian",
start = list(QUASI = FALSE),
data = df)
assign("chainVCV", chainX$VCV[,1])
chainVCVdf[,i]=(chainVCV)
colnames(chainVCVdf)[i] = colnames(chainX$VCV)[1]
}
It then became possible to build a matrix of the VCV component that I am interested in (namely the randomised L assignment in columns R1-Rn)
It seems as though you want to run a number of different MCMCglmm formulas in a loop. #Roland has helped you found the solution to this (although I personally would create the formulas prior to the loop). #Roland also points out that in order to save the results of each model, you should save them in a list - rather than a chain as you are currently doing. You could also save each model as an .RData file, as seen in the end of the question. To formalize an answer to this question I would perform this in the following way:
Rs = paste0("~R", 1:5, " + V") ## Create all model formulae
chainNames = paste0("chainR", 1:5) ## Names for each model
chains = list() ## Initialize list
## Loop over models
for(i in 1:length(Rs)){
chains[[i]] = MCMCglmm(A ~1 + B,
random = formula(Rs[i]),
rcov = ~units,
nitt = 500,
thin = 2,
burnin = 50,
prior = prior2,
family = "gaussian",
start = list(QUASI = FALSE),
data = df)
}
names(chains) = chainNames ## Name each model
save(chains, "chainsR1-R5.Rdata") ## Save all model output
A side note, paste0 is the same as paste, but with the argument sep="" by default