# R/compare_plans.R In grabsampling: Probability of Detection for Grab Sample Selection

#### Documented in compare_plans

```##' This function allows comparison of different sampling schemes, which can be systematic and random sampling of primary increments or grab sampling of blocks of primary increments.  A graphical display of the probability of detection \eqn{P_D} or probability of non detection \eqn{P_{ND}} versus fraction nonconforming \eqn{p} for up to four selected schemes will be produced.
##' @title Probability of detection or non detection  versus fraction nonconforming curve
##' @param c1,c2,c3,c4 acceptance numbers
##' @param r1,r2,r3,r4 number of primary increments in a grab sample or grab sample size
##' @param t1,t2,t3,t4 number of grab samples
##' @param d serial correlation of contamination between the primary increments
##' @param N length of the production
##' @param method1,method2,method3,method4 what sampling method we have applied such as \code{'systematic'} or \code{'random'} selection methods
##' @param plim the upper limit for graphing the fraction nonconforming or proportion of contaminated increments
##' @param type what type of graph we want to produce such as \code{D} or \code{ND}. \code{\link{compare_plans}} produces a graphical display of \eqn{P_D} or \eqn{P_{ND}} versus \eqn{p} depending on the \code{D} or \code{ND} of type
##' @return Probability of detection or non detection vs limiting fraction curves
##' @examples
##' c1 <- 0
##' c2 <- 0
##' c3 <- 0
##' c4 <- 0
##' r1 <- 1
##' r2 <- 10
##' r3 <- 30
##' r4 <- 75
##' t1 <- 750
##' t2 <- 75
##' t3 <- 25
##' t4 <- 10
##' d <- 0.99
##' N <- 1e9
##' method1 <- method2 <- method3 <- method4 <- 'systematic'
##' plim <- 0.10
##' compare_plans(d, N, plim, type ='D', c1, r1, t1, method1, c2, r2, t2, method2)
##' compare_plans(d, N, plim, type ='D', c1, r1, t1, method1, c2, r2, t2, method2,
##'                         c3, r3, t3, method3)
##' compare_plans(d, N, plim, type ='D', c1, r1, t1, method1, c2, r2, t2, method2,
##'                         c3, r3, t3, method3, c4, r4, t4, method4)
##' compare_plans(d, N, plim, type ='ND', c1, r1, t1, method1, c2, r2, t2, method2,
##'                         c3, r3, t3, method3, c4, r4, t4, method4)
##'
##' @usage compare_plans(d, N, plim, type, c1, r1, t1, method1, c2, r2, t2, method2,
##'                      c3, r3, t3, method3, c4, r4, t4, method4)
##' @export
compare_plans <- function(d, N, plim, type, c1, r1, t1, method1, c2 = NULL, r2 = NULL, t2 = NULL, method2 = NULL, c3 = NULL, r3 = NULL, t3 = NULL, method3 = NULL, c4 = NULL, r4 = NULL, t4 = NULL, method4 = NULL) {
Sampling_scheme <- NULL  # Initalizing
P_D <- NULL
p <- seq(1e-05, plim, by = 1e-05)
f_spr <- function(t, r, c, method) {
if (method == "systematic") {
if (r == 1) {
sprintf("systematic increments sampling (t=%.0f, c=%.0f)", t, c)
} else {
sprintf("systematic grab sampling (t=%.0f, r=%.0f, c=%.0f)", t, r, c)
}
} else {
if (r == 1) {
sprintf("random increments sampling (t=%.0f, c=%.0f)", t, c)
} else {
sprintf("random grab sampling (t=%.0f, r=%.0f, c=%.0f)", t, r, c)
}
}
}
if(is.null(c4) && is.null(r4) && is.null(t4) ) {
if(is.null(c3) && is.null(r3) && is.null(t3) ) {
p_d1 <- prob_detect(c1, r1, t1, d, p, N, method1)
p_d2 <- prob_detect(c2, r2, t2, d, p, N, method2)
Prob_df <- data.frame(p, p_d1, p_d2)
Prob <- plyr::rename(Prob_df, c(p_d1 = f_spr(t1, r1, c1, method1), p_d2 = f_spr(t2, r2, c2,method2)))
} else {
p_d1 <- prob_detect(c1, r1, t1, d, p, N, method1)
p_d2 <- prob_detect(c2, r2, t2, d, p, N, method2)
p_d3 <- prob_detect(c3, r3, t3, d, p, N, method3)
Prob_df <- data.frame(p, p_d1, p_d2, p_d3)
Prob <- plyr::rename(Prob_df, c(p_d1 = f_spr(t1, r1, c1, method1), p_d2 = f_spr(t2, r2, c2, method2), p_d3 = f_spr(t3, r3, c3, method3)))
}
} else {
p_d1 <- prob_detect(c1, r1, t1, d, p, N, method1)
p_d2 <- prob_detect(c2, r2, t2, d, p, N, method2)
p_d3 <- prob_detect(c3, r3, t3, d, p, N, method3)
p_d4 <- prob_detect(c4, r4, t4, d, p, N, method4)
Prob_df <- data.frame(p, p_d1, p_d2, p_d3, p_d4)
Prob <- plyr::rename(Prob_df, c(p_d1 = f_spr(t1, r1, c1, method1), p_d2 = f_spr(t2, r2, c2, method2), p_d3 = f_spr(t3, r3, c3, method3), p_d4 = f_spr(t4, r4, c4, method4)))
}
melten.Prob <- reshape2::melt(Prob, id = "p", variable.name = "Sampling_scheme", value.name = "P_D")
if (type == "D") {
ggplot2::ggplot(melten.Prob) + ggplot2::geom_line(ggplot2::aes(x = p, y = P_D, group = Sampling_scheme, colour = Sampling_scheme)) + ggplot2::ylab(expression(P[D])) +
ggplot2::theme_classic() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5, size = 10), legend.position = c(0.75, 0.25)) + ggthemes::scale_colour_colorblind()
} else if (type == "ND"){
ggplot2::ggplot(melten.Prob) + ggplot2::geom_line(ggplot2::aes(x = p, y = 1-P_D, group = Sampling_scheme, colour = Sampling_scheme)) + ggplot2::ylab(expression(P[ND])) +
ggplot2::theme_classic() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5, size = 10), legend.position = c(0.75, 0.75)) + ggthemes::scale_colour_colorblind()
}
}
```

## Try the grabsampling package in your browser

Any scripts or data that you put into this service are public.

grabsampling documentation built on March 13, 2020, 5:07 p.m.