R/wizualizacje.R

In mstaniak/AnalizaZanieczyszczen: Modelowanie zanieczyszczenia powietrza błądzeniem losowym Kendalla.

#' Histogram minimum, maksimum i średniej stężenia polutanta.
#'
#'
#' @param obs Ramka z danymi zwrócona przez funkcję obliczStatystyki.
#' @param ... Opcje do przekazania geom_histogram.
#'
#' @return obiekt ggplot2
#'
#' @export
#' 

rysujHistogram <- function(obs, ...) {
  obs %>%
    mutate(rok = year(dzienPomiaru)) %>%
    ggplot(aes(x = wartosc, fill = statystyka)) + 
    geom_histogram(...) +
    theme_bw() +
    xlab("Wartość statystyki") +
    ylab("Liczba wystąpień") -> wykres
  nStat <- n_distinct(obs$statystyka)
  nLat <- n_distinct(year(obs$dzienPomiaru))
  if(nStat > 1 & nLat > 1) {
    wykres <- wykres + facet_wrap(rok~statystyka, scales = "free")
  } else if(nStat > 1) {
    wykres <- wykres + facet_wrap(~statystyka, scales = "free")
  } else if(nLat > 1) {
    wykres <- wykres + facet_wrap(~rok, scales = "free")
  }
  if(nStat > 1 | nLat > 1) {
    wykres <- wykres + theme(panel.grid.major.y = element_line(linetype = 2, 
                                                               size = 0.2, color = "grey"),
                             panel.grid = element_line(linetype = 2, size = 0.2, color = "grey"))  
  }
  if(nStat == 1) wykres <- wykres + guides(fill = "none")
  wykres
}


#' Rysunek szeregu czasowego - średnich, minimów i maksimów. 
#' 
#' @param ramka tibble zwrócona przez funkcję przygotujDoWiz
#'
#' @return obiekt ggplot2
#'
#' @export
#'

rysujwCzasie <- function(ramka) {
  ggplot(ramka, aes(x = dzienPomiaru, y = wartosc, color = statystyka, group = dzienPomiaru)) +
    geom_point(size = 0.5) +
    geom_line() + 
    theme_bw() +
    theme(panel.grid.major.y = element_line(linetype = 2, size = 0.2, color = "grey"),
          panel.grid = element_line(linetype = 2, size = 0.2, color = "grey")) + 
    scale_color_discrete(name = "") +
    xlab("Data pomiaru") +
    ylab("Dzienne stężenie")
}


#' Wykres qq dla porównania rozkładu danej statystyki z rozkładem teoretycznym.
#'
#' @param obserwacje wektor obserwacji.
#' @param rozklad funkcja obliczająca kwantyle rozkładu teoretycznego.
#' @param parametry lista parametrów rozkładu.
#' @param kwantyle wektor z kwantylami rozkładu teoretycznego.
#' @param transformacja funkcja, którą mają zostać przekształcone dane.
#' @param ... opcjonalne argumenty do funkcji transformującej.
#'
#' @return obiekt ggplot2
#'
#' @export
#'

qqPlot <- function(obserwacje, rozklad, parametry, kwantyle = NULL, transformacja = function(x) x, ...) {
  wynik <- ggplot(as_tibble(x = obserwacje), aes(sample = transformacja(obserwacje, ...))) +
  if(is.null(kwantyle)) wynik <- wynik + stat_qq(distribution = rozklad, dparams = parametry)
  else {
    wynik <- ggplot(as_tibble(x = kwantyle, y = obserwacje)) + geom_point()
  }
  wynik +
  theme_bw() +
  xlab("rozkład teoretyczny") +
  ylab("rozkład empiryczny")
}