## ----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)


