На основе ответов здесь и здесь я создал свою функцию.
Поскольку в hist
могут встречаться нули, я думаю, что это должна быть новая функция.
Начнем (если я заменю последнюю строку на plot(h)
, предупреждения пропадут, но я не уверен, действительно ли отображается гистограмма с правильными параметрами из ...
):
order_of_magnitude_hist <- function(x, ylog = FALSE, ...) {
params <- list(...)
optionalParamNames <- c(
"breaks", "freq", "probability", "include.lowest", "right", "density",
"angle", "col", "border", "main", "xlim", "ylim", "xlab", "ylab", "axes",
"plot", "labels", "nclass", "warn.unused")
unusedParams <- setdiff(names(params),optionalParamNames)
if (length(unusedParams)) {
stop('unused parameters ',paste(unusedParams,collapse = ', '))
}
if ("breaks" %in% names(params)) {
h <- hist(x, breaks = params$breaks, plot = FALSE)
} else {
h <- hist(x, plot = FALSE, ...)
}
assertthat::assert_that(all(h$counts >= 0))
if (!ylog) {
h$counts[h$counts == 0] <- 0
h$counts[h$counts %in% c(1:9)] <- 1
h$counts[h$counts %in% c(10:99)] <- 2
h$counts[h$counts %in% c(100:999)] <- 3
h$counts[h$counts %in% c(1000:9999)] <- 4
h$counts[h$counts %in% c(10000:99999)] <- 5
} else {
h$counts[h$counts == 0] <- 0
h$counts[h$counts == 1] <- 1
h$counts[h$counts > 1] <- log10(h$counts[h$counts > 1])
}
plot(h, ...)
}
set.seed(1)
dt <- 1/runif (n = 1000, min = 0.0001, max = 10)
order_of_magnitude_hist(dt,
breaks = seq(min(dt), max(dt), length.out = 101),
main = "Title 1")
order_of_magnitude_hist(dt,
breaks = seq(min(dt), max(dt), length.out = 101),
ylog = TRUE,
main = "title 2")
В принципе выглядит нормально, но появляются следующие предупреждения:
Warning messages:
1: In plot.window(xlim, ylim, "", ...) : "breaks" ist kein Grafikparameter
2: In title(main = main, sub = sub, xlab = xlab, ylab = ylab, ...) :
"breaks" ist kein Grafikparameter
3: In axis(1, ...) : "breaks" ist kein Grafikparameter
4: In axis(2, ...) : "breaks" ist kein Grafikparameter
...
1: In doTryCatch(return(expr), name, parentenv, handler) :
"breaks" ist kein Grafikparameter
Предупреждение имеет смысл для меня, но я понятия не имею, как решить проблему.
Любые идеи?
Предупреждающее сообщение появляется при вызове plot(h,...)
. Поскольку h
относится к классу "histogram"
, plot()
вызывает graphics:::plot.histogram()
, у которого нет аргумента breaks
. Ожидается, что разрывы уже будут внутри аргумента x, который относится к классу "histogram"
.
Если вы хотите избавиться от этих предупреждений, я бы рекомендовал передавать только те параметры, которые допустимы для функции graphics:::plot.histogram()
. См. valid_plotting_parameters
и my_plotting_parameters
ниже.
Однако при таком подходе вы можете потерять другие графические параметры, содержащиеся в аргументе ...
функции order_of_magnitude_hist()
. Конечно, вы можете вручную увеличить valid_plotting_parameters
до всех параметров, которые хотите передать graphics:::plot.histogram()
.
order_of_magnitude_hist <- function(x, ylog = FALSE, ...) {
params <- list(...)
optionalParamNames <- c(
"breaks", "freq", "probability", "include.lowest", "right", "density",
"angle", "col", "border", "main", "xlim", "ylim", "xlab", "ylab", "axes",
"plot", "labels", "nclass", "warn.unused")
unusedParams <- setdiff(names(params),optionalParamNames)
if (length(unusedParams)) {
stop('unused parameters ',paste(unusedParams,collapse = ', '))
}
if ("breaks" %in% names(params)) {
h <- hist(x, breaks = params$breaks, plot = FALSE)
} else {
h <- hist(x, plot = FALSE, ...)
}
assertthat::assert_that(all(h$counts >= 0))
if (!ylog) {
h$counts[h$counts == 0] <- 0
h$counts[h$counts %in% c(1:9)] <- 1
h$counts[h$counts %in% c(10:99)] <- 2
h$counts[h$counts %in% c(100:999)] <- 3
h$counts[h$counts %in% c(1000:9999)] <- 4
h$counts[h$counts %in% c(10000:99999)] <- 5
} else {
h$counts[h$counts == 0] <- 0
h$counts[h$counts == 1] <- 1
h$counts[h$counts > 1] <- log10(h$counts[h$counts > 1])
}
# plot(h, ...)
valid_plotting_parameters <- c(
"freq", "density", "angle", "col", "border", "lty", "main", "sub", "xlab",
"ylab", "xlim", "ylim", "axes", "labels", "add", "ann")
my_plotting_parameters <- params[names(params) %in% valid_plotting_parameters]
do.call(what = "plot",
args = append(list(x = h), my_plotting_parameters))
}
set.seed(1)
dt <- 1/runif (n = 1000, min = 0.0001, max = 10)
order_of_magnitude_hist(dt,
breaks = seq(min(dt), max(dt), length.out = 101),
main = "Title 1")
order_of_magnitude_hist(dt,
breaks = seq(min(dt), max(dt), length.out = 101),
ylog = TRUE,
main = "title 2")