R: извлекать оригинальные значения из формулы модели

Question

Я очень новичок в R, и я создаю функцию для вычисления индекса Furnival, пытаясь сделать его более чистым, где пользователю нужно будет только вставить скорректированную модель. У меня возникли проблемы с определением того, является ли преобразование журнала в модели естественным или любым другим видом, потому что индекс изменится в соответствии с этой информацией. Поэтому я решил вычислить эту информацию, используя a = b^1/x, где «a» - это база логарифмов, «x» и «b» - это информация формулы с/без преобразования журнала соответственно. Но для этого мне нужно исходное значение из модели, потому что, используя «модель $ 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 

Все это делается путем тщательного deparsing формулы объекта, был использован для соответствия модели.