## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(IMR) set.seed(2026) ## ----echo=FALSE, eval=FALSE--------------------------------------------------- # # to be run once and save objects # library(IMR) # set.seed(2026) # Bixi <- IMR::Bixi_sample # data <- imr_data(Y = Bixi$Y, X = Bixi$X, Z = Bixi$Z, val_prop = 0.2, seed = 2026) # data <- update(data, shared_beta = TRUE, row_intercept = TRUE) # fit <- imr_fit(data, rank = 10, lambda_m = 1e-1, lambda_beta = 0, lambda_gamma = 0.02) # grid <- imr_tune_grid( # beta = c(0, NA, 40), # (min, max, length) # gamma = c(0, NA, 40), #(min, max, length) # nuclear = c(0, NA, 40, 2), #(min, max, length, early-stopping tolerance) # rank = c(2, 15, 1,2) #(min, max, step, early-stopping tolerance) # ) # convergence <- imr_convergence(maxit = 1000, thresh = 1e-5) # grid <- imr_set_grid_limits(data, grid, # default_rank = 2, default_lambda_m = 0, # default_lambda_beta = 0, default_lambda_gamma = 0, # bisection_iter = 10, # number of iteration in the second step # verbose = TRUE,convergence = convergence ) # cv_out <- imr_tune(data, grid, fast_nuclear = TRUE, convergence = convergence, # n_cores= 7, seed = 2026, verbose=1) # similarity_cols <- imr_similarity(x = "matern", d = Bixi$spatial_distance, # invert=TRUE, jitter = 0.1, # matern_smoothness = 5/2, matern_range = .018); # # similarity_rows <- imr_similarity(x = "rbf", d = Bixi$temporal_distance, # invert=TRUE, jitter = 0.1, # rbf_ell = 6); # data <- imr_data(Bixi$Y, Bixi$X, Bixi$Z, # similarity_rows = similarity_rows, # similarity_cols = similarity_cols, # val_prop = 0.2, seed = 2026) # # data <- update(data, shared_beta = TRUE, row_intercept = TRUE) # grid2 <- imr_tune_grid( # beta = cv_out$params$lambda_beta, # gamma = cv_out$params$lambda_gamma, # nuclear = c(0, NA, 40, 2), # rank = cv_out$params$rank_in # ) # # grid2 <- imr_set_grid_limits(data, grid2, # default_rank = cv_out$params$rank_in, # default_lambda_beta = cv_out$params$lambda_beta, # default_lambda_gamma = cv_out$params$lambda_gamma, # bisection_iter = 10, # verbose = 2) # # cv_out2 <- imr_tune(data, grid2,fast_nuclear = TRUE, # nuclear_log_scale = TRUE, # n_cores= 7 , seed = 2026, verbose=1) # # summary(cv_out2$fit) # # prepared_objects <- list( # fit = fit, # grid1 = grid, # cv1 = cv_out, # grid2 = grid2, # cv2 = cv_out2 # ) # saveRDS(prepared_objects, "vignette_prepared_objects.rda") ## ----echo = FALSE, message = FALSE, warning=FALSE----------------------------- # knitr::opts_chunk$set(collapse = T, comment = "#>> ", cache = FALSE) # options(tibble.print_min = 4L, tibble.print_max = 4L) # library(IMR) # library(dplyr) # library(magrittr) # set.seed(2026) ## ----eval=TRUE, echo=TRUE----------------------------------------------------- # load the library require(IMR) # set the hyperparameter value. lambda_beta <- 0.02 # load the data example (see ?IMR::Bixi_sample for more information) Bixi <- IMR::Bixi_sample # create the data object data <- imr_data(Y = Bixi$Y, X = Bixi$X) # update the model structure to fit example 1 data <- update(data, row_covariates = TRUE, # turn XBeta on (on by default when X is provided) shared_beta = TRUE, # make beta a p-dimensional vector (off by default) low_rank_component = FALSE, # turn M off (on by default) row_intercept = TRUE) # turn row intercepts on (off by default). # fit the model fit <- imr_fit(data, lambda_beta = lambda_beta ) # obtain \hat{Y} Y_hat <- reconstruct(fit, data)$estimates ## ----------------------------------------------------------------------------- Bixi <- IMR::Bixi_sample head(Bixi$X,2) head(Bixi$Z,3) dim(Bixi$Y) Bixi$Y[1:6,11:12] sprintf("Percentage of observed entries in Y: %.1f%%", 100*sum(Bixi$Y != 0)/length(Bixi$Y)) sprintf("Percentage of entries in the test set: %.1f%%", 100* sum(Bixi$test != 0)/length(Bixi$test)) ## ----------------------------------------------------------------------------- data <- imr_data(Y = Bixi$Y, X = Bixi$X, Z = Bixi$Z, val_prop = 0.2, seed = 2026) print(data) ## ----------------------------------------------------------------------------- Bixi$test <- as_incomplete(Bixi$test) Bixi$test[3:5,3:4] ## ----------------------------------------------------------------------------- data <- update(data, shared_beta = TRUE, row_intercept = TRUE) print(data) ## ----echo=TRUE, eval=FALSE---------------------------------------------------- # fit <- imr_fit(data, rank = 10, lambda_m = 1e-1, lambda_beta = 0, lambda_gamma = 0.02) ## ----echo=FALSE, eval=TRUE---------------------------------------------------- prepared <- readRDS("vignette_prepared_objects.rda") fit <- prepared$fit ## ----------------------------------------------------------------------------- print(fit) summary(fit) names(coef(fit)) ## ----------------------------------------------------------------------------- convergence <- imr_convergence(maxit = 15, thresh = 1e-5, trace = TRUE); print(convergence) fit2 <- imr_fit(data, rank = 10, lambda_m = 1e-1, lambda_beta = 0, lambda_gamma = 0.02, convergence = convergence) ## ----------------------------------------------------------------------------- data_out <- reconstruct(fit, data) print(names(data_out)) ## ----------------------------------------------------------------------------- cat(sprintf("True value of the entry (1,1) int he data matrix is %.4f and the estimated value is %.4f", data$Y[1,1], # row intercept + data_out$beta0[1] + # row covariates (X beta) + Bixi$X[1,] %*% data_out$beta + # column covariates (gamma Z) + data_out$gamma[1,] %*% t(Bixi$Z)[,1] + # low-rank matrix (M) data_out$M[1,1])) ## ----------------------------------------------------------------------------- preds <- reconstruct_partial(fit, data, Bixi$test@i, Bixi$test@p, trace=TRUE, return_matrix = TRUE) print(preds[1:9,1:9]) ## ----------------------------------------------------------------------------- knitr::kable(evaluate(preds@x, Bixi$test@x),format = "pipe",digits = 4) ## ----------------------------------------------------------------------------- grid <- imr_tune_grid( beta = c(0, NA, 40), # (min, max, length) gamma = c(0, NA, 40), #(min, max, length) nuclear = c(0, NA, 40, 2), #(min, max, length, early-stopping tolerance) rank = c(2, 15, 1,2) #(min, max, step, early-stopping tolerance) ) print(grid) ## ----------------------------------------------------------------------------- imr_tune_grid( beta = 3, gamma = c(0, NA), nuclear = c(0), rank = c(0, 10) ) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # convergence <- imr_convergence(maxit = 1000, thresh = 1e-5) # grid <- imr_set_grid_limits(data, grid, # default_rank = 2, default_lambda_m = 0, # default_lambda_beta = 0, default_lambda_gamma = 0, # bisection_iter = 10, # number of iteration in the second step # verbose = TRUE,convergence = convergence ) ## ----echo=FALSE, eval=TRUE---------------------------------------------------- convergence <- imr_convergence(maxit = 1000, thresh = 1e-5) grid <- prepared$grid1 ## ----------------------------------------------------------------------------- print(grid) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # cv_out <- imr_tune(data, grid, fast_nuclear = TRUE, convergence = convergence, # n_cores= 1, seed = 2026, verbose=1) ## ----echo=FALSE, eval=TRUE---------------------------------------------------- cv_out <- prepared$cv1 ## ----------------------------------------------------------------------------- summary(cv_out$fit) print(cv_out$fit) ## ----------------------------------------------------------------------------- preds <- reconstruct_partial(cv_out$fit, data, Bixi$test@i, Bixi$test@p, return_matrix = FALSE) knitr::kable(evaluate(preds, Bixi$test@x),format = "simple",digits = 4) ## ----------------------------------------------------------------------------- similarity_cols <- imr_similarity(x = "matern", d = Bixi$spatial_distance, invert=TRUE, jitter = .1, matern_smoothness = 5/2, matern_range = .018); print(similarity_cols) similarity_rows <- imr_similarity(x = "rbf", d = Bixi$temporal_distance, invert=TRUE, jitter = .1, rbf_ell = 6); print(similarity_rows) ## ----------------------------------------------------------------------------- data <- imr_data(Bixi$Y, Bixi$X, Bixi$Z, similarity_rows = similarity_rows, similarity_cols = similarity_cols, val_prop = 0.2, seed = 2026) data <- update(data, shared_beta = TRUE, row_intercept = TRUE) print(data) ## ----------------------------------------------------------------------------- grid <- imr_tune_grid( beta = cv_out$params$lambda_beta, gamma = cv_out$params$lambda_gamma, nuclear = c(0, NA, 40, 2), rank = cv_out$params$rank_in ) print(grid) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # grid <- imr_set_grid_limits(data, grid, verbose = TRUE, # default_rank = cv_out$params$rank_in, # default_lambda_beta = cv_out$params$lambda_beta, # default_lambda_gamma = cv_out$params$lambda_gamma, # convergence = convergence) # cv_out <- imr_tune(data, grid, # n_cores= 4, seed = 2026, verbose=1, # nuclear_log_scale = TRUE, # convergence = convergence) ## ----echo=FALSE, eval=TRUE---------------------------------------------------- grid <- prepared$grid2 cv_out <- prepared$cv2 ## ----------------------------------------------------------------------------- summary(cv_out$fit) print(cv_out$fit) ## ----------------------------------------------------------------------------- preds <- reconstruct_partial(cv_out$fit, data, Bixi$test@i, Bixi$test@p) knitr::kable(evaluate(preds, Bixi$test@x),format = "pipe",digits = 4)