如何解决如何省略do.call产生的大量代码?
我想构建一个函数 additive_glm
,它允许用户在需要时为 glm 函数指定附加参数。
让我们考虑数据:
set.seed(42)
bin_var <- sample(0:1,125,T)
indep_1 <- rnorm(125)
indep_2 <- rexp(125)
df <- data.frame("norm" = indep_1,"Exp" = indep_2)
还有我的函数 additive_glm
:
additive_glm <- function(y,x,glm_args = NULL){
do.call("glm",c(list(
formula = y ~ .,data = base::quote(as.data.frame(x)),family = binomial(link = 'logit')
),glm_args))
}
但是现在如果我想运行我的函数:
additive(bin_var,df)
我明白了:
Call: glm(formula = y ~ .,family = structure(list(family = "binomial",link = "logit",linkfun = function (mu)
.Call(C_logit_link,mu),linkinv = function (eta)
.Call(C_logit_linkinv,eta),variance = function (mu)
mu * (1 - mu),dev.resids = function (y,mu,wt)
.Call(C_binomial_dev_resids,y,wt),aic = function (y,n,wt,dev)
{
m <- if (any(n > 1))
n
else wt
-2 * sum(ifelse(m > 0,(wt/m),0) * dbinom(round(m *
y),round(m),log = TRUE))
},mu.eta = function (eta)
.Call(C_logit_mu_eta,initialize = expression({
if (NCOL(y) == 1) {
if (is.factor(y))
y <- y != levels(y)[1L]
n <- rep.int(1,nobs)
y[weights == 0] <- 0
if (any(y < 0 | y > 1))
stop("y values must be 0 <= y <= 1")
mustart <- (weights * y + 0.5)/(weights + 1)
m <- weights * y
if (any(abs(m - round(m)) > 0.001))
warning("non-integer #successes in a binomial glm!")
}
else if (NCOL(y) == 2) {
if (any(abs(y - round(y)) > 0.001))
warning("non-integer counts in a binomial glm!")
n <- y[,1] + y[,2]
y <- ifelse(n == 0,y[,1]/n)
weights <- weights * n
mustart <- (n * y + 0.5)/(n + 1)
}
else stop("for the 'binomial' family,y must be a vector of 0 and 1's\nor a 2 column matrix where col 1 is no. successes and col 2 is no. failures")
}),validmu = function (mu)
all(is.finite(mu)) && all(mu > 0 & mu < 1),valideta = function (eta)
TRUE,simulate = function (object,nsim)
{
ftd <- fitted(object)
n <- length(ftd)
ntot <- n * nsim
wts <- object$prior.weights
if (any(wts%%1 != 0))
stop("cannot simulate from non-integer prior.weights")
if (!is.null(m <- object$model)) {
y <- model.response(m)
if (is.factor(y)) {
yy <- factor(1 + rbinom(ntot,size = 1,prob = ftd),labels = levels(y))
split(yy,rep(seq_len(nsim),each = n))
}
else if (is.matrix(y) && ncol(y) == 2) {
yy <- vector("list",nsim)
for (i in seq_len(nsim)) {
Y <- rbinom(n,size = wts,prob = ftd)
YY <- cbind(Y,wts - Y)
colnames(YY) <- colnames(y)
yy[[i]] <- YY
}
yy
}
else rbinom(ntot,prob = ftd)/wts
}
else rbinom(ntot,prob = ftd)/wts
}),class = "family"),data = as.data.frame(x))
Coefficients:
(Intercept) norm Exp
0.2235 -0.2501 -0.2612
degrees of Freedom: 124 Total (i.e. Null); 122 Residual
Null Deviance: 173.2
Residual Deviance: 169.7 AIC: 175.7
所以我确实得到了我想要的东西 - 它前面是巨大的 Call
代码。我正在寻找一些技术来摆脱它,但是我并没有那么成功。你知道如何省略这大部分不必要的代码吗?
解决方法
1) 将家庭参数放在 quote(...)
内。仅更改了标记为 ## 的行。
additive_glm <- function(y,x,glm_args = NULL){
do.call("glm",c(list(
formula = y ~ .,data = base::quote(as.data.frame(x)),family = quote(binomial(link = 'logit')) ##
),glm_args))
}
additive_glm(bin_var,df)
给予:
Call: glm(formula = y ~ .,family = binomial(link = "logit"),data = as.data.frame(x))
Coefficients:
(Intercept) Norm Exp
0.32821 -0.06504 -0.05252
Degrees of Freedom: 124 Total (i.e. Null); 122 Residual
Null Deviance: 171
Residual Deviance: 170.7 AIC: 176.7
2) 另一种可能是:
additive_glm2 <- function(y,...){
glm(y ~ .,data = as.data.frame(x),...)
}
additive_glm2(bin_var,data = as.data.frame(x))
Coefficients:
(Intercept) Norm Exp
0.32821 -0.06504 -0.05252
Degrees of Freedom: 124 Total (i.e. Null); 122 Residual
Null Deviance: 171
Residual Deviance: 170.7 AIC: 176.7
,
我不明白您为什么使用 do.call
。我会这样做:
additive_glm <- function(y,family = binomial(link = 'logit'),...){
mc <- match.call()
yname <- mc[["y"]]
xname <- mc[["x"]]
x[[as.character(yname)]] <- y
assign(as.character(xname),x)
eval(substitute(glm(yname ~ .,data = xname,family = family,...),env = environment()))
}
additive_glm(bin_var,df)
#Call: glm(formula = bin_var ~ .,# data = df)
#
#Coefficients:
#(Intercept) Norm Exp
# 0.32821 -0.06504 -0.05252
#
#Degrees of Freedom: 124 Total (i.e. Null); 122 Residual
#Null Deviance: 171
#Residual Deviance: 170.7 AIC: 176.7
注意打印精美的电话。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。