R/pobieranie.R

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

#' Pobranie podzbioru danych z bazy.
#'
#' @param stacje wektor nazwy stacji.
#' @param substancje wektor nazw substancji.
#' @param rok dwuelementowy wektor z datami, 
#'        spomiędzy których mają pochodzić dane.
#' @param liczbaGodzin 1 (pomiary zbierane co godzinę) lub 24 (dane dobowe).
#' @param sciezka nazwa folderu, w którym znajdują się pliki .csv lub .xls z danymi.
#' @param pominiecie Liczba wierszy do pomięnicia. Nie należy wczytywać wierszy, w których
#'        nie ma pomiarów, bo powoduje to problemy z formatem daty.
#'
#' @return tibble 
#'

pobierzJedenPlik <- function(stacja, substancja, rok, liczbaGodzin = 1,
			     sciezka = getwd(), pominiecie = 3) {
  list.files(sciezka, pattern = "*.xlsx") %>%
    grep(pattern = rok, value = TRUE) %>%
    grep(pattern = substancja, value = TRUE) %>%
    grep(pattern = paste0(liczbaGodzin, "g"), value = TRUE) -> listaPlikow

  if(length(listaPlikow) < 1) stop("Nie ma takiego pliku")
  if(length(listaPlikow) > 1) stop("Plik nie jest jednoznaczny")

  plik <- paste(sciezka, listaPlikow, sep = "/")
  nazwyKolumn <- colnames(read_excel(plik))

if(!sum(grepl(nazwyKolumn, pattern = stacja))) {
  czyStara  <- sum(grepl(names(kodyStacji), pattern = stacja))
  czyNowa <- sum(grepl(kodyStacji, pattern = stacja))
  if(czyStara) {
    stacja <- kodyStacji[stacja]
  } else if(czyNowa) {
    stacja <- names(kodyStacji)[grep(kodyStacji, pattern = stacja)]
  }
  if(!sum(grepl(nazwyKolumn, pattern = stacja))) {
    wynik <- tibble(dataPomiaru = character(0),
		    stacja = character(0),
		    substancja = character(0),
		    pomiar = numeric(0))
    return(wynik)
  }
}

  ramka <- as_tibble(read_excel(plik, skip = pominiecie, col_names = FALSE))
  colnames(ramka) <- nazwyKolumn
  colnames(ramka)[1] <- "dataPomiaru"
  ramka <- ramka[, c("dataPomiaru", stacja)]
  colnames(ramka)[2] <- "pomiar"

  ramka %>%
    mutate(pomiar = str_replace_all(pomiar, ",", ".")) %>%
    mutate(pomiar = as.numeric(pomiar),
	   stacja = stacja,
	   substancja = substancja)
}


#' Funkcja pobierają dane dla jednej stacji, kilku lat i substancji.
#'
#' @param stacja chr, nazwa stacji wg oficjalnego kodowania.
#' @param substancje chr, nazwy substancji do pobrania.
#' @param lata chr, zakres lat, z których mają pochodzić pomiary.
#' @param liczbaGodzin 1 (pomiary zbierane co godzinę) lub 24 (dane dobowe).
#' @param sciezka nazwa folderu, w którym znajdują się pliki .csv lub .xls z danymi.
#' @param pominiecie Liczba wierszy do pomięnicia. Nie należy wczytywać wierszy, w których
#'        nie ma pomiarów, bo powoduje to problemy z formatem daty.
#' 
#' @return tibble z kolumnami analogicznymi jak w funkcji pobierzJedenPlik.
#'
#' @export
#'

pobierzXLSX <- function(stacja, substancje, lata, liczbaGodzin = 1, 
			sciezka = getwd(), pominiecie = 3) {
  wynik <- vector("list", length(substancje)*length(lata))
  for(i in substancje) {
    for(j in lata) {
      wynik[[paste0(i, j)]] <- pobierzJedenPlik(stacja, i, j, liczbaGodzin, sciezka, pominiecie)
    }
  }
  wynik %>%
    bind_rows() %>%
    select(stacja, substancja, dataPomiaru, pomiar) %>%
    mutate(dataPomiaru = ymd_hms(dataPomiaru)) %>%
    mutate(dataPomiaru = round_date(dataPomiaru, unit = "hour")) %>%
    filter(year(dataPomiaru) %in% lata)
}

#' Pobranie podzbioru danych z bazy z pliku csv.
#'
#' @param stacje wektor nazwy stacji.
#' @param substancje wektor nazw substancji.
#' @param rok dwuelementowy wektor z datami, 
#'        spomiędzy których mają pochodzić dane.
#' @param liczbaGodzin 1 (pomiary zbierane co godzinę) lub 24 (dane dobowe).
#' @param sciezka nazwa folderu, w którym znajdują się pliki .csv lub .xls z danymi.
#'
#' @return tibble 
#'

pobierzJedenCSV <- function(stacja, substancja, rok, liczbaGodzin = 1, sciezka = getwd()) {
  list.files(sciezka, pattern = "*.csv") %>%
    grep(pattern = rok, value = TRUE) %>%
    grep(pattern = substancja, value = TRUE) %>%
    grep(pattern = paste0(liczbaGodzin, "g"), value = TRUE) -> listaPlikow

  if(length(listaPlikow) < 1) stop("Nie ma takiego pliku")
  if(length(listaPlikow) > 1) stop("Plik nie jest jednoznaczny")

  plik <- paste(sciezka, listaPlikow, sep = "/")

  ramka <- as_tibble(read_csv(plik, col_names = FALSE))
  colnames(ramka) <- ramka[1, ]
  colnames(ramka)[1] <- "dataPomiaru"
  ramka <- ramka[-(1:3), ]

if(!sum(grepl(colnames(ramka), pattern = stacja))) {
  czyStara  <- sum(grepl(names(kodyStacji), pattern = stacja))
  czyNowa <- sum(grepl(kodyStacji, pattern = stacja))
  if(czyStara) {
    stacja <- kodyStacji[stacja]
  } else if(czyNowa) {
    stacja <- names(kodyStacji)[grep(kodyStacji, pattern = stacja)]
  }
  if(!sum(grepl(colnames(ramka), pattern = stacja))) {
    wynik <- tibble(dataPomiaru = character(0),
		    stacja = character(0),
		    substancja = character(0),
		    pomiar = numeric(0))
    return(wynik)
  }
}

  ramka <- ramka[, c("dataPomiaru", stacja)]
  colnames(ramka)[2] <- "pomiar"

  ramka %>%
    mutate(pomiar = as.numeric(pomiar),
	   stacja = stacja,
	   substancja = substancja)
}


#' Funkcja pobierają dane dla jednej stacji, kilku lat i substancji z pliku csv.
#'
#' @param stacja chr, nazwa stacji wg oficjalnego kodowania.
#' @param substancje chr, nazwy substancji do pobrania.
#' @param lata chr, zakres lat, z których mają pochodzić pomiary.
#' @param liczbaGodzin 1 (pomiary zbierane co godzinę) lub 24 (dane dobowe).
#' @param sciezka nazwa folderu, w którym znajdują się pliki .csv lub .xls z danymi.
#' 
#' @return tibble z kolumnami analogicznymi jak w funkcji pobierzJedenPlik.
#'
#' @export
#'

pobierzCSV <- function(stacja, substancje, lata, liczbaGodzin = 1, sciezka = getwd()) {
  wynik <- vector("list", length(substancje)*length(lata))
  for(i in substancje) {
    for(j in lata) {
      wynik[[paste0(i, j)]] <- pobierzJedenCSV(stacja, i, j, liczbaGodzin, sciezka)
    }
  }

wynik %>%
    bind_rows() %>%
    select(stacja, substancja, dataPomiaru, pomiar) %>%
    mutate(dataPomiaru = ymd_hms(dataPomiaru)) %>%
    mutate(dataPomiaru = round_date(dataPomiaru, unit = "hour")) %>%
    filter(year(dataPomiaru) %in% lata)
}