## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(dpi = 72, collapse = TRUE, comment = "#>") # Penalized fits need glmnet (frequentist) / shrinkem (Bayesian), both declared # in Suggests. If a backend is unavailable - e.g. a CRAN check run with # _R_CHECK_FORCE_SUGGESTS_=false - the relevant chunks render code-only instead # of erroring the vignette build. has_glmnet <- requireNamespace("glmnet", quietly = TRUE) has_shrinkem <- requireNamespace("shrinkem", quietly = TRUE) ## ----load--------------------------------------------------------------------- library(remverse) ## ----data--------------------------------------------------------------------- data(randomREH3) data(info3) reh <- remify(edgelist = randomREH3, model = "tie", directed = TRUE) ## ----kitchen-sink------------------------------------------------------------- effects_rich <- ~ inertia(scaling = "std") + reciprocity(scaling = "std") + indegreeSender(scaling = "std") + indegreeReceiver(scaling = "std") + outdegreeSender(scaling = "std") + outdegreeReceiver(scaling = "std") + totaldegreeDyad(scaling = "std") + isp(scaling = "std") + osp(scaling = "std") + itp(scaling = "std") + otp(scaling = "std") + send("age", attr_actors = info3, scaling = "std") + receive("age", attr_actors = info3, scaling = "std") + difference("age", attr_actors = info3, scaling = "std") stats_rich <- remstats(reh = reh, tie_effects = effects_rich, first = 500, memory = "decay", memory_value = 2000) dimnames(stats_rich)[[3]] ## ----mle-rich----------------------------------------------------------------- fit_mle <- remstimate(reh = reh, stats = stats_rich) summary(fit_mle) ## ----shrinkem, message=FALSE, eval=has_shrinkem------------------------------- fit_bayes <- rempenalty(reh = reh, stats = stats_rich, approach = "Bayesian") summary(fit_bayes) round(coef(fit_bayes), 3) ## ----glmnet-default, message=FALSE, eval=has_glmnet--------------------------- fit_glmnet <- rempenalty(reh = reh, stats = stats_rich, approach = "frequentist") summary(fit_glmnet) coef(fit_glmnet) ## ----compare-coefs, eval=has_glmnet------------------------------------------- coefs_mle <- coef(fit_mle) coefs_bayes <- coef(fit_bayes) coefs_glmnet <- coef(fit_glmnet) shared <- intersect(intersect(names(coefs_mle), names(coefs_glmnet)), names(coefs_bayes)) comparison <- data.frame( statistic = shared, MLE = round(coefs_mle[shared], 3), BAYES = round(coefs_bayes[shared], 3), GLMNET = round(coefs_glmnet[shared], 3), row.names = NULL ) comparison ## ----alpha, message=FALSE, eval=has_glmnet------------------------------------ # Pure lasso (default): maximum sparsity fit_lasso <- rempenalty(reh, stats_rich, approach = "frequentist", alpha = 1) # Pure ridge: shrinkage without variable selection fit_ridge <- rempenalty(reh, stats_rich, approach = "frequentist", alpha = 0) cat("Lasso non-zero:", sum(coef(fit_lasso) != 0), "of", length(coef(fit_lasso)), "\n") cat("Ridge non-zero:", sum(coef(fit_ridge) != 0), "of", length(coef(fit_ridge)), "\n") ## ----lambda, message=FALSE, eval=has_glmnet----------------------------------- fit_min <- rempenalty(reh, stats_rich, approach = "frequentist", lambda_select = "min") cat("lambda.1se non-zero:", sum(coef(fit_glmnet) != 0), "\n") cat("lambda.min non-zero:", sum(coef(fit_min) != 0), "\n") ## ----diagnostics, out.width="50%", dev=c("jpeg"), dev.args = list(bg = "white"), eval=has_glmnet---- diag_mle <- diagnostics(fit_mle, reh, stats_rich) diag_bayes <- diagnostics(fit_bayes, reh, stats_rich) diag_glmnet <- diagnostics(fit_glmnet, reh, stats_rich) cat("MLE recall: ", round(diag_mle$recall$summary$mean_rel_rank, 3), "\n") cat("BAYES recall: ", round(diag_bayes$recall$summary$mean_rel_rank, 3), "\n") cat("GLMNET recall: ", round(diag_glmnet$recall$summary$mean_rel_rank, 3), "\n") plot(diag_mle) plot(diag_bayes) plot(diag_glmnet) ## ----show-comparison, eval=has_glmnet----------------------------------------- comparison