Version 0.1.2

NAMESPACE

@@ -2,8 +2,10 @@
 
 S3method(plot,accept_reject)
 S3method(print,accept_reject)
+S3method(qqplot,accept_reject)
 export(accept_reject)
 export(inspect)
+export(qqplot)
 import(rlang)
 importFrom(Rcpp,evalCpp)
 importFrom(assertthat,assert_that)
@@ -13,10 +15,12 @@ importFrom(cli,cli_alert_success)
 importFrom(cli,cli_alert_warning)
 importFrom(cli,cli_h1)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,aes_string)
 importFrom(ggplot2,after_stat)
 importFrom(ggplot2,annotate)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_text)
+importFrom(ggplot2,geom_abline)
 importFrom(ggplot2,geom_area)
 importFrom(ggplot2,geom_bar)
 importFrom(ggplot2,geom_histogram)

NEWS.md

@@ -8,7 +8,7 @@
 
 * Now it is possible to specify a different base density/probability mass function than the uniform one. If none is specified, the uniform density (either discrete or continuous) is assumed for the case of discrete or continuous random variables, respectively;
 
-* Now the function `inspect()` is available, allowing you to compare the base probability density function with the theoretical density function. The `inspect()` function is useful for finding a reasonable base density function. It returns an object of the classes gg and ggplot with the density curves, the intersection area, and the value of the intersection. Users are not obligated to use the `inspect()` function since the `accept_reject()` function already takes care of a lot. However, for the continuous case, providing the f_base argument to the `accept_reject()` function with a good candidate base density function can be a good idea.
+* Now the function `inspect()` is available, allowing you to compare the base probability density function with the theoretical density function. The `inspect()` function is useful for finding a reasonable base density function. It returns an object of the classes gg and ggplot with the density curves, the intersection area, and the value of the intersection. Users are not obligated to use the `inspect()` function since the `accept_reject()` function already takes care of a lot. However, for the continuous case, providing the f_base argument to the `accept_reject()` function with a good candidate base density function can be a good idea;
 
 * In generating observations of continuous random variables, using histogram with the same breaks as the R graphics `hist()` function, in the histogram created by **ggplot2**;
 
@@ -26,9 +26,11 @@
 
 # AcceptReject 0.1.2
 
-* The performance of the `one_step()` function, an internal function used in the implementation of C++ using Rcpp, has been improved.
+* The performance of the `one_step()` function, an internal function used in the implementation of C++ using Rcpp, has been improved;
 
-* The function `accept_reject()` now has the argument cores, which allows the user to control the number of cores that will be used if `parallel = TRUE`. The default, `cores = NULL`, means that all processor cores will be used. If `parallel = FALSE`, the cores argument is ignored.
+* The method `qqplot.accept_reject()` has been added, which constructs the QQ-Plot of an object of class `accept_reject` returned by the function `accept_reject()`;
+
+* The function `accept_reject()` now has the argument cores, which allows the user to control the number of cores that will be used if `parallel = TRUE`. The default, `cores = NULL`, means that all processor cores will be used. If `parallel = FALSE`, the cores argument is ignored;
 
 * The [DESCRIPTION](https://raw.githubusercontent.com/prdm0/AcceptReject/main/DESCRIPTION) file was edited;
 

R/RcppExports.R

@@ -5,3 +5,7 @@ one_step <- function(n, f, f_base, random_base, c) {
     .Call(`_AcceptReject_one_step`, n, f, f_base, random_base, c)
 }
 
+internal_quantile <- function(continuous, f, p, xlim1, xlim2) {
+    .Call(`_AcceptReject_internal_quantile`, continuous, f, p, xlim1, xlim2)
+}
+

R/accept_reject.r

@@ -118,7 +118,6 @@
 #' @importFrom glue glue
 #' @useDynLib AcceptReject, .registration = TRUE
 #' @importFrom Rcpp evalCpp
-#'
 #' @export
 accept_reject <-
   function(n = 1L,

R/qqplot.R

@@ -0,0 +1,85 @@
+quantile_custom <- function(x, p) {
+  f <- attr(x, "f")
+  continuous <- attr(x, "continuous")
+  xlim <- attr(x, "xlim")
+
+  return(
+    internal_quantile(
+      continuous,
+      f,
+      p,
+      xlim[1L],
+      xlim[2L]
+    )
+  )
+}
+
+#' QQ-Plot
+#' QQ-Plot between observed quantiles and theoretical quantiles.
+#' @param x Object of the class `accept_reject` returned by the function `accept_reject()`.
+#' @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()].
+#' @export
+qqplot <- function(x) {
+  UseMethod("qqplot")
+}
+
+#' 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 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`).
+#' @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.
+#' @examples
+#' set.seed(0) # setting a seed for reproducibility
+#'
+#' x <- accept_reject(
+#'   n = 2000L,
+#'   f = dbinom,
+#'   continuous = FALSE,
+#'   args_f = list(size = 5, prob = 0.5),
+#'   xlim = c(0, 10)
+#' )
+#' qqplot(x)
+#'
+#' y <- accept_reject(
+#'   n = 1000L,
+#'   f = dnorm,
+#'   continuous = TRUE,
+#'   args_f = list(mean = 0, sd = 1),
+#'   xlim = c(-4, 4)
+#' )
+#' qqplot(y)
+#' @importFrom Rcpp evalCpp
+#' @importFrom ggplot2 ggplot geom_point geom_abline labs theme element_text
+#' aes_string
+#' @export
+qqplot.accept_reject <- function(x, alpha = 0.5, color_points = "#FE4F0E", color_line = "#BB9FC9", size_points = 1, size_line = 1) {
+  sample_quantiles <- sort(x)
+  p <- (rank(sample_quantiles) - 0.375) / (length(sample_quantiles) + 0.25)
+  theoretical_quantiles <- sapply(p, function(p) quantile_custom(x = x, p = p))
+
+  df <- data.frame(Theoretical = theoretical_quantiles, Sample = sample_quantiles)
+  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) +
+    labs(x = "Theoretical Quantiles", y = "Sample Quantiles", title = "QQ-Plot") +
+    theme(
+      axis.title = ggplot2::element_text(face = "bold"),
+      title = ggplot2::element_text(face = "bold"),
+      legend.title = ggplot2::element_text(face = "bold"),
+      plot.subtitle = ggplot2::element_text(face = "plain")
+    )
+}

README.Rmd

@@ -104,14 +104,27 @@ simulation <- function(n){
     parallel = TRUE
   )
 }
-# Inspecting
-a <- plot(simulation(n = 100L))
-b <- plot(simulation(n = 150L))
-c <- plot(simulation(n = 250L))
-d <- plot(simulation(n = 2500L))
 
-plot_grid(a, b, c, d, nrow = 2L, labels = c("a", "b", "c", "d"))
+a <- simulation(n = 100L)
+b <- simulation(n = 150L)
+c <- simulation(n = 250L)
+d <- simulation(n = 2500L)
+
+# Plots
+p1 <- plot(a)
+p2 <- plot(b)
+p3 <- plot(c)
+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)
+
+plot_grid(q1, q2, q3, q4, nrow = 2L, labels = c("a", "b", "c", "d"))
 ```
 
 The [`accept_reject()`](https://prdm0.github.io/AcceptReject/reference/accept_reject.html) function supports, **for the continuous case**, specifying a base probability density function if you don't want to use the continuous uniform distribution as the default base.
@@ -205,6 +218,11 @@ p1 <- plot(case_1)
 p2 <- plot(case_2)
 
 plot_grid(p1, p2, nrow = 2L)
+
+# QQ-plot
+q1 <- qqplot(case_1)
+q2 <- qqplot(case_2)
+plot_grid(q1, q2, nrow = 2L)
 ```
 
 Notice that the results were very close in a graphical analysis. However, the execution time specifying a convenient base density was lower for a very large sample.

README.md

@@ -115,6 +115,11 @@ very close to zero. In this case, we choose `xlim = c(0, 20)`, where
 
 ``` r
 library(AcceptReject)
+#> 
+#> Attaching package: 'AcceptReject'
+#> The following object is masked from 'package:stats':
+#> 
+#>     qqplot
 library(cowplot) # install.packages("cowplot")
 # Ensuring Reproducibility
 set.seed(0) 
@@ -166,17 +171,36 @@ simulation <- function(n){
     parallel = TRUE
   )
 }
-# Inspecting
-a <- plot(simulation(n = 100L))
-b <- plot(simulation(n = 150L))
-c <- plot(simulation(n = 250L))
-d <- plot(simulation(n = 2500L))
 
-plot_grid(a, b, c, d, nrow = 2L, labels = c("a", "b", "c", "d"))
+a <- simulation(n = 100L)
+b <- simulation(n = 150L)
+c <- simulation(n = 250L)
+d <- simulation(n = 2500L)
+
+# Plots
+p1 <- plot(a)
+p2 <- plot(b)
+p3 <- plot(c)
+p4 <- plot(d)
+
+plot_grid(p1, p2, p3, p4, nrow = 2L, labels = c("a", "b", "c", "d"))
 ```
 
 <img src="man/figures/README-unnamed-chunk-3-1.png" width="100%" />
 
+``` r
+
+# QQ-plots
+q1 <- qqplot(a)
+q2 <- qqplot(b)
+q3 <- qqplot(c)
+q4 <- qqplot(d)
+
+plot_grid(q1, q2, q3, q4, nrow = 2L, labels = c("a", "b", "c", "d"))
+```
+
+<img src="man/figures/README-unnamed-chunk-3-2.png" width="100%" />
+
 The
 [`accept_reject()`](https://prdm0.github.io/AcceptReject/reference/accept_reject.html)
 function supports, **for the continuous case**, specifying a base
@@ -282,7 +306,7 @@ case_1 <- accept_reject(
   xlim = c(0, 10)
 )
 toc()
-#> 0.009 sec elapsed
+#> 0.01 sec elapsed
 
 # Specifying the base probability density function
 tic()
@@ -309,6 +333,16 @@ plot_grid(p1, p2, nrow = 2L)
 
 <img src="man/figures/README-unnamed-chunk-5-1.png" width="100%" />
 
+``` r
+
+# QQ-plot
+q1 <- qqplot(case_1)
+q2 <- qqplot(case_2)
+plot_grid(q1, q2, nrow = 2L)
+```
+
+<img src="man/figures/README-unnamed-chunk-5-2.png" width="100%" />
+
 Notice that the results were very close in a graphical analysis.
 However, the execution time specifying a convenient base density was
 lower for a very large sample.