#' Pre-smooth sparse longitudinal data
#'
#' @param obs_data data.frame or tibble containing the observed data, with columns \code{id} identifying the individual measured, \code{tt} identifying the time of the observation, \code{x} the value of the surrogate at time \code{tt}, and \code{a} indicating 1 for treatment arm and 0 for control arm.
#' @param ... additional arguments to pass to the function PCA function
#'
#' @return list containing matrices \code{X_t} and \code{X_c}, which are the smoothed surrogate values for the treated and control groups, respectively, for use in downstream analyses
#'
#' @examples
#' library(dplyr)
#' library(longsurr)
#' obs_data <-
#' generate_discontinuous_data(n = 50, n_i = 5, delta_s = 0.5,
#' k = 1, s_y = 0.1, s_x = 0.1)$obs_ds
#'
#' head(obs_data)
#' presmooth_X <- presmooth_data(obs_data)
#'
#' wide_ds <- full_data %>%
#' dplyr::select(id, a, tt, x, y) %>%
#' tidyr::spread(tt, x)
#'
#' y_t <- wide_ds %>%
#' filter(a == 1) %>%
#' pull(y)
#' y_c <- wide_ds %>%
#' filter(a == 0) %>%
#' pull(y)
#' X_t <- presmooth_X$X_t
#' X_c <- presmooth_X$X_c
#'
#' estimate_surrogate_value(y_t = y_t, y_c = y_c,
#' X_t = X_t, X_c = X_c, method = 'linear')
#'
#' @import dplyr
#' @export
#'
presmooth_data <- function(obs_data, ...) {
# browser()
treatment_arm <- obs_data %>%
filter(a == 1) %>%
arrange(id, tt)
control_arm <- obs_data %>%
filter(a == 0) %>%
arrange(id, tt)
n_trt <- treatment_arm %>%
count(id) %>%
nrow
n_ctrl <- control_arm %>%
count(id) %>%
nrow
trt_fpc_fit <- fpca(ds = treatment_arm, ycol = 'x', tcol = 'tt', idcol = 'id', ...)
ctrl_fpc_fit <- fpca(ds = control_arm, ycol = 'x', tcol = 'tt', idcol = 'id', ...)
times_1 <- tibble(tt = trt_fpc_fit$fpca_result$workGrid,
t_n = rank(tt))
times_0 <- tibble(tt = ctrl_fpc_fit$fpca_result$workGrid,
t_n = rank(tt))
# browser()
trt_yh <- trt_fpc_fit$yh_ds %>%
gather(tp, X, -id)
ctrl_yh <- ctrl_fpc_fit$yh_ds %>%
gather(tp, X, -id)
trt_xhat <- trt_yh %>%
mutate(id = as.integer(id),
# tt = rep(seq(-1, 1, length = 51), each = n_trt),
t_n = as.numeric(stringr::str_remove(tp, 'yhat\\.')),
type = 'estimated') %>%
inner_join(times_1)
ctrl_xhat <- ctrl_yh %>%
mutate(id = as.integer(id),
t_n = as.numeric(stringr::str_remove(tp, 'yhat\\.')),
type = 'estimated') %>%
inner_join(times_0)
# browser()
trt_xhat_wide <- trt_xhat %>%
dplyr::select(-tp, -type, -t_n) %>%
spread(tt, X) %>%
dplyr::select(-id) %>%
as.matrix
colnames(trt_xhat_wide) <- colnames(trt_xhat_wide)
rownames(trt_xhat_wide) <- trt_xhat$id %>% unique
ctrl_xhat_wide <- ctrl_xhat %>%
dplyr::select(-tp, -type, -t_n) %>%
spread(tt, X) %>%
dplyr::select(-id) %>%
as.matrix
colnames(ctrl_xhat_wide) <- colnames(ctrl_xhat_wide)
rownames(ctrl_xhat_wide) <- ctrl_xhat$id %>% unique
list(X_t = trt_xhat_wide, X_c = ctrl_xhat_wide)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.