Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
svyglm() support #17
  • Loading branch information
ewenharrison committed Apr 3, 2019
1 parent 779ae49 commit 5794f3e
Show file tree
Hide file tree
Showing 14 changed files with 380 additions and 10 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
Expand Up @@ -46,5 +46,6 @@ Suggests:
rlang,
rmarkdown,
covr,
survey,
testthat
VignetteBuilder: knitr
3 changes: 3 additions & 0 deletions NAMESPACE
Expand Up @@ -22,6 +22,7 @@ S3method(fit2df,glmlist)
S3method(fit2df,lm)
S3method(fit2df,lmerMod)
S3method(fit2df,lmlist)
S3method(fit2df,svyglmlist)
export("%<>%")
export("%>%")
export(boot_compare)
Expand Down Expand Up @@ -86,6 +87,8 @@ export(rm_duplicate_labels)
export(round_tidy)
export(summary_factorlist)
export(surv_plot)
export(svyglmmulti)
export(svyglmuni)
export(variable_type)
import(Hmisc)
import(ggplot2)
Expand Down
4 changes: 2 additions & 2 deletions R/finalfit_internal_functions.R
Expand Up @@ -355,8 +355,8 @@ format_n_percent = function(n, percent) {
# quo() enquo() !! all a bit of a nightmare
# So let's square bracket away!
remove_intercept = function(.data, intercept_name = "(Intercept)"){
.data = .data[-which(.data[,1] == intercept_name),]
return(.data)
.data %>%
dplyr::filter_at(.vars = 1, dplyr::any_vars(. != intercept_name))
}

#' Remove duplicate levels within \code{\link{summary_factorlist}}: \code{finalfit} helper function
Expand Down
52 changes: 52 additions & 0 deletions R/fit2df.R
Expand Up @@ -348,6 +348,58 @@ fit2df.glmlist <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept
}
}


#' Extract \code{svyglmuni} and \code{svyglmmulti} model fit results to dataframe: \code{finalfit} model extracters
#'
#' \code{fit2df.svyglmlist} is the model extract method for \code{svyglmuni} and \code{svyglmmulti}.
#'
#' @rdname fit2df
#' @method fit2df svyglmlist
#' @export

fit2df.svyglmlist <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
explanatory_name = "explanatory",
estimate_name = "Coefficient",
estimate_suffix = "",
p_name = "p",
digits=c(2,2,3),
exp = FALSE,
confint_type = "profile",
confint_level = 0.95,
confint_sep = "-", ...){

if (metrics==TRUE && length(.data)>1){
stop("Metrics only generated for single models: multiple models supplied to function")
}

df.out = .data %>%
purrr::map_dfr(extract_fit, explanatory_name = explanatory_name,
estimate_name = estimate_name, estimate_suffix = estimate_suffix,
p_name = p_name, exp = exp,
confint_type = confint_type,
confint_level = confint_level,
digits=digits)

if (condense==TRUE){
df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
estimate_name=estimate_name, estimate_suffix=estimate_suffix,
p_name=p_name, digits=digits, confint_sep=confint_sep)
}

if (remove_intercept==TRUE){
df.out = remove_intercept(df.out)
}

# Extract model metrics
if (metrics==TRUE){
metrics.out = ff_metrics(.data)
return(list(df.out, metrics.out))
} else {
return(df.out)
}
}


#' Extract \code{lmerMod} model fit results to dataframe: \code{finalfit} model
#' extracters
#'
Expand Down
4 changes: 2 additions & 2 deletions R/glmmulti.R
Expand Up @@ -16,7 +16,7 @@
#' @param explanatory Character vector of any length: name(s) of explanatory
#' variables.
#' @param family Character vector quoted or unquoted of the error distribution
#' and link function to be used in the model, seem \code{\link[stats]{glm}}.
#' and link function to be used in the model, see \code{\link[stats]{glm}}.
#' @param ... Other arguments to pass to \code{\link[stats]{glm}}.
#' @return A list of multivariable \code{\link[stats]{glm}} fitted model
#' outputs. Output is of class \code{glmlist}.
Expand All @@ -39,7 +39,7 @@ glmmulti <- function(.data, dependent, explanatory, family = "binomial", ...){
result = list()
for (i in 1:length(dependent)){
result[[i]] = ff_eval(
glm(paste(dependent[i], "~", paste(explanatory, collapse="+")),
glm(ff_formula(dependent[i], explanatory),
data = .data, family = family, ...)
)
}
Expand Down
4 changes: 2 additions & 2 deletions R/glmuni.R
Expand Up @@ -10,7 +10,7 @@
#' @param dependent Character vector of length 1: name of depdendent variable (must have 2 levels).
#' @param explanatory Character vector of any length: name(s) of explanatory variables.
#' @param family Character vector quoted or unquoted of the error distribution
#' and link function to be used in the model, seem \code{\link[stats]{glm}}.
#' and link function to be used in the model, see \code{\link[stats]{glm}}.
#' @param ... Other arguments to pass to \code{\link[stats]{glm}}.
#' @return A list of univariable \code{\link[stats]{glm}} fitted model outputs.
#' Output is of class \code{glmlist}.
Expand All @@ -34,7 +34,7 @@ glmuni <- function(.data, dependent, explanatory, family = "binomial", ...){
result <- list()
for (i in 1:length(explanatory)){
result[[i]] <- ff_eval(
glm(paste(dependent, "~", explanatory[i]), data = .data, family = family, ...)
glm(ff_formula(dependent, explanatory[i]), data = .data, family = family, ...)
)
}
class(result) = "glmlist"
Expand Down
2 changes: 1 addition & 1 deletion R/lmmulti.R
Expand Up @@ -34,7 +34,7 @@ lmmulti <- function(.data, dependent, explanatory, ...){
result = list()
for (i in 1:length(dependent)){
result[[i]] = ff_eval(
lm(paste(dependent[i], "~", paste(explanatory, collapse="+")), data = .data, ...)
lm(ff_formula(dependent[i], explanatory), data = .data, ...)
)
}
result = setNames(result, dependent)
Expand Down
2 changes: 1 addition & 1 deletion R/lmuni.R
Expand Up @@ -32,7 +32,7 @@ lmuni <- function(.data, dependent, explanatory, ...){
result <- list()
for (i in 1:length(explanatory)){
result[[i]] <- ff_eval(
lm(paste(dependent, "~", explanatory[i]), data = .data, ...)
lm(ff_formula(dependent, explanatory[i]), data = .data, ...)
)
}
class(result) = "lmlist"
Expand Down
152 changes: 152 additions & 0 deletions R/svyglm.R
@@ -0,0 +1,152 @@
#' Univariable survey-weighted generalised linear models
#'
#' Wrapper for \code{\link[survey]{svyglm}}. Fit a generalised linear model to
#' data from a complex survey design, with inverse-probability weighting and
#' design-based standard errors.
#'
#' @param design Survey design.
#' @param dependent Character vector of length 1: name of depdendent variable
#' (must have 2 levels).
#' @param explanatory Character vector of any length: name(s) of explanatory
#' variables.
#' @param ... Other arguments to be passed to \code{\link[survey]{svyglm}}.
#'
#' @return A list of univariable fitted model outputs. Output is of class
#' \code{svyglmlist}.
#' @export
#'
#' @examples
#' # Examples taken from survey::svyglm() help page.
#'
#' library(survey)
#' library(dplyr)
#' data(api)
#' dependent = "api00"
#' explanatory = c("ell", "meals", "mobility")
#'
#' # Stratified design
#' dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc)
#'
#' # Linear example
#' ## Note respects svgglm default settings, family=stats::gaussian()
#' apistrat %>%
#' summary_factorlist(dependent, explanatory, fit_id = TRUE) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmuni(dependent, explanatory) %>%
#' fit2df(estimate_suffix = " (univariable)")
#' ) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmmulti(dependent, explanatory) %>%
#' fit2df(estimate_suffix = " (multivariable)")
#' ) %>%
#' select(-fit_id, -index) %>%
#' dependent_label(apistrat, dependent)
#'
#' # Binomial example
#' ## Require to specify family = "quasibinomial" and (if desired)
#' ## to exponentiate result and name it Odds ratio
#'
#' dependent = "sch.wide"
#'
#' apistrat %>%
#' summary_factorlist(dependent, explanatory, fit_id = TRUE) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmuni(dependent, explanatory, family = "quasibinomial") %>%
#' fit2df(exp = TRUE, estimate_name = "OR", estimate_suffix = " (univariable)")
#' ) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmmulti(dependent, explanatory, family = "quasibinomial") %>%
#' fit2df(exp = TRUE, estimate_name = "OR", estimate_suffix = " (multivariable)")
#' ) %>%
#' select(-fit_id, -index) %>%
#' dependent_label(apistrat, dependent)
svyglmuni <- function(design, dependent, explanatory, ...){
result <- list()
for (i in 1:length(explanatory)){
result[[i]] <- ff_eval(
survey::svyglm(ff_formula(dependent, explanatory[i]), design = design, ...)
)
}
class(result) = c("svyglmlist", "glmlist")
return(result)
}


#' Multivariable survey-weighted generalised linear models
#'
#' Wrapper for \code{\link[survey]{svyglm}}. Fit a generalised linear model to
#' data from a complex survey design, with inverse-probability weighting and
#' design-based standard errors.
#'
#' @param design Survey design.
#' @param dependent Character vector of length 1: name of depdendent variable
#' (must have 2 levels).
#' @param explanatory Character vector of any length: name(s) of explanatory
#' variables.
#' @param ... Other arguments to be passed to \code{\link[survey]{svyglm}}.
#'
#' @return A list of univariable fitted model outputs. Output is of class
#' \code{svyglmlist}.
#' @export
#'
#' @examples
#' # Examples taken from survey::svyglm() help page.
#'
#' library(survey)
#' library(dplyr)
#'
#' data(api)
#' dependent = "api00"
#' explanatory = c("ell", "meals", "mobility")
#'
#' # Stratified design
#' dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc)
#'
#' # Linear example
#' apistrat %>%
#' summary_factorlist(dependent, explanatory, fit_id = TRUE) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmuni(dependent, explanatory) %>%
#' fit2df(estimate_suffix = " (univariable)")
#' ) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmmulti(dependent, explanatory) %>%
#' fit2df(estimate_suffix = " (multivariable)")
#' ) %>%
#' select(-fit_id, -index) %>%
#' dependent_label(apistrat, dependent)
#'
#' # Binomial example
#' dependent = "sch.wide"
#'
#' apistrat %>%
#' summary_factorlist(dependent, explanatory, fit_id = TRUE) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmuni(dependent, explanatory, family = "quasibinomial") %>%
#' fit2df(exp = TRUE, estimate_name = "OR", estimate_suffix = " (univariable)")
#' ) %>%
#' ff_merge(
#' dstrat %>%
#' svyglmmulti(dependent, explanatory, family = "quasibinomial") %>%
#' fit2df(exp = TRUE, estimate_name = "OR", estimate_suffix = " (multivariable)")
#' ) %>%
#' select(-fit_id, -index) %>%
#' dependent_label(apistrat, dependent)
svyglmmulti <- function(design, dependent, explanatory, ...){
result = list()
for (i in 1:length(dependent)){
result[[i]] = ff_eval(
survey::svyglm(ff_formula(dependent[i], explanatory), design = design, ...)
)
}
result = setNames(result, dependent)
class(result) = c("svyglmlist", "glmlist")
return(result)
}
9 changes: 9 additions & 0 deletions man/fit2df.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/glmmulti.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/glmuni.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 5794f3e

Please sign in to comment.