使用非默认选项运行现有功能答案

【问题标题】：Running existing function with non-default option使用非默认选项运行现有功能
【发布时间】：2015-06-25 18:58:53
【问题描述】：

从 ResourceSelection::hoslem.test 粘贴的以下代码执行 Hosmer 和 Lemeshow 拟合优度测试。在调查为什么输出与另一个软件 (Stata) 执行的输出不完全一致时，我发现差异与分位数函数 (type=7) 使用默认 R 参数有关。我想使用这个函数和不同的默认值来计算分位数（type=6）。

FWIW，R 使用的 9 种可能方法的参考可以在以下位置找到：

https://www.amherst.edu/media/view/129116/original/Sample+Quantiles.pdf

Stata manual for pctile 指的是默认方法和“altdef”方法。我发现很难将这两种方法映射到相应的 R 类型。

然而，

hoslem.test(yhat, y, type=6)

生产：

> hl <- hoslem.test(y, yhat, type=6)
Error in hoslem.test(y, yhat, type = 6) : unused argument (type = 6)

有没有办法使用分位数函数的非默认参数运行下面的函数？

即。允许以下行添加 ', type=6':

qq <- unique(quantile(yhat, probs = seq(0, 1, 1/g), type=6))

有问题的函数是：

> ResourceSelection::hoslem.test
function (x, y, g = 10) 
{
    DNAME <- paste(deparse(substitute(x)), deparse(substitute(y)), 
        sep = ", ")
    METHOD <- "Hosmer and Lemeshow goodness of fit (GOF) test"
    yhat <- y
    y <- x
    qq <- unique(quantile(yhat, probs = seq(0, 1, 1/g)))
    cutyhat <- cut(yhat, breaks = qq, include.lowest = TRUE)
    observed <- xtabs(cbind(y0 = 1 - y, y1 = y) ~ cutyhat)
    expected <- xtabs(cbind(yhat0 = 1 - yhat, yhat1 = yhat) ~ 
        cutyhat)
    chisq <- sum((observed - expected)^2/expected)
    PVAL = 1 - pchisq(chisq, g - 2)
    PARAMETER <- g - 2
    names(chisq) <- "X-squared"
    names(PARAMETER) <- "df"
    structure(list(statistic = chisq, parameter = PARAMETER, 
        p.value = PVAL, method = METHOD, data.name = DNAME, observed = observed, 
        expected = expected), class = "htest")
}

【问题讨论】：

标签： r function arguments stata

【解决方案1】：

我们可以修改一些函数。看一下函数体

as.list(body(hoslem.test))

看到我们要修改的元素是body中的第6个元素

[[1]]
`{`

[[2]]
DNAME <- paste(deparse(substitute(x)), deparse(substitute(y)), 
    sep = ", ")

[[3]]
METHOD <- "Hosmer and Lemeshow goodness of fit (GOF) test"

[[4]]
yhat <- y

[[5]]
y <- x

[[6]]
qq <- unique(quantile(yhat, probs = seq(0, 1, 1/g)))

将第6个元素修改为你想要的

body(hoslem.test)[[6]] = substitute(qq <- unique(quantile(yhat,
                                    probs = seq(0, 1, 1/g), type = 6)))

【讨论】：

【解决方案2】：

最简单的方法是重新输入你自己的函数：

myhoslem.test<-function(x, y, g = 10, mytype = 6){
    DNAME <- paste(deparse(substitute(x)), deparse(substitute(y)), 
        sep = ", ")
    METHOD <- "Hosmer and Lemeshow goodness of fit (GOF) test"
    yhat <- y
    y <- x
    qq <- unique(quantile(yhat, probs = seq(0, 1, 1/g), type = mytype))
    cutyhat <- cut(yhat, breaks = qq, include.lowest = TRUE)
    observed <- xtabs(cbind(y0 = 1 - y, y1 = y) ~ cutyhat)
    expected <- xtabs(cbind(yhat0 = 1 - yhat, yhat1 = yhat) ~ 
        cutyhat)
    chisq <- sum((observed - expected)^2/expected)
    PVAL = 1 - pchisq(chisq, g - 2)
    PARAMETER <- g - 2
    names(chisq) <- "X-squared"
    names(PARAMETER) <- "df"
    structure(list(statistic = chisq, parameter = PARAMETER, 
        p.value = PVAL, method = METHOD, data.name = DNAME, observed = observed, 
        expected = expected), class = "htest")
}

这里的关键变化是：

qq <- unique(quantile(yhat, probs = seq(0, 1, 1/g), type = mytype))

并允许 mytype 作为函数的参数，默认为 6

【讨论】：

【解决方案3】：

这两个答案建议了一个包装函数来灵活修改 hoslem.test

myhoslem.test<-function(x, y, g = 10, mytype = 6){
  body(hoslem.test)[[6]] = substitute(qq <- unique(quantile(yhat,
                                              probs = seq(0, 1, 1/g), type = mytype))) 
  hoslem.test(x,y, g=10)
}

【讨论】：