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

所有这一切都是通过仔细删除用于拟合模型的公式对象来完成的。

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

1 个答案: