Version 0.1.2

prdm0 · Apr 30, 2024 · 59e2c4e · 59e2c4e
1 parent fd0d39b
commit 59e2c4e
Show file tree

Hide file tree

Showing 53 changed files with 183 additions and 70 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -25,7 +25,8 @@ Imports:
     purrr,
     Rcpp,
     rlang,
-    scales
+    scales,
+    scattermore
 Suggests: 
     knitr,
     rmarkdown,

diff --git a/NAMESPACE b/NAMESPACE
@@ -45,6 +45,7 @@ importFrom(purrr,map_dbl)
 importFrom(purrr,partial)
 importFrom(rlang,list2)
 importFrom(scales,percent)
+importFrom(scattermore,geom_scattermore)
 importFrom(stats,density)
 importFrom(stats,dunif)
 importFrom(stats,dweibull)

diff --git a/R/accept_reject.r b/R/accept_reject.r
@@ -92,7 +92,7 @@
 #'   f = dbinom,
 #'   continuous = FALSE,
 #'   args_f = list(size = 5, prob = 0.5),
-#'   xlim = c(0, 10)
+#'   xlim = c(0, 5)
 #' )
 #' plot(x)
 #'

diff --git a/R/plot.r b/R/plot.r
@@ -15,8 +15,8 @@
 #' @param color_real_point Color of real probability points (discrete case)
 #' @param alpha Bar chart transparency (discrete case) and observed density
 #' (continuous case)
-#' @param hist If TRUE, a histogram will be plotted in the continuous case,
-#' comparing the theoretical density with the observed one. If FALSE,
+#' @param hist If `TRUE`, a histogram will be plotted in the continuous case,
+#' comparing the theoretical density with the observed one. If `FALSE`,
 #' [ggplot2::geom_density()] will be used instead of the histogram.
 #'
 #' @param ... Additional arguments.
@@ -72,10 +72,10 @@ plot.accept_reject <-
   function(
     x,
     color_observed_density = "#BB9FC9", #"#E65A65", # "#FBBA78",
-    color_true_density = "#FE4F0E",
+    color_true_density = "#F890C2",  #"#FE4F0E",
     color_bar = "#BB9FC9", #"#E65A65", #"#FCEFC3",
     color_observable_point = "#7BBDB3",
-    color_real_point = "#FE4F0E",
+    color_real_point = "#F890C2", #"#FE4F0E",
     alpha = .3,
     hist = TRUE,
     ...

diff --git a/R/plot_inspect.r b/R/plot_inspect.r
@@ -103,7 +103,7 @@ inspect <-
     c = 1,
     alpha = 0.4,
     color_intersection = "#BB9FC9",
-    color_f = "#FE4F0E",
+    color_f = "#F890C2", #"#FE4F0E",
     color_f_base = "#7BBDB3"
   ) {
 

diff --git a/R/qqplot.R b/R/qqplot.R
@@ -22,17 +22,19 @@ quantile_custom_vec <-
 
 #' QQ-Plot
 #' QQ-Plot between observed quantiles and theoretical quantiles.
-#' @param x Object of the class `accept_reject` returned by the function `accept_reject()`.
+#' @param x Object of the class `accept_reject` returned by the function
+#' `accept_reject()`.
 #' @param ... Additional arguments to be passed to methods.
-#' @returns An object of classes `gg` and `ggplot` with the QQ-Plot of theoretical quantiles versus observed quantiles.
+#' @returns An object of classes `gg` and `ggplot` with the QQ-Plot of
+#' theoretical quantiles versus observed quantiles.
 #' @details
 #' Generic method to plot the QQ-Plot between observed quantiles and theoretical
 #' quantiles. The generic method will call the specific method
 #' `qqplot.accept_reject()`, which operates on objects of class accept_reject
 #' returned by the function `accept_reject()`.
 #'
-#' @seealso [accept_reject()], [print.accept_reject()], [plot.accept_reject()] and
-#' [inspect()].
+#' @seealso [accept_reject()], [print.accept_reject()], [plot.accept_reject()]
+#' and [inspect()].
 #' @export
 qqplot <- function(x, ...) {
   UseMethod("qqplot")
@@ -41,12 +43,29 @@ qqplot <- function(x, ...) {
 #' QQ-Plot
 #' Plot the QQ-Plot between observed quantiles and theoretical quantiles.
 #' @param x Object of the class accept_reject returned by the function `accept_reject()`.
-#' @param alpha Transparency of the points and reference line representing where the quantiles should be (theoretical quantiles).
-#' @param color_points Color of the points (default is `"#FE4F0E"`).
+#' @param alpha Transparency of the points and reference line representing where
+#' the quantiles should be (theoretical quantiles).
+#' @param color_points Color of the points (default is `"#F890C2"`).
 #' @param color_line Color of the reference line (detault is `"#BB9FC9"`).
 #' @param size_points Size of the points (default is `1`).
 #' @param size_line Thickness of the reference line (default is `1`).
+#' @param parallel If `TRUE`, all cores will be used for internal calculations of
+#' theoretical quantiles. The default is `FALSE`. Use TRUE if you find the plot
+#' is taking too long.
+#' @param cores Number of cores to be used if `parallel = TRUE`. Defalut is `NULL`,
+#' which means all cores will be used.
 #' @param ... Additional arguments.
+#' @details
+#' Just like in the `accept_reject()` function, the `qqplot.accept_reject()`
+#' function uses parallelism using FORK, meaning it works on Unix-based
+#' operating systems (Linux and MacOS). What is parallelized are the internal
+#' calculations of theoretical quantiles of the true distribution. This
+#' parallelism will only be useful for excessively large samples. Additionally,
+#' for samples larger than ten thousand, the `geom_scattermost()` function from
+#' the [**scattermore**](https://CRAN.R-project.org/package=scattermore) library
+#' is used to plot the points, as it is more efficient than `geom_point()` from
+#' the [**ggplot2**](https://CRAN.R-project.org/package=ggplot2) library.
+#'
 #' @return An object of classes gg and ggplot with the QQ-Plot between the
 #' observed quantiles generated by the return of the function `accept_reject()`
 #' and the theoretical quantiles of the true distribution.
@@ -58,7 +77,7 @@ qqplot <- function(x, ...) {
 #'   f = dbinom,
 #'   continuous = FALSE,
 #'   args_f = list(size = 5, prob = 0.5),
-#'   xlim = c(0, 10)
+#'   xlim = c(0, 5)
 #' )
 #' qqplot(x)
 #'
@@ -72,20 +91,59 @@ qqplot <- function(x, ...) {
 #' qqplot(y)
 #' @importFrom Rcpp evalCpp
 #' @importFrom ggplot2 ggplot geom_point geom_abline labs theme element_text
-#' coord_cartesian scale_x_continuous scale_y_continuous
-#' aes_string
+#' coord_cartesian scale_x_continuous scale_y_continuous aes_string
+#' @importFrom scattermore geom_scattermore
+#' @importFrom parallel mclapply detectCores
 #' @export
-qqplot.accept_reject <- function(x, alpha = 0.5, color_points = "#FE4F0E", color_line = "#BB9FC9", size_points = 1, size_line = 1, ...) {
+qqplot.accept_reject <-
+  function(x,
+           alpha = 0.5,
+           color_points = "#F890C2",
+           color_line = "#BB9FC9",
+           size_points = 1,
+           size_line = 1,
+           parallel = FALSE,
+           cores = NULL,
+           ...
+  ) {
+
+  continuous <- attr(x, "continuous")
   sample_quantiles <- sort(x)
   p <- (rank(sample_quantiles) - 0.375) / (length(sample_quantiles) + 0.25)
-  theoretical_quantiles <- quantile_custom_vec(x = x, p = p)
+
+  theoretical_quantiles <-
+    unlist(
+      parallel::mclapply(
+        X = p,
+        FUN = function(i) quantile_custom_vec(x = x, i),
+        mc.cores = ifelse(
+          parallel,
+          ifelse(is.null(cores), parallel::detectCores(), cores),
+          1L
+        )
+      )
+    )
+
   df <- data.frame(Theoretical = theoretical_quantiles, Sample = sample_quantiles)
   xlim <- attr(x, "xlim")
-  continuous <- attr(x, "continuous")
 
   plot <- ggplot(df, aes_string(x = "Theoretical", y = "Sample")) +
-    geom_abline(slope = 1, intercept = 0, color = color_line, size = size_line) +
-    geom_point(alpha = alpha, color = color_points, size = size_points) +
+    geom_abline(slope = 1, intercept = 0, color = color_line, size = size_line)
+
+  if (continuous && length(x) >= 10e3){
+    plot <- plot +
+      geom_scattermore(
+        pointsize = size_points + 2,
+        interpolate = TRUE,
+        color = color_points
+    )
+  } else {
+    plot <- plot +
+      geom_point(alpha = alpha, color = color_points, size = size_points)
+  }
+
+  plot <-
+    plot +
     coord_cartesian(xlim = xlim, ylim = xlim) +
     labs(x = "Theoretical Quantiles", y = "Sample Quantiles", title = "QQ-Plot") +
     theme(

diff --git a/README.Rmd b/README.Rmd
@@ -96,10 +96,10 @@ p4 <- plot(d)
 plot_grid(p1, p2, p3, p4, nrow = 2L, labels = c("a", "b", "c", "d"))
 
 # QQ-Plots
-q1 <- qqplot(a)
-q2 <- qqplot(b)
-q3 <- qqplot(c)
-q4 <- qqplot(d)
+q1 <- qqplot(a, size_points = 2)
+q2 <- qqplot(b, size_points = 2)
+q3 <- qqplot(c, size_points = 2)
+q4 <- qqplot(d, size_points = 2)
 
 plot_grid(q1, q2, q3, q4, nrow = 2L, labels = c("a", "b", "c", "d"))
 ```

diff --git a/README.md b/README.md
@@ -190,10 +190,10 @@ plot_grid(p1, p2, p3, p4, nrow = 2L, labels = c("a", "b", "c", "d"))
 ``` r
 
 # QQ-Plots
-q1 <- qqplot(a)
-q2 <- qqplot(b)
-q3 <- qqplot(c)
-q4 <- qqplot(d)
+q1 <- qqplot(a, size_points = 2)
+q2 <- qqplot(b, size_points = 2)
+q3 <- qqplot(c, size_points = 2)
+q4 <- qqplot(d, size_points = 2)
 
 plot_grid(q1, q2, q3, q4, nrow = 2L, labels = c("a", "b", "c", "d"))
 ```
@@ -377,7 +377,7 @@ case_2 <- accept_reject(
   c = 1.2
 )
 toc()
-#> 0.007 sec elapsed
+#> 0.006 sec elapsed
 
 # Visualizing the results
 p1 <- plot(case_1)

diff --git a/docs/articles/accept_reject.html b/docs/articles/accept_reject.html
diff --git a/docs/articles/accept_reject_files/figure-html/unnamed-chunk-12-1.png b/docs/articles/accept_reject_files/figure-html/unnamed-chunk-12-1.png
diff --git a/docs/articles/accept_reject_files/figure-html/unnamed-chunk-13-1.png b/docs/articles/accept_reject_files/figure-html/unnamed-chunk-13-1.png
diff --git a/docs/articles/inspect.html b/docs/articles/inspect.html
diff --git a/docs/articles/inspect_files/figure-html/unnamed-chunk-2-1.png b/docs/articles/inspect_files/figure-html/unnamed-chunk-2-1.png
diff --git a/docs/articles/inspect_files/figure-html/unnamed-chunk-3-1.png b/docs/articles/inspect_files/figure-html/unnamed-chunk-3-1.png
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -4,5 +4,5 @@ pkgdown_sha: ~
 articles:
   accept_reject: accept_reject.html
   inspect: inspect.html
-last_built: 2024-04-29T11:14Z
+last_built: 2024-04-30T13:40Z
 
diff --git a/docs/reference/Rplot001.png b/docs/reference/Rplot001.png
diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png
diff --git a/docs/reference/Rplot003.png b/docs/reference/Rplot003.png
diff --git a/docs/reference/accept_reject-1.png b/docs/reference/accept_reject-1.png
diff --git a/docs/reference/accept_reject-2.png b/docs/reference/accept_reject-2.png
diff --git a/docs/reference/accept_reject.html b/docs/reference/accept_reject.html
diff --git a/docs/reference/figures/README-unnamed-chunk-3-1.png b/docs/reference/figures/README-unnamed-chunk-3-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-3-2.png b/docs/reference/figures/README-unnamed-chunk-3-2.png
diff --git a/docs/reference/figures/README-unnamed-chunk-4-1.png b/docs/reference/figures/README-unnamed-chunk-4-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-4-2.png b/docs/reference/figures/README-unnamed-chunk-4-2.png
diff --git a/docs/reference/figures/README-unnamed-chunk-5-1.png b/docs/reference/figures/README-unnamed-chunk-5-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-6-1.png b/docs/reference/figures/README-unnamed-chunk-6-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-6-2.png b/docs/reference/figures/README-unnamed-chunk-6-2.png
diff --git a/docs/reference/inspect-1.png b/docs/reference/inspect-1.png
diff --git a/docs/reference/inspect-2.png b/docs/reference/inspect-2.png
diff --git a/docs/reference/inspect-3.png b/docs/reference/inspect-3.png
-Original file line number
+Diff line change
@@ Expand Up / @@ -25,7 +25,8 @@ Imports: @@
         purrr,
         Rcpp,
         rlang,
-        scales
+        scales,
+        scattermore
     Suggests:
         knitr,
         rmarkdown,
@@ Expand Down @@