R version 4.4.0 RC (2024-04-16 r86468 ucrt) -- "Puppy Cup"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(pedbp)
> 
> ################################################################################
> # expect an error if q and/or p have length 1
> test <- tryCatch(est_norm(q = c(1), p = c(0.1)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "length(q) > 1L & length(p) > 1L is not TRUE"))
> 
> test <- tryCatch(est_norm(q = c(1), p = c(0.1, 0.2)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "length(q) > 1L & length(p) > 1L is not TRUE"))
> 
> test <- tryCatch(est_norm(q = c(1, 2), p = c(0.2)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "length(q) > 1L & length(p) > 1L is not TRUE"))
> 
> test <- tryCatch(est_norm(q = c(1, 2), p = numeric(1)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "length(q) > 1L & length(p) > 1L is not TRUE"))
> 
> test <- tryCatch(est_norm(q = c(1, 2)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "argument \"p\" is missing, with no default"))
> 
> test <- tryCatch(est_norm(p = c(0.1, 0.22)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "argument \"q\" is missing, with no default"))
> 
> ################################################################################
> # expect an error when q and p are of different length
> test <- tryCatch(est_norm(q = c(1, 2), p = c(0.1, 0.2, 0.3)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "length(q) == length(p) is not TRUE"))
> 
> ################################################################################
> # check that all( p > 0 & p < 1)
> test <- tryCatch(est_norm(q = c(1, 2), p = numeric(2)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "all(p > 0) & all(p < 1) is not TRUE"))
> 
> test <- tryCatch(est_norm(q = c(1, 2), p = c(0.1, 02)), error = function(e) e)
> stopifnot(inherits(test,"simpleError"))
> stopifnot(identical(test$message, "all(p > 0) & all(p < 1) is not TRUE"))
> 
> ################################################################################
> # quick check of results
> set.seed(42)
> m <- pi
> s <- (1 + sqrt(5)) / 2
> ps <- c(0.1988159, 0.5340165, 0.8743177, 0.9812)
> qs <- qnorm(ps, mean = m, sd = s)
> out <- est_norm(qs, ps)
> 
> stopifnot(identical(names(out$par), c("mean", "sd")))
> stopifnot(isTRUE(abs(m - out$par[1]) < 0.0001))
> stopifnot(isTRUE(abs(s - out$par[2]) < 0.0001))
> 
> # also check that the printing method returns the object
> out2 <- print(out)
    mean       sd 
3.141593 1.618034 
> stopifnot(identical(out2, out))
> 
> # the print method is identical to the print(x$par)
> stopifnot(identical(capture.output(print(out)), capture.output(print.default(out$par))))
> 
> ################################################################################
> # what happens when a completely insane set of values is used to start?
> #
> # unsorted values will error
> ps2 <- sample(ps)
> qs2 <- sample(ps)
> 
> test <- tryCatch(est_norm(qs, ps2), error = function(e) e)
> stopifnot(identical(test$message, "q and p are expected to be sorted in ascending order."))
> 
> test <- tryCatch(est_norm(qs2, ps), error = function(e) e)
> stopifnot(identical(test$message, "q and p are expected to be sorted in ascending order."))
> 
> test <- tryCatch(est_norm(qs2, ps2), error = function(e) e)
> stopifnot(identical(test$message, "q and p are expected to be sorted in ascending order."))
> 
> ################################################################################
> # test the plot -- this was okay on one machine, but fails on other machines
> #g <- plot(out)
> #
> ## when needed, update the saved plot that is tested against
> ## ggplot2::ggsave(g, file = "tests/plot.est_norm.png", width = 7, height = 7)
> #
> ## build and save a graphic
> #tmpfile <- tempfile(fileext = ".png")
> #ggplot2::ggsave(g, file = tmpfile, width = 7, height = 7)
> #
> ## read the graphics
> #if (interactive()) {
> #  expected_img <- png::readPNG("tests/plot.est_norm.png")
> #} else {
> #  expected_img <- png::readPNG("plot.est_norm.png")
> #}
> #new_img <- png::readPNG(tmpfile)
> #
> ## compare the graphics
> #stopifnot(identical(new_img, expected_img))
> 
> ################################################################################
> ##                                End of file                                 ##
> ################################################################################
> 
> proc.time()
   user  system elapsed 
   0.20    0.03    0.21