Add report() function

Author: koenderks

DESCRIPTION

@@ -11,7 +11,7 @@ Authors@R:
 Description: Implements the audit sampling workflow as discussed in Derks et al. (2019) <doi:10.31234/osf.io/9f6ub>. The package makes it easy for an auditor to plan an audit sample, sample from the population, and evaluating that sample using various confidence bounds according to the International Standards on Auditing. Furthermore, the package implements Bayesian equivalents of these methods. 
 BugReports: https://github.com/koenderks/jfa/issues
 URL: https://github.com/koenderks/jfa, https://koenderks.github.io/jfa/
-Suggests: testthat, knitr, rmarkdown
+Suggests: testthat, knitr, rmarkdown, kableExtra
 Language: en-US
 License: GPL-3
 Encoding: UTF-8

NAMESPACE

@@ -13,4 +13,5 @@ S3method(print,jfaSelection)
 export(auditPrior)
 export(evaluation)
 export(planning)
+export(report)
 export(selection)

NEWS.md

@@ -1,5 +1,6 @@
 # jfa 0.5.0
 
+- Add a function `report()` that automatically generates an audit report.
 - Removed the `sampling()` function, which is now replaced entirely with the `selection()` function.
 - Changed the output of the `evaluation()` function when an estimator is used.
 

R/evaluation.R

@@ -83,6 +83,7 @@
 #' \item{populationK}{the assumed total errors in the population. Used in inferences with \code{hypergeometric} method.}
 #' \item{prior}{an object of class 'jfaPrior' to represents the prior distribution.}
 #' \item{posterior}{an object of class 'jfaPosterior' to represents the posterior distribution.}
+#' \item{data}{a data frame containing the relevant columns from the \code{sample} input.}
 #'
 #' @author Koen Derks, \email{k.derks@nyenrode.nl}
 #'
@@ -357,10 +358,10 @@ evaluation <- function(confidence = 0.95, method = "binomial", N = NULL,
 		result[["mle"]]			<- as.numeric(mle)
 	if(!is.null(precision))
 		result[["precision"]]	<- as.numeric(precision)
+	if(!is.null(populationBookValue))
+		result[["popBookvalue"]]   <- as.numeric(populationBookValue)
 	if(method %in% c("direct", "difference", "quotient", "regression")){
 		# These methods yield an interval instead of a bound
-		result[["popBookvalue"]]   <- as.numeric(populationBookValue)
-		result[["pointEstimate"]]  <- as.numeric(out[["pointEstimate"]])
 		result[["lowerBound"]]     <- as.numeric(out[["lowerBound"]])
 		result[["upperBound"]]     <- as.numeric(out[["upperBound"]])
 	} else {
@@ -377,12 +378,17 @@ evaluation <- function(confidence = 0.95, method = "binomial", N = NULL,
 		result[["populationK"]]        		 <- as.numeric(populationK)
 	# Produce relevant conclusions conditional on the analysis result
 	approvePrecision <- TRUE
-	if(minPrecision != 1)
-		approvePrecision <- result[["precision"]] <= minPrecision
+	if(minPrecision != 1){
+		if(method %in% c("direct", "difference", "quotient", "regression")){
+			approvePrecision <- (result[["precision"]] / populationBookValue) < minPrecision
+		} else {
+			approvePrecision <- result[["precision"]] < minPrecision
+		}
+	}
 	approveMateriality <- TRUE
 	if(materiality != 1){
 		if(method %in% c("direct", "difference", "quotient", "regression")){
-			approveMateriality <- populationBookValue <= result[["upperBound"]] && populationBookValue >= result[["lowerBound"]]
+			approveMateriality <- (result[["upperBound"]] / populationBookValue) < materiality
 		} else {
 			approveMateriality <- result[["confBound"]] < materiality
 		}
@@ -466,6 +472,16 @@ evaluation <- function(confidence = 0.95, method = "binomial", N = NULL,
 		# Add class 'jfaPosterior' to the posterior distribution object.
 		class(result[["posterior"]]) <- "jfaPosterior"
 	}
+	if(!is.null(sample)){
+		indexa <- which(colnames(sample) == auditValues)
+		indexb <- which(colnames(sample) == bookValues)
+		frame <- as.data.frame(sample[, c(indexb, indexa)])
+		frame <- cbind(as.numeric(rownames(frame)), frame)
+		frame[["difference"]] <- frame[, 2] - frame[, 3]
+		frame[["taint"]] <- frame[, 4] / frame[, 2]
+		colnames(frame) <- c("Row", bookValues, auditValues, "Difference", "Taint")
+		result[["data"]] <- frame
+	}
 	# Add class 'jfaEvaluation' to the result.
 	class(result) <- "jfaEvaluation"
 	return(result)

R/hidden.R

@@ -180,7 +180,7 @@ print.jfaEvaluation <- function(x, digits = 2, ...){
 # ------------------------------------------------------------
 # Output:
 #
-# Most likely error:       ", round(x[["pointEstimate"]], digits), "
+# Most likely error:       ", round(x[["mle"]], digits), "
 # Lower bound:             ", round(x[["lowerBound"]], digits),"
 # Upper bound:             ", round(x[["upperBound"]], digits),"
 # Precision:               ", round(x[["precision"]], digits),"
@@ -382,13 +382,23 @@ plot.jfaEvaluation <- function(x, ...){
 	if(x[["method"]] %in% c("stringer", "stringer-meikle", "stringer-lta", "stringer-pvz", "rohrbach", "moment", "coxsnell"))
 		stop("No plotting method available for a confidence bound from this method.")
 	if(x[["method"]] %in% c("direct", "difference", "quotient", "regression")){
-		ymin <- x[["lowerBound"]] - (x[["pointEstimate"]] - x[["lowerBound"]])
-		ymax <- x[["upperBound"]] + (x[["upperBound"]] - x[["pointEstimate"]])
-		ticks <- pretty(ymin, ymax, min.n = 5)
-		graphics::plot(x = 0, y = x[["pointEstimate"]], bty = "n", cex = 2, pch = 19, xlab = "Population book value", ylab = "", ylim = c(min(ticks), max(ticks)), xlim = c(-0.1, 0.1), axes = FALSE)
-		graphics::arrows(x0 = 0, x1 = 0, y0 = x[["lowerBound"]], y1 = x[["upperBound"]], code = 3, lwd = 2, col = "black", angle = 90)
-		graphics::axis(2, at = ticks, las = 1)
-		graphics::abline(h = x[["popBookvalue"]], lty = 2)
+		ymin <- x[["mle"]] - 2 * x[["precision"]]
+		ymax <- x[["mle"]] + 2 * x[["precision"]]
+		graphics::plot(0, type = "n", ylim = c(ymin, ymax), ylab = expression(E), xlim = c(0, 1), bty = "n", xaxt = "n", xlab = "", yaxt = "n", main = paste0(round(x[["confidence"]] * 100, 2), "% Confidence interval"))
+  		yBreaks <- base::pretty(c(ymin, ymax), n = 6)
+  		graphics::axis(side = 2, at = yBreaks, labels = base::format(round(yBreaks), scientific = F, big.mark = ","), las = 1)
+		graphics::segments(x0 = 0, x1 = 1, y0 = 0, y1 = 0, lty = 2, col = "gray")
+  		if(x[["materiality"]] != 1)
+    		graphics::segments(x0 = 0, x1 = 1, y0 = (x[["popBookvalue"]] * x[["materiality"]]), y1 = (x[["popBookvalue"]] * x[["materiality"]]), lty = 2, col = "red")
+  		graphics::points(x = 0.5, y = x[["mle"]], pch = 19)
+		graphics::arrows(x0 = 0.5, x1 = 0.5, y0 = x[["lowerBound"]], y1 = x[["upperBound"]], code = 3, lwd = 2, col = "black", angle = 90)
+		graphics::text(x = 0.86, y = x[["mle"]], labels = paste0("Most likely error = ", format(round(x[["mle"]], 2), scientific = FALSE, big.mark = ",")), cex = 0.75, adj = c(1, 0.5))
+		graphics::text(x = 0.87, y = x[["lowerBound"]], labels = paste0("Lower bound = ", format(round(x[["lowerBound"]], 2), scientific = FALSE, big.mark = ",")), cex = 0.75, adj = c(1, 0.5))
+		graphics::text(x = 0.87, y = x[["upperBound"]], labels = paste0("Upper bound = ", format(round(x[["upperBound"]], 2), scientific = FALSE, big.mark = ",")), cex = 0.75, adj = c(1, 0.5))
+		graphics::segments(x0 = 0.40, x1 = 0.40, y0 = x[["mle"]], y1 = x[["upperBound"]], col = "black")
+		graphics::segments(x0 = 0.40, x1 = 0.42, y0 = x[["mle"]], y1 = x[["mle"]], col = "black")
+		graphics::segments(x0 = 0.40, x1 = 0.42, y0 = x[["upperBound"]], y1 = x[["upperBound"]], col = "black")
+		graphics::text(x = 0.15, y = (x[["upperBound"]] - x[["precision"]]/2), labels = paste0("Precision = ", format(round(x[["precision"]], 2), scientific = FALSE, big.mark = ",")), cex = 0.75, adj = c(0, 0.5))
 	} else {
 		limx <- length(0:x[["n"]])
 		if(limx > 51){

R/internal.R

@@ -17,4 +17,13 @@
 # .dCoxAndSnellF <- function(x, df1, df2, multiplicationFactor){
 # 	# Rewritten using Wolfram Mathematica
 # 	(df1 ** (df1 / 2) * df2**(df2 / 2) * (x / multiplicationFactor) ** (- 1 + df1 / 2) * (df2 + (df1 * x) / multiplicationFactor)**(( -df1 - df2) / 2))/(abs(multiplicationFactor) * beta(df1/2, df2/2))
-# }
+# }
+
+.getfun<-function(x) {
+  if(length(grep("::", x))>0) {
+    parts<-strsplit(x, "::")[[1]]
+    getExportedValue(parts[1], parts[2])
+  } else {
+    x
+  }
+}

R/report.R

@@ -0,0 +1,63 @@
+#' Generate an Audit Report
+#'
+#' @description This function takes an object of class \code{jfaEvaluation}, creates a report containing the results, and saves the report to a file in your working directory.
+#'
+#' For more details on how to use this function see the package vignette:
+#' \code{vignette("jfa", package = "jfa")}
+#'
+#' @usage report(object = NULL, file = NULL, format = "html_document")
+#'
+#' @param object an object of class 'jfaEvaluation' as returned by the \code{evaluation()} function.
+#' @param file a string that gives the desired name of the file (e.g. \code{"report.html"}). The report is created in your current working directory.          
+#' @param format can be either one of \code{"html_document"} or \code{"pdf_document"} (required MikTex).
+#'
+#' @return A html or pdf report containing the results of the evaluation.
+#'
+#' @author Koen Derks, \email{k.derks@nyenrode.nl}
+#'
+#' @seealso \code{\link{evaluation}}
+#'
+#' @examples
+#' library(jfa)
+#' set.seed(1)
+#' 
+#' # Generate some audit data (N = 1000):
+#' data <- data.frame(ID = sample(1000:100000, size = 1000, replace = FALSE), 
+#'                    bookValue = runif(n = 1000, min = 700, max = 1000))
+#' 
+#' # Using monetary unit sampling, draw a random sample from the population.
+#' s1 <- selection(population = data, sampleSize = 100, units = "mus", 
+#'                  bookValues = "bookValue", algorithm = "random")
+#' s1_sample <- s1$sample
+#' s1_sample$trueValue <- s1_sample$bookValue
+#' s1_sample$trueValue[2] <- s1_sample$trueValue[2] - 500 # One overstatement is found
+#'
+#' e2 <- evaluation(sample = s1_sample, bookValues = "bookValue", auditValues = "trueValue", 
+#'                  method = "stringer", materiality = 0.05, counts = s1_sample$counts)
+#'
+#' # Generate report
+#' # report(e2, file = "myFile.html")
+#'
+#' @keywords evaluation report audit
+#'
+#' @export
+
+report <- function(object = NULL, file = NULL, format = "html_document"){
+
+  if(!class(object) == "jfaEvaluation")
+    stop("Object must be of class 'jfaEvaluation'.")
+
+  #Determine the template
+  theFile <- system.file("rmd/report.Rmd", package = "jfa")
+
+  #Process the Arguments
+  args               <- list()
+  args$input         <- theFile
+  args$output_dir    <- getwd()
+  args$output_format <- format
+  args$output_file   <- file
+
+  #Run the render
+  outputFileName <- do.call(.getfun('rmarkdown::render'), args = args)
+  invisible(outputFileName)
+}

README.Rmd

@@ -82,6 +82,8 @@ library(jfa)
 
 ### Vignettes
 
+The package vignettes contain explanations about the functionality of `jfa` illustated using simple examples.
+
 * [Get started](https://koenderks.github.io/jfa/articles/jfa.html) 
 * [The audit sampling workflow](https://koenderks.github.io/jfa/articles/v1auditWorkflow.html)
 * [Constructing a prior distribution](https://koenderks.github.io/jfa/articles/v2priorDistributions.html)
@@ -104,6 +106,12 @@ If you are willing to contribute to the improvement of the package by adding a b
 
 Below is a list of the available functions in the current version of `jfa`, sorted by their occurrence in the standard audit sampling workflow.
 
+* [`auditPrior()`](#create-a-prior-distribution-with-the-auditprior-function)
+* [`planning()`](#plan-a-sample-with-the-planning-function)
+* [`selection()`](#select-transactions-with-the-selection-function)
+* [`evaluation()`](#evaluate-a-sample-with-the-evaluation-function)
+* [`report()`](#generate-a-report-with-the-report-function)
+
 ### Create a prior distribution with the `auditPrior()` function:
 
 The `auditPrior()` function creates a prior distribution according to one of several methods, including the audit risk model and assessments of the inherent and control risk. The returned object is of class `jfaPrior` and can be used with associated `print()` and `plot()` methods. `jfaPrior` results can also be used as input argument for the `prior` argument in other functions.
@@ -197,9 +205,19 @@ The `evaluation()` function takes a sample data frame or summary statistics abou
 | `quotient` | Touw and Hoogduin (2011) | Quotient estimator | `populationBookValue` |
 | `regression` | Touw and Hoogduin (2011) | Regression estimator | `populationBookValue` |
 
+### Generate a report with the `report()` function:
+
+The `report()` function takes an object of class `jfaEvaluation` as returned by the `evaluation()` function, automatically generates a `html` or `pdf` report containing the analysis results and their interpretation, and saves the report to your local computer. 
+
+*Full function with default arguments:*
+
+`report(object = NULL, file = NULL, format = "html_document")`
+
+For an example report, see the following [link](https://github.com/koenderks/jfa/tree/master/man/figures/readme/report/report.pdf).
+
 ## References
 
-- Bickel, P. J. (1992). Inference and auditing: The Stringer Bound. *International Statistical Review*, 60(2), 197–209. - [View online](https://www.jstor.org/stable/1403650)
+- Bickel, P. J. (1992). Inference and auditing: The Stringer bound. *International Statistical Review*, 60(2), 197–209. - [View online](https://www.jstor.org/stable/1403650)
 - Cox, D. R., & Snell, E. J. (1979). On sampling and the estimation of rare errors. *Biometrika*, 66(1), 125-132. - [View online](https://doi.org/10.1093/biomet/66.1.125)
 - Derks, K. (2020). jfa: Bayesian and classical audit sampling. R package version 0.4.0. - [View online](https://cran.r-project.org/package=jfa)
 - Derks, K., de Swart, J., van Batenburg, P., Wagenmakers, E.-J., & Wetzels, R. (2020). Priors in a Bayesian audit: How integration of existing information into the prior distribution can improve audit transparency and efficiency. *Under review*. - [View online](https://psyarxiv.com/8fhkp/)

README.md

@@ -88,6 +88,9 @@ The `jfa` package can then be loaded in R or RStudio by typing:
 
 ### Vignettes
 
+The package vignettes contain explanations about the functionality of
+`jfa` illustated using simple examples.
+
   - [Get started](https://koenderks.github.io/jfa/articles/jfa.html)
   - [The audit sampling
     workflow](https://koenderks.github.io/jfa/articles/v1auditWorkflow.html)
@@ -129,6 +132,12 @@ Below is a list of the available functions in the current version of
 `jfa`, sorted by their occurrence in the standard audit sampling
 workflow.
 
+  - [`auditPrior()`](#create-a-prior-distribution-with-the-auditprior-function)
+  - [`planning()`](#plan-a-sample-with-the-planning-function)
+  - [`selection()`](#select-transactions-with-the-selection-function)
+  - [`evaluation()`](#evaluate-a-sample-with-the-evaluation-function)
+  - [`report()`](#generate-a-report-with-the-report-function)
+
 ### Create a prior distribution with the `auditPrior()` function:
 
 The `auditPrior()` function creates a prior distribution according to
@@ -254,9 +263,23 @@ FALSE, nPrior = 0, kPrior = 0, rohrbachDelta = 2.7, momentPoptype =
 | `quotient`        | Touw and Hoogduin (2011)              | Quotient estimator                      | `populationBookValue`    |
 | `regression`      | Touw and Hoogduin (2011)              | Regression estimator                    | `populationBookValue`    |
 
+### Generate a report with the `report()` function:
+
+The `report()` function takes an object of class `jfaEvaluation` as
+returned by the `evaluation()` function, automatically generates a
+`html` or `pdf` report containing the analysis results and their
+interpretation, and saves the report to your local computer.
+
+*Full function with default arguments:*
+
+`report(object = NULL, file = NULL, format = "html_document")`
+
+For an example report, see the following
+[link](https://github.com/koenderks/jfa/tree/master/man/figures/readme/report/report.pdf).
+
 ## References
 
-  - Bickel, P. J. (1992). Inference and auditing: The Stringer Bound.
+  - Bickel, P. J. (1992). Inference and auditing: The Stringer bound.
     *International Statistical Review*, 60(2), 197–209. - [View
     online](https://www.jstor.org/stable/1403650)
   - Cox, D. R., & Snell, E. J. (1979). On sampling and the estimation of

cran-comments.md

@@ -1,7 +1,9 @@
 ## This is a submission for version 0.5.0
 This is jfa version 0.5.0. In this version I have:
 
+* Added a report function.
 * Deprecated the sampling function.
+* Extended unit tests.
 
 ## Test environments
 * OS X install (on travis-ci), R release