Last active
January 14, 2020 16:34
-
-
Save SigurdJanson/d13f45871ed9d9ac7797c23f9208ef3b to your computer and use it in GitHub Desktop.
ReversionTest
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' ReversionTest | |
#' Tests the precision of two reciprocal functions. It evaluates the differences between | |
#' a computed value \eqn{x'} and an expected value \eqn{x} after \eqn{x' = finv(f(x))}. | |
#' @param f,finv The functions to be tested for precision with finv the inverse function for f. | |
#' @param ToIterate a list of vectors, on for each variable. | |
#' @param KeyVar The variable in ToIterate for which the test is for. Either an list index | |
#' or a name as string (partial strings allowed). | |
#' @param ... additional arguments to be passed to f and finv. | |
#' @param DiffFunc A function to quantify the difference between expected | |
#' value and computed value. If Null, ReversionTest will use the absolute ratio. | |
#' @details Each list element of \code{ToIterate} is a vector that contains | |
#' the values that shall be used for the tests. Each list element must be | |
#' named after the argument that will be passed on to f and finv. The 'DiffFunc' | |
#' must allow the arguments x, y, and tol (see [.NearlyEqual][.NearlyEqual()]). | |
#' @value The result is a list of class 'ReversionTest'. | |
#' @example TotalResult <- ReversionTest("qnorm", "pnorm", ToIterate=list(mean = -4:4, sd=c(0.5, 1.5), c(0.1, 0.2, 0.9)), KeyVar = 3) | |
ReversionTest <- function(f, finv, ToIterate = NULL, KeyVar = 1, DiffFunc = .NearlyEqual, ...) { | |
.forwardreverse <- function(x, ...) { | |
## example: do.call("dnorm", list(-1:1, sd = -2, mean = 0, ...)) | |
Args.Forward <- append(x, list(...)) | |
Result <- do.call(f, Args.Forward) | |
Args.Backward <- x | |
Args.Backward[KeyVar] <- Result | |
Args.Backward <- append(Args.Backward, list(...)) | |
Result <- do.call(finv, Args.Backward) | |
return(Result) | |
} | |
# PRECONDITIONS | |
if(!is.character(f) || !is.character(finv)) | |
stop("Need function name for 'f' and 'finv' as string") | |
TestResult <- list(Functions = list(f, finv)) | |
f <- match.fun(f) | |
finv <- match.fun(finv) | |
# | |
if(!is.list(ToIterate)) stop("List expected for 'ToIterate'") | |
if(length(ToIterate) < 1) stop("Nothing to iterate through") | |
if(!all(unlist(lapply(ToIterate, is.atomic )))) | |
stop("'ToIterate' must contain only atomic numeric vectors") | |
if(!all(unlist(lapply(ToIterate, is.numeric)))) | |
stop("'ToIterate' must contain only atomic numeric vectors") | |
# | |
if(is.numeric(KeyVar)) { | |
if(KeyVar <= 0) stop("Key variable must be 1 or greater") | |
if(KeyVar > length(ToIterate)) stop("Index of key variable out of bounds") | |
} else { | |
KeyVar <- pmatch(KeyVar, names(ToIterate)) | |
if(is.na(KeyVar)) stop("Key variable not found in ToIterate") | |
} | |
# Fix order in case of unnamed arguments | |
ArgNameLen <- nchar(names(ToIterate)) | |
if(any(ArgNameLen > 0)) { # there are unnamed arguments | |
# Better safe than sorry | |
if(sum(ArgNameLen == 0) > 1) | |
stop("This function can handle only a single unnamed argument") | |
# An unnamed variable must come first | |
OldOrder <- names(ToIterate) | |
ToIterate <- ToIterate[c(which(ArgNameLen == 0), which(ArgNameLen != 0))] | |
NewOrder <- names(ToIterate) | |
# Correct index of KeyVar | |
KeyVar <- which(names(NewOrder) == names(OldOrder[KeyVar])) | |
if(length(KeyVar) == 0L) KeyVar <- 1 # Correction because 'which' does not catch empty strings | |
} | |
# | |
delta <- match.fun(DiffFunc) | |
Precision <- sqrt(.Machine$double.eps) | |
# CODE | |
# get data.frame with all combinations of vector elements in ToIterate | |
Df <- expand.grid(ToIterate) | |
# Force the names to the original ones because expand.grid replaces "" with "Var?" | |
if(is.null(names(ToIterate))) names(ToIterate) <- "" | |
names(Df) <- names(ToIterate) | |
# Go, iterate! | |
Df$Result <- apply(Df, 1, .forwardreverse, ...) | |
Df["Delta"] <- delta(Df[[KeyVar]], Df$Result, tol = Precision) | |
# Build result object | |
TestResult <- append(TestResult, list(Diff = DiffFunc, Data = Df)) | |
TestResult <- append(TestResult, list(Variables = names(ToIterate))) | |
TestResult <- append(TestResult, list(Precision = Precision, TestTime = Sys.time())) | |
class(TestResult) <- "ReversionTest" | |
return(TestResult) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment