resolved merge conflicts

.Rbuildignore

@@ -1,3 +1,4 @@
+^Meta$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^README\.Rmd$

.gitignore

@@ -1,3 +1,4 @@
+Meta
 .Rproj.user
 .Rhistory
 .RData
@@ -7,5 +8,8 @@ README.Rmd
 # Ignore data files
 /archive
 /data-raw
+<<<<<<< HEAD
 inst/doc
 inst/rmarkdown/templates/docx_letter
+=======
+>>>>>>> 5f675318c758311140ae387150324351c1da0776

DESCRIPTION

@@ -1,12 +1,11 @@
 Package: biometrics
 Title: Report Templates for the Telethon Kids Institute
-Version: 1.0.3
-Authors@R: c(
-    person("Paul", "Stevenson",
-      email = "Paul.Stevenson@telethonkids.org.au", role = c("aut", "cre")),
-    person("Matt", "Cooper",
-      email = "Matt.Cooper@telethonkids.org.au", role = "aut"))
-Date: 2019-01-24
+Version: 1.0.3.999
+Authors@R: c(person("Paul", "Stevenson",
+    email = "Paul.Stevenson@telethonkids.org.au", role = c("aut", "cre")),
+    person("Matthew", "Cooper",
+    email = "Matt.Cooper@telethonkids.org.au", role = c("aut")))
+Date: 2019-02-08
 Description: A pair of templates have been created that incorporate styling
     themes present throughout the Telethon Kids Institute style guide, web page
     and template documents. Currently, templates are available to produce

NAMESPACE

@@ -1,8 +1,8 @@
 # Generated by roxygen2: do not edit by hand
-
-export(abbreviator)
+export(format_model)
 export(group_interval)
-export(recoder)
+export(meansd)
+export(nPer)
 export(roll_up)
 export(round_df)
 export(scale_color_telethonkids)
@@ -17,6 +17,13 @@ import(data.table)
 import(dplyr)
 import(ggplot2)
 import(tibble)
+import(tidyr)
+importFrom(broom,tidy)
+importFrom(data.table,shift)
+importFrom(dplyr,left_join)
+importFrom(dplyr,mutate)
+importFrom(dplyr,mutate_at)
+importFrom(dplyr,select)
 importFrom(grDevices,colorRampPalette)
 importFrom(igraph,components)
 importFrom(igraph,graph_from_data_frame)

R/data.R

@@ -1,11 +1,23 @@
+#' @title Excel column reference map
+#' @description A data table of alpha/numeric key/value pairs, where key is the
+#' letter sequence of the excel column. Range of letter sequence is A - ZZZ.
+#' Usage: excel_ref["ABC"]$numbers that return the column number of that letter
+#' sequence.
+#' @format A data table with 18278 rows and 2 columns:
+#' \describe{
+#'   \item{\code{letters}}{character Excel column reference letters}
+#'   \item{\code{numbers}}{integer corresponding column number}
+#' }
+"excel_ref"
+
 #' @title ICD-10 hash table
 #' @description A data.table that maps ICD-10 classification code to the disease
 #'   name, disease category, parent category and disease group. Codes were
 #'   sourced from GNU Health (downloaded June-2018).
 #'
 #' @format A data frame with 6820 rows and 5 variables:
 #' \describe{
-#'   \item{\code{id}}{(character key ICD-10 codes WITHOUT decimal points}
+#'   \item{\code{id}}{character key ICD-10 codes WITHOUT decimal points}
 #'   \item{\code{name}}{character disease name}
 #'   \item{\code{disease_category}}{character disease category}
 #'   \item{\code{parent_category}}{character parent disease category}

R/format_model.R

@@ -0,0 +1,35 @@
+#' Format a model for quick in-text referencing
+#'
+#' This function builds on `broom::tidy()` by adding formatted strings ready for use in text.
+#'
+#' @param x a model object
+#' @param effects (default NULL) a tidy effects option e.g. "fixed", "random"
+#' @param conf.level (default 0.95) the reported confidence interval of model estimates
+#' @param dp (default 2) the number of decimal points reported in returned strings
+#'
+#' @return a tibble with default `tidy()` parameters plus `conf.low`, `conf.high`, `text1`, and `text2`
+#'
+#' @importFrom broom tidy
+#' @importFrom dplyr mutate select left_join
+#'
+#' @examples
+#' \dontrun{
+#' data(iris)
+#' m1 <- lm(Sepal.Length ~ Sepal.Width, data = iris)
+#'
+#' format_model(m1) %>% select(term, estimate, conf.low, conf.high)
+#'
+#' format_model(m1)$text1
+#' format_model(m1)$text2
+#' }
+#'
+#' @export
+format_model <- function(x, effects = NULL, conf.level = 0.95, dp = 2) {
+  a <- broom::tidy(x, effects = effects, conf.int = T, conf.level = conf.level)
+  b <- a %>%
+    round_df(dp) %>%
+    dplyr::mutate(text1 = paste0(estimate, " (", 100 * conf.level, "% CI: ", conf.low, " to ", conf.high, ")"),
+                  text2 = paste0("(", estimate, "; , ", 100 * conf.level, "% CI: ", conf.low, " to ", conf.high, ")")) %>%
+    dplyr::select(term, text1, text2)
+  dplyr::left_join(a, b, by = "term")
+}

R/meansd.R

@@ -0,0 +1,11 @@
+#' @export
+
+meansd <- function(x, dpp=2, dps=2){
+  if(any(class(x)!="numeric" | class(x)!="interger")) {} else{print("Check you format")}
+  x <- as.numeric(x)
+  paste0(sprintf(paste0("%.",dpp,"f"), mean(x, na.rm=T)),
+         " (",
+         sprintf(paste0("%.",dps,"f"), sd(x, na.rm=T)),
+         ")"
+  )
+}

R/nPer.R

@@ -0,0 +1,22 @@
+#' @title printing N and percentage
+#'
+#' @export
+
+nPer <- function(vec, intGroup, dp = 1){
+  paste0(sum(vec == intGroup, na.rm=T),
+         " (",
+         sprintf(paste0("%.", dp, "f"), sum(vec == intGroup, na.rm = T) / sum(!is.na(vec)) * 100),
+         "%)"
+  )
+}
+
+# nPer4 <- function(vec, intGroup, dp = 1){
+#   paste0(sum(vec == intGroup, na.rm=T),
+#          "/",
+#          "sum(!is.na(vec))",
+#
+#          " (",
+#          sprintf(paste0("%.", dp, "f"), sum(vec == intGroup, na.rm = T) / sum(!is.na(vec)) * 100),
+#          "%)"
+#   )
+# }

R/round_df.R

@@ -1,22 +1,25 @@
-#' Rounds the double columns in a data frame
+#' Round data frame decimal points
 #'
-#' All columns in a data frame with class double will be rounded to the sepecified
-#' number of digits. Integer classes will be left unchanged.
+#' Round the numeric columns of a data frame to the specified number of decimal
+#' points using the `sprintf` function.
 #'
-#' @param df a data frame object
-#' @param digits the number of digits after the decimal point
+#' @param df the data frame to be rounded
+#' @param dp (default 2) the desired number of decimal points
 #'
-#' @return the data frame with rounded numbers
+#' @return a data frame, the rounded columns are convertd to character objects.
 #'
-#' @examples
+#' @importFrom dplyr mutate_at
 #'
-#' df <- data.frame(a = "a", b = 0.025, c = 15.34234, d = T)
+#' @examples
+#' \dontrun{
+#' data(mtcars)
 #'
-#' round_df(df, 2)
+#' head( round_df(mtcars, 1) )
+#' }
 #'
 #' @export
-round_df <- function(df, digits) {
-  nums <- vapply(df, is.double, FUN.VALUE = logical(1))
-  df[,nums] <- round(df[,nums], digits = digits)
-  df
+round_df <- function(df, dp = 2) {
+  mutate_at(df,
+            names(df)[vapply(df, is.numeric, FUN.VALUE = logical(1), USE.NAMES = F)],
+            .funs = list(~sprintf(paste0("%0.", dp, "f"), .)))
 }

biometrics.Rproj

@@ -18,3 +18,4 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace,vignette

config/README.md

@@ -0,0 +1,5 @@
+# config
+## ProjectTemplate directory
+global.dcf stores all configuration settings for `ProjectTemplate`.
+`load_libraries = FALSE` as default project settings will be controlled by the
+.Rprofile file.

config/global.dcf

@@ -0,0 +1,16 @@
+version: 0.8.2
+data_loading: TRUE
+data_loading_header: TRUE
+data_ignore:
+cache_loading: TRUE
+recursive_loading: FALSE
+munging: TRUE
+logging: FALSE
+logging_level: INFO
+load_libraries: FALSE
+libraries: stats, reshape2, plyr, tidyverse
+as_factors: TRUE
+data_tables: FALSE
+attach_internal_libraries: FALSE
+cache_loaded_data:  FALSE
+sticky_variables: NONE

doc/html_report.R

@@ -0,0 +1,72 @@
+## ----init, include = FALSE-----------------------------------------------
+# Load packages and add citation information to packages.bib
+# By default, packages listed in global.dcf are ignored and environment initiation is handled by .RProfile.
+library(repmis)
+LoadandCite(pkgs = c("tidyverse", "lubridate", "ProjectTemplate", "repmis", "biometrics", "knitr", "kableExtra", "broom", "GGally", "lme4"),
+            file = "assets/bib/packages.bib")
+
+# loads in template hooks
+source("assets/R/hooks.R")
+
+
+## ----hello_world, include = TRUE-----------------------------------------
+  print("Hello World!")
+
+
+## ----echo_false, echo = FALSE--------------------------------------------
+  print("In this example, the source code has been hidden and only the output is displayed.")
+
+
+## ----load_data-----------------------------------------------------------
+data(iris)
+
+
+## ----automatic_table, table = T, results = "hide", eval = F--------------
+#  head(iris)
+#  
+
+## ----manual_table--------------------------------------------------------
+head(iris) %>%
+  kable("html") %>%
+  kable_styling("hover", full_width = TRUE)
+
+
+## ----model_summary, comment = ""-----------------------------------------
+model <- lmer(Sepal.Length ~ Sepal.Width + Petal.Width + (1|Species), data = iris)
+
+summary(model)
+
+
+## ----tidy, table = T, results = "hide", warning = F----------------------
+tidy(model)
+
+
+## ----glance, table = T, results = "hide"---------------------------------
+glance(model)
+
+
+## ----augment, table = T, results = "hide"--------------------------------
+augment(model) %>%
+  head()
+
+
+## ----ggpairs, out.extra = 'class="img-fluid center"', message = FALSE----
+ggpairs(iris, mapping=ggplot2::aes(colour = Species), diag = list(continuous = "densityDiag"),
+        axisLabels = "show")
+
+
+## ----discrete_plot, out.extra = "figure"---------------------------------
+ggplot(iris, aes(Petal.Width, Petal.Length, color = Species)) +
+  labs(title = "Iris Dataset", x = "Petal Width", y = "Petal Length") +
+  geom_point(size = 4) +
+  scale_color_telethonkids("light") +
+  theme_classic()
+
+
+## ----continuous_plot, out.extra = "figure"-------------------------------
+ggplot(iris, aes(Petal.Width, Petal.Length, color = Petal.Length)) +
+  geom_point(size = 4, alpha = .6) +
+  scale_color_telethonkids(discrete = FALSE, palette = "dark") +
+  theme_classic()
+
+