ошибка формулы внутри функции

Question

Я хочу использовать survfit() и basehaz() внутри функции, но они не работают.Не могли бы вы взглянуть на эту проблему.Спасибо за вашу помощь.Следующий код приводит к ошибке:

library(survival)

n <- 50      # total sample size
nclust <- 5  # number of clusters
clusters <- rep(1:nclust,each=n/nclust)
beta0 <- c(1,2)
set.seed(13)
#generate phmm data set
Z <- cbind(Z1=sample(0:1,n,replace=TRUE),
       Z2=sample(0:1,n,replace=TRUE),
       Z3=sample(0:1,n,replace=TRUE))
b <- cbind(rep(rnorm(nclust),each=n/nclust),rep(rnorm(nclust),each=n/nclust))
Wb <- matrix(0,n,2)
for( j in 1:2) Wb[,j] <- Z[,j]*b[,j]
Wb <- apply(Wb,1,sum)
T <- -log(runif(n,0,1))*exp(-Z[,c('Z1','Z2')]%*%beta0-Wb)
C <- runif(n,0,1)
time <- ifelse(T<C,T,C)
event <- ifelse(T<=C,1,0)
mean(event)
phmmd <- data.frame(Z)
phmmd$cluster <- clusters
phmmd$time <- time
phmmd$event <- event

fmla <- as.formula("Surv(time, event) ~ Z1 + Z2")

BaseFun <- function(x){
start.coxph <- coxph(x, phmmd)  

print(start.coxph)

betahat <- start.coxph$coefficient
print(betahat) 
print(333)  
print(survfit(start.coxph))                                                                                                                                                                                                                                     
m <- basehaz(start.coxph)
print(m)
}  
BaseFun(fmla)
Error in formula.default(object, env = baseenv()) : invalid formula

Но работает следующая функция:

fit <- coxph(fmla, phmmd)    
basehaz(fit)

Answer 1

Это проблема определения объема.Обратите внимание, что среда basehaz имеет вид:

environment(basehaz)
<environment: namespace:survival>

между тем:

environment(BaseFun)
<environment: R_GlobalEnv>

Поэтому, поэтому функция basehaz не может найти локальную переменную внутри функции.

Возможное решение - отправить x наверх, используя assign:

 BaseFun <- function(x){

    assign('x',x,pos=.GlobalEnv)

    start.coxph <- coxph(x, phmmd)  
    print(start.coxph)

    betahat <- start.coxph$coefficient
    print(betahat) 
    print(333)  
    print(survfit(start.coxph)) 

    m <- basehaz(start.coxph)
    print(m) 
    rm(x)

       }  
    BaseFun(fmla)

Другие решения могут включать более непосредственное взаимодействие со средой.

Answer 2

Я отслеживаю комментарий @ moli к ответу @ aatrujillob.Они были полезны, поэтому я подумал, что объясню, как это решило для меня проблему и аналогичную проблему с пакетами rpart и partykit.

Некоторые данные игрушки:

N <- 200
data <- data.frame(X = rnorm(N),W = rbinom(N,1,0.5))
data <-  within( data, expr = {
  trtprob <- 0.4 + 0.08*X + 0.2*W -0.05*X*W
  Trt <- rbinom(N, 1, trtprob)
  outprob <- 0.55 + 0.03*X -0.1*W - 0.3*Trt
  Outcome <- rbinom(N,1,outprob)
  rm(outprob, trtprob)
})

Iхотите разделить данные на обучающие (train_data) и тестовые наборы и обучить дерево классификации на train_data.

Вот формула, которую я хочу использовать, и проблема со следующим примером.Когда я определяю эту формулу, объект train_data еще не существует.

my_formula <- Trt~W+X 
exists("train_data")
# [1] FALSE
exists("train_data", envir = environment(my_formula))
# [1] FALSE

Вот моя функция, которая похожа на исходную функцию.Опять же,

badFunc <- function(data, my_formula){
  train_data <- data[1:100,]
  ct_train <- rpart::rpart(
    data= train_data,
    formula = my_formula,
    method = "class")
  ct_party <- partykit::as.party(ct_train)
}

При попытке запустить эту функцию выдается ошибка, похожая на OP.

library(rpart)
library(partykit)

bad_out <- badFunc(data=data, my_formula = my_formula)
# Error in is.data.frame(data) : object 'train_data' not found 
# 10.   is.data.frame(data) 
# 9.    model.frame.default(formula = Trt ~ W + X, data = train_data, 
#          na.action = function (x) {Terms <- attr(x, "terms") ... 
# 8.    stats::model.frame(formula = Trt ~ W + X, data = train_data, 
#          na.action = function (x) {Terms <- attr(x, "terms") ... 
# 7.    eval(expr, envir, enclos) 
# 6.    eval(mf, env) 
# 5.    model.frame.rpart(obj) 
# 4.    model.frame(obj) 
# 3.    as.party.rpart(ct_train) 
# 2.    partykit::as.party(ct_train) 
# 1.    badFunc(data = data, my_formula = my_formula) 

print(bad_out)
# Error in print(bad_out) : object 'bad_out' not found

К счастью, rpart() похож на coxph() в том смысле, что вы можете указать аргумент model=TRUE для решения этих вопросов.Здесь снова, с этим дополнительным аргументом.

goodFunc <- function(data, my_formula){
  train_data <- data[1:100,]
  ct_train <- rpart::rpart(
    data= train_data,
    ## This solved it for me
    model=TRUE,
    ## 
    formula = my_formula,
    method = "class")
  ct_party <- partykit::as.party(ct_train)
}
good_out <- goodFunc(data=data, my_formula = my_formula)
print(good_out)    
# Model formula:
# Trt ~ W + X
# 
# Fitted party:
# [1] root
# |   [2] X >= 1.59791: 0.143 (n = 7, err = 0.9)
##### etc

документация для model аргумента в rpart():

модель:

если логично:сохранить копию фрейма модели в результате?Если входное значение для модели является фреймом модели (вероятно, из более раннего вызова функции rpart), то этот фрейм используется вместо создания новых данных.

Формулы могут быть хитрыми, поскольку они используют лексическая область видимости и окружения способом, который не всегда естественен (для меня).Слава Богу, Терри Терно сделал нашу жизнь проще с model=TRUE в этих двух упаковках!