R：从公式模型中提取原始值

Question

我在R中是新手，我正在创建一个计算Furnival Index的函数，试图使其更整洁，用户只需要插入调整后的模型即可。 我很难确定模型中的对数转换是自然对数还是任何其他类型，因为索引会根据此信息而变化。 因此，我想使用a = b ^ 1 / x来计算此信息，其中“ a”是对数底，“ x”和“ b”分别是具有/不具有对数变换的公式信息。 但是为此，我需要模型的原始值，因为使用“ model $ model”只能得到对数值。

到目前为止，这是我所做的：

furnival=function(object=NULL)
{
  w <- object$weights
  if(!is.null(object) && is.numeric(object))
    stop("'object' must be a formula")
  if(is.null(w <- object$weights)){
    w <- 1
  }else{
    w
  }
  if(length(grep("log", formula(object)))!=0){
    y <- as.numeric(as.matrix(object$model[1L]))
    modelValues <- object[Something to identify the original value]
    routine <- object$model == 1        
    if(any(routine))
       modelValues[!routine]
    modelValues <- sample(modelValues,1)
    a <- modelValues^(1/y)
    if(grep("log", formula(object))[1L]==2)
      y <- a^y
    if(a == exp(1)){ 
      df <- df.residual(object)
      MSE <- sum((residuals(object)^2)*w)
      index <- (exp(mean(log(y))))*(sqrt(MSE/df))
      return(index)
    }else{
      df <- df.residual(object)
      MSE <- sum((residuals(object)^2)*w)
      index <- (a^(mean(log(y,a))))*(sqrt(MSE/df))*(log(exp(1),a)^-1)
      return(index)
    }
  }
  else{
    df <- df.residual(object)
    MSE <- sum((residuals(object)^2)*w)
    index <- sqrt((MSE/df))
    return(index)
  }
}            

如果有某种方法可以执行此操作，或者即使有更智能的方法也可以执行此功能。

Answer 1

如果仅在您尝试确定公式响应的对数转换的基础的地方隔离该部分，则此辅助函数应对此进行确认。

getresplogbase <- function(obj) {
    if(class(obj)=="lm") {
        obj = terms(obj)
    }
    stopifnot(is(obj,"formula"))
    rhs <- obj[[2]]
    if (is.recursive(rhs)) {
        if(rhs[[1]]==quote(log)) {
            if(length(rhs)==2) {
                return(exp(1))
            } else {
                return(eval(rhs[[3]], environment(obj)))
            }
        } else {
            stop("unable to parse:", deparse(rhs))
        }
    } else {
        NA
    }
}

例如，您可以像

getresplogbase(y~x)
# [1] NA
getresplogbase(log(y)~x)
# [1] 2.718282
getresplogbase(log(y,10)~x)
# [1] 10
a<-2
getresplogbase(log(y,a)~x)
# [1] 2

您也可以传递lm()模型

dd <- data.frame(y=runif(50,4,50)); dd$z=log(dd$y,2)+rnorm(50)
mod <- lm(log(z) ~ y, dd)
getresplogbase(mod)
# [1] 2.718282

所有这些都是通过仔细地分解用于拟合模型的公式对象来完成的。