#' Wykres - histogram
#' @description
#' Rysuje histogram z przekazanych danych.
#' @param dane wektor danych
#' @param n liczba przedziałów
#' @param tytul tytuł wykresu
#' @param tytulX tytuł osi X wykresu
#' @param tytulY tytuł osi Y wykresu
#' @param rozmiarTekstu bazowy rozmiar tekstu
#' @param opcjeWykresu dodatkowe opcje wykresu (zostaną dodane do obiektu
#' wykresu ggplot2)
#' @param rownePrzedzialy czy przedziały na osi X powinny być równe (TRUE) czy
#' wyznaczane przez kwantyle (FALSE)
#' @param rysuj czy funkcja ma narysować wykres czy tylko zwrócić wygenerowany
#' obiekt wykresu
#' @param pomijajEtykiety wartość, na podstawie której funkcja decyduje, które
#' etykiety będą na siebie nachodzić i należy je pomijać; nie ma żadnej
#' intuicyjnej interpretacji, wiadomo jedynie, że im ona mniejsza, tym
#' szybciej etykiety będą pomijane; odpowiedią wartość należy dobrać
#' eksperymentalnie
#' @return [gg] obiekt wykresu pakietu ggplot2
#' @export
#' @import ggplot2
wykresHistogram = function(dane, n = 9, tytul = '', tytulX = NULL, tytulY = NULL, rozmiarTekstu = NULL, opcjeWykresu = NULL, rownePrzedzialy = FALSE, rysuj = TRUE, pomijajEtykiety = 500){
stopifnot(
is.vector(dane) | is.factor(dane),
is.numeric(dane) | is.character(dane) | is.logical(dane) | is.factor(dane)
)
nGiodo = 3
dane[is.nan(dane) | is.infinite(dane)] = NA
dane = stats::na.exclude(dane)
if (length(dane) == 0) {
return(wykresPusty(tytul = tytul, tytulX = tytulX, tytulY = tytulY, rysuj = rysuj))
}
if (is.numeric(dane)) {
if (rownePrzedzialy) {
breaks = seq(min(dane), max(dane), length.out = n + 1)
} else {
n = min(n, length(unique(dane)))
breaks = stats::quantile(dane, seq(0, 1, length.out = n + 1))
while (length(breaks) != length(unique(breaks))) {
n = n - 1
breaks = stats::quantile(dane, seq(0, 1, length.out = n + 1))
}
# straszliwe ręczne generowanie wysokości słupków
szer = cbind(breaks[-1], breaks[-length(breaks)])
szer = 1 / (szer[, 1] - szer[, 2])
szer = szer / sum(szer)
breaksTmp = breaks + 10^-6
breaksTmp[1] = breaks[1]
if (length(breaksTmp) == 1) {
return(wykresPusty(tytul = tytul, tytulX = tytulX, tytulY = tytulY, rysuj = rysuj))
# breaksTmp[2] = breaksTmp[1] + 10^-6
# coś jeszcze zrobić z szerokościami
}
grupy = cut(dane, breaksTmp, labels = names(szer), right = FALSE)
nMin = min(table(grupy))
if (nMin < nGiodo) {
return(wykresPusty(tytul = tytul, tytulX = tytulX, tytulY = tytulY, rysuj = rysuj))
}
wagi = szer[grupy]
wys = stats::aggregate(wagi, list(names(wagi)), function(x){x[1] * length(x)})
wys$x = round(1000 * wys$x)
srednie = rowMeans(cbind(breaks[-1], breaks[-length(breaks)]))
wys$grupa = srednie[wys[, 1]] - 1 #!!!
dane = as.numeric(unlist(by(wys, wys$grupa, function(x){
return(rep(x$grupa[1], x$x[1]))
})))
}
wykres = ggplot(data = data.frame(d = dane)) + aes(x = get('d')) +
suppressWarnings( # różna szerokość słupków generuje "position_stack requires constant width: output may be incorrect"
geom_histogram(
breaks = breaks,
colour = '#999999',
fill = '#FFFFFF'
)
)
}else{
nMin = min(table(dane))
if (nMin < nGiodo) {
return(wykresPusty(tytul = tytul, tytulX = tytulX, tytulY = tytulY, rysuj = rysuj))
}
wykres = ggplot(data = data.frame(d = dane)) + aes(x = get('d')) +
geom_bar(
colour = '#000000',
fill = '#FFFFFF',
stat = 'count'
)
}
wykres = wykresDefaultTheme(wykres, tytul = tytul, tytulX = tytulX, tytulY = tytulY, rozmiarTekstu = rozmiarTekstu) +
theme(
axis.line = element_line(colour = '#000000', linetype = 'solid'),
axis.line.x = element_blank(),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)
)
if (rownePrzedzialy == FALSE) {
wykres = wykres + theme(axis.line.y = element_blank(), axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank())
}
# skala osi X dla danych ciągłych
if (is.numeric(dane)) {
wykres = etykietyHistogramu(wykres, breaks, rozmiarTekstu, pomijajEtykiety)
}
if (!is.null(opcjeWykresu)) {
wykres = wykres + opcjeWykresu
}
if (rysuj) {
suppressWarnings(print(wykres))
}
return(invisible(wykres))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.