Nothing
fuzzyRangeChange <- function(pred1, pred2, number = TRUE, prop = TRUE,
na.rm = TRUE, round.digits = 2,
measures = c("Gain", "Loss", "Stable positive", "Stable negative", "Balance"),
plot = TRUE, plot.type = "lollipop", x.lab = TRUE,
...) { # log = NA,
# version 1.9 (12 Jan 2023)
# version 2.0 (-- Jan 2023) -> new arg 'log': NA or the base of the log for the scale (see https://blog.datawrapper.de/weeklychart-logscale3/)
pred1 <- unlist(pred1)
pred2 <- unlist(pred2)
stopifnot(#ncol(pred1) == ncol(pred2),
#all(pred1[is.finite(pred1)] >= 0 && pred1[is.finite(pred1)] <= 1),
#all(pred2[is.finite(pred2)] >= 0 && pred2[is.finite(pred2)] <= 1)
length(pred1) == length(pred2),
min(c(pred1, pred2), na.rm = TRUE) >= 0,
max(c(pred1, pred2), na.rm = TRUE) <= 1
)
if (!number & !prop) stop ("Nothing to calculate if both 'number' and 'prop' are FALSE.")
values <- vector("numeric", length(measures))
names(values) <- measures
if ("Gain" %in% measures) values["Gain"] <- sum(fuzzyOverlay(data.frame(pred1, pred2), op = "expansion", na.rm = na.rm), na.rm = na.rm)
if ("Loss" %in% measures) values["Loss"] <- sum(fuzzyOverlay(data.frame(pred1, pred2), op = "contraction", na.rm = na.rm), na.rm = na.rm)
if ("Stable positive" %in% measures) values["Stable positive"] <- sum(fuzzyOverlay(data.frame(pred1, pred2), op = "maintenance", na.rm = na.rm), na.rm = na.rm)
if ("Stable negative" %in% measures) values["Stable negative"] <- sum(fuzzyOverlay(1 - data.frame(pred1, pred2), op = "maintenance", na.rm = na.rm), na.rm = na.rm)
if ("Balance" %in% measures) values["Balance"] <- sum(fuzzyOverlay(data.frame(pred1, pred2), op = "change", na.rm = na.rm), na.rm = na.rm)
result <- data.frame(Measure = measures, Number = values)
if (prop) {
if (na.rm) n <- length(na.omit(pred1))
else n <- length(pred1)
range.size <- sum(pred1, na.rm = na.rm)
stable.abs <- result[result$Measure == "Stable negative", "Number"]
result$Proportion <- result[ , "Number"] / range.size
result[result$Measure == "Stable negative", "Proportion"] <- stable.abs / (n - range.size)
}
if (!number) {
result <- result[ , - (ncol(result) - 1)]
}
if (plot) {
plot.type <- match.arg(plot.type, c("lollipop", "barplot"))
if (x.lab) xlab <- gsub(x = rownames(result), pattern = " ", replacement = "\n") else xlab <- ""
if (plot.type == "lollipop") modEvA::lollipop(result[ , ncol(result)], names = xlab, ylab = names(result)[ncol(result)], ...)
else if (plot.type == "barplot") barplot(result[ , ncol(result)], names.arg = xlab, ylab = names(result)[ncol(result)], ...)
else message("Invalid 'plot.type'. Plot not produced.")
abline(h = 0)
}
result[ , "Measure"] <- NULL
if (is.finite(round.digits)) result <- round(result, round.digits)
result
}
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.