test: adding Arial Narrow font files

Author: laresbernardo

R/clusters.R

@@ -115,7 +115,7 @@ clusterKmeans <- function(df, k = NULL, wss_var = 0, limit = 15, drop_na = TRUE,
       y = "Within Groups Sum of Squares"
     ) +
     scale_y_comma() +
-    theme_lares()
+    theme_lares(...)
   results[["nclusters"]] <- nclusters
   results[["nclusters_plot"]] <- nclusters_plot
 
@@ -225,16 +225,16 @@ clusterVisualK <- function(df, ks = 2:6, ...) {
     explained <<- clusters$PCA$pca_explained[1:2]
     return(pca)
   }
-  clus_plot <- function(clus_dat) {
+  clus_plot <- function(clus_dat, ...) {
     clus_dat %>%
       ggplot(aes(x = .data$PC1, y = .data$PC2, colour = as.character(.data$cluster))) +
       geom_point() +
       guides(colour = "none") +
       labs(subtitle = glued("{clus_dat$k[1]} clusters")) +
-      theme_lares(pal = 2)
+      theme_lares(pal = 2, ...)
   }
   dats <- lapply(ks, function(x) clus_dat(df, x, ...))
-  plots <- lapply(dats, clus_plot)
+  plots <- lapply(dats, function(x) clus_plot(x, ...))
 
   total <- formatNum(sum(explained), 1, pos = "%")
   explained <- formatNum(explained, 1, pos = "%")
@@ -281,7 +281,7 @@ clusterOptimalK <- function(df, method = c("wss", "silhouette", "gap_stat"),
   try_require("factoextra")
   df <- .prepare_cluster(df, drop_na = drop_na, ohse = ohse, norm = norm, quiet = quiet)
   plots <- lapply(method, function(x) {
-    fviz_nbclust(df, kmeans, method = x, ...) + theme_lares(pal = 2)
+    fviz_nbclust(df, kmeans, method = x, ...) + theme_lares(pal = 2, ...)
   })
   return(plots)
 }

R/colour_palettes.R

@@ -159,6 +159,7 @@ lares_pal <- function(return = "list") {
 #' This function plots a list of colours
 #'
 #' @family Themes
+#' @inheritParams cache_write
 #' @param fill Vector. List of colours for fills.
 #' @param colour Vector. List of colours for colours.
 #' @param id Vector. ID for each color.
@@ -173,7 +174,7 @@ lares_pal <- function(return = "list") {
 #' pal <- lares_pal("pal")
 #' plot_palette(fill = names(pal), colour = as.vector(pal))
 #' @export
-plot_palette <- function(fill, colour = "black", id = NA, limit = 12) {
+plot_palette <- function(fill, colour = "black", id = NA, limit = 12, ...) {
   if (length(fill) > limit) {
     fill <- fill[1:limit]
     colour <- colour[1:limit]
@@ -191,6 +192,6 @@ plot_palette <- function(fill, colour = "black", id = NA, limit = 12) {
     coord_flip() +
     labs(x = NULL, y = NULL) +
     guides(fill = "none", colour = "none") +
-    theme_lares(font = NA, axis = "Y")
+    theme_lares(font = NA, axis = "Y", ...)
   return(p)
 }

R/correlations.R

@@ -306,7 +306,7 @@ plot.corr_var <- function(x, var, max_pvalue = 1, top = NA, limit = NULL, ...) {
       expand = c(0, 0), position = "right",
       labels = function(x) sub("^(-)?0[.]", "\\1.", x)
     ) +
-    theme_lares()
+    theme_lares(...)
 
   if (is.null(limit)) limit <- 100
   if (!is.na(top) && top < limit) {
@@ -492,7 +492,7 @@ corr_cross <- function(df, plot = TRUE,
         ) +
         scale_y_continuous(labels = function(x) sub("^(-)?0[.]", "\\1.", x)) +
         coord_flip() +
-        theme_lares(pal = 2)
+        theme_lares(pal = 2, ...)
     }
     if (max_pvalue < 1) {
       p <- p + labs(caption = paste("Correlations with p-value <", max_pvalue))

R/frequencies.R

@@ -45,7 +45,7 @@
 #'
 #' # Let's check the results with plots:
 #'
-#' #' # How many survived and see plot?
+#' # How many survived and see plot?
 #' dft %>% freqs(Survived, plot = TRUE)
 #'
 #' # How many survived per class?
@@ -163,13 +163,13 @@ freqs <- function(df, ..., wt = NULL,
 
   # Create some dynamic aesthetics
   plot$labels <- paste0(formatNum(plot$n, decimals = 0), " (", signif(plot$p, 4), "%)")
-  plot$label_colours <- ifelse(plot$p > mean(range(plot$p)) * 0.9, "TRUE", "FALSE")
+  plot$label_colours <- ifelse(plot$p > mean(range(plot$p)) * 0.9, "white", "black")
   lim <- 0.35
   plot$label_hjust <- ifelse(
     plot$n < min(plot$n) + diff(range(plot$n)) * lim, -0.1, 1.05
   )
   plot$label_colours <- ifelse(
-    plot$label_colours == "TRUE" & plot$label_hjust < lim, "FALSE", plot$label_colours
+    plot$label_colours == "white" & plot$label_hjust < lim, "black", plot$label_colours
   )
   variable <- colnames(plot)[1]
 
@@ -220,7 +220,7 @@ freqs <- function(df, ..., wt = NULL,
     coord_flip() + guides(colour = "none") +
     labs(
       x = NULL, y = NULL, fill = NULL,
-      title = ifelse(is.na(title), paste("Frequencies and Percentages"), title),
+      title = ifelse(is.na(title), "Frequencies and Percentages", title),
       subtitle = ifelse(is.na(subtitle),
         paste(
           "Variable:", ifelse(!is.na(variable_name), variable_name, variable),
@@ -230,7 +230,8 @@ freqs <- function(df, ..., wt = NULL,
       ), caption = obs
     ) +
     scale_fill_gradient(low = "lightskyblue2", high = "navy") +
-    theme_lares(pal = 4, which = "c", legend = "none", grid = "Xx") +
+    scale_color_identity() +
+    theme_lares(which = "c", legend = "none", grid = "Xx") +
     scale_y_comma(position = "right", expand = c(0, 0), limits = c(0, 1.03 * max(output$n)))
 
   # When two features
@@ -380,7 +381,7 @@ freqs_df <- function(df,
       out <- rbind(out, res)
     }
     out <- out %>%
-      mutate(p = round(100 * .data$count / nrow(df), 2)) %>%
+      mutate(p = signif(100 * .data$count / nrow(df), 3)) %>%
       mutate(value = ifelse(.data$p > min * 100, as.character(.data$value), "(HF)")) %>%
       group_by(.data$col, .data$value) %>%
       summarise(p = sum(.data$p), count = sum(.data$count)) %>%
@@ -430,7 +431,7 @@ freqs_df <- function(df,
     out <- select(out, .data$col, .data$value, .data$count, .data$p) %>%
       rename(n = .data$count, variable = .data$col) %>%
       group_by(.data$variable) %>%
-      mutate(pcum = round(cumsum(.data$p), 2))
+      mutate(pcum = signif(cumsum(.data$p), 3))
     return(out)
   }
 }

R/theme_lares.R

@@ -373,7 +373,7 @@ gg_vals <- function(layer = "fill", column = layer, cols = NULL, ...) {
   return(values)
 }
 
-.font_global <- function(font, quiet = FALSE, when_not = NA, ask_install = TRUE, ...) {
+.font_global <- function(font, quiet = FALSE, when_not = NA, ask_install = FALSE, ...) {
   if ("ignore" %in% tolower(font)) {
     return(NULL) 
   } else {
@@ -383,7 +383,7 @@ gg_vals <- function(layer = "fill", column = layer, cols = NULL, ...) {
         if (isTRUE(font[1] != "") && !quiet) {
           if (ask_install & font[1] %in% list.files(system.file("fonts", package = "lares"))) {
             yes <- readline(sprintf("Do you want to install %s font for better results? [y/n]: ", font))
-            if ("y" %in% yes) install_localfont(font)
+            if ("y" %in% yes) try(install_localfont(font))
           } else {
             warning(sprintf("Font(s) %s not installed, with other name, or can't be found", v2t(font))) 
           }
@@ -400,7 +400,7 @@ gg_vals <- function(layer = "fill", column = layer, cols = NULL, ...) {
 }
 
 install_localfont <- function(
-    font, dir = system.file(paste0("fonts/", font), package = "lares"),
+    font, dir = system.file(paste0("fonts/", gsub(" ", "_", font)), package = "lares"),
     ...) {
   try_require("extrafont")
   font_import(dir, prompt = FALSE, ...)