diff --git a/R/fsw.R b/R/fsw.R index cd13579..6db2803 100644 --- a/R/fsw.R +++ b/R/fsw.R @@ -113,9 +113,9 @@ fsw.ivreg <- function(object) { fswp[i] <- stats::pf(fsw[i], nendog, wldtst$Res.Df[2L], lower.tail = FALSE) } - fswres = cbind(fsw, fswdf, fswresdf, fswp) - rownames(fswres) = namesendog - colnames(fswres) = c("F value","d.f.","Residual d.f.","Pr(>F)") + fswres <- cbind(fsw, fswdf, fswresdf, fswp) + rownames(fswres) <- namesendog + colnames(fswres) <- c("F value", "d.f.", "Residual d.f.", "Pr(>F)") output <- list(fswres = fswres, namesendog = namesendog, diff --git a/R/msmm.R b/R/msmm.R index 82a49c6..58d1760 100644 --- a/R/msmm.R +++ b/R/msmm.R @@ -155,31 +155,31 @@ msmm <- function(formula, instruments, data, subset, na.action, # code from beginning for ivreg::ivreg() ## set up model.frame() call cl <- match.call() - if(missing(data)) data <- environment(formula) + if (missing(data)) data <- environment(formula) mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "weights", "offset"), names(mf), 0) mf <- mf[c(1, m)] mf$drop.unused.levels <- TRUE ## handle instruments for backward compatibility - if(!missing(instruments)) { + if (!missing(instruments)) { formula <- Formula::as.Formula(formula, instruments) cl$instruments <- NULL cl$formula <- formula(formula) } else { formula <- Formula::as.Formula(formula) } - if(length(formula)[2L] == 3L) formula <- Formula::as.Formula( + if (length(formula)[2L] == 3L) formula <- Formula::as.Formula( formula(formula, rhs = c(2L, 1L), collapse = TRUE), formula(formula, lhs = 0L, rhs = c(3L, 1L), collapse = TRUE) ) stopifnot(length(formula)[1L] == 1L, length(formula)[2L] %in% 1L:2L) ## try to handle dots in formula has_dot <- function(formula) inherits(try(stats::terms(formula), silent = TRUE), "try-error") - if(has_dot(formula)) { + if (has_dot(formula)) { f1 <- formula(formula, rhs = 1L) f2 <- formula(formula, lhs = 0L, rhs = 2L) if (!has_dot(f1) && has_dot(f2)) formula <- Formula::as.Formula(f1, - stats::update(formula(formula, lhs = 0L, rhs = 1L), f2)) + stats::update(formula(formula, lhs = 0L, rhs = 1L), f2)) } ## call model.frame() mf$formula <- formula @@ -190,7 +190,7 @@ msmm <- function(formula, instruments, data, subset, na.action, mt <- stats::terms(formula, data = data) mtX <- stats::terms(formula, data = data, rhs = 1) X <- stats::model.matrix(mtX, mf, contrasts) - if(length(formula)[2] < 2L) { + if (length(formula)[2] < 2L) { mtZ <- NULL Z <- NULL } else { @@ -234,13 +234,13 @@ msmm <- function(formula, instruments, data, subset, na.action, stop("With tsls and tslsalt, only 1 exposure variable is allowed.") if (estmethod == "gmm") - output = msmm_gmm(x = X[,-1], y = Y, z = Z[,-1], xnames = xnames, t0 = t0) + output <- msmm_gmm(x = X[, -1], y = Y, z = Z[,-1], xnames = xnames, t0 = t0) if (estmethod == "gmmalt") - output = msmm_gmm_alt(x = X[,-1], y = Y, z = Z[,-1], xnames = xnames, t0 = t0) + output <- msmm_gmm_alt(x = X[, -1], y = Y, z = Z[,-1], xnames = xnames, t0 = t0) if (estmethod == "tsls") - output = msmm_tsls(x = X[,-1], y = Y, z = Z[,-1]) + output <- msmm_tsls(x = X[, -1], y = Y, z = Z[,-1]) if (estmethod == "tslsalt") - output = msmm_tsls_alt(x = X[,-1], y = Y, z = Z[,-1]) + output <- msmm_tsls_alt(x = X[, -1], y = Y, z = Z[,-1]) class(output) <- append("msmm", class(output)) output @@ -268,10 +268,10 @@ msmm_tsls <- function(x, y, z) { logcrrse <- msm::deltamethod(~ log(-1 / x2), beta, estvar) # crr with 95% CI - crrci <- unname(c(-1/beta[2], exp(logcrr - 1.96*logcrrse), exp(logcrr + 1.96*logcrrse))) + crrci <- unname(c(-1 / beta[2], exp(logcrr - 1.96 * logcrrse), exp(logcrr + 1.96 * logcrrse))) # baseline risk - ey0ci <- cbind(stats::coef(fit), stats::confint(fit))[1,] + ey0ci <- cbind(stats::coef(fit), stats::confint(fit))[1, ] # list of results to return reslist <- list(stage1 = stage1, @@ -304,7 +304,7 @@ msmm_tsls_alt <- function(x, y, z) { logcrrse <- msm::deltamethod(~ log(-1 * x2), beta, estvar) # crr with 95% CI - crrci <- unname(c(-1*beta[2], exp(logcrr - 1.96*logcrrse), exp(logcrr + 1.96*logcrrse))) + crrci <- unname(c(-1 * beta[2], exp(logcrr - 1.96 * logcrrse), exp(logcrr + 1.96 * logcrrse))) # list of results to return reslist <- list(stage1 = stage1, @@ -314,14 +314,14 @@ msmm_tsls_alt <- function(x, y, z) { return(reslist) } -msmmMoments <- function(theta, x){ +msmmMoments <- function(theta, x) { # extract variables from x - Y <- as.matrix(x[,"y"]) + Y <- as.matrix(x[, "y"]) xcolstop <- length(theta) - X <- as.matrix(x[,2:xcolstop]) + X <- as.matrix(x[, 2:xcolstop]) zcolstart <- 1 + length(theta) # 1 is y, length(theta) is nX zcolstop <- ncol(x) - Z <- as.matrix(x[,zcolstart:zcolstop]) + Z <- as.matrix(x[, zcolstart:zcolstop]) nZ <- zcolstop - zcolstart + 1 nZp1 <- nZ + 1 @@ -329,15 +329,15 @@ msmmMoments <- function(theta, x){ # moments moments <- matrix(nrow = nrow(x), ncol = nZp1, NA) - moments[,1] <- (Y*exp(linearpredictor) - theta[1]) + moments[, 1] <- (Y*exp(linearpredictor) - theta[1]) for (i in 1:nZ) { j <- i + 1 - moments[,j] <- (Y*exp(linearpredictor) - theta[1])*Z[,i] + moments[, j] <- (Y*exp(linearpredictor) - theta[1])*Z[, i] } return(moments) } -msmm_gmm <- function(x, y, z, xnames, t0){ +msmm_gmm <- function(x, y, z, xnames, t0) { x <- as.matrix(x) dat = data.frame(y, x, z) diff --git a/R/tsps.R b/R/tsps.R index 441c7d4..6d7e72b 100644 --- a/R/tsps.R +++ b/R/tsps.R @@ -328,8 +328,7 @@ tsps <- function(formula, instruments, data, subset, na.action, if (tsps_env$anycovs) { stage2linpred <- as.matrix(cbind(linearpredictor, covariates)) - } - else { + } else { stage2linpred <- linearpredictor } @@ -387,8 +386,7 @@ tsps <- function(formula, instruments, data, subset, na.action, if (tsps_env$anycovs) { stage2linpred <- as.matrix(cbind(linearpredictor, covariates)) - } - else { + } else { stage2linpred <- linearpredictor } @@ -405,7 +403,7 @@ tsps <- function(formula, instruments, data, subset, na.action, return(moments) } - tspsLogitMoments <- function(theta, x){ + tspsLogitMoments <- function(theta, x) { # extract variables from x Y <- as.matrix(x[,"y"]) X <- x[, tsps_env$xnames] diff --git a/R/tsri.R b/R/tsri.R index fdf76de..5fe389c 100644 --- a/R/tsri.R +++ b/R/tsri.R @@ -98,21 +98,21 @@ tsri <- function(formula, instruments, data, subset, na.action, mf <- mf[c(1, m)] mf$drop.unused.levels <- TRUE ## handle instruments for backward compatibility - if(!missing(instruments)) { + if (!missing(instruments)) { formula <- Formula::as.Formula(formula, instruments) cl$instruments <- NULL cl$formula <- formula(formula) } else { formula <- Formula::as.Formula(formula) } - if(length(formula)[2L] == 3L) formula <- Formula::as.Formula( + if (length(formula)[2L] == 3L) formula <- Formula::as.Formula( formula(formula, rhs = c(2L, 1L), collapse = TRUE), formula(formula, lhs = 0L, rhs = c(3L, 1L), collapse = TRUE) ) stopifnot(length(formula)[1L] == 1L, length(formula)[2L] %in% 1L:2L) ## try to handle dots in formula has_dot <- function(formula) inherits(try(stats::terms(formula), silent = TRUE), "try-error") - if(has_dot(formula)) { + if (has_dot(formula)) { f1 <- formula(formula, rhs = 1L) f2 <- formula(formula, lhs = 0L, rhs = 2L) if (!has_dot(f1) && has_dot(f2)) formula <- Formula::as.Formula(f1, @@ -175,18 +175,15 @@ tsri <- function(formula, instruments, data, subset, na.action, } if (link == "identity") { stage2 <- stats::lm(Y ~ X[,2] + res) - } - else if (link == "logadd") { + } else if (link == "logadd") { stage2 <- stats::glm(Y ~ X[,2] + res, family = stats::poisson(link = "log")) - } - else if (link == "logmult") { + } else if (link == "logmult") { Ystar <- Y Ystar[Y == 0] <- 0.001 - stage2 <- stats::glm(Ystar ~ X[,2] + res, family = stats::Gamma(link = "log"), + stage2 <- stats::glm(Ystar ~ X[, 2] + res, family = stats::Gamma(link = "log"), control = list(maxit = 1E5)) - } - else if (link == "logit") { - stage2 <- stats::glm(Y ~ X[,2] + res, family = stats::binomial(link = "logit")) + } else if (link == "logit") { + stage2 <- stats::glm(Y ~ X[, 2] + res, family = stats::binomial(link = "logit")) } t0 <- c(t0, stats::coef(stage2)) @@ -216,7 +213,7 @@ tsri <- function(formula, instruments, data, subset, na.action, x <- x[,!(colnames(x) %in% tsri_env$covariatenames), drop = FALSE] } - dat = data.frame(y, x, z) + dat <- data.frame(y, x, z) if (is.null(t0)) t0 <- rep(0, ncol(x) + 1) @@ -224,15 +221,12 @@ tsri <- function(formula, instruments, data, subset, na.action, # gmm fit if (link == "identity") { fit <- gmm::gmm(tsriIdentityMoments, x = dat, t0 = t0, vcov = "iid") - } - else if (link == "logadd") { + } else if (link == "logadd") { fit <- gmm::gmm(tsriLogaddMoments, x = dat, t0 = t0, vcov = "iid") - } - else if (link == "logmult") { + } else if (link == "logmult") { fit <- gmm::gmm(tsriLogmultMoments, x = dat, t0 = t0, vcov = "iid", itermax = 1E7) - } - else if (link == "logit") { + } else if (link == "logit") { fit <- gmm::gmm(tsriLogitMoments, x = dat, t0 = t0, vcov = "iid") } diff --git a/vignettes/compare-smm-fits.Rmd b/vignettes/compare-smm-fits.Rmd index 8d6377a..1b6f632 100644 --- a/vignettes/compare-smm-fits.Rmd +++ b/vignettes/compare-smm-fits.Rmd @@ -28,9 +28,9 @@ n <- 5000 psi0 <- 0.5 psi1 <- 0.2 Z <- rbinom(n, 1, 0.5) -X <- rbinom(n, 1, 0.7*Z + 0.2*(1 - Z)) +X <- rbinom(n, 1, 0.7*Z + 0.2*(1 - Z)) m0 <- plogis(1 + 0.8*X - 0.39*Z) -Y <- rbinom(n, 1, plogis(psi0*X + log(m0/(1 - m0)))) +Y <- rbinom(n, 1, plogis(psi0*X + log(m0/(1 - m0)))) dat <- data.frame(Z, X, Y) ``` diff --git a/vignettes/f-statistic-comparison.Rmd b/vignettes/f-statistic-comparison.Rmd index dc12e17..9756b41 100644 --- a/vignettes/f-statistic-comparison.Rmd +++ b/vignettes/f-statistic-comparison.Rmd @@ -39,12 +39,11 @@ fsw(mod) ## Comparison with F-statistic from lfe package ```{r} -modst2 <- felm(lwage ~ 1 | 0 | (educ | exper ~ age + kidslt6 + kidsge6), - data = dat) +modst2 <- felm(lwage ~ 1 | + 0 | (educ | exper ~ age + kidslt6 + kidsge6), data = dat) summary(modst2) -t(sapply(modst2$stage1$lhs, - function(lh) waldtest(modst2$stage1, - ~ age | kidslt6 | kidsge6, lhs = lh))) +t(sapply(modst2$stage1$lhs, function(lh) + waldtest(modst2$stage1, ~ age | kidslt6 | kidsge6, lhs = lh))) condfstat(modst2, quantiles = c(0.025, 0.975)) ```