捕获警告在用户定义的函数中不起作用，但在它之外起作用

Question

所以，我正在尝试为一些简单的分析自动创建表格。有很多很多表，因此创建了一个用户定义的函数来制作并将它们输出到 excel.

我的问题是某些分析存在收敛问题，我希望将其捕获并包含在输出中，以便查看它们的人知道如何查看这些估计值。

我能够通过一组简单的步骤成功地做到这一点。但是，一旦我将这些步骤放在一个函数中，它就会失败。

代码如下：

# create data
wt <- rgamma(6065, 0.7057511981,  0.0005502062)
grp <- sample(c(replicate(315, "Group1"), replicate(3672, "Group2"), replicate(1080, "Group3"), replicate(998, "Group4")))
dta <- data.frame(grp, wt)
head(dta)
str(dta)

# declare design
my.svy <- svydesign(ids=~1, weights=~wt, data=dta)

# subset
grp1 <- subset(my.svy, grp == "Group1")

# set options and clear old warnings
options(warn=0)
assign("last.warning", NULL, envir = baseenv())

## proportions and CIs
p <- ((svyciprop(~grp, grp1, family=quasibinomial))[1])

# save warnings
wrn1 <- warnings(p)

ci_l <- (confint(svyciprop(~grp, grp1, family=quasibinomial), 'ci')[1])
ci_u <- (confint(svyciprop(~grp, grp1, family=quasibinomial), 'ci')[2])

## sample counts
n <- unwtd.count(~grp, grp1)[1]

## combine into table
overall <- data.frame(n, p, ci_l, ci_u)
colnames(overall) <- c("counts", "Group1", "LL", "UL")

## add any warnings
ind <- length(wrn1)
ind

if (ind == 0) { msg <- "No warnings" }
if (ind > 0) {msg <- names(warnings()) }
overall[1,5] <- msg

print(overall)

这是上面的输出：

> # set options and clear old warnings
> options(warn=0)
> assign("last.warning", NULL, envir = baseenv())
> 
> ## proportions and CIs
> p <- ((svyciprop(~grp, grp1, family=quasibinomial))[1])
Warning message:
glm.fit: algorithm did not converge 
> 
> # save warnings
> wrn1 <- warnings(p)
> 
> ci_l <- (confint(svyciprop(~grp, grp1, family=quasibinomial), 'ci')[1])
Warning message:
glm.fit: algorithm did not converge 
> ci_u <- (confint(svyciprop(~grp, grp1, family=quasibinomial), 'ci')[2])
Warning message:
glm.fit: algorithm did not converge 
> 
> ## sample counts
> n <- unwtd.count(~grp, grp1)[1]
> 
> ## combine into table
> overall <- data.frame(n, p, ci_l, ci_u)
> colnames(overall) <- c("counts", "Group1", "LL", "UL")
> 
> ## add any warnings
> ind <- length(wrn1)
> ind
[1] 1
> 
> if (ind == 0) { msg <- "No warnings" }
> if (ind > 0) {msg <- names(warnings()) }
> overall[1,5] <- msg
> 
> print(overall)
       counts       Group1           LL           UL                                  V5
counts    315 2.364636e-12 2.002372e-12 2.792441e-12 glm.fit: algorithm did not converge

函数如下：

est <- function(var) {

## set up formula
formula <- paste ("~", var)

## set options and clear old warning
options(warn=0)
assign("last.warning", NULL, envir = baseenv())

## proportions and CIs
p <- ((svyciprop(as.formula(formula), grp1, family=quasibinomial))[1])

## save warnings
wrn1 <- warnings(p)

ci_l <- (confint(svyciprop(as.formula(formula) , grp1, family=quasibinomial), 'ci')[1])
ci_u <- (confint(svyciprop(as.formula(formula) , grp1, family=quasibinomial), 'ci')[2])

## sample counts
n <- unwtd.count(as.formula(formula), grp1)[1]

## combine into table
overall <- data.frame(n, p, ci_l, ci_u)
colnames(overall) <- c("counts", "Group1", "LL", "UL")


## add any warnings
ind <- length(warnings(p))
print(ind)

if (ind == 0) { msg <- "No warnings" }
if (ind > 0) {msg <- names(warnings()) }
overall[1,5] <- msg

print(overall)

}

# call function
est("grp")

这是运行函数的输出：

> est("grp")
[1] 0
       counts       Group1           LL           UL          V5
counts    315 2.364636e-12 2.002372e-12 2.792441e-12 No warnings
Warning messages:
1: glm.fit: algorithm did not converge 
2: glm.fit: algorithm did not converge 
3: glm.fit: algorithm did not converge

因此，警告显示在函数末尾的输出中，但它们并没有像运行在函数外部时那样被捕获。注意 print(ind) 的 0 输出和 V7 有 "No warnings".

我在函数内部了解很多 "behave" 不同的东西。举个例子，使用 "as.formula(var)" 而不仅仅是传递给函数的“~grp”。

我在各种与 R 相关的论坛中进行了大量搜索，但未能找到解决方案。所以，如果有人能提供帮助，我将不胜感激。

（旁注：我使用 rgamma 来创建我的采样权重，因为它最类似于我的权重分布并且它足够接近以重现收敛问题。如果我使用 rnorm 甚至 rlnorm 或 rweibull 我无法重现它。仅供参考。)

Answer 1

好的，感谢 William Dunlap 通过 r-help 我解决了这个问题。它涉及使用 withCallingHandlers:

withWarnings <- function(expr) {
   .warnings <- NULL # warning handler will append to this using '<<-'
   value <- withCallingHandlers(expr,
                                warning=function(e) {
                                    .warnings <<- c(.warnings, conditionMessage(e))
                                    invokeRestart("muffleWarning")
                                })
   structure(value, warnings=.warnings)
}

然后我必须修改我的原始函数 "est" 以便捕获的警告在被覆盖之前立即作为对象存储：

## save warnings
ind <- length(attr(p, "warnings"))
if (ind == 0) { 
msg <- "No warnings"
} else {
msg <- attr(p, "warnings")
}

调用 svyciprop 之后。

这是整个函数，包括构建数据集（因此任何人都可以复制它并运行看看它是如何工作的）：

library(survey)

# create data
wt <- rgamma(6065, 0.7057511981,  0.0005502062)
grp <- sample(c(replicate(315, "Group1"), replicate(3672, "Group2"), replicate(1080, "Group3"), replicate(998, "Group4")))
dta <- data.frame(grp, wt)
head(dta)
str(dta)

# declare design
my.svy <- svydesign(ids=~1, weights=~wt, data=dta)

# subset
grp1 <- subset(my.svy, grp == "Group1")

# set up function to capture warnings
withWarnings <- function(expr) {
   .warnings <- NULL # warning handler will append to this using '<<-'
   value <- withCallingHandlers(expr,
                                warning=function(e) {
                                    .warnings <<- c(.warnings, conditionMessage(e))
                                    invokeRestart("muffleWarning")
                                })
   structure(value, warnings=.warnings)
}

# build user-defined function
est <- function(var) {

## set up formula
formula <- paste ("~", var)

## set options and clear old warning
assign("last.warning", NULL, envir = baseenv())
msg<-NULL

## proportions and CIs
p <- withWarnings((svyciprop(as.formula(formula), grp1, family=quasibinomial))[1])

## save warnings
ind <- length(attr(p, "warnings"))
if (ind == 0) { 
msg <- "No warnings"
} else {
msg <- attr(p, "warnings")
}

ci_l <- (confint(svyciprop(as.formula(formula) , grp1, family=quasibinomial), 'ci')[1])
ci_u <- (confint(svyciprop(as.formula(formula) , grp1, family=quasibinomial), 'ci')[2])

## sample counts
n <- unwtd.count(as.formula(formula), grp1)[1]

## combine into table
overall <- data.frame(n, p, ci_l, ci_u)
colnames(overall) <- c("counts", "Group1", "LL", "UL")


## add any warnings
overall[1,5] <- msg

print(overall)

}

# call function
est("grp")

这是输出：

> # call function
> est("grp")
       counts       Group1           LL           UL                                  V5
counts    315 2.417004e-12 2.040761e-12 2.862612e-12 glm.fit: algorithm did not converge
Warning messages:
1: glm.fit: algorithm did not converge 
2: glm.fit: algorithm did not converge 
>

这非常有用，我感谢 William Dunlap 的帮助。我希望这对其他人有帮助

捕获警告在用户定义的函数中不起作用，但在它之外起作用

Capturing warnings isn't working within user-defined function but works outside of it

warnings

r

user-defined-functions