# 1) Setup data:
data(toy)
toy2 <- toy
toy2[, 4] <- round( ( toy[, 4] - 10 ) / 30, 2 ) # i. rescale age:
y <- toy2 %>% group_by(id) %>% summarise(outcome = mean(outcome) ) %>% pull(outcome) # extract outcome:
t_obs <- toy2 %>% group_by(id) %>% summarise(age = list(age)) %>%  pull(age) # extract age
exposure <- toy2 %>% group_by(id) %>% summarise(exposure = list(exposure)) %>%  pull(exposure) # extract exposure
# 2) run lpfr
lp <- lpfr( y, t_obs, xobs = exposure, compiled_file = "./inst/stan/lpfr.stan")
library(dplyr)
devtools::load_all(".")
devtools::load_all(".")
library(dplyr)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
toy2 <- toy
toy2[, 4] <- round( ( toy[, 4] - 10 ) / 30, 2 ) # i. rescale age:
y <- toy2 %>% group_by(id) %>% summarise(outcome = mean(outcome) ) %>% pull(outcome) # extract outcome:
t_obs <- toy2 %>% group_by(id) %>% summarise(age = list(age)) %>%  pull(age) # extract age
exposure <- toy2 %>% group_by(id) %>% summarise(exposure = list(exposure)) %>%  pull(exposure) # extract exposure
toy2$outcome <- rbinom(len(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
toy2$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
toy2$outcome
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
padding
library(fRLM)
padding
devtools::load_all()
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
toy2 <- toy
toy2[, 4] <- round( ( toy[, 4] - 10 ) / 30, 2 ) # i. rescale age:
y <- toy2 %>% group_by(id) %>% summarise(outcome = mean(outcome) ) %>% pull(outcome) # extract outcome:
t_obs <- toy2 %>% group_by(id) %>% summarise(age = list(age)) %>%  pull(age) # extract age
exposure <- toy2 %>% group_by(id) %>% summarise(exposure = list(exposure)) %>%  pull(exposure) # extract exposure
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
lapply(list_of_vec, length()) %>% unlist %>% length
Nmax <- lapply(list_of_vec, function(x) length(x)) %>% unlist %>% length
Nmax
Nmax <- lapply(list_of_vec, function(x) length(x)) %>% unlist %>% max
Nmax
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
tobs$mask
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
tobs$padded
tobs$mask
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
phi
psi
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
devtools::load_all()
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
toy2 <- toy
toy2[, 4] <- round( ( toy[, 4] - 10 ) / 30, 2 ) # i. rescale age:
y <- toy2 %>% group_by(id) %>% summarise(outcome = mean(outcome) ) %>% pull(outcome) # extract outcome:
t_obs <- toy2 %>% group_by(id) %>% summarise(age = list(age)) %>%  pull(age) # extract age
exposure <- toy2 %>% group_by(id) %>% summarise(exposure = list(exposure)) %>%  pull(exposure) # extract exposure
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
# padding with mask
padding <- function(list_of_vec) {
# Function to pad a single vector and create its mask
pad_and_mask <- function(x) {
pad_length <- Nmax - length(x)
padded <- c(x, rep(0, pad_length))
mask <- c(rep(0, length(x)), rep(1, pad_length))
list(padded = padded, mask = mask)
}
# Apply the function to each vector in the list
results <- lapply(list_of_vec, pad_and_mask)
# Combine the padded vectors and masks
padded_matrix <- do.call(rbind, lapply(results, `[[`, "padded"))
mask_matrix <- do.call(rbind, lapply(results, `[[`, "mask"))
list(mat = padded_matrix, mask = mask_matrix)
}
devtools::load_all()
# padding with mask
padding <- function(list_of_vec) {
# Function to pad a single vector and create its mask
pad_and_mask <- function(x) {
pad_length <- Nmax - length(x)
padded <- c(x, rep(0, pad_length))
mask <- c(rep(0, length(x)), rep(1, pad_length))
list(padded = padded, mask = mask)
}
# Apply the function to each vector in the list
results <- lapply(list_of_vec, pad_and_mask)
# Combine the padded vectors and masks
padded_matrix <- do.call(rbind, lapply(results, `[[`, "padded"))
mask_matrix <- do.call(rbind, lapply(results, `[[`, "mask"))
list(mat = padded_matrix, mask = mask_matrix)
}
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
library(fRLM)
roxygen2::roxygenize()
library(fRLM)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
roxygen2::roxygenize()
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
padding
devtools::load_all()
padding
devtools::document()
library(fRLM)
padding
devtools::load_all()
library(fRLM)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
padding
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
padding
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
Nvec
# Create the Nvec list TODO: use the mask instead
Nvec <- lapply(1:nrow(tobs$mask), function(i)sum(tobs$mask[i,]==0))
Nvec
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
n = length(y)
length(y)
L
K
ncol(C)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
C
ncol(C)
Nmax
y
C
phi_mat
J
Nvec
tobs$mat
xobs$mat
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
stan_file
fit <- rstan::stan( file = stan_file, data = dat, ... )
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
toy2$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
# toy2 <- toy
# toy2[, 4] <- round( ( toy[, 4] - 10 ) / 30, 2 ) # i. rescale age:
# y <- toy2 %>% group_by(id) %>% summarise(outcome = mean(outcome) ) %>% pull(outcome) # extract outcome:
# t_obs <- toy2 %>% group_by(id) %>% summarise(age = list(age)) %>%  pull(age) # extract age
# exposure <- toy2 %>% group_by(id) %>% summarise(exposure = list(exposure)) %>%  pull(exposure) # extract exposure
# # 2) run lpfr
# lp <- lpfr( y, t_obs, xobs = exposure, compiled_file = "./inst/stan/lpfr.stan")
#
# fit <- fRLM_lpfr(data = toy,
#           id="id",  # string, name of the subject identifier
#           exposures = "exposure", # string, the variable name of the exposures (for now, one)
#           outcome="outcome", # string, the variable name of the outcome
#           time = "age" # string, the variable name of the time at which measures were taken
#           )
#
# # Binary outcome
toy2$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
toy2
toy2
# 1) Setup data:
data(toy)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
toy$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
fit <- fRLM_lpfr(data = toy2,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
fit <- fRLM_lpfr(data = toy2,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
# fit <- fRLM_lpfr(data = toy,
#           id="id",  # string, name of the subject identifier
#           exposures = "exposure", # string, the variable name of the exposures (for now, one)
#           outcome="outcome", # string, the variable name of the outcome
#           time = "age" # string, the variable name of the time at which measures were taken
#           )
# Binary outcome ---
toy$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
library(dplyr)
# 1) Setup data:
data(toy)
# fit <- fRLM_lpfr(data = toy,
#           id="id",  # string, name of the subject identifier
#           exposures = "exposure", # string, the variable name of the exposures (for now, one)
#           outcome="outcome", # string, the variable name of the outcome
#           time = "age" # string, the variable name of the time at which measures were taken
#           )
# Binary outcome ---
toy$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy2$outcome)))
toy$outcome <- rbinom(length(toy2$outcome), 1, 1/(1+exp(-toy$outcome)))
toy$outcome <- rbinom(length(toy$outcome), 1, 1/(1+exp(-toy$outcome)))
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
# fit <- fRLM_lpfr(data = toy,
#           id="id",  # string, name of the subject identifier
#           exposures = "exposure", # string, the variable name of the exposures (for now, one)
#           outcome="outcome", # string, the variable name of the outcome
#           time = "age" # string, the variable name of the time at which measures were taken
#           )
# Binary outcome ---
toy$outcome_binary <- rbinom(length(toy$outcome), 1, 1/(1+exp(-toy$outcome)))
toy$outcome_binary
fit <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome_binary", # string, the variable name of the outcome
family="binary",
time = "age" # string, the variable name of the time at which measures were taken
)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
y
toy$outcome
plot(toy$outcome)
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
rbinom(1,1,c(0.2,0.3))
toy %>% group_by(id) %>% mutate(outcome_binary = rbinom(1,1,1/(1+exp(-outcome)))) %>% ungroup()
library(fRLM)
library(dplyr)
# 1) Setup data:
data(toy)
# fit <- fRLM_lpfr(data = toy,
#           id="id",  # string, name of the subject identifier
#           exposures = "exposure", # string, the variable name of the exposures (for now, one)
#           outcome="outcome", # string, the variable name of the outcome
#           time = "age" # string, the variable name of the time at which measures were taken
#           )
# Binary outcome ---
toy <- toy %>% group_by(id) %>% mutate(outcome_binary = rbinom(1,1,1/(1+exp(-outcome)))) %>% ungroup()
toy$outcome_binary
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
devtools::load_all()
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
fit <- rstan::stan( file = stan_file, data = dat, ... )
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
fit <- rstan::stan( file = stan_file, data = dat, ... )
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
fit <- rstan::stan( file = stan_file, data = dat, ... )
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
fit <- rstan::stan( file = stan_file, data = dat, ... )
out <- c( fit = fit, rstan::extract(fit ), L = L )
out
out$psi <- psi
psi
out$Xhat <- t( sapply( apply(out$xi, 2, function(x) x %*% t(psi), simplify = F), colMeans ) )
class(out) <- "funcRegBayes"
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
plot(fit)
plot(fit)
summary(fit)
w = predict(fit)
w
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
devtools::load_all()
source("C:/Users/Willwhite/Documents/Github/fRLM/development/lpfr/minimal_example.R", echo=TRUE)
plot(fit)
toy$age
hist(toy$age)
roxygen2::roxygenize()
devtools::document()
library(fRLM)
?fRLM_lpfr
source("~/.active-rstudio-document", echo=TRUE)
source("~/.active-rstudio-document", echo=TRUE)
plot(fit)
devtools::load_all()
fit_binary <- fRLM_lpfr(data = toy,
id="id",  # string, name of the subject identifier
exposures = "exposure", # string, the variable name of the exposures (for now, one)
outcome="outcome_binary", # string, the variable name of the outcome
family="binary",
time = "age",
bounded_exposures = TRUE,
warmup=5,
iter=10,
chains=1
)
plot(fit_binary)
w_binary = predict(fit_binary)
roxygen2::roxygenize()
devtools::document()
?fRLM_lpfr
library(fRLM)
?fRLM_lpfr