## assertive has some important changes. Read ?changes for details.
The mad
function in the stats
package calculates the median absolute deviation.
stats::mad
## function (x, center = median(x), constant = 1.4826, na.rm = FALSE,
## low = FALSE, high = FALSE)
## {
## if (na.rm)
## x <- x[!is.na(x)]
## n <- length(x)
## constant * if ((low || high) && n%%2 == 0) {
## if (low && high)
## stop("'low' and 'high' cannot be both TRUE")
## n2 <- n%/%2 + as.integer(high)
## sort(abs(x - center), partial = n2)[n2]
## }
## else median(abs(x - center))
## }
## <bytecode: 0x0000000006211f38>
## <environment: namespace:stats>
Run example(mad)
to get a feel for how it works.
Update the function to include some assertions checking the inputs. Hint: Some of the inputs should be numeric; others should be logical. Some should be only allow a single value.
Whether you decide to throw errors or correct the inputs is up to you. I prefer to throw errors for the main arguments, and correct the more obscure ‘advanced use’ arguments.
# modify this function
mad2 <- function (x, center = median(x), constant = 1.4826, na.rm = FALSE,
low = FALSE, high = FALSE)
{
assert_is_numeric(x)
center <- coerce_to(use_first(center), "numeric")
constant <- coerce_to(use_first(constant), "numeric")
na.rm <- coerce_to(use_first(na.rm), "logical")
low <- coerce_to(use_first(low), "logical")
high <- coerce_to(use_first(high), "logical")
if (na.rm)
x <- x[!is.na(x)]
n <- length(x)
constant * if ((low || high) && n%%2 == 0) {
if (low && high)
stop("'low' and 'high' cannot be both TRUE")
n2 <- n%/%2 + as.integer(high)
sort(abs(x - center), partial = n2)[n2]
}
else median(abs(x - center))
}
Call the mad2
function to make sure that it works the way you think it should. Remember to include cases of bad inputs as well as good ones, in order to test your assertions.
# run your updated function to see if it works
# some OK examples
x <- 1:100
(mad_x <- mad(x))
## [1] 37.065
(mad2_x <- mad2(x))
## [1] 37.065
all.equal(mad_x, mad2_x)
## [1] TRUE
x2 <- rnorm(100, sd = 20)
(mad_x2 <- mad(x2))
## [1] 20.38694
(mad2_x2 <- mad2(x2))
## [1] 20.38694
all.equal(mad_x2, mad2_x2)
## [1] TRUE
# test funny center arg
mad2(x2, center = c(TRUE, FALSE))
## Warning: Only the first value of 'center' will be used.
## Warning: Coercing use_first(center) to class 'numeric'.
## [1] 18.8511
# test funny constant arg
mad2(x2, center = c("1.4826", "Inf"))
## Warning: Only the first value of 'center' will be used.
## Warning: Coercing use_first(center) to class 'numeric'.
## [1] 19.5666
# similar tests for funny na.rm, low, high args
mad2(x2, na.rm = c(1i, 0), low = raw(10), high = c(4, 20))
## Warning: Only the first value of 'na.rm' will be used.
## Warning: Coercing use_first(na.rm) to class 'logical'.
## Warning: Only the first value of 'low' will be used.
## Warning: Coercing use_first(low) to class 'logical'.
## Warning: Only the first value of 'high' will be used.
## Warning: Coercing use_first(high) to class 'logical'.
## [1] 20.4848