所以，我正在尝试为一些简单的分析自动创建表。有很多很多表，因此创建了一个用户定义的函数来制作和输出它们。
我的问题是，某些分析存在收敛问题，我希望将其捕获并包含在输出中，以便查看它们的人知道如何查看这些估算值。
我能够通过简单的步骤成功完成这项工作。但是，一旦我将这些步骤放在一个函数中，它就会失败。
以下是代码：
catList这是以上输出：
# 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")
因此，警告会在函数末尾的输出中显示，但它们不像在函数外部运行时那样被捕获。注意print（ind）的0输出和V7的＃34;没有警告＆＃34;。
我知道很多事情＆＃34;表现＆＃34;内部功能不同。例如，使用＆＃34; as.formula（var）＆＃34;而不只是＆＃34; ~grp＆＃34;传递给函数。
在经过大量搜索各种R相关论坛后，我找不到解决方案。所以，如果有人可以提供帮助，我会感激不尽。
（旁注：我使用rgamma创建我的采样权重，因为它最像我的权重分布，它足够接近重现收敛问题。如果我使用rnorm甚至rlnorm或rweibull我无法复制它。仅仅是FYI。）
答案 0 :(得分：0)
好的，感谢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)
}
然后我必须修改我的原始功能＆＃34; est＆＃34;因此，捕获的警告在被覆盖之前就会被存储为对象：
## 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。我希望这有助于其他人