eval，
parseas.formula示例：
library("ipw")
data("haartdat")
haartdat[1:10,]
numerator <- as.formula("~ sex + age")
denominator <- as.formula("~ cd4.sqrt + sex + age")
temp <- ipwtm(exposure = haartind, family = "survival",
numerator = numerator, denominator = denominator,
id = patient, tstart = tstart, timevar = fuptime, type = "first",
data = haartdat)
评论中提到的 @as @jvargh7是因为
match.call+
deparsematch.call()之后添加源代码中的两行，并将其称为新函数。
ipwtm2 <- function (exposure, family, link, numerator = NULL, denominator,
id, tstart, timevar, type, data, corstr = "ar1", trunc = NULL,
...) {
tempcall <- match.call()
tempcall$numerator <- numerator # new
tempcall$denominator <- denominator # new
...
...
}
测试
library(survival)
library(ipw)
data(haartdat)
numerator <- as.formula("~ sex + age")
denominator <- as.formula("~ sex + age + cd4.sqrt")
temp <- ipwtm2(exposure = haartind, family = "survival",
numerator = numerator, denominator = denominator,
id = patient, tstart = tstart, timevar = fuptime, type = "first",
data = haartdat)
temp_old <- ipwtm(exposure = haartind, family = "survival",
numerator = ~ sex + age, denominator = ~ sex + age + cd4.sqrt,
id = patient, tstart = tstart, timevar = fuptime, type = "first",
data = haartdat)
temp$num.mod
Call:
coxph(formula = Surv(tstart, fuptime, haartind) ~ sex + age,
data = haartdat, subset = tempdat$selvar == 1, na.action = na.fail,
method = "efron")
coef exp(coef) se(coef) z p
sex 0.069424 1.071891 0.124365 0.558 0.577
age 0.007521 1.007549 0.005123 1.468 0.142
Likelihood ratio test=2.22 on 2 df, p=0.3287
n= 14389, number of events= 376
temp_old$num.mod
Call:
coxph(formula = Surv(tstart, fuptime, haartind) ~ sex + age,
data = haartdat, subset = tempdat$selvar == 1, na.action = na.fail,
method = "efron")
coef exp(coef) se(coef) z p
sex 0.069424 1.071891 0.124365 0.558 0.577
age 0.007521 1.007549 0.005123 1.468 0.142
Likelihood ratio test=2.22 on 2 df, p=0.3287
n= 14389, number of events= 376
是更改源代码（可能会降低便携性）的替代方案，也可以构造包含呼叫IPWTM函数的字符串。我编写了一个与IPWTM相同语法的函数，但是在分子和分母参数中接受公式字符串或变量名称的向量：
library(dplyr)
library(ipw)
my_ipwtm <- function(exposure, family, link, numerator = NULL, denominator, id, tstart, timevar, type, data) {
#' Calculate Inverse Probability Weights for Marginal Structural Models
#'
#' This function constructs and evaluates a call to the `ipwtm` function, which calculates
#' inverse probability weights for marginal structural models. It allows for flexible
#' specification of exposure, family, link, and other model parameters.
#'
#' @param exposure Expression representing the exposure variable in the model.
#' @param family Character string specifying the distribution family for the model (e.g., "binomial", "gaussian").
#' @param link Character string specifying the link function for the model (e.g., "logit", "identity").
#' @param numerator Optional vector or expression specifying the model for the numerator of the weight. Defaults to NULL.
#' @param denominator Vector or expression specifying the model for the denominator of the weight.
#' @param id Expression representing the unique identifier for each subject in the data.
#' @param tstart Expression representing the start time variable for each subject.
#' @param timevar Expression representing the time-varying variable in the model.
#' @param type Character string specifying the type of model to be used (e.g., "cox", "glm").
#' @param data Data frame containing the variables used in the model.
#'
#' @return An object containing the calculated inverse probability weights, as produced by the `ipwtm` function.
#'
#' @examples
#' # Example usage:
#' # my_ipwtm(exposure = treatment, family = "binomial", link = "logit",
#' # numerator = c("age", "sex"), denominator = c("age", "sex", "comorbidity"),
#' # id = patient_id, tstart = start_time, timevar = follow_up_time,
#' # type = "cox", data = my_data)
#'
#' @details
#' The function first substitutes the provided expressions with their string representations,
#' constructs a call to `ipwtm`, and evaluates it to compute the weights. The numerator and
#' denominator can be specified as vectors or expressions, and the function will construct
#' the appropriate formula strings for the model.
exposure_string <- substitute(exposure) %>% deparse()
tstart_string <- substitute(tstart) %>% deparse()
id_string <- substitute(id) %>% deparse()
timevar_string <- substitute(timevar) %>% deparse()
if (is.null(numerator)) {
numerator_string <- "NULL"
} else if(length(numerator) > 1) {
numerator_string <- make_formula_string(numerator)
} else {
numerator_string <- numerator
}
if (length(denominator) > 1) {
denominator_string <- make_formula_string(denominator)
} else {
denominator_string <- denominator
}
ipw_call_str <- ipw_call_string(exposure_str = exposure_string, family_str = family, link_str = link, numerator_str = numerator_string, denominator_str = denominator_string, id_st = id_string, tstart_str = tstart_string, timevar_str = timevar_string, type_str = type)
ipw.object <- parse(text = ipw_call_str) %>% eval()
return(ipw.object)
}
make_formula_string <- function(varnames) {
f <- paste("~", paste0(varnames, collapse = " + "))
return(f)
}
ipw_call_string <- function(exposure_str, family_str, link_str, numerator_str, denominator_str, id_str, tstart_str, timevar_str, type_str) {
call_str <-
"ipwtm(exposure = EXPOSURE, family = 'FAMILY', link = 'LINK', numerator = NUMERATOR, denominator = DENOMINATOR, id = PAT_ID, tstart = TSTART, timevar = TIMEVAR, type = 'TYPE', data = data)"
call_str <- gsub("EXPOSURE", exposure_str, call_str)
call_str <- gsub("FAMILY", family_str, call_str)
call_str <- gsub("LINK", link_str, call_str)
call_str <- gsub("NUMERATOR", numerator_str, call_str)
call_str <- gsub("DENOMINATOR", denominator_str, call_str)
call_str <- gsub("PAT_ID", id_str, call_str)
call_str <- gsub("TIMEVAR", timevar_str, call_str)
call_str <- gsub("TYPE", type_str, call_str)
return(call_str)
}