Nothing
similarity <- function(model = NULL, obs = NULL, pred = NULL, thresh, measures = modEvAmethods("similarity"), simplif = FALSE, plot = TRUE, plot.type = "lollipop", plot.ordered = FALSE, verbosity = 2, interval = 0.01, quant = 0, na.rm = TRUE, rm.dup = FALSE, ...) {
# version 1.0 (10 Nov 2023)
obspred <- inputMunch(model, obs, pred, na.rm = na.rm, rm.dup = rm.dup)
obs <- obspred[ , "obs"]
pred <- obspred[ , "pred"]
#if (any(pred < 0 | pred > 1)) stop ("'pred' must range between 0 and 1")
# if (!(thresh == "preval" | is.numeric(thresh)))
# stop("'thresh' must be either 'preval' or a numeric value between 0 and 1")
# if (thresh == "preval") thresh <- prevalence(obs)
if (!(is.numeric(thresh) || thresh %in% modEvAmethods("getThreshold")))
stop("'thresh' must be either a numeric value between 0 and 1, or one of the options obtained with modEvAmethods('getThreshold')")
if (thresh %in% modEvAmethods("getThreshold")) thresh <- getThreshold(obs = obs, pred = pred, threshMethod = thresh, interval = interval, quant = quant, na.rm = na.rm)
if (is.finite(thresh)) {
pred01 <- pred
pred01[pred < thresh] <- 0
pred01[pred >= thresh] <- 1
N <- length(pred)
}
Nmeasures <- length(measures)
measureValues <- as.vector(rep(NA, Nmeasures), mode = "numeric")
names(measureValues) <- measures
A <- sum(obs, na.rm = na.rm)
B <- sum(pred01, na.rm = na.rm)
C <- sum(pmin(obs, pred01, na.rm = na.rm), na.rm = na.rm) # intersection
for (m in measures) {
if (m %in% modEvAmethods("similarity") && is.finite(thresh)) {
if (m == "Jaccard") measureValues[m] <- C / (A + B - C)
if (m == "Sorensen") measureValues[m] <- 2 * C / (A + B)
} # end if m in modEvAmethods("similarity")
else {
warning("'", m, "' is not a valid measure;
type modEvAmethods('similarity') for available options.")
next
} # end else
} # end for m
Measures <- matrix(data = measureValues, nrow = Nmeasures, ncol = 1, dimnames = list(measures, "Value"))
if (simplif) { # shorter version for use with e.g. optiThresh function
return(Measures)
} else {
if (plot) {
measures.plot <- measureValues
if (plot.ordered) {
measures.plot <- sort(measures.plot, decreasing = TRUE, na.last = TRUE)
}
measures.plot[is.infinite(measures.plot)] <- NA
if (plot.type == "barplot" && any(is.finite(measures.plot))) barplot(measures.plot[is.finite(measures.plot)], las = 3, ...)
if (plot.type == "lollipop" && any(is.finite(measures.plot))) lollipop(measures.plot[is.finite(measures.plot)], las = 3, ymin = NA, ylab = "", ...)
} # end if plot
return(list(N = N, Threshold = thresh,
similarity = Measures))
} # end else
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.