R Under development (unstable) (2024-07-10 r86888 ucrt) -- "Unsuffered Consequences" 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(fitdistrplus) Loading required package: MASS Loading required package: survival > > > testdpqfun <- fitdistrplus:::testdpqfun > > > > ##### first argument ##### > #a data.frame of TRUE and "" > testdpqfun("exp", start=c(rate=1)) ok txt 1 TRUE 2 TRUE 3 TRUE > #a data.frame with error messages > dEXP <- function(y, rate) dexp(x, rate) > pEXP <- function(y, rate) pexp(x, rate) > qEXP <- function(y, rate) qexp(x, rate) > testdpqfun("EXP", start=c(rate=1)) ok txt 1 FALSE The dEXP function should have its first argument named: x as in base R 2 FALSE The pEXP function should have its first argument named: q as in base R 3 FALSE The qEXP function should have its first argument named: p as in base R > > > ##### existence ##### > #a data.frame of TRUE and "" > testdpqfun("exp", start=c(rate=1)) ok txt 1 TRUE 2 TRUE 3 TRUE > #a data.frame with error messages > testdpqfun("exp2", start=c(rate=1)) ok txt 1 FALSE The dexp2 function must be defined 2 FALSE The pexp2 function must be defined 3 FALSE The qexp2 function must be defined > > ##### void vector ##### > dexp2 <- function(x, rate) + ifelse(length(x)==0, stop("zero input"), dexp(x,rate)) > dexp3 <- function(x, rate) + ifelse(length(x)==0, NA, dexp(x,rate)) > #TRUE > testdpqfun("exp", "d", c(rate=1)) ok txt 1 TRUE > #error message > testdpqfun("exp2", "d", c(rate=1)) ok 1 FALSE txt 1 The dexp2 function should return a zero-length vector when input has length zero and not raise an error > #error message > testdpqfun("exp3", "d", c(rate=1)) ok 1 FALSE txt 1 The dexp3 function should return a zero-length vector when input has length zero > > ##### inconsistent value ##### > pexp2 <- function(q, rate) + { + res <- pexp(q, rate) + if(any(is.nan(res))) + stop("NaN values") + res + } > pexp3 <- function(q, rate) + { + res <- pexp(q, rate) + if(any(is.infinite(q))) + stop("Inf values") + res + } > > #TRUE > testdpqfun("exp", "p", c(rate=1)) ok txt 1 TRUE > #error message > testdpqfun("exp2", "p", c(rate=1)) ok 1 FALSE txt 1 The pexp2 function should return a vector of with NaN values when input has inconsistent values and not raise an error > #error message > testdpqfun("exp3", "p", c(rate=1)) ok 1 FALSE txt 1 The pexp3 function should return a vector of with NaN values when input has inconsistent values and not raise an error > > ##### missing value ##### > qexp2 <- function(p, rate) + { + res <- qexp(p, rate) + if(any(is.na(res))) + stop("NA values") + res + } > qexp3 <- function(p, rate) + { + res <- qexp(p, rate) + res[!is.na(res)] + } > > #TRUE > testdpqfun("exp", "q", c(rate=1)) ok txt 1 TRUE > #error message > testdpqfun("exp2", "q", c(rate=1)) ok 1 FALSE txt 1 The qexp2 function should return a vector of with NaN values when input has inconsistent values and not raise an error > #error message > testdpqfun("exp3", "q", c(rate=1)) ok 1 FALSE txt 1 The qexp3 function should return a vector of with NA values when input has missing values and not remove missing values > > ##### inconsistent parameter ##### > dnorm2 <- function(x, mean, sd) + { + if(sd < 0) + stop("negative param") + else + dnorm(x,mean,sd) + } > #TRUE > testdpqfun("norm", "d", c(mean=1, sd=1)) ok txt 1 TRUE > #error message > testdpqfun("norm2", "d", c(mean=1, sd=1)) ok 1 FALSE txt 1 The dnorm2 function should return a vector of with NaN values when input has inconsistent parameters and not raise an error > > ##### inconsistent name ##### > dnorm2 <- function(x, mean=0, sd=1, ...) + dnorm(x, mean, sd) > > dnorm3 <- dnorm2 > pnorm3 <- pnorm > qnorm3 <- qnorm > > #TRUE > testdpqfun("norm", "d", c(mean=1, sd=1)) ok txt 1 TRUE > #error message > testdpqfun("norm2", "d", c(mean=1, sd=1)) ok 1 FALSE txt 1 The dnorm2 function should raise an error when names are incorrectly named > > > #a data.frame with error messages > testdpqfun("norm", c("d", "p", "q"), c(mean=1, sd=1)) ok txt 1 TRUE 2 TRUE 3 TRUE > testdpqfun("norm2", c("d", "p", "q"), c(mean=1, sd=1)) ok 1 FALSE 2 FALSE 3 FALSE txt 1 The dnorm2 function should raise an error when names are incorrectly named 2 The pnorm2 function must be defined 3 The qnorm2 function must be defined > testdpqfun("norm3", c("d", "p", "q"), c(mean=1, sd=1)) ok 1 FALSE 2 TRUE 3 TRUE txt 1 The dnorm3 function should raise an error when names are incorrectly named 2 3 > > x <- rnorm(100) > fitdist(x, "norm") #ok Fitting of the distribution ' norm ' by maximum likelihood Parameters: estimate Std. Error mean -0.04566303 0.11105126 sd 1.11051264 0.07852482 > fitdist(x, "norm2", start=list(mean=1, sd=1)) #pnorm2 not defined Fitting of the distribution ' norm2 ' by maximum likelihood Parameters: estimate Std. Error mean -0.04563277 0.11107396 sd 1.11073958 0.07856494 Warning messages: 1: In fitdist(x, "norm2", start = list(mean = 1, sd = 1)) : The dnorm2 function should raise an error when names are incorrectly named 2: In fitdist(x, "norm2", start = list(mean = 1, sd = 1)) : The pnorm2 function must be defined > fitdist(x, "norm3", start=list(mean=1, sd=1)) #The dnorm3 function should return raise an error when names are incorrectly named Fitting of the distribution ' norm3 ' by maximum likelihood Parameters: estimate Std. Error mean -0.04563277 0.11107396 sd 1.11073958 0.07856494 Warning message: In fitdist(x, "norm3", start = list(mean = 1, sd = 1)) : The dnorm3 function should raise an error when names are incorrectly named > > > proc.time() user system elapsed 1.76 0.25 2.00