Add chapter 3 and several changes

danielvartan · Jan 13, 2025 · b2c37b7 · b2c37b7
1 parent fa498ef
commit b2c37b7
Show file tree

Hide file tree

Showing 113 changed files with 7,762 additions and 6,355 deletions.
diff --git a/R/_dev.R b/R/_dev.R
@@ -53,9 +53,9 @@
 # --cache-refresh
 # quarto render
 # quarto render --profile gfm
-# quarto render --profile pdf
-# quarto render --profile html
-# quarto render --profile revealjs
+# quarto render --profile pdf # Source pre-render first.
+# quarto render --profile html # Source pre-render first.
+# quarto render --profile revealjs # Source pre-render first.
 
 # # LaTeX
 #

diff --git a/R/_post-render-html.R b/R/_post-render-html.R
@@ -3,11 +3,11 @@
 # library(rutils) # github.com/danielvartan/rutils
 # library(yaml)
 
-# Post-render begin ----------
+# Post-render begin -----
 
 source(here::here("R", "_post-render-begin.R"))
 
-# Copy PDF (if exists) to `output_dir_html` folder ----------
+# Copy PDF (if exists) to `output_dir_html` folder -----
 
 pdf_file <- list.files(output_dir_pdf, full.names = TRUE, pattern = ".pdf$")
 
@@ -18,7 +18,7 @@ if (length(pdf_file) == 1) {
   )
 }
 
-# Create robots.txt file ----------
+# Create robots.txt file -----
 
 robots_file <- file.path(output_dir_html, "robots.txt")
 
@@ -43,6 +43,17 @@ writeLines(
   con = robots_file
 )
 
+# Copy favicon.png file to the `docs` folder -----
+
+favicon_file <- here::here("images", "favicon.png")
+
+if (prettycheck:::test_file_exists(favicon_file)) {
+  rutils:::copy_file(
+    from = favicon_file,
+    to = file.path(output_docs, "favicon.png")
+  )
+}
+
 # Post-render end ----------
 
 source(here::here("R", "_post-render-end.R"))
diff --git a/R/_pre-render-begin.R b/R/_pre-render-begin.R
@@ -116,7 +116,7 @@ quarto_yml_pdf_vars <- yaml::read_yaml(quarto_yml_pdf_path)
 # This function should work with any version of BetterBibTeX (BBT) for Zotero.
 # Verify if @wmoldham PR was merged in the `rbbt` package (see issue #47
 # <https://github.com/paleolimbot/rbbt/issues/47>). If not, install `rbbt`
-# from @wmoldham fork `remotes::install_github("wmoldham/rbbt")`.
+# from @wmoldham fork `renv::install("wmoldham/rbbt")`.
 
 if (isTRUE(quarto_yml_pdf_vars$format$`abnt-pdf`$zotero)) {
   rutils:::bbt_write_quarto_bib(

diff --git a/R/_pre-render-vars.R b/R/_pre-render-vars.R
@@ -1,64 +1,133 @@
+# Load packages -----
+
 # library(dplyr)
 # library(lubritime)
 library(magrittr)
 library(targets)
 
+# Load functions -----
+
 source(here::here("R", "utils.R"))
 
+# Load variables -----
+
+env_vars <- yaml::read_yaml(here::here("_variables.yml"))
+res_vars <- yaml::read_yaml(here::here("_results.yml"))
+
+# Load data -----
+
 # targets::tar_make(script = here::here("_targets.R"))
 
 raw_data <- targets::tar_read(
   "raw_data",
   store = here::here("_targets")
 )
 
+tidy_data <- targets::tar_read(
+  "tidy_data",
+  store = here::here("_targets")
+)
+
 weighted_data <- targets::tar_read(
   "weighted_data",
   store = here::here("_targets")
 )
 
-# Chapter 6 -----
+# Chapter 5 -----
 
-analysis_sample_per_nrow_2017_10_15 <-
+pr_analysis_sample_msf_sc_mean <-
   weighted_data |>
-  dplyr::filter(lubridate::date(timestamp) == as.Date("2017-10-15")) |>
+  dplyr::pull(msf_sc) |>
+  lubritime:::link_to_timeline(threshold = hms::parse_hms("12:00:00")) |>
+  mean(na.rm = TRUE) |>
+  hms::as_hms() |>
+  lubritime::round_time() |>
+  as.character()
+
+pr_analysis_sample_msf_sc_sd <-
+  weighted_data |>
+  dplyr::pull(msf_sc) |>
+  lubritime:::link_to_timeline(threshold = hms::parse_hms("12:00:00")) |>
+  stats::sd(na.rm = TRUE) |>
+  hms::as_hms() |>
+  lubritime::round_time() |>
+  as.character()
+
+pr_tidy_data_per_nrow_2017_10_15_21 <-
+  tidy_data |>
+  dplyr::filter(
+    lubridate::date(timestamp) >= as.Date("2017-10-15"),
+    lubridate::date(timestamp) <= as.Date("2017-10-21")
+  ) |>
   nrow() |>
-  magrittr::divide_by(weighted_data |> nrow()) |>
+  magrittr::divide_by(tidy_data |> nrow()) |>
   magrittr::multiply_by(100)
 
-# Supplemental Material 1 -----
-
-# Supplemental Material 2 -----
-
-# Supplemental Material 3 -----
-
-# Supplemental Material 4 -----
-
-# Supplemental Material 5 -----
-
-# Supplemental Material 6 -----
+data_sex_per <-
+  weighted_data |>
+  dplyr::summarise(
+    n = dplyr::n(),
+    .by = sex
+  ) |>
+  dplyr::mutate(n_per = (n / sum(n)) * 100)
+
+pr_weighted_data_male_per <-
+  data_sex_per |>
+  dplyr::filter(sex == "Male") |>
+  dplyr::pull(n_per)
+
+pr_weighted_data_female_per <-
+  data_sex_per |>
+  dplyr::filter(sex == "Female") |>
+  dplyr::pull(n_per)
 
-# Supplemental Material 7 -----
+# Chapter 6 -----
 
-# Supplemental Material 8 -----
+pr_analysis_sample_per_nrow_2017_10_15 <-
+  weighted_data |>
+  dplyr::filter(lubridate::date(timestamp) == as.Date("2017-10-15")) |>
+  nrow() |>
+  magrittr::divide_by(weighted_data |> nrow()) |>
+  magrittr::multiply_by(100)
 
-# Supplemental Material 9 -----
+# Others -----
 
-# Supplemental Material 10 -----
+if (res_vars$hta_effect_size$f_squared >
+    res_vars$htb_effect_size$f_squared) {
+  final_effect_size <- res_vars$hta_effect_size
+} else {
+  final_effect_size <- res_vars$htb_effect_size
+}
 
 # Write in `results.yml` -----
 
 write_in_results_yml(
   list(
     pr_raw_data_nrow = raw_data |> nrow(),
-    pr_analysis_sample_per_nrow_2017_10_15 = analysis_sample_per_nrow_2017_10_15
+    pr_analysis_sample_msf_sc_mean = pr_analysis_sample_msf_sc_mean,
+    pr_analysis_sample_msf_sc_sd = pr_analysis_sample_msf_sc_sd,
+    pr_tidy_data_per_nrow_2017_10_15_21 = pr_tidy_data_per_nrow_2017_10_15_21,
+    pr_weighted_data_male_per = pr_weighted_data_male_per,
+    pr_weighted_data_female_per = pr_weighted_data_female_per,
+    pr_analysis_sample_per_nrow_2017_10_15 = pr_analysis_sample_per_nrow_2017_10_15,
+    final_effect_size = final_effect_size
   )
 )
 
+# Clean environment -----
+
 rm(
   raw_data,
   weighted_data,
-  analysis_sample_per_nrow_2017_10_15
+  pr_analysis_sample_msf_sc_mean,
+  pr_analysis_sample_msf_sc_sd,
+  pr_tidy_data_per_nrow_2017_10_15_21,
+  pr_weighted_data_male_per,
+  pr_weighted_data_female_per,
+  pr_analysis_sample_per_nrow_2017_10_15,
+  final_effect_size
 )
 
-results_vars <- yaml::read_yaml(here::here("_results.yml"))
+# Reload `result_vars` -----
+
+res_vars <- yaml::read_yaml(here::here("_results.yml"))
diff --git a/R/_render-common.R b/R/_render-common.R
@@ -50,10 +50,10 @@ if (!prettycheck:::test_file_exists(env_vars_file_path)) {
 
 # Create `_results.yml` if it doesn't exist -----
 
-results_vars_file_path <- here::here("_results.yml")
+res_vars_file_path <- here::here("_results.yml")
 
-if (!prettycheck:::test_file_exists(results_vars_file_path)) {
-  rutils:::create_file(results_vars_file_path)
+if (!prettycheck:::test_file_exists(res_vars_file_path)) {
+  rutils:::create_file(res_vars_file_path)
 }
 
 # Run the data pipeline if the `_targets` directory doesn't exist -----

diff --git a/R/_setup.R b/R/_setup.R
@@ -1,6 +1,6 @@
 ## Based on <https://github.com/hadley/r4ds/blob/main/_common.R>.
 
-# Load libraries -----
+# Load packages -----
 
 library(downlit)
 library(ggplot2)
@@ -41,7 +41,7 @@ options(
 set.seed(2025)
 
 env_vars <- yaml::read_yaml(here::here("_variables.yml"))
-results_vars <- yaml::read_yaml(here::here("_results.yml"))
+res_vars <- yaml::read_yaml(here::here("_results.yml"))
 
 if (env_vars$format == "html") {
   base_size <- 11

diff --git a/R/cohens_f_squared.R b/R/cohens_f_squared.R
@@ -25,12 +25,12 @@ cohens_f_squared <- function(base_r_squared, new_r_squared = NULL) {
 # library(prettycheck) # github.com/danielvartan/prettycheck
 
 cohens_f_squared_effect_size <- function(f_squared) {
-  prettycheck:::assert_number(f_squared, lower = - 1, upper = 1)
+  prettycheck:::assert_number(f_squared, lower = 0)
 
   dplyr::case_when(
-    abs(f_squared) >= 0.35 ~ "Large",
-    abs(f_squared) >= 0.15 ~ "Medium",
-    abs(f_squared) >= 0.02 ~ "Small",
+    f_squared >= 0.35 ~ "Large",
+    f_squared >= 0.15 ~ "Medium",
+    f_squared >= 0.02 ~ "Small",
     TRUE ~ "Negligible"
   )
 }
@@ -41,17 +41,42 @@ cohens_f_squared_effect_size <- function(f_squared) {
 cohens_f_squared_summary <- function(
     base_r_squared,
     new_r_squared = NULL
-) {
-  prettycheck:::assert_number(base_r_squared, lower = 0, upper = 1)
-  prettycheck:::assert_number(
-    new_r_squared, lower = 0, upper = 1, null.ok = TRUE
-  )
+  ) {
+  if (is.atomic(base_r_squared)) {
+    prettycheck:::assert_number(base_r_squared, lower = 0, upper = 1)
+    prettycheck:::assert_number(
+      new_r_squared, lower = 0, upper = 1, null.ok = TRUE
+    )
 
-  f_squared <- cohens_f_squared(base_r_squared, new_r_squared)
-  category <- cohens_f_squared_effect_size(f_squared)
+    f_squared <- cohens_f_squared(base_r_squared, new_r_squared)
 
-  dplyr::tibble(
-    name = c("f_squared", "effect_size"),
-    value = c(f_squared, category)
-  )
+    list(
+      f_squared = f_squared,
+      effect_size = cohens_f_squared_effect_size(f_squared)
+    )
+  } else {
+    col_check <- c("Rsq", "SErsq", "LCL", "UCL") # psychometric::CI.Rsq()
+
+    prettycheck:::assert_data_frame(base_r_squared)
+    prettycheck:::assert_set_equal(names(base_r_squared), col_check)
+    prettycheck:::assert_data_frame(new_r_squared)
+    prettycheck:::assert_set_equal(names(new_r_squared), col_check)
+
+    f_values <- c(
+      cohens_f_squared(base_r_squared$UCL, new_r_squared$UCL),
+      cohens_f_squared(base_r_squared$UCL, new_r_squared$LCL),
+      cohens_f_squared(base_r_squared$LCL, new_r_squared$UCL),
+      cohens_f_squared(base_r_squared$LCL, new_r_squared$LCL)
+    )
+
+    min_f <- ifelse(min(f_values) < 0, 0, min(f_values))
+    max_f <- ifelse(max(f_values) < 0, 0, max(f_values))
+
+    list(
+      f_squared = cohens_f_squared(base_r_squared$Rsq, new_r_squared$Rsq),
+      lower_ci_limit = min_f,
+      upper_ci_limit = max_f,
+      effect_size = cohens_f_squared_effect_size(min_f)
+    )
+  }
 }