R/f_functions_v1.R

In GitHunter0/Futilities2: Various Helper Functions

### Helper Functions ----

# packages to import: c('knitr','huxtable','estimatr', 'tidyverse')
# if (FALSE) librarian::shelf(knitr, huxtable, estimatr, tidyverse)

##
#' @title Create and dislay Tables from Regressions Output object
#' @description FUNCTION_DESCRIPTION
#' @param tab PARAM_DESCRIPTION
#' @param title PARAM_DESCRIPTION, Default: NA
#' @param pane PARAM_DESCRIPTION, Default: 'viewer'
#' @return OUTPUT_DESCRIPTION
#' @details DETAILS
#' @examples
#' \dontrun{
#' if(interactive()){
#'  #EXAMPLE1
#'  }
#' }
#' @seealso
#'  \code{\link[broom]{reexports}}
#'  \code{\link[huxtable]{huxtable}},\code{\link[huxtable]{align}},\code{\link[huxtable]{position}},\code{\link[huxtable]{themes}},\code{\link[huxtable]{caption}},\code{\link[huxtable]{quick-output}}
#'  \code{\link[fs]{path}}
#'  \code{\link[utils]{browseURL}}
#'  \code{\link[knitr]{is_latex_output}}
#'  \code{\link[rstudioapi]{isAvailable}},\code{\link[rstudioapi]{viewer}}
#' @rdname myhux
#' @export
#' @importFrom broom glance augment tidy
#' @importFrom huxtable hux set_align set_position theme_article set_caption quick_html
#' @importFrom fs path
#' @importFrom utils browseURL
#' @importFrom knitr is_html_output is_latex_output
#' @importFrom rstudioapi isAvailable viewer
myhux <- function(tab, title=NA, pane='viewer'){
	# HuxTable Dataframe of Statistics (R2, Sigma, AIC, BIC, N.obs., LogLik, ...)
  stats_ht <- broom::glance(tab) %>% huxtable::hux()
  # Dataframe with residuals
  resids_ht <- tryCatch(broom::augment(tab), error = function(e) e)
	# HuxTable Dataframe of the Coefficients
  coefs_ht <-
	  tab %>% broom::tidy() %>% huxtable::hux() %>%
		# huxtable::add_colnames()  %>%
	  # Horizontal Alignment
		huxtable::set_align('center') %>%
		# Page Alignment
		huxtable::set_position('center') %>%
		# Layout Theme
	  huxtable::theme_article() # theme_blue() %>%
	# set_width() is important to control alignment and line breaks in PDF Output
  # huxtable::set_width(0.73)
	#
	if(!is.na(title)){
		coefs_ht <- huxtable::set_caption(coefs_ht, title)
		stats_ht <- huxtable::set_caption(stats_ht, title)
	}
	#
	# Save tables in TEMPORARY Html files, since it is the only way to force the
	# html to be to opened in RStudio Viewer.
	dir <- tempdir()
	#
	stats_html <- fs::path(dir, "stats.html")
	huxtable::quick_html(stats_ht, file=stats_html)
	#
	coefs_html <- fs::path(dir, "coefs.html")
	huxtable::quick_html(coefs_ht, file=coefs_html)
	#
	if(pane=='browser'){
		# Open file in the browser
		# shell.exec('ht_temp.html')
		if (interactive()) {
		  utils::browseURL(stats_html)
		  utils::browseURL(coefs_html)
		}
	#
	} else if(pane=='viewer' &
     # rstudioapi::...() generates error when rendering files with knitr
     # so we have to not run this type of function in this context
     knitr::is_html_output()==FALSE &
     knitr::is_latex_output()==FALSE
	){
		# Open file in RStudio Viewer
		if (interactive() & rstudioapi::isAvailable()) {
		  rstudioapi::viewer(stats_html)
		  Sys.sleep(5)
		  rstudioapi::viewer(coefs_html)
		}
	}
	#
	return(list('coefs' = coefs_ht, 'resids' = resids_ht, 'stats' = stats_ht))
}
## Applications
#
# # Linear Regression
# Futilities2::myhux(lm(cars[,1]~cars[,2]), title='Linear Regression Table')
#
# # Robust SE Regression with estimatr package
# Futilities2::myhux(estimatr::lm_robust(cars[,1]~cars[,2]), pane='browser')


##
#' @title Create New Variable in "mtcars" dataset
#' @description Create a new variable for "mtcars" dataset. Just a test function
#' @param x Numeric vector
#' @return OUTPUT_DESCRIPTION
#' @details Details of the function
#' @examples
#' \dontrun{
#' if(interactive()){
#'  #EXAMPLE1
#'  }
#' }
#' @seealso
#'  \code{\link[utils]{data}}
#'  \code{\link[dplyr]{mutate}}
#' @rdname myfun1
#' @export
#' @importFrom utils data
#' @importFrom dplyr mutate
myfun1 <- function(x){
  utils::data(mtcars)
  data <- mtcars %>% dplyr::mutate("var" = cyl*x)
  return(data)
}


#' @title Calculate Mean and Statistical Mode
#' @description FUNCTION_DESCRIPTION
#' @param x PARAM_DESCRIPTION
#' @return OUTPUT_DESCRIPTION
#' @details DETAILS
#' @examples
#' \dontrun{
#' if(interactive()){
#'  #EXAMPLE1
#'  }
#' }
#' @seealso
#'  \code{\link[DescTools]{Median}}
#' @rdname myfun2
#' @export
#' @importFrom DescTools Median
myfun2 <- function(x){
  stats_output <- list("mode" = DescTools::Mode(x, na.rm=TRUE),
                       "mean"= mean(x, na.rm=TRUE))
  return(stats_output)
}




#' @title dplyr function passing arguments without quotes and other data tests
#' @description A test of function using dplyr passing arguments without quotes
#' and other package data tests. \cr
#' Let's see if that added a line break here.
#' @param group_var PARAM_DESCRIPTION
#' @param var PARAM_DESCRIPTION
#' @param new_var PARAM_DESCRIPTION
#' @return OUTPUT_DESCRIPTION
#' @details DETAILS
#' @examples
#' \dontrun{
#' if(interactive()){
#'  #EXAMPLE1
#'  }
#' }
#' @seealso
#'  \code{\link[dplyr]{all_equal}},\code{\link[dplyr]{group_by}},\code{\link[dplyr]{summarise}},\code{\link[dplyr]{context}},\code{\link[dplyr]{mutate}}
#'  \code{\link[Futilities2]{external_dataset1}},\code{\link[Futilities2]{external_dataset2}}
#' @rdname myfun3
#' @export
#' @importFrom dplyr all_equal group_by summarise n mutate
myfun3 <- function(group_var, var, new_var){
  # Compare Internal datasets
  print(paste("compare internal data:",
              dplyr::all_equal(internal_dataset1, internal_dataset2)))
  # Compare External datasets
  print(paste("compare external data:",
              dplyr::all_equal(Futilities2::external_dataset1,
                               Futilities2::external_dataset2)))
  #
  internal_dataset1 %>%
  dplyr::group_by({{group_var}}) %>%
  dplyr::summarise(mean = mean({{var}}), n = dplyr::n()) %>%
  dplyr::mutate({{new_var}} := {{group_var}}*100)
}
# Futilities2::myfun3(cyl, disp, cyl100)