Folks,
I have some problem when try resuming h2o deep learning in R from a checkpointed model with validation frame provided. It says "Validation dataset must be the same as for the check pointed model", which I believe I do have the same validation datasets. If I leave validation_frame blank, checkpointing model works fine. I attach my code below:
localh2o <- h2o.init(nthreads = -1)
train_image.hex <- read.csv("mnist_train.csv",header=FALSE)
train_image.hex[,785] <- factor(train_image.hex[,785])
train_image.hex <- as.h2o(train_image.hex)
test_image.hex <- read.csv("mnist_test.csv",header=FALSE)
test_image.hex[,785] <- factor(test_image.hex[,785])
test_image.hex <- as.h2o(test_image.hex)
mnist_model <- h2o.deeplearning(x=1:784, y = 785,
training_frame= train_image.hex,
validation_frame = test_image.hex,
activation = "RectifierWithDropout", hidden = c(500,1000),
input_dropout_ratio = 0.2,
hidden_dropout_ratios = c(0.5,0.5), adaptive_rate=TRUE,
rho=0.98, epsilon = 1e-7,
l1 = 1e-8, l2 = 1e-7, max_w2 = 10,
epochs = 10, export_weights_and_biases = TRUE,
variable_importances = FALSE
)
h2o.saveModel(mnist_model, path="/tmp",force=TRUE)
Then I shut down the h2o, quit R and restart h2o in R to resume training, where h2o errors out:
localh2o <- h2o.init(nthreads = -1)
train_image.hex <- read.csv("mnist_train.csv",header=FALSE)
train_image.hex[,785] <- factor(train_image.hex[,785])
train_image.hex <- as.h2o(train_image.hex)
test_image.hex <- read.csv("mnist_test.csv",header=FALSE)
test_image.hex[,785] <- factor(test_image.hex[,785])
test_image.hex <- as.h2o(test_image.hex)
startmodel <- h2o.loadModel("/tmp/DeepLearning_model_R_1443812402059_20", localh2o)
mnist_model <- h2o.deeplearning(x=1:784, y = 785,
checkpoint = startmodel#model_id,
training_frame= train_image.hex,
validation_frame = test_image.hex,
activation = "RectifierWithDropout", hidden = c(500,1000),
input_dropout_ratio = 0.2,
hidden_dropout_ratios = c(0.5,0.5), adaptive_rate=TRUE,
rho=0.98, epsilon = 1e-7,
l1 = 1e-8, l2 = 1e-7, max_w2 = 10,
epochs = 10, export_weights_and_biases = TRUE,
variable_importances = FALSE
)
Thank you for pointing this out to us. I have added a JIRA, and you can track its progress here: https://0xdata.atlassian.net/browse/PUBDEV-2182
You can expect the problem to be fixed soon.
Thanks!
Avni
Please try again using the latest version. This should work now.
Related
I am trying to make use of tabnet with tidymodels and the Titanic dataset. Here is my code:
pacman::p_load(tidyverse,
tidymodels,
tabnet,
torch,
doParallel,
reprex)
data(Titanic)
Titanic <- as.data.frame(Titanic)
#partition data
set.seed(1711)
titanic_split <- initial_split(Titanic, prop = 0.75, strata = Survived)
titanic_train <- training(titanic_split)
titanic_test <- testing(titanic_split)
#create cross-validation folds of training data
set.seed(1712)
folds <- vfold_cv(titanic_train,
folds = 3,
strata = Survived)
# define recipes for different models
titanic_rec <- recipe(formula = Survived ~ ., data = titanic_train) %>%
update_role(Survived, new_role = "outcome") %>%
step_zv() %>%
step_novel(all_nominal_predictors()) %>%
step_dummy(all_nominal_predictors(), one_hot = TRUE) %>%
step_YeoJohnson()
juice(prep(titanic_rec))
#define model
tab_spec <- tabnet(
mode = "classification",
epochs = 1, batch_size = 16384, decision_width = tune(), attention_width = tune(),
num_steps = tune(), penalty = 0.000001, virtual_batch_size = 512, momentum = 0.6,
feature_reusage = 1.5, learn_rate = tune()
) %>%
set_engine("torch", verbose= T)
wf <- workflow() %>%
add_model(tab_spec) %>%
add_recipe(titanic_rec)
grid <-
wf %>%
extract_parameter_set_dials() %>%
update(
decision_width = decision_width(range = c(20, 40)),
attention_width = attention_width(range = c(20, 40)),
num_steps = num_steps(range = c(4, 6)),
learn_rate = learn_rate(range = c(-2.5, -1))
) %>%
grid_max_entropy(size = 8)
auc_metric <- metric_set(yardstick::roc_auc)
auc_ctrl <- control_race(
verbose_elim = TRUE)
auc_results <- wf %>%
tune_grid(
resamples = folds,
control = auc_ctrl,
grid = grid)
This works like a charm . If i try however to use paraller processing I´m getting an error:
cl7 <- makePSOCKcluster(7)
registerDoParallel(cl7)
auc_results <- wf %>%
tune_grid(
resamples = folds,
control = auc_ctrl,
grid = grid)
Warning message:
All models failed. Run show_notes(.Last.tune.result) for more information.
Upon running shoe_notes i get the following : unique notes:
Error in UseMethod("filter"): no applicable method for 'filter' applied to an object of class "NULL"
Anyone knows how to fix this ?
I am using the R programming language. I am interested in learning how to save several "html widgets" together. I have been able to manually create different types of html widgets:
#widget 1
library(htmlwidgets)
library(leaflet)
library(RColorBrewer)
# create map data
map_data <- data.frame(
"Lati" = c(43.6426, 43.6424, 43.6544, 43.6452, 43.6629), "Longi" = c(-79.3871, -79.3860, -79.3807, -79.3806, -79.3957),
"Job" = c("Economist", "Economist", "Teacher", "Teacher", "Lawyer"),
"First_Name" = c("John", "James", "Jack", "Jason", "Jim"),
"Last_Name" = c("Smith", "Charles", "Henry", "David", "Robert"),
"vehicle" = c("car", "van", "car", "none", "car")
)
kingdom <- c("Economist", "Lawyer", "Teacher")
my_palette <- brewer.pal(3, "Paired")
factpal <- colorFactor(my_palette, levels = kingdom)
groups <- unique(map_data$Job)
# finalize map
map <- leaflet(map_data) %>%
addTiles(group = "OpenStreetMap") %>%
addCircleMarkers(~Longi, ~Lati, popup = ~Job,
radius = 10, weight = 2, opacity = 1, color = ~factpal(Job),
fill = TRUE, fillOpacity = 1, group = ~Job
)
widget_1 = map %>%
addLayersControl(overlayGroups = groups, options = layersControlOptions(collapsed = FALSE)) %>%
addTiles() %>%
addMarkers(lng = ~Longi,
lat = ~Lati,
popup = ~paste("Job", Job, "<br>",
"First_Name:", First_Name, "<br>",
"Last_Name:", Last_Name, "<br>", "vehicle:", vehicle, "<br>"))
widget 2:
##### widget 2
library(plotly)
library(ggplot2)
p_plot <- data.frame(frequency = c(rnorm(31, 1), rnorm(31)),
is_consumed = factor(round(runif(62))))
p2 <- p_plot %>%
ggplot(aes(frequency, fill = is_consumed)) +
geom_density(alpha = 0.5)
widget_2 = ggplotly(p2)
widget 3:
#####widget_3
today <- Sys.Date()
tm <- seq(0, 600, by = 10)
x <- today - tm
y <- rnorm(length(x))
widget_3 <- plot_ly(x = ~x, y = ~y, mode = 'lines', text = paste(tm, "days from today"))
widget 4:
####widget_4
library(igraph)
library(dplyr)
library(visNetwork)
Data_I_Have <- data.frame(
"Node_A" = c("John", "John", "John", "Peter", "Peter", "Peter", "Tim", "Kevin", "Adam", "Adam", "Xavier"),
"Node_B" = c("Claude", "Peter", "Tim", "Tim", "Claude", "Henry", "Kevin", "Claude", "Tim", "Henry", "Claude")
)
graph_file <- data.frame(Data_I_Have$Node_A, Data_I_Have$Node_B)
colnames(graph_file) <- c("Data_I_Have$Node_A", "Data_I_Have$Node_B")
graph <- graph.data.frame(graph_file, directed=F)
graph <- simplify(graph)
nodes <- data.frame(id = V(graph)$name, title = V(graph)$name)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]
widget_4 = visNetwork(nodes, edges) %>% visIgraphLayout(layout = "layout_with_fr") %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)
From here, I found another stackoverflow post where a similar question was asked: Using R and plot.ly, how to save multiples htmlwidgets to my html?
In this post, it explains how to save several html widgets together - the person who answered the question wrote a function to do so:
library(htmltools)
save_tags <- function (tags, file, selfcontained = F, libdir = "./lib")
{
if (is.null(libdir)) {
libdir <- paste(tools::file_path_sans_ext(basename(file)),
"_files", sep = "")
}
htmltools::save_html(tags, file = file, libdir = libdir)
if (selfcontained) {
if (!htmlwidgets:::pandoc_available()) {
stop("Saving a widget with selfcontained = TRUE requires pandoc. For details see:\n",
"https://github.com/rstudio/rmarkdown/blob/master/PANDOC.md")
}
htmlwidgets:::pandoc_self_contained_html(file, file)
unlink(libdir, recursive = TRUE)
}
return(htmltools::tags$iframe(src= file, height = "400px", width = "100%", style="border:0;"))
}
I tried using this function to save the 4 widgets together:
save_tags(widget_1, widget_2, widget_3, widget_4)
But doing so, I got the following error:
Error in dirname(file) : a character vector argument expected
Is there a straightforward and simple way for saving multiple html widgets together?
Thanks
NOTE: I know that you can use the combineWidgets() function in R:
library(manipulateWidget)
combineWidgets(widget_1, widget_2, widget_3, widget_4)
However, I am working with a computer that has no internet access or USB ports. This computer has a pre-installed copy of R with limited libraries (it has all the libraries used throughout my question except "manipulateWidget"). I am looking for the simplest way to save multiple html widgets together (e.g. is this possible in base R)?
Thanks
If format doesn't matter too much, you can merge the widgets using tagList and save them directly:
htmltools::save_html(tagList(widget_1, widget_2, widget_3, widget_4), file = "C://Users//Me//Desktop//widgets.html")
(It goes without saying that you will need to edit the filepath!)
If you want to control the layout of the widgets, you can wrap each in a div, and then style those:
doc <- htmltools::tagList(
div(widget_1, style = "float:left;width:50%;"),
div(widget_2,style = "float:left;width:50%;"),
div(widget_3, style = "float:left;width:50%;"),
div(widget_4, style = "float:left;width:50%;")
)
htmltools::save_html(html = doc, file = "C://Users//Me//Desktop//widgets.html")
I am trying to get a univariate regression table using tbl_uvregression from gtsummary. I am running these regression models with lme4 and I am not sure where and how to specify the random effect. Here's an example using the trial data from the survival package.
library(lme4)
#> Loading required package: Matrix
library(gtsummary)
library(survival)
data(trial)
trial %>%
tbl_uvregression(
method = glmer,
y = response,
method.args = list(family = binomial),
exponentiate = TRUE,
pvalue_fun = function(x) style_pvalue(x, digits = 2),
formula = "{y} ~ {x}+ {1|grade}"
)
#> Error: Problem with `mutate()` input `formula_chr`.
#> x object 'grade' not found
#> i Input `formula_chr` is `glue(formula)`.
Created on 2020-09-28 by the reprex package (v0.3.0)
Please help
For the RE in the model do not specify with the {} instead use ().
library(lme4)
#> Loading required package: Matrix
library(gtsummary)
library(survival)
data(trial)
trial %>%
tbl_uvregression(
method = glmer,
y = response,
method.args = list(family = binomial),
exponentiate = TRUE,
pvalue_fun = function(x) style_pvalue(x, digits = 2),
formula = "{y} ~ {x}+ (1|grade)"
)
I have a question in the MLR package,
after tuning a randomforest hyperparameters with a cross validation
getLearnerModel(rforest) - will not use CV, rather use the entire data set as a whole, is that correct?
#traintask
trainTask <- makeClassifTask(data = trainsample,target = "DIED30", positive="1")
#random forest tuning
rf <- makeLearner("classif.randomForest", predict.type = "prob", par.vals = list(ntree = 1000, mtry = 3))
rf$par.vals <- list( importance = TRUE)
rf_param <- makeParamSet(
makeDiscreteParam("ntree",values= c(500,750, 1000,2000)),
makeIntegerParam("mtry", lower = 1, upper = 15),
makeDiscreteParam("nodesize", values =c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20))
)
rancontrol <- makeTuneControlGrid()
set_cv <- makeResampleDesc("CV",iters = 10L)
rf_tune <- tuneParams(learner = rf, resampling = set_cv, task = trainTask, par.set = rf_param, control = rancontrol, measures = auc)
rf_tune$x
rf.tree <- setHyperPars(rf, par.vals = rf_tune$x)
#train best model
rforest <- train(rf.tree, trainTask)
getLearnerModel(rforest)
#predict
pforest<- predict(rforest,trainTask)
rforest is eventually trained using the RF model on the entire data, rather than cross validation.
is there any way to perform the final training with CV as well in MLR?
I'm planning to validate the result on an external dataset. Should I train the model with 10CV prior to running on the external dataset (don't know how) or just use parameters found in the 10CV hyperparameters search?
thanks in advance for your time,
I've run a benchmark experiment with nested cross validation (tuning + performance measurement) for a classification problem and would like to create calibration charts.
If I pass a benchmark result object to generateCalibrationData, what does plotCalibration do? Is it averaging? If so how?
Does it make sense to have an aggregate = FALSE option to understand variability across folds as per generateThreshVsPerfData for ROC curves?
In response to #Zach's request for a reproducible example, I (the OP) edit my original post as follows:
Edit: Reproducible Example
# Practice Data
library("mlr")
library("ROCR")
library(mlbench)
data(BreastCancer)
dim(BreastCancer)
levels(BreastCancer$Class)
head(BreastCancer)
BreastCancer <- BreastCancer[, -c(1, 6, 7)]
BreastCancer$Cl.thickness <- as.factor(unclass(BreastCancer$Cl.thickness))
BreastCancer$Cell.size <- as.factor(unclass(BreastCancer$Cell.size))
BreastCancer$Cell.shape <- as.factor(unclass(BreastCancer$Cell.shape))
BreastCancer$Marg.adhesion <- as.factor(unclass(BreastCancer$Marg.adhesion))
head(BreastCancer)
# Define Nested Cross-Validation Strategy
cv.inner <- makeResampleDesc("CV", iters = 2, stratify = TRUE)
cv.outer <- makeResampleDesc("CV", iters = 6, stratify = TRUE)
# Define Performance Measures
perf.measures <- list(auc, mmce)
# Create Task
bc.task <- makeClassifTask(id = "bc",
data = BreastCancer,
target = "Class",
positive = "malignant")
# Create Tuned KSVM Learner
ksvm <- makeLearner("classif.ksvm",
predict.type = "prob")
ksvm.ps <- makeParamSet(makeDiscreteParam("C", values = 2^(-2:2)),
makeDiscreteParam("sigma", values = 2^(-2:2)))
ksvm.ctrl <- makeTuneControlGrid()
ksvm.lrn = makeTuneWrapper(ksvm,
resampling = cv.inner,
measures = perf.measures,
par.set = ksvm.ps,
control = ksvm.ctrl,
show.info = FALSE)
# Create Tuned Random Forest Learner
rf <- makeLearner("classif.randomForest",
predict.type = "prob",
fix.factors.prediction = TRUE)
rf.ps <- makeParamSet(makeDiscreteParam("mtry", values = c(2, 3, 5)))
rf.ctrl <- makeTuneControlGrid()
rf.lrn = makeTuneWrapper(rf,
resampling = cv.inner,
measures = perf.measures,
par.set = rf.ps,
control = rf.ctrl,
show.info = FALSE)
# Run Cross-Validation Experiments
bc.lrns = list(ksvm.lrn, rf.lrn)
bc.bmr <- benchmark(learners = bc.lrns,
tasks = bc.task,
resampling = cv.outer,
measures = perf.measures,
show.info = FALSE)
# Calibration Charts
bc.cal <- generateCalibrationData(bc.bmr)
plotCalibration(bc.cal)
Produces the following:
Aggregared Calibration Plot
Attempting to un-aggregate leads to:
> bc.cal <- generateCalibrationData(bc.bmr, aggregate = FALSE)
Error in generateCalibrationData(bc.bmr, aggregate = FALSE) :
unused argument (aggregate = FALSE)
>
> sessionInfo()
R version 3.2.3 (2015-12-10)
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] mlbench_2.1-1 ROCR_1.0-7 gplots_3.0.1 mlr_2.9
[5] stringi_1.1.1 ParamHelpers_1.10 ggplot2_2.1.0 BBmisc_1.10
loaded via a namespace (and not attached):
[1] digest_0.6.9 htmltools_0.3.5 R6_2.2.0 splines_3.2.3
[5] scales_0.4.0 assertthat_0.1 grid_3.2.3 stringr_1.0.0
[9] bitops_1.0-6 checkmate_1.8.2 gdata_2.17.0 survival_2.38-3
[13] munsell_0.4.3 tibble_1.2 randomForest_4.6-12 httpuv_1.3.3
[17] parallelMap_1.3 mime_0.5 DBI_0.5-1 labeling_0.3
[21] chron_2.3-47 shiny_1.0.0 KernSmooth_2.23-15 plyr_1.8.4
[25] data.table_1.9.6 magrittr_1.5 reshape2_1.4.1 kernlab_0.9-25
[29] ggvis_0.4.3 caTools_1.17.1 gtable_0.2.0 colorspace_1.2-6
[33] tools_3.2.3 parallel_3.2.3 dplyr_0.5.0 xtable_1.8-2
[37] gtools_3.5.0 backports_1.0.4 Rcpp_0.12.4
no plotCalibration doesn't do any averaging, though it can plot a smooth.
if you call generateCalibrationData on a benchmark result object it will treat each iteration of your resampled predictions as exchangeable and compute the calibration across all resampled predictions for that bin.
yes it probably would make sense to have an option to generate an unaggregated calibration data object and be able to plot it. you are welcome to open an issue on GitHub to that effect, but this is going to be low on my priority list TBH.