diff --git a/DESCRIPTION b/DESCRIPTION index 27f3917..f0ddaaf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: climate Title: Interface to Download Meteorological (and Hydrological) Datasets -Version: 1.0.0 +Version: 1.0.1 Authors@R: c(person(given = "Bartosz", family = "Czernecki", role = c("aut", "cre"), @@ -33,7 +33,8 @@ Depends: Imports: XML, httr, - curl + curl, + data.table Suggests: testthat, knitr, diff --git a/NAMESPACE b/NAMESPACE index 454195a..ee0e7d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ import(httr) importFrom(XML,readHTMLTable) importFrom(curl,curl_download) importFrom(curl,has_internet) +importFrom(data.table,fread) importFrom(stats,na.omit) importFrom(stats,runif) importFrom(utils,data) diff --git a/NEWS.md b/NEWS.md index 1654b6b..4facfd8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# climate 1.0.1 + +* Adding `data.table` package to read CP1250 on machines that do not support this encoding (translit used instead) + # climate 0.9.9 * Changing URL `danepubliczne.imgw.pl` to `dane.imgw.pl` where needed diff --git a/R/check_locale.R b/R/check_locale.R index 8d81277..2bcb2bc 100644 --- a/R/check_locale.R +++ b/R/check_locale.R @@ -1,12 +1,23 @@ #' Check locale #' -#' This is an extra check for some systems that make use of "C.UTF-8" that cannot parse properly tags used inside the Polish metservice's repository +#' This is an extra check for some systems that make use of "C.UTF-8" or any iso-like encoding recognized as causing potential problems; +#' The provided list of checked encoding cannot parse properly characters used in the Polish metservice's repository and therefore will be forced to use ASCII//TRANSLIT #' @noRd check_locale = function(){ - if(any(strsplit(Sys.getlocale(), "/")[[1]] == "C.UTF-8")){ - message(" Your system locale contains 'C.UTF-8' which may cause trouble. + + if(Sys.getlocale("LC_CTYPE") %in% c("C.UTF-8", "en_US.iso885915")){ + locale = Sys.getlocale("LC_CTYPE") + message(paste0(" Your system locale is: " , locale," which may cause trouble. Please consider changing it manually while working with climate, e.g.: - Sys.setlocale(category = 'LC_ALL', locale = 'en_US.UTF-8') ") + Sys.setlocale(category = 'LC_ALL', locale = 'en_US.UTF-8') ")) + Sys.sleep(4) + return(1) + + } else { + + return(0) } + } + diff --git a/R/clean_metadata_hydro.R b/R/clean_metadata_hydro.R index e03825d..22e38ba 100644 --- a/R/clean_metadata_hydro.R +++ b/R/clean_metadata_hydro.R @@ -5,32 +5,13 @@ #' @param interval temporal interval #' @importFrom utils read.fwf #' @keywords internal -clean_metadata_hydro <- function(address, interval){ - #miesieczne - #address="https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/miesieczne/mies_info.txt" - #dobowe - #address="https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/dobowe/codz_info.txt" - #"https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/dobowe/zjaw_info.txt" - #polroczne_i_roczne - #address="https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/polroczne_i_roczne/polr_info.txt" - #a <- suppressWarnings(na.omit(read.fwf(address, widths = c(1000), - # fileEncoding = "CP1250", stringsAsFactors = FALSE))) +clean_metadata_hydro = function(address, interval){ temp = tempfile() test_url(link = address, output = temp) a = readLines(temp, warn = FALSE) - # if (!httr::http_error(address)) { - # a = readLines(address, warn = FALSE) - # } else { - # stop(call. = FALSE, - # paste0("\nDownload failed. ", - # "Check your internet connection or validate this url in your browser: ", - # url, "\n")) - # } - - a = iconv(a, from = "cp1250", to = "ASCII//TRANSLIT") # usuwamy polskie znaki, bo to robi spore "kuku" a = gsub(a, pattern = "\\?", replacement = "") # usuwamy znaki zapytania powstale po konwersji @@ -39,27 +20,27 @@ clean_metadata_hydro <- function(address, interval){ a = gsub(x = a, pattern="\\^", replacement = "") if (interval == "monthly") { - b <- list(data.frame(parameters = a[3:12])) # skład danych jeszcze nie wiem jak ominąć problem kontroli + b = list(data.frame(parameters = a[3:12])) # sklad danych jeszcze nie wiem jak ominąć problem kontroli # ale on może się zmienić nie wiem czy nie lepiej wykluczyć ostatni rok } if (interval == "daily") { - b <- data.frame(parameters = a[3:12]) + b = data.frame(parameters = a[3:12]) } if (interval == "semiannual_and_annual") { - godzina <- paste0(a[15], ":", a[16]) # nie jestem pewien czy tak bo w dokumentacji jest podzial na dwie kolumny, + godzina = paste0(a[15], ":", a[16]) # nie jestem pewien czy tak bo w dokumentacji jest podzial na dwie kolumny, #ale w pliku jest jedna kolumna a pomiaru brak - data <- c(a[12:14], godzina) - data_od <- paste0("wystapienie_od_", data) - data_do <- paste0("wystapienie_od_", data) - SPT <- unlist(strsplit(a[10], "]/")) # stan/przeplyw/temperatura - SPT[1] <- paste0(SPT[1], "]") - SPT[2] <- paste0(SPT[2], "]") - b <- NULL + data = c(a[12:14], godzina) + data_od = paste0("wystapienie_od_", data) + data_do = paste0("wystapienie_od_", data) + SPT = unlist(strsplit(a[10], "]/")) # stan/przeplyw/temperatura + SPT[1] = paste0(SPT[1], "]") + SPT[2] = paste0(SPT[2], "]") + b = NULL for (i in seq_along(SPT)) { - tmp <- c(a[3:9], SPT[i], data_od, data_do) - b <- cbind(b, tmp) + tmp = c(a[3:9], SPT[i], data_od, data_do) + b = cbind(b, tmp) } - b <- list("H" = data.frame(parameters = b[, 1]), + b = list("H" = data.frame(parameters = b[, 1]), "Q" = data.frame(parameters = b[, 2]), "T" = data.frame(parameters = b[, 3])) } diff --git a/R/clean_metadata_meteo.R b/R/clean_metadata_meteo.R index 34df2e6..27e712f 100644 --- a/R/clean_metadata_meteo.R +++ b/R/clean_metadata_meteo.R @@ -16,7 +16,7 @@ #' } #' -clean_metadata_meteo <- function(address, rank = "synop", interval = "hourly"){ +clean_metadata_meteo = function(address, rank = "synop", interval = "hourly"){ temp = tempfile() @@ -24,53 +24,43 @@ clean_metadata_meteo <- function(address, rank = "synop", interval = "hourly"){ test_url(link = address, output = temp) a = readLines(temp, warn = FALSE) - # if (!httr::http_error(address)) { - # a = readLines(address, warn = FALSE) - # } else { - # a = stop(call. = FALSE, - # paste0("\nDownload failed. ", - # "Check your internet connection or validate this url in your browser: ", - # url, "\n")) - # } - - a <- iconv(a, from = "cp1250", to = "ASCII//TRANSLIT") # usuwamy polskie znaki, bo to robi spore "kuku" - a <- gsub(a, pattern = "\\?", replacement = "") # usuwamy znaki zapytania powstale po konwersji + a = iconv(a, from = "cp1250", to = "ASCII//TRANSLIT") # usuwamy polskie znaki, bo to robi spore "kuku" + a = gsub(a, pattern = "\\?", replacement = "") # usuwamy znaki zapytania powstale po konwersji # additional workarounds for mac os but not only... a = gsub(x = a, pattern="'", replacement = "") a = gsub(x = a, pattern="\\^0", replacement = "") - a <- data.frame(V1 = a[nchar(a) > 0], stringsAsFactors = FALSE) + a = data.frame(V1 = a[nchar(a) > 0], stringsAsFactors = FALSE) # to nie dziala na windowsie: - # a <- suppressWarnings(na.omit(read.fwf(address, widths = c(1000), + # a = suppressWarnings(na.omit(read.fwf(address, widths = c(1000), # fileEncoding = "CP1250", stringsAsFactors = FALSE))) - - length_char <- max(nchar(a$V1), na.rm = TRUE) + length_char = max(nchar(a$V1), na.rm = TRUE) - if(rank == "precip" && interval == "hourly") length_char <- 40 # wyjatek dla precipow - if(rank == "precip" && interval == "daily") length_char <- 40 # wyjatek dla precipow dobowych - if(rank == "synop" && interval == "hourly") length_char <- 60 # wyjatek dla synopow terminowych - if(rank == "climate" && interval == "monthly") length_char <- 52 # wyjatek dla synopow terminowych + if(rank == "precip" && interval == "hourly") length_char = 40 # wyjatek dla precipow + if(rank == "precip" && interval == "daily") length_char = 40 # wyjatek dla precipow dobowych + if(rank == "synop" && interval == "hourly") length_char = 60 # wyjatek dla synopow terminowych + if(rank == "climate" && interval == "monthly") length_char = 52 # wyjatek dla synopow terminowych - field <- substr(a$V1, length_char - 3, length_char) + field = substr(a$V1, length_char - 3, length_char) if(rank == "synop" && interval == "monthly") { - length_char <- as.numeric(names(sort(table(nchar(a$V1)), decreasing = TRUE)[1])) + 2 - field <- substr(a$V1, length_char - 3, length_char + 2) + length_char = as.numeric(names(sort(table(nchar(a$V1)), decreasing = TRUE)[1])) + 2 + field = substr(a$V1, length_char - 3, length_char + 2) } - a$field1 <- suppressWarnings(as.numeric(unlist(lapply(strsplit(field, "/"), function(x) x[1])))) - a$field2 <- suppressWarnings(as.numeric(unlist(lapply(strsplit(field, "/"), function(x) x[2])))) + a$field1 = suppressWarnings(as.numeric(unlist(lapply(strsplit(field, "/"), function(x) x[1])))) + a$field2 = suppressWarnings(as.numeric(unlist(lapply(strsplit(field, "/"), function(x) x[2])))) - a$V1 <- trimws(substr(a$V1, 1, nchar(a$V1) - 3)) + a$V1 = trimws(substr(a$V1, 1, nchar(a$V1) - 3)) strsplit(x = a$V1, split = "/") - #a <- a[nchar(a$V1)>2,] # usuwamy puste lub prawie puste wiersze dodatkowo... - a <- a[!(is.na(a$field1) & is.na(a$field2)), ] # usuwanie info o statusach - colnames(a)[1] <- "parameters" + #a = a[nchar(a$V1)>2,] # usuwamy puste lub prawie puste wiersze dodatkowo... + a = a[!(is.na(a$field1) & is.na(a$field2)), ] # usuwanie info o statusach + colnames(a)[1] = "parameters" a } diff --git a/R/get_coord_from_string.R b/R/get_coord_from_string.R index 630edd1..03d8212 100644 --- a/R/get_coord_from_string.R +++ b/R/get_coord_from_string.R @@ -10,24 +10,24 @@ #' #' @examples #' \donttest{ -#' txt <- "12120: Leba (Poland)\nLatitude: 54-45N Longitude: 017-32E Altitude: 2 m." +#' txt = "12120: Leba (Poland)\nLatitude: 54-45N Longitude: 017-32E Altitude: 2 m." #' climate:::get_coord_from_string(txt, pattern = "Latitude") #' } #' -get_coord_from_string <- function(txt, pattern = "Longitude") { - tt <- gregexpr(pattern, txt) - start <- tt[[1]][1] + attributes(tt[[1]])$match.length + 1 - tmp <- trimws(substr(txt, start = start, stop = start + 8)) - tmp <- strsplit(tmp, "-")[[1]] - hemisphere <- gsub("[0-9]", "", strsplit(tmp, "-")[2]) - hemisphere <- gsub(".*?(\\b[A-Za-z0-9 ]+\\b).*","\\1", hemisphere) +get_coord_from_string = function(txt, pattern = "Longitude") { + tt = gregexpr(pattern, txt) + start = tt[[1]][1] + attributes(tt[[1]])$match.length + 1 + tmp = trimws(substr(txt, start = start, stop = start + 8)) + tmp = strsplit(tmp, "-")[[1]] + hemisphere = gsub("[0-9]", "", strsplit(tmp, "-")[2]) + hemisphere = gsub(".*?(\\b[A-Za-z0-9 ]+\\b).*","\\1", hemisphere) - tmp <- suppressWarnings(as.numeric(gsub("([0-9]+).*$", "\\1", strsplit(tmp, "-")))) + tmp = suppressWarnings(as.numeric(gsub("([0-9]+).*$", "\\1", strsplit(tmp, "-")))) - wsp <- suppressWarnings(as.numeric(tmp)[1] + (as.numeric(tmp)[2] * 5 / 3) / 100) + wsp = suppressWarnings(as.numeric(tmp)[1] + (as.numeric(tmp)[2] * 5 / 3) / 100) if( hemisphere %in% c("W","S") ) { - wsp <- wsp * -1 + wsp = wsp * -1 } return(wsp) } diff --git a/R/hydro_imgw.R b/R/hydro_imgw.R index 384d8cc..ccef235 100644 --- a/R/hydro_imgw.R +++ b/R/hydro_imgw.R @@ -17,20 +17,20 @@ #' #' @examples #' \donttest{ -#' x <- hydro_imgw("monthly", year = 1999) +#' x = hydro_imgw("monthly", year = 1999) #' head(x) #' } -hydro_imgw <- function(interval, year, coords = FALSE, value = "H", station = NULL, col_names = "short", ...){ +hydro_imgw = function(interval, year, coords = FALSE, value = "H", station = NULL, col_names = "short", ...){ if (interval == "daily"){ # dobowe - calosc <- hydro_imgw_daily(year = year, coords = coords, station = station, col_names = col_names, ...) + calosc = hydro_imgw_daily(year = year, coords = coords, station = station, col_names = col_names, ...) } else if (interval == "monthly"){ #miesieczne - calosc <- hydro_imgw_monthly(year = year, coords = coords, station = station, col_names = col_names, ...) + calosc = hydro_imgw_monthly(year = year, coords = coords, station = station, col_names = col_names, ...) } else if (interval == "semiannual_and_annual"){ # polroczne_i_roczne - calosc <- hydro_imgw_annual(year = year, coords = coords, value = value, station = station, col_names = col_names, ...) + calosc = hydro_imgw_annual(year = year, coords = coords, value = value, station = station, col_names = col_names, ...) } else{ stop("Wrong `interval` value. It should be either 'daily', 'monthly', or 'semiannual_and_annual'.", call. = FALSE) } diff --git a/R/hydro_imgw_annual.R b/R/hydro_imgw_annual.R index c27be26..56345f9 100644 --- a/R/hydro_imgw_annual.R +++ b/R/hydro_imgw_annual.R @@ -12,8 +12,9 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils download.file unzip read.csv +#' @importFrom data.table fread #' @export -#' +#' #' @examples #' \donttest{ #' yearly = hydro_imgw_annual(year = 2000, value = "H", station = "ANNOPOL") @@ -23,7 +24,7 @@ hydro_imgw_annual = function(year, coords = FALSE, value = "H", station = NULL, # options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - check_locale() + translit = check_locale() base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" interval = "semiannual_and_annual" @@ -70,7 +71,13 @@ hydro_imgw_annual = function(year, coords = FALSE, value = "H", station = NULL, #download.file(address, temp) unzip(zipfile = temp, exdir = temp2) file1 = paste(temp2, dir(temp2), sep = "/")[1] - data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data1) = meta[[value]]$parameters all_data[[i]] = data1 } @@ -101,7 +108,7 @@ hydro_imgw_annual = function(year, coords = FALSE, value = "H", station = NULL, } all_data = all_data[order(all_data$`Nazwa stacji`, all_data$`Rok hydrologiczny`), ] - # dodanie opcji dla skracania kolumn i usuwania duplikatow: + # adding option for shortening column names and removing duplicates all_data = hydro_shortening_imgw(all_data, col_names = col_names, ...) return(all_data) diff --git a/R/hydro_imgw_daily.R b/R/hydro_imgw_daily.R index c79d9ac..40e7da6 100644 --- a/R/hydro_imgw_daily.R +++ b/R/hydro_imgw_daily.R @@ -10,6 +10,7 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils download.file unzip read.csv +#' @importFrom data.table fread #' @export #' #' @examples \donttest{ @@ -21,7 +22,7 @@ hydro_imgw_daily = function(year, coords = FALSE, station = NULL, col_names= "short", ...){ #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - check_locale() + translit = check_locale() base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" interval = "daily" @@ -68,7 +69,13 @@ hydro_imgw_daily = function(year, coords = FALSE, station = NULL, col_names= "sh #download.file(address, temp) unzip(zipfile = temp, exdir = temp2) file1 = paste(temp2, dir(temp2), sep = "/")[1] - data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data1) = meta[[1]][,1] data=rbind(data,data1) } @@ -80,7 +87,13 @@ hydro_imgw_daily = function(year, coords = FALSE, station = NULL, col_names= "sh test_url(address, temp) unzip(zipfile = temp, exdir = temp2) file2 = paste(temp2, dir(temp2), sep = "/")[1] - data2 = read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + + if(translit){ + data2 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file2))) + } else { + data2 = read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data2) = meta[[2]][, 1] all_data[[i]] = merge(data, data2, diff --git a/R/hydro_imgw_monthly.R b/R/hydro_imgw_monthly.R index 6d8720c..d633d46 100644 --- a/R/hydro_imgw_monthly.R +++ b/R/hydro_imgw_monthly.R @@ -10,22 +10,23 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils download.file unzip read.csv +#' @importFrom data.table fread #' @export #' #' @examples \donttest{ -#' monthly <- hydro_imgw_monthly(year = 2000) +#' monthly = hydro_imgw_monthly(year = 2000) #' head(monthly) #' } #' -hydro_imgw_monthly <- function(year, coords = FALSE, station = NULL, col_names= "short", ...){ +hydro_imgw_monthly = function(year, coords = FALSE, station = NULL, col_names= "short", ...){ #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - check_locale() + translit = check_locale() - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" - interval <- "monthly" - interval_pl <- "miesieczne" + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" + interval = "monthly" + interval_pl = "miesieczne" temp = tempfile() test_url(link = paste0(base_url, interval_pl, "/"), output = temp) @@ -43,44 +44,50 @@ hydro_imgw_monthly <- function(year, coords = FALSE, station = NULL, col_names= # } # - ind <- grep(readHTMLTable(a)[[1]]$Name, pattern = "/") - catalogs <- as.character(readHTMLTable(a)[[1]]$Name[ind]) - catalogs <- gsub(x = catalogs, pattern = "/", replacement = "") - catalogs <- catalogs[catalogs %in% as.character(year)] + ind = grep(readHTMLTable(a)[[1]]$Name, pattern = "/") + catalogs = as.character(readHTMLTable(a)[[1]]$Name[ind]) + catalogs = gsub(x = catalogs, pattern = "/", replacement = "") + catalogs = catalogs[catalogs %in% as.character(year)] if (length(catalogs) == 0) { stop("Selected year(s) is not available in the database.", call. = FALSE) } - meta <- hydro_metadata_imgw(interval) + meta = hydro_metadata_imgw(interval) - all_data <- vector("list", length = length(catalogs)) + all_data = vector("list", length = length(catalogs)) for (i in seq_along(catalogs)){ - catalog <- catalogs[i] + catalog = catalogs[i] #print(i) - adres <- paste0(base_url, interval_pl, "/", catalog, "/mies_", catalog, ".zip") + adres = paste0(base_url, interval_pl, "/", catalog, "/mies_", catalog, ".zip") - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(adres, temp) #download.file(adres, temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/")[1] - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]][, 1] - all_data[[i]] <- data1 + file1 = paste(temp2, dir(temp2), sep = "/")[1] + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data1) = meta[[1]][, 1] + all_data[[i]] = data1 } - all_data <- do.call(rbind, all_data) + all_data = do.call(rbind, all_data) # wyjatki na brak stanu, przeplywu i temperatury # Stan wody 9999 oznacza brak danych w bazie lub przerwy w obserwacjach w danym miesiącu i stad brak możliwości obliczenia charakterystyk. #Przepływ 99999.999 oznacza brak danych lub przerwy w obserwacjach w danym miesiacu i stad brak możliwości obliczenia charakterystyk. #Temperatura wody 99.9 oznacza brak danych lub przerwy w obserwacjach w danym miesiacu i stad brak możliwości obliczenia charakterystyk. - all_data[all_data == 9999] <- NA - all_data[all_data == 99999.999] <- NA - all_data[all_data == 99.9] <- NA - colnames(all_data) <- meta[[1]][, 1] + all_data[all_data == 9999] = NA + all_data[all_data == 99999.999] = NA + all_data[all_data == 99.9] = NA + colnames(all_data) = meta[[1]][, 1] # coords if (coords){ - all_data <- merge(climate::imgw_hydro_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) + all_data = merge(climate::imgw_hydro_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) } #station selection if (!is.null(station)) { @@ -90,7 +97,7 @@ hydro_imgw_monthly <- function(year, coords = FALSE, station = NULL, col_names= stop("Selected station(s) is not available in the database.", call. = FALSE) } } else if (is.numeric(station)){ - all_data <- all_data[all_data$`Kod stacji` %in% station, ] + all_data = all_data[all_data$`Kod stacji` %in% station, ] if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } @@ -99,9 +106,9 @@ hydro_imgw_monthly <- function(year, coords = FALSE, station = NULL, col_names= } } - all_data <- all_data[order(all_data$`Nazwa stacji`, all_data$`Rok hydrologiczny`, all_data$`Wskaznik miesiaca w roku hydrologicznym`), ] + all_data = all_data[order(all_data$`Nazwa stacji`, all_data$`Rok hydrologiczny`, all_data$`Wskaznik miesiaca w roku hydrologicznym`), ] # dodanie opcji dla skracania kolumn i usuwania duplikatow: - all_data <- hydro_shortening_imgw(all_data, col_names = col_names, ...) + all_data = hydro_shortening_imgw(all_data, col_names = col_names, ...) return(all_data) } diff --git a/R/hydro_metadata_imgw.R b/R/hydro_metadata_imgw.R index 1973614..6df2d07 100644 --- a/R/hydro_metadata_imgw.R +++ b/R/hydro_metadata_imgw.R @@ -8,29 +8,29 @@ #' #' @examples #' \donttest{ -#' meta <- climate:::hydro_metadata_imgw(interval = "daily") -#' meta <- climate:::hydro_metadata_imgw(interval = "monthly") -#' meta <- climate:::hydro_metadata_imgw(interval = "semiannual_and_annual") +#' meta = climate:::hydro_metadata_imgw(interval = "daily") +#' meta = climate:::hydro_metadata_imgw(interval = "monthly") +#' meta = climate:::hydro_metadata_imgw(interval = "semiannual_and_annual") #' } -hydro_metadata_imgw <- function(interval){ +hydro_metadata_imgw = function(interval){ - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" if (interval == "daily"){ # dobowe - address_meta1 <- paste0(base_url, "dobowe/codz_info.txt") - address_meta2 <- paste0(base_url, "dobowe/zjaw_info.txt") - meta <- list(clean_metadata_hydro(address_meta1, interval), + address_meta1 = paste0(base_url, "dobowe/codz_info.txt") + address_meta2 = paste0(base_url, "dobowe/zjaw_info.txt") + meta = list(clean_metadata_hydro(address_meta1, interval), clean_metadata_hydro(address_meta2, interval)) } else if (interval == "monthly"){ #miesieczne - address_meta <- paste0(base_url, "miesieczne/mies_info.txt") - meta <- clean_metadata_hydro(address_meta, interval) + address_meta = paste0(base_url, "miesieczne/mies_info.txt") + meta = clean_metadata_hydro(address_meta, interval) } else if (interval == "semiannual_and_annual"){ # polroczne_i_roczne - address_meta <- paste0(base_url, "polroczne_i_roczne/polr_info.txt") - meta <- clean_metadata_hydro(address_meta, interval) + address_meta = paste0(base_url, "polroczne_i_roczne/polr_info.txt") + meta = clean_metadata_hydro(address_meta, interval) } else{ stop("Wrong `interval` value. It should be either 'daily', 'monthly', or 'semiannual_and_annual'.") } diff --git a/R/hydro_shortening_imgw.R b/R/hydro_shortening_imgw.R index d691e78..6d2a7d9 100644 --- a/R/hydro_shortening_imgw.R +++ b/R/hydro_shortening_imgw.R @@ -9,44 +9,44 @@ #' #' @examples #' \donttest{ -#' monthly <- hydro_imgw("monthly", year = 1969) +#' monthly = hydro_imgw("monthly", year = 1969) #' colnames(monthly) -#' abbr <- climate:::hydro_shortening_imgw(data = monthly, +#' abbr = climate:::hydro_shortening_imgw(data = monthly, #' col_names = "full", #' remove_duplicates = TRUE) #' head(abbr) #' } #' -hydro_shortening_imgw <- function(data, col_names = "short", remove_duplicates = TRUE){ +hydro_shortening_imgw = function(data, col_names = "short", remove_duplicates = TRUE){ if (col_names != "polish"){ - abbrev <- climate::imgw_hydro_abbrev + abbrev = climate::imgw_hydro_abbrev # additional workarounds for mac os but not only... abbrev$fullname = gsub(x = abbrev$fullname, pattern="'", replacement = "") abbrev$fullname = gsub(x = abbrev$fullname, pattern="\\^", replacement = "") # end of workaround - orig_columns <- trimws(gsub("\\s+", " ", colnames(data))) # remove double spaces + orig_columns = trimws(gsub("\\s+", " ", colnames(data))) # remove double spaces - matches <- match(orig_columns, abbrev$fullname) - matches <- matches[!is.na(matches)] + matches = match(orig_columns, abbrev$fullname) + matches = matches[!is.na(matches)] if (col_names == "short"){ # abbrev english - colnames(data)[orig_columns %in% abbrev$fullname] <- abbrev$abbr_eng[matches] + colnames(data)[orig_columns %in% abbrev$fullname] = abbrev$abbr_eng[matches] } if (col_names == "full"){ # full english names: - colnames(data)[orig_columns %in% abbrev$fullname] <- abbrev$fullname_eng[matches] + colnames(data)[orig_columns %in% abbrev$fullname] = abbrev$fullname_eng[matches] } } # removing duplicated column names: (e.g. station's name) if (remove_duplicates == TRUE) { - data <- data[, !duplicated(colnames(data))] + data = data[, !duplicated(colnames(data))] } return(data) diff --git a/R/meteo_imgw.R b/R/meteo_imgw.R index 21c80a3..23b7d08 100644 --- a/R/meteo_imgw.R +++ b/R/meteo_imgw.R @@ -17,19 +17,19 @@ #' #' @examples #' \donttest{ -#' x <- meteo_imgw("monthly", year = 2018, coords = TRUE) +#' x = meteo_imgw("monthly", year = 2018, coords = TRUE) #' head(x) #' } -meteo_imgw <- function(interval, rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ +meteo_imgw = function(interval, rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ if (interval == "daily"){ # daily - calosc <- meteo_imgw_daily(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) + calosc = meteo_imgw_daily(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) } else if (interval == "monthly"){ #monthly - calosc <- meteo_imgw_monthly(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) + calosc = meteo_imgw_monthly(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) } else if (interval == "hourly"){ #hourly - calosc <- meteo_imgw_hourly(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) + calosc = meteo_imgw_hourly(rank = rank, year = year, status = status, coords = coords, station = station, col_names = col_names, ...) } else{ stop("Wrong `interval` value. It should be either 'hourly', 'daily', or 'monthly'.") } diff --git a/R/meteo_imgw_daily.R b/R/meteo_imgw_daily.R index ffb08de..964f26d 100644 --- a/R/meteo_imgw_daily.R +++ b/R/meteo_imgw_daily.R @@ -12,27 +12,28 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils download.file unzip read.csv +#' @importFrom data.table fread #' @export #' #' @examples \donttest{ -#' daily <- meteo_imgw_daily(rank = "climate", year = 2000) +#' daily = meteo_imgw_daily(rank = "climate", year = 2000) #' head(daily) #' } #' -meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ +meteo_imgw_daily = function(rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - check_locale() + translit = check_locale() - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" - interval <- "daily" # to mozemy ustawic na sztywno - interval_pl <- "dobowe" + interval = "daily" # to mozemy ustawic na sztywno + interval_pl = "dobowe" meta = meteo_metadata_imgw(interval = "daily", rank = rank) - rank_pl <- switch(rank, synop = "synop", climate = "klimat", precip = "opad") + rank_pl = switch(rank, synop = "synop", climate = "klimat", precip = "opad") temp = tempfile() @@ -45,53 +46,62 @@ meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALS # ftp.use.epsv = FALSE, # dirlistonly = TRUE) - ind <- grep(readHTMLTable(a)[[1]]$Name, pattern = "/") - catalogs <- as.character(readHTMLTable(a)[[1]]$Name[ind]) + ind = grep(readHTMLTable(a)[[1]]$Name, pattern = "/") + catalogs = as.character(readHTMLTable(a)[[1]]$Name[ind]) # fragment dla lat (ktore catalogs wymagaja pobrania: - years_in_catalogs <- strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") - years_in_catalogs <- lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) - ind <- lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) - catalogs <- catalogs[unlist(ind)] # to sa nasze prawdziwe catalogs do przemielenia + years_in_catalogs = strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") + years_in_catalogs = lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) + ind = lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) + catalogs = catalogs[unlist(ind)] # to sa nasze prawdziwe catalogs do przemielenia - all_data <- NULL + all_data = NULL for (i in seq_along(catalogs)){ - catalog <- gsub(catalogs[i], pattern = "/", replacement = "") + catalog = gsub(catalogs[i], pattern = "/", replacement = "") if(rank == "synop") { - address <- paste0(base_url, "/dane_meteorologiczne/dobowe/synop", + address = paste0(base_url, "/dane_meteorologiczne/dobowe/synop", "/", catalog, "/") - #folder_contents <- getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu + #folder_contents = getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu test_url(link = address, output = temp) folder_contents = readLines(temp, warn = FALSE) unlink(temp) - ind <- grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") - files <- as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) - addresses_to_download <- paste0(address, files) + ind = grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") + files = as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) + addresses_to_download = paste0(address, files) # w tym miejscu trzeba przemyslec fragment kodu do dodania dla pojedynczej stacji jesli tak sobie zazyczy uzytkownik: # na podstawie zawartosci obiektu files for(j in seq_along(addresses_to_download)){ - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(addresses_to_download[j], temp) #download.file(addresses_to_download[j], temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/")[1] - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/")[1] + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } - file2 <- paste(temp2, dir(temp2), sep = "/")[2] - data2 <- read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data2) <- meta[[2]]$parameters + colnames(data1) = meta[[1]]$parameters + + file2 = paste(temp2, dir(temp2), sep = "/")[2] + if(translit){ + data2 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file2))) + } else { + data2 = read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data2) = meta[[2]]$parameters # usuwa statusy if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL - data2[grep("^Status", colnames(data2))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL + data2[grep("^Status", colnames(data2))] = NULL } unlink(c(temp, temp2)) @@ -103,7 +113,7 @@ meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALS if (!is.null(station)) { all_data[[length(all_data) + 1]] = ttt[substr(ttt$`Nazwa stacji.x`,1,nchar(station))==station,] } else { - all_data[[length(all_data) + 1]] <- ttt + all_data[[length(all_data) + 1]] = ttt } # koniec proby z obejsciem @@ -114,41 +124,49 @@ meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALS ###################### ###### KLIMAT: ####### if(rank == "climate") { - address <- paste0(base_url, "dane_meteorologiczne/dobowe/klimat", + address = paste0(base_url, "dane_meteorologiczne/dobowe/klimat", "/", catalog, "/") - #folder_contents <- getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu + #folder_contents = getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu test_url(link = address, output = temp) folder_contents = readLines(temp, warn = FALSE) unlink(temp) - ind <- grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") - files <- as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) - addresses_to_download <- paste0(address, files) + ind = grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") + files = as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) + addresses_to_download = paste0(address, files) # w tym miejscu trzeba przemyslec fragment kodu do dodania dla pojedynczej stacji jesli tak sobie zazyczy uzytkownik: # na podstawie zawartosci obiektu files for(j in seq_along(addresses_to_download)){ - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(addresses_to_download[j], temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/")[1] - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/")[1] + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data1) = meta[[1]]$parameters - file2 <- paste(temp2, dir(temp2), sep = "/")[2] - data2 <- read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data2) <- meta[[2]]$parameters + file2 = paste(temp2, dir(temp2), sep = "/")[2] + if(translit){ + data2 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file2))) + } else { + data2 = read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + colnames(data2) = meta[[2]]$parameters # usuwa statusy if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL - data2[grep("^Status", colnames(data2))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL + data2[grep("^Status", colnames(data2))] = NULL } unlink(c(temp, temp2)) - all_data[[length(all_data)+1]] <- merge(data1, data2, + all_data[[length(all_data)+1]] = merge(data1, data2, by = c("Kod stacji", "Rok", "Miesiac", "Dzien"), all.x = TRUE) } # koniec petli po zipach do pobrania @@ -159,65 +177,70 @@ meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALS ###################### ######## OPAD: ####### if(rank == "precip") { - address <- paste0(base_url, "dane_meteorologiczne/dobowe/opad", + address = paste0(base_url, "dane_meteorologiczne/dobowe/opad", "/", catalog, "/") - #folder_contents <- getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu + #folder_contents = getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego yearu test_url(link = address, output = temp) folder_contents = readLines(temp, warn = FALSE) unlink(temp) - ind <- grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") - files <- as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) - addresses_to_download <- paste0(address, files) + ind = grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") + files = as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) + addresses_to_download = paste0(address, files) for(j in seq_along(addresses_to_download)){ - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(addresses_to_download[j], temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/")[1] - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/")[1] + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data1) = meta[[1]]$parameters # usuwa statusy if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL } unlink(c(temp, temp2)) - all_data[[length(all_data)+1]] <- data1 + all_data[[length(all_data)+1]] = data1 } # koniec petli po zipach do pobrania } # koniec if'a dla klimatu } # koniec petli po glownych catalogach danych dobowych - all_data <- do.call(rbind, all_data) + all_data = do.call(rbind, all_data) if (coords){ - all_data <- merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) + all_data = merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) } # dodaje rank - rank_code <- switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA", precip = "OPADOWA") - all_data <- cbind(data.frame(rank_code = rank_code), all_data) + rank_code = switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA", precip = "OPADOWA") + all_data = cbind(data.frame(rank_code = rank_code), all_data) - all_data <- all_data[all_data$Rok %in% year, ] # przyciecie tylko do wybranych lat gdyby sie pobralo za duzo + all_data = all_data[all_data$Rok %in% year, ] # przyciecie tylko do wybranych lat gdyby sie pobralo za duzo #station selection if (!is.null(station)) { if (is.character(station)) { - if(rank == 'synop' | rank == 'climate') all_data <- all_data[substr(all_data$`Nazwa stacji.x`,1,nchar(station))==station, ] # sprawdzic tutaj czy jest Nazwa stacji.x w synopach + if(rank == 'synop' | rank == 'climate') all_data = all_data[substr(all_data$`Nazwa stacji.x`,1,nchar(station))==station, ] # sprawdzic tutaj czy jest Nazwa stacji.x w synopach # exception for column names in precipitation data: - if(rank == 'precip') all_data <- all_data[substr(all_data$`Nazwa stacji`,1,nchar(station))==station, ] # sprawdzic tutaj czy jest Nazwa stacji.x w synopach + if(rank == 'precip') all_data = all_data[substr(all_data$`Nazwa stacji`,1,nchar(station))==station, ] # sprawdzic tutaj czy jest Nazwa stacji.x w synopach if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } } else if (is.numeric(station)){ - all_data <- all_data[all_data$`Kod stacji` %in% station, ] + all_data = all_data[all_data$`Kod stacji` %in% station, ] if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } @@ -228,17 +251,14 @@ meteo_imgw_daily <- function(rank = "synop", year, status = FALSE, coords = FALS # sortowanie w zaleznosci od nazw kolumn - raz jest "kod stacji", raz "id" if(sum(grepl(x = colnames(all_data), pattern = "Kod stacji"))){ - all_data <- all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac, all_data$Dzien), ] + all_data = all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac, all_data$Dzien), ] } else { - all_data <- all_data[order(all_data$id, all_data$Rok, all_data$Miesiac, all_data$Dzien), ] + all_data = all_data[order(all_data$id, all_data$Rok, all_data$Miesiac, all_data$Dzien), ] } - - # # dodanie opcji dla skracania kolumn i usuwania duplikatow: - all_data <- meteo_shortening_imgw(all_data, col_names = col_names, ...) + all_data = meteo_shortening_imgw(all_data, col_names = col_names, ...) return(all_data) - } # koniec funkcji meteo_daily diff --git a/R/meteo_imgw_hourly.R b/R/meteo_imgw_hourly.R index c628115..7a1d3c9 100644 --- a/R/meteo_imgw_hourly.R +++ b/R/meteo_imgw_hourly.R @@ -12,29 +12,31 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils download.file unzip read.csv +#' @importFrom data.table fread #' @export #' #' @examples \donttest{ -#' hourly <- meteo_imgw_hourly(rank = "climate", year = 1984) +#' hourly = meteo_imgw_hourly(rank = "climate", year = 1984) #' head(hourly) #' } #' -meteo_imgw_hourly <- function(rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ +meteo_imgw_hourly = function(rank = "synop", year, status = FALSE, + coords = FALSE, station = NULL, col_names = "short", ...){ - check_locale() + translit = check_locale() stopifnot(rank == "synop" | rank == "climate") # dla terminowek tylko synopy i klimaty maja dane #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" - interval <- "hourly" # to mozemy ustawic na sztywno - interval_pl <- "terminowe" # to mozemy ustawic na sztywno + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" + interval = "hourly" # to mozemy ustawic na sztywno + interval_pl = "terminowe" # to mozemy ustawic na sztywno - meta <- meteo_metadata_imgw(interval = "hourly", rank = rank) + meta = meteo_metadata_imgw(interval = "hourly", rank = rank) - rank_pl <- switch(rank, synop = "synop", climate = "klimat", precip = "opad") + rank_pl = switch(rank, synop = "synop", climate = "klimat", precip = "opad") temp = tempfile() test_url(link = paste0(base_url, "dane_meteorologiczne/", interval_pl, "/", rank_pl, "/"), @@ -42,55 +44,61 @@ meteo_imgw_hourly <- function(rank = "synop", year, status = FALSE, coords = FAL a = readLines(temp, warn = FALSE) unlink(temp) - # a <- getURL(paste0(base_url, "dane_meteorologiczne/", interval_pl, "/", rank_pl, "/"), + # a = getURL(paste0(base_url, "dane_meteorologiczne/", interval_pl, "/", rank_pl, "/"), # ftp.use.epsv = FALSE, # dirlistonly = TRUE) - ind <- grep(readHTMLTable(a)[[1]]$Name, pattern = "/") - catalogs <- as.character(readHTMLTable(a)[[1]]$Name[ind]) + ind = grep(readHTMLTable(a)[[1]]$Name, pattern = "/") + catalogs = as.character(readHTMLTable(a)[[1]]$Name[ind]) # fragment dla lat (ktore catalogs wymagaja pobrania: - years_in_catalogs <- strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") - years_in_catalogs <- lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) - ind <- lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) - catalogs <- catalogs[unlist(ind)] # to sa nasze prawdziwe catalogs do przemielenia + years_in_catalogs = strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") + years_in_catalogs = lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) + ind = lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) + catalogs = catalogs[unlist(ind)] # to sa nasze prawdziwe catalogs do przemielenia - all_data <- NULL + all_data = NULL for (i in seq_along(catalogs)){ - catalog <- gsub(catalogs[i], pattern = "/", replacement = "") + catalog = gsub(catalogs[i], pattern = "/", replacement = "") if(rank == "synop") { - address <- paste0(base_url, "dane_meteorologiczne/terminowe/synop", + address = paste0(base_url, "dane_meteorologiczne/terminowe/synop", "/", catalog, "/") - #folder_contents <- getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego roku + #folder_contents = getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego roku test_url(link = address, output = temp) folder_contents = readLines(temp, warn = FALSE) unlink(temp) - ind <- grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") - files <- as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) - addresses_to_download <- paste0(address, files) + ind = grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") + files = as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) + addresses_to_download = paste0(address, files) # w tym miejscu trzeba przemyslec fragment kodu do dodania dla pojedynczej stacji jesli tak sobie zazyczy uzytkownik: # na podstawie zawartosci obiektu files for(j in seq_along(addresses_to_download)){ - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(addresses_to_download[j], temp) #download.file(addresses_to_download[j], temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/") - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/") + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data1) = meta[[1]]$parameters # usuwa statusy if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL } unlink(c(temp, temp2)) - all_data[[length(all_data) + 1]] <- data1 + all_data[[length(all_data) + 1]] = data1 } # koniec petli po zipach do pobrania } # koniec if'a dla synopa @@ -98,50 +106,56 @@ meteo_imgw_hourly <- function(rank = "synop", year, status = FALSE, coords = FAL ###### KLIMAT: ####### ###################### if(rank == "climate") { - address <- paste0(base_url, "dane_meteorologiczne/terminowe/klimat", + address = paste0(base_url, "dane_meteorologiczne/terminowe/klimat", "/", catalog, "/") - #folder_contents <- getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego roku + #folder_contents = getURL(address, ftp.use.epsv = FALSE, dirlistonly = FALSE) # zawartosc folderu dla wybranego roku test_url(link = address, output = temp) folder_contents = readLines(temp, warn = FALSE) unlink(temp) - ind <- grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") - files <- as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) - addresses_to_download <- paste0(address, files) + ind = grep(readHTMLTable(folder_contents)[[1]]$Name, pattern = "zip") + files = as.character(readHTMLTable(folder_contents)[[1]]$Name[ind]) + addresses_to_download = paste0(address, files) # w tym miejscu trzeba przemyslec fragment kodu do dodania dla pojedynczej stacji jesli tak sobie zazyczy uzytkownik: # na podstawie zawartosci obiektu files for(j in seq_along(addresses_to_download)){ - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(addresses_to_download[j], temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/") - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/") + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data1) = meta[[1]]$parameters # usuwa statusy if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL } unlink(c(temp, temp2)) - all_data[[length(all_data) + 1]] <- data1 + all_data[[length(all_data) + 1]] = data1 } # koniec petli po zipach do pobrania } # koniec if'a dla klimatu } # koniec petli po glownych catalogach danych dobowych - all_data <- do.call(rbind, all_data) + all_data = do.call(rbind, all_data) if (coords){ - all_data <- merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) + all_data = merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) } # dodaje rank - rank_code <- switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA") - all_data <- cbind(data.frame(rank_code = rank_code), all_data) + rank_code = switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA") + all_data = cbind(data.frame(rank_code = rank_code), all_data) - all_data <- all_data[all_data$Rok %in% year, ] # przyciecie tylko do wybranych lat gdyby sie pobralo za duzo + all_data = all_data[all_data$Rok %in% year, ] # przyciecie tylko do wybranych lat gdyby sie pobralo za duzo #station selection if (!is.null(station)) { @@ -151,7 +165,7 @@ meteo_imgw_hourly <- function(rank = "synop", year, status = FALSE, coords = FAL stop("Selected station(s) is not available in the database.", call. = FALSE) } } else if (is.numeric(station)){ - all_data <- all_data[all_data$`Kod stacji`%in% station, ] + all_data = all_data[all_data$`Kod stacji`%in% station, ] if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } @@ -163,13 +177,13 @@ meteo_imgw_hourly <- function(rank = "synop", year, status = FALSE, coords = FAL # sortowanie w zaleznosci od nazw kolumn - raz jest "kod stacji", raz "id" if(sum(grepl(x = colnames(all_data), pattern = "Kod stacji"))){ - all_data <- all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac, all_data$Dzien, all_data$Godzina), ] + all_data = all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac, all_data$Dzien, all_data$Godzina), ] } else { - all_data <- all_data[order(all_data$id, all_data$Rok, all_data$Miesiac, all_data$Dzien, all_data$Godzina), ] + all_data = all_data[order(all_data$id, all_data$Rok, all_data$Miesiac, all_data$Dzien, all_data$Godzina), ] } # dodanie opcji dla skracania kolumn i usuwania duplikatow: - all_data <- meteo_shortening_imgw(all_data, col_names = col_names, ...) + all_data = meteo_shortening_imgw(all_data, col_names = col_names, ...) return(all_data) } # koniec funkcji meteo_terminowe diff --git a/R/meteo_imgw_monthly.R b/R/meteo_imgw_monthly.R index 4aa7ecc..9ae9878 100644 --- a/R/meteo_imgw_monthly.R +++ b/R/meteo_imgw_monthly.R @@ -12,14 +12,15 @@ #' @param ... other parameters that may be passed to the 'shortening' function that shortens column names #' @importFrom XML readHTMLTable #' @importFrom utils unzip read.csv +#' @importFrom data.table fread #' @export #' #' @examples \donttest{ -#' monthly <- meteo_imgw_monthly(rank = "climate", year = 1969) +#' monthly = meteo_imgw_monthly(rank = "climate", year = 1969) #' head(monthly) #' #' # a descriptive (long) column names: -#' monthly2 <- meteo_imgw_monthly(rank = "synop", year = 2018, +#' monthly2 = meteo_imgw_monthly(rank = "synop", year = 2018, #' col_names = "full") #' head(monthly2) #' @@ -29,13 +30,13 @@ #' coords = TRUE, station = c("POZNAŃ","POZNAŃ-ŁAWICA")) #' } #' -meteo_imgw_monthly <- function(rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ +meteo_imgw_monthly = function(rank = "synop", year, status = FALSE, coords = FALSE, station = NULL, col_names = "short", ...){ - check_locale() + translit = check_locale() #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" # if (httr::http_error(base_url)) { # b = stop(call. = FALSE, @@ -46,104 +47,113 @@ meteo_imgw_monthly <- function(rank = "synop", year, status = FALSE, coords = FA # } # # - interval_pl <- "miesieczne" # to mozemy ustawic na sztywno do odwolania w url - meta <- meteo_metadata_imgw(interval = "monthly", rank = rank) + interval_pl = "miesieczne" + meta = meteo_metadata_imgw(interval = "monthly", rank = rank) - rank_pl <- switch(rank, synop = "synop", climate = "klimat", precip = "opad") + rank_pl = switch(rank, synop = "synop", climate = "klimat", precip = "opad") - # checking net connection: + # checking internet connection: temp = tempfile() test_url(link = paste0(base_url, "dane_meteorologiczne/", interval_pl, "/", rank_pl, "/"), output = temp) a = readLines(temp, warn = FALSE) unlink(temp) - # a <- getURL(paste0(base_url, "dane_meteorologiczne/", interval, "/", rank_pl, "/"), - # ftp.use.epsv = FALSE, - # dirlistonly = TRUE) - ind <- grep(readHTMLTable(a)[[1]]$Name, pattern = "/") - catalogs <- as.character(readHTMLTable(a)[[1]]$Name[ind]) + ind = grep(readHTMLTable(a)[[1]]$Name, pattern = "/") + catalogs = as.character(readHTMLTable(a)[[1]]$Name[ind]) - # fragment dla lat (ktore catalogs wymagaja pobrania: - years_in_catalogs <- strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") - years_in_catalogs <- lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) - ind <- lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) - catalogs <- catalogs[unlist(ind)] # to sa nasze prawdziwe catalogs do przemielenia + # check for catalogs / years that require downloading: + years_in_catalogs = strsplit(gsub(x = catalogs, pattern = "/", replacement = ""), split = "_") + years_in_catalogs = lapply(years_in_catalogs, function(x) x[1]:x[length(x)]) + ind = lapply(years_in_catalogs, function(x) sum(x %in% year) > 0) + catalogs = catalogs[unlist(ind)] - all_data <- vector("list", length = length(catalogs)) + all_data = vector("list", length = length(catalogs)) for (i in seq_along(catalogs)){ # print(i) - catalog <- gsub(catalogs[i], pattern = "/", replacement = "") + catalog = gsub(catalogs[i], pattern = "/", replacement = "") if(rank == "synop") { - address <- paste0(base_url, "dane_meteorologiczne/miesieczne/synop", + address = paste0(base_url, "dane_meteorologiczne/miesieczne/synop", "/", catalog, "/", catalog, "_m_s.zip") } if(rank == "climate") { - address <- paste0(base_url, "dane_meteorologiczne/miesieczne/klimat", + address = paste0(base_url, "dane_meteorologiczne/miesieczne/klimat", "/", catalog, "/", catalog, "_m_k.zip") } if(rank == "precip") { - address <- paste0(base_url, "dane_meteorologiczne/miesieczne/opad", + address = paste0(base_url, "dane_meteorologiczne/miesieczne/opad", "/", catalog, "/", catalog, "_m_o.zip") } - temp <- tempfile() - temp2 <- tempfile() + temp = tempfile() + temp2 = tempfile() test_url(address, temp) #download.file(address, temp) unzip(zipfile = temp, exdir = temp2) - file1 <- paste(temp2, dir(temp2), sep = "/")[1] - data1 <- read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data1) <- meta[[1]]$parameters + file1 = paste(temp2, dir(temp2), sep = "/")[1] + + if(translit){ + data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file1))) + } else { + data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data1) = meta[[1]]$parameters if( rank != "precip"){ # w opadowkach jest tylko jeden plik - file2 <- paste(temp2, dir(temp2), sep = "/")[2] - data2 <- read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") - colnames(data2) <- meta[[2]]$parameters + file2 = paste(temp2, dir(temp2), sep = "/")[2] + + if(translit){ + data2 = as.data.frame(data.table::fread(cmd = paste("iconv -f CP1250 -t ASCII//TRANSLIT", file2))) + } else { + data2 = read.csv(file2, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250") + } + + colnames(data2) = meta[[2]]$parameters } - # usuwa statusy + # removing status if set if(status == FALSE){ - data1[grep("^Status", colnames(data1))] <- NULL + data1[grep("^Status", colnames(data1))] = NULL - if(rank != "precip"){ # w plikach opadowych tylko jeden plik - data2[grep("^Status", colnames(data2))] <- NULL + if(rank != "precip"){ # in precipitation station only 1 file + data2[grep("^Status", colnames(data2))] = NULL } } unlink(c(temp, temp2)) if(rank != "precip"){ - all_data[[i]] <- merge(data1, data2, + all_data[[i]] = merge(data1, data2, by = c("Kod stacji", "Nazwa stacji", "Rok", "Miesiac"), all.x = TRUE) } else { - all_data[[i]] <- data1 + all_data[[i]] = data1 } } - all_data <- do.call(rbind, all_data) - all_data <- all_data[all_data$Rok %in% year, ] + all_data = do.call(rbind, all_data) + all_data = all_data[all_data$Rok %in% year, ] if (coords){ - all_data <- merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) + all_data = merge(climate::imgw_meteo_stations, all_data, by.x = "id", by.y = "Kod stacji", all.y = TRUE) } - # dodaje rank - rank_code <- switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA", precip = "OPADOWA") - all_data <- cbind(data.frame(rank_code = rank_code), all_data) + # add rank + rank_code = switch(rank, synop = "SYNOPTYCZNA", climate = "KLIMATYCZNA", precip = "OPADOWA") + all_data = cbind(data.frame(rank_code = rank_code), all_data) #station selection if (!is.null(station)) { if (is.character(station)) { - all_data <- all_data[substr(all_data$`Nazwa stacji`,1,nchar(station))==station, ] + all_data = all_data[substr(all_data$`Nazwa stacji`,1,nchar(station))==station, ] if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } } else if (is.numeric(station)){ - all_data <- all_data[all_data$`Kod stacji` %in% station, ] + all_data = all_data[all_data$`Kod stacji` %in% station, ] if (nrow(all_data) == 0){ stop("Selected station(s) is not available in the database.", call. = FALSE) } @@ -153,16 +163,16 @@ meteo_imgw_monthly <- function(rank = "synop", year, status = FALSE, coords = FA } - # sortowanie w zaleznosci od nazw kolumn - raz jest "kod stacji", raz "id" + # sorting data accordingly to column names - (could be "kod stacji" or "id") if(sum(grepl(x = colnames(all_data), pattern = "Kod stacji"))){ - all_data <- all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac), ] + all_data = all_data[order(all_data$`Kod stacji`, all_data$Rok, all_data$Miesiac), ] } else { - all_data <- all_data[order(all_data$id, all_data$Rok, all_data$Miesiac), ] + all_data = all_data[order(all_data$id, all_data$Rok, all_data$Miesiac), ] } - # dodanie opcji dla skracania kolumn i usuwania duplikatow: - all_data <- meteo_shortening_imgw(all_data, col_names = col_names, ...) + # adding option to shorten columns and removing duplicates: + all_data = meteo_shortening_imgw(all_data, col_names = col_names, ...) - return(all_data) # przyciecie tylko do wybranych lat gdyby sie pobralo za duzo + return(all_data) # clipping to selected years only } diff --git a/R/meteo_metadata_imgw.R b/R/meteo_metadata_imgw.R index 81c0580..2517212 100644 --- a/R/meteo_metadata_imgw.R +++ b/R/meteo_metadata_imgw.R @@ -9,35 +9,35 @@ #' #' @examples #' \donttest{ -#' meta <- climate:::meteo_metadata_imgw(interval = "hourly", rank = "synop") -#' meta <- climate:::meteo_metadata_imgw(interval = "daily", rank = "synop") -#' meta <- climate:::meteo_metadata_imgw(interval = "monthly", rank = "precip") +#' meta = climate:::meteo_metadata_imgw(interval = "hourly", rank = "synop") +#' meta = climate:::meteo_metadata_imgw(interval = "daily", rank = "synop") +#' meta = climate:::meteo_metadata_imgw(interval = "monthly", rank = "precip") #' } -meteo_metadata_imgw <- function(interval, rank){ # interval moze byc: monthly, hourly, hourly - b <- NULL +meteo_metadata_imgw = function(interval, rank){ # interval moze byc: monthly, hourly, hourly + b = NULL - base_url <- "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" + base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/" # METADANE daily: if(interval == "daily") { # uwaga! daily maja dla climateow i synopow po 2 pliki z metadanymi!!! if(rank == "synop"){ - b[[1]] <- clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/synop/s_d_format.txt"), + b[[1]] = clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/synop/s_d_format.txt"), rank = "synop", interval = "daily") - b[[2]] <- clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/synop/s_d_t_format.txt"), + b[[2]] = clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/synop/s_d_t_format.txt"), rank = "synop", interval = "daily") } if(rank == "climate"){ - b[[1]] <- clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/klimat/k_d_format.txt"), + b[[1]] = clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/klimat/k_d_format.txt"), rank = "climate", interval = "daily") - b[[2]] <- clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/klimat/k_d_t_format.txt"), + b[[2]] = clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/klimat/k_d_t_format.txt"), rank = "climate", interval = "daily") } if(rank == "precip"){ - b[[1]] <- clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/opad/o_d_format.txt"), + b[[1]] = clean_metadata_meteo(address = paste0(base_url, "dane_meteorologiczne/dobowe/opad/o_d_format.txt"), rank = "precip", interval = "daily") } @@ -50,21 +50,21 @@ meteo_metadata_imgw <- function(interval, rank){ # interval moze byc: monthly, h if(interval == "monthly") { if(rank == "synop"){ - b[[1]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/synop/s_m_d_format.txt"), + b[[1]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/synop/s_m_d_format.txt"), rank = "synop", interval = "monthly") - b[[2]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/synop/s_m_t_format.txt"), + b[[2]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/synop/s_m_t_format.txt"), rank = "synop", interval = "monthly") } if(rank == "climate"){ - b[[1]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/klimat/k_m_d_format.txt"), + b[[1]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/klimat/k_m_d_format.txt"), rank = "climate", interval = "monthly") - b[[2]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/klimat/k_m_t_format.txt"), + b[[2]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/klimat/k_m_t_format.txt"), rank = "climate", interval = "monthly") } if(rank == "precip"){ - b[[1]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/opad/o_m_format.txt"), + b[[1]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/miesieczne/opad/o_m_format.txt"), rank = "precip", interval = "monthly") } @@ -73,9 +73,9 @@ meteo_metadata_imgw <- function(interval, rank){ # interval moze byc: monthly, h ## rozpoczecie dla danych TERMINOWYCH: if(interval == "hourly"){ - if(rank == "synop") b[[1]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/terminowe/synop/s_t_format.txt"), + if(rank == "synop") b[[1]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/terminowe/synop/s_t_format.txt"), rank = "synop", interval = "hourly") - if(rank == "climate") b[[1]] <- clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/terminowe/klimat/k_t_format.txt"), + if(rank == "climate") b[[1]] = clean_metadata_meteo(paste0(base_url, "dane_meteorologiczne/terminowe/klimat/k_t_format.txt"), rank = "climate", interval = "hourly") if(rank == "precip"){ stop("The precipitation stations ('precip') does not provide hourly data.", call. = FALSE) diff --git a/R/meteo_noaa_co2.R b/R/meteo_noaa_co2.R index 6259231..754d562 100644 --- a/R/meteo_noaa_co2.R +++ b/R/meteo_noaa_co2.R @@ -37,13 +37,13 @@ #' #' #' @examples \donttest{ -#' #co2 <- meteo_noaa_co2() +#' #co2 = meteo_noaa_co2() #' #head(co2) #' #plot(co2$yy_d, co2$co2_avg, type='l') #' } #' -meteo_noaa_co2 <- function(){ +meteo_noaa_co2 = function(){ base_url = "ftp://aftp.cmdl.noaa.gov/products/trends/co2/co2_mm_mlo.txt" temp = tempfile() diff --git a/R/meteo_noaa_hourly.R b/R/meteo_noaa_hourly.R index 99020a2..5a32d52 100644 --- a/R/meteo_noaa_hourly.R +++ b/R/meteo_noaa_hourly.R @@ -18,14 +18,14 @@ #' } #' -meteo_noaa_hourly <- function(station = NULL, year, fm12 = TRUE){ +meteo_noaa_hourly = function(station = NULL, year, fm12 = TRUE){ stopifnot(is.character(station)) #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - base_url <- "https://www1.ncdc.noaa.gov/pub/data/noaa/" + base_url = "https://www1.ncdc.noaa.gov/pub/data/noaa/" - all_data <- NULL + all_data = NULL for (i in seq_along(year)){ @@ -79,11 +79,11 @@ meteo_noaa_hourly <- function(station = NULL, year, fm12 = TRUE){ } # end of if statement for empty files - all_data[[length(all_data) + 1]] <- dat + all_data[[length(all_data) + 1]] = dat } # end of loop for years if(is.list(all_data)){ - all_data <- do.call(rbind, all_data) + all_data = do.call(rbind, all_data) } diff --git a/R/meteo_ogimet.R b/R/meteo_ogimet.R index 0df81ae..8695dde 100644 --- a/R/meteo_ogimet.R +++ b/R/meteo_ogimet.R @@ -65,16 +65,16 @@ #' # head(poznan) #' } #' -meteo_ogimet <- function(interval, date, coords = FALSE, station, precip_split = TRUE){ +meteo_ogimet = function(interval, date, coords = FALSE, station, precip_split = TRUE){ if (interval == "daily"){ # daily if (!precip_split){ warning("The `precip_split` argument is only valid for hourly time step", call. = FALSE) } - all_data <- ogimet_daily(date = date, coords = coords, station = station) + all_data = ogimet_daily(date = date, coords = coords, station = station) } else if (interval == "hourly"){ #hourly - all_data <- ogimet_hourly(date = date, coords = coords, station = station, + all_data = ogimet_hourly(date = date, coords = coords, station = station, precip_split = precip_split) } else{ stop("Wrong `interval` value. It should be either 'hourly' or 'daily'") diff --git a/R/meteo_shortening_imgw.R b/R/meteo_shortening_imgw.R index 9247be8..ae93f33 100644 --- a/R/meteo_shortening_imgw.R +++ b/R/meteo_shortening_imgw.R @@ -9,38 +9,38 @@ #' #' @examples #' \donttest{ -#' monthly <- meteo_imgw("monthly", rank = "climate", year = 1969) +#' monthly = meteo_imgw("monthly", rank = "climate", year = 1969) #' colnames(monthly) -#' abbr <- climate:::meteo_shortening_imgw(data = monthly, +#' abbr = climate:::meteo_shortening_imgw(data = monthly, #' col_names = "full", #' remove_duplicates = TRUE) #' head(abbr) #' } #' -meteo_shortening_imgw <- function(data, col_names = "short", remove_duplicates = TRUE){ +meteo_shortening_imgw = function(data, col_names = "short", remove_duplicates = TRUE){ if (col_names != "polish"){ - abbrev <- climate::imgw_meteo_abbrev - orig_columns <- trimws(gsub("\\s+", " ", colnames(data))) # remove double spaces + abbrev = climate::imgw_meteo_abbrev + orig_columns = trimws(gsub("\\s+", " ", colnames(data))) # remove double spaces - matches <- match(orig_columns, abbrev$fullname) - matches <- matches[!is.na(matches)] + matches = match(orig_columns, abbrev$fullname) + matches = matches[!is.na(matches)] if (col_names == "short"){ # abbrev english - colnames(data)[orig_columns %in% abbrev$fullname] <- abbrev$abbr_eng[matches] + colnames(data)[orig_columns %in% abbrev$fullname] = abbrev$abbr_eng[matches] } if (col_names == "full"){ # full english names: - colnames(data)[orig_columns %in% abbrev$fullname] <- abbrev$fullname_eng[matches] + colnames(data)[orig_columns %in% abbrev$fullname] = abbrev$fullname_eng[matches] } } # removing duplicated column names: (e.g. station's name) if (remove_duplicates == TRUE) { - data <- data[, !duplicated(colnames(data))] + data = data[, !duplicated(colnames(data))] } return(data) diff --git a/R/nearest_stations_imgw.R b/R/nearest_stations_imgw.R index 8b9f8a8..f62604d 100644 --- a/R/nearest_stations_imgw.R +++ b/R/nearest_stations_imgw.R @@ -25,7 +25,7 @@ #' } #' -nearest_stations_imgw <- function(type = "meteo", +nearest_stations_imgw = function(type = "meteo", rank = "synop", year = 2018, add_map = TRUE, @@ -84,9 +84,9 @@ nearest_stations_imgw <- function(type = "meteo", stop("package maps required, please install it first") } # plot a little bit more: - addfactor <- as.numeric(diff(stats::quantile(result$Y, na.rm = TRUE, c(0.48, 0.51)))) #lat Y - addfactor <- ifelse(addfactor > 0.2, 0.2, addfactor) - addfactor <- ifelse(addfactor < 0.05, 0.05, addfactor) + addfactor = as.numeric(diff(stats::quantile(result$Y, na.rm = TRUE, c(0.48, 0.51)))) #lat Y + addfactor = ifelse(addfactor > 0.2, 0.2, addfactor) + addfactor = ifelse(addfactor < 0.05, 0.05, addfactor) graphics::plot( result$X, diff --git a/R/nearest_stations_noaa.R b/R/nearest_stations_noaa.R index d72ed57..53b878f 100644 --- a/R/nearest_stations_noaa.R +++ b/R/nearest_stations_noaa.R @@ -24,7 +24,7 @@ #' } #' -nearest_stations_nooa <- function(country, +nearest_stations_nooa = function(country, date = Sys.Date(), add_map = TRUE, point = NULL, no_of_stations = 10, ...){ @@ -46,7 +46,7 @@ nearest_stations_nooa <- function(country, # options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl linkpl2 <-"https://www1.ncdc.noaa.gov/pub/data/noaa/country-list.txt" - #a <- getURL(linkpl2) + #a = getURL(linkpl2) temp = tempfile() test_url(link = linkpl2, output = temp) @@ -108,9 +108,9 @@ nearest_stations_nooa <- function(country, stop("package maps required, please install it first") } # plot labels a little bit higher... - addfactor <- as.numeric(diff(stats::quantile(result$LAT, na.rm = TRUE, c(0.48, 0.51)))) - addfactor <- ifelse(addfactor > 0.2, 0.2, addfactor) - addfactor <- ifelse(addfactor < 0.05, 0.05, addfactor) + addfactor = as.numeric(diff(stats::quantile(result$LAT, na.rm = TRUE, c(0.48, 0.51)))) + addfactor = ifelse(addfactor > 0.2, 0.2, addfactor) + addfactor = ifelse(addfactor < 0.05, 0.05, addfactor) graphics::plot( result$LON, diff --git a/R/nearest_stations_ogimet.R b/R/nearest_stations_ogimet.R index 8669395..e59ad77 100644 --- a/R/nearest_stations_ogimet.R +++ b/R/nearest_stations_ogimet.R @@ -24,7 +24,7 @@ #' } #' -nearest_stations_ogimet <- function(country = "United+Kingdom", +nearest_stations_ogimet = function(country = "United+Kingdom", date = Sys.Date(), add_map = FALSE, point = c(2, 50), @@ -44,14 +44,14 @@ nearest_stations_ogimet <- function(country = "United+Kingdom", } # initalizing empty data frame for storing results: - result <- NULL + result = NULL for (number_countries in country) { # print(number_countires) - year <- format(date, "%Y") - month <- format(date, "%m") - day <- format(date, "%d") - ndays <- 1 + year = format(date, "%Y") + month = format(date, "%m") + day = format(date, "%d") + ndays = 1 linkpl2 <- paste0( "http://ogimet.com/cgi-bin/gsynres?lang=en&state=", @@ -65,66 +65,66 @@ nearest_stations_ogimet <- function(country = "United+Kingdom", "&hora=06&ndays=1&Send=send" ) - #a <- getURL(linkpl2) - temp <- tempfile() + #a = getURL(linkpl2) + temp = tempfile() test_url(link = linkpl2, output = temp) # run only if downloaded file is valid if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { - a <- readLines(temp) - a <- paste(a, sep="", collapse="") + a = readLines(temp) + a = paste(a, sep="", collapse="") - b <- strsplit(a, "Decoded synops since") + b = strsplit(a, "Decoded synops since") - b1 <- lapply(b, function(x) substr(x, 1, 400)) - b1[[1]] <- b1[[1]][-1] # header + b1 = lapply(b, function(x) substr(x, 1, 400)) + b1[[1]] = b1[[1]][-1] # header - b21 <- unlist(lapply(gregexpr('Lat=', b1[[1]], fixed = TRUE), function(x) x[1])) + b21 = unlist(lapply(gregexpr('Lat=', b1[[1]], fixed = TRUE), function(x) x[1])) - pattern <- paste0(" (", gsub(x = number_countries, pattern = "+", replacement = " ", fixed = TRUE)) - b22 <- unlist(lapply(gregexpr(pattern = pattern, b1[[1]], fixed = TRUE), function(x) x[1])) + pattern = paste0(" (", gsub(x = number_countries, pattern = "+", replacement = " ", fixed = TRUE)) + b22 = unlist(lapply(gregexpr(pattern = pattern, b1[[1]], fixed = TRUE), function(x) x[1])) - b1 <- data.frame(str = b1[[1]], start = b21, stop = b22, stringsAsFactors = FALSE) + b1 = data.frame(str = b1[[1]], start = b21, stop = b22, stringsAsFactors = FALSE) - res <- substr(b1$str, b1$start, b1$stop) + res = substr(b1$str, b1$start, b1$stop) - station_names <- unlist(lapply(strsplit(res, " - "), function(x) x[length(x)])) + station_names = unlist(lapply(strsplit(res, " - "), function(x) x[length(x)])) - res <- gsub(x = res, pattern = ", CAPTION, '", replacement = '', fixed = TRUE) - res <- gsub(x = res, pattern = " m'", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = " - ", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = "Lat=", replacement = '', fixed = TRUE) - res <- gsub(x = res, pattern = "Lon=", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = "Alt=", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = ", CAPTION, '", replacement = '', fixed = TRUE) + res = gsub(x = res, pattern = " m'", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = " - ", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = "Lat=", replacement = '', fixed = TRUE) + res = gsub(x = res, pattern = "Lon=", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = "Alt=", replacement = ' ', fixed = TRUE) - res <- suppressWarnings(do.call("rbind", strsplit(res, " "))) + res = suppressWarnings(do.call("rbind", strsplit(res, " "))) - res1 <- res[,c(1,3,5:7)] + res1 = res[,c(1,3,5:7)] - lat <- as.numeric(substr(res1[, 1], 1, 2)) + + lat = as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[,1], 4, 5))/100) * 1.6667 - lon_hemisphere <- gsub("[0-9]", "\\1", res1[, 2]) - lon_hemisphere <- gsub("-", "", lon_hemisphere) - lon_hemisphere <- ifelse(lon_hemisphere == "W", -1, 1) + lon_hemisphere = gsub("[0-9]", "\\1", res1[, 2]) + lon_hemisphere = gsub("-", "", lon_hemisphere) + lon_hemisphere = ifelse(lon_hemisphere == "W", -1, 1) - lat_hemisphere <- gsub("[0-9]", "\\1", res1[, 1]) - lat_hemisphere <- gsub("-", "", lat_hemisphere) - lat_hemisphere <- ifelse(lat_hemisphere == "S", -1, 1) + lat_hemisphere = gsub("[0-9]", "\\1", res1[, 1]) + lat_hemisphere = gsub("-", "", lat_hemisphere) + lat_hemisphere = ifelse(lat_hemisphere == "S", -1, 1) - lon <- as.numeric(substr(res1[, 2], 1, 3)) + (as.numeric(substr(res1[, 2], 5, 6)) / 100)*1.6667 - lon <- lon*lon_hemisphere + lon = as.numeric(substr(res1[, 2], 1, 3)) + (as.numeric(substr(res1[, 2], 5, 6)) / 100)*1.6667 + lon = lon*lon_hemisphere - lat <- as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[, 1], 4, 5)) / 100)*1.6667 - lat <- lat * lat_hemisphere + lat = as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[, 1], 4, 5)) / 100)*1.6667 + lat = lat * lat_hemisphere - res <- data.frame(wmo_id = res1[, 4], station_names = station_names, + res = data.frame(wmo_id = res1[, 4], station_names = station_names, lon = lon, lat = lat, alt = as.numeric(res1[, 3])) result=rbind(result,res) } else { - result <- NULL + result = NULL cat(paste("Wrong name of a country. Please check countries names at https://ogimet.com/display_stations.php?lang=en&tipo=AND&isyn=&oaci=&nombre=&estado=&Send=Send")) } # end of checking internet connection @@ -133,26 +133,26 @@ nearest_stations_ogimet <- function(country = "United+Kingdom", if (!is.null(result)) { - point <- as.data.frame(t(point)) - names(point) <- c("lon", "lat") - distmatrix <- rbind(point,result[, 3:4]) - distance_points <- stats::dist(distmatrix, method = "euclidean")[1:dim(result)[1]] - result["distance [km]"] <- distance_points * 112.196672 + point = as.data.frame(t(point)) + names(point) = c("lon", "lat") + distmatrix = rbind(point,result[, 3:4]) + distance_points = stats::dist(distmatrix, method = "euclidean")[1:dim(result)[1]] + result["distance [km]"] = distance_points * 112.196672 orderd_distance = result[order(result$distance), ] result = orderd_distance[1:no_of_stations, ] # removing rows with all NA records from the obtained dataset; # otherwise there might be problems with plotting infinite xlim, ylim, etc.. - result <- result[!apply(is.na(result), 1, sum) == ncol(result),] + result = result[!apply(is.na(result), 1, sum) == ncol(result),] if(add_map == TRUE){ if (!requireNamespace("maps", quietly = TRUE)){ stop("package maps required, please install it first") } # plot labels a little bit higher... - addfactor <- as.numeric(diff(stats::quantile(result$lat, na.rm = TRUE, c(0.48, 0.51)))) - addfactor <- ifelse(addfactor > 0.2, 0.2, addfactor) - addfactor <- ifelse(addfactor < 0.05, 0.05, addfactor) + addfactor = as.numeric(diff(stats::quantile(result$lat, na.rm = TRUE, c(0.48, 0.51)))) + addfactor = ifelse(addfactor > 0.2, 0.2, addfactor) + addfactor = ifelse(addfactor < 0.05, 0.05, addfactor) graphics::plot( result$lon, diff --git a/R/ogimet_daily.R b/R/ogimet_daily.R index af545eb..f1b3f97 100644 --- a/R/ogimet_daily.R +++ b/R/ogimet_daily.R @@ -15,19 +15,19 @@ #' #' @examples \donttest{ #' # downloading data for Poznan-Lawica -#' poznan <- ogimet_daily(station = 12330, +#' poznan = ogimet_daily(station = 12330, #' date = c("2019-01-01", "2019-03-31"), #' coords = TRUE) #' head(poznan) #' } #' -ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, station = c(12326, 12330), hour = 6, fill_empty = TRUE) { +ogimet_daily = function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, station = c(12326, 12330), hour = 6, fill_empty = TRUE) { #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - dates <- seq.Date(min(as.Date(date)), max(as.Date(date)), by = "1 month") - dates <- unique(c(dates, as.Date(max(date)))) + dates = seq.Date(min(as.Date(date)), max(as.Date(date)), by = "1 month") + dates = unique(c(dates, as.Date(max(date)))) # initalizing empty data frame for storing results: @@ -68,45 +68,45 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, # adding progress bar if at least 3 iterations are needed if (length(dates) * length(station) >= 3){ - pb <- txtProgressBar(min = 0, max = length(dates) * length(station) - 1, style = 3) + pb = txtProgressBar(min = 0, max = length(dates) * length(station) - 1, style = 3) } for (i in length(dates):1) { # update progressbar: if (length(dates) >=3 ) paste(setTxtProgressBar(pb, abs(length(dates)*length(station) - i)),"\n") - year <- format(dates[i], "%Y") - month <- format(dates[i], "%m") - day <- format(dates[i], "%d") - ndays <- day - linkpl2 <- paste("https://www.ogimet.com/cgi-bin/gsynres?lang=en&ind=", station_nr, "&ndays=32&ano=", year, "&mes=", month, "&day=", day, "&hora=", hour,"&ord=REV&Send=Send", sep="") - if(month == 1) linkpl2 <- paste("https://www.ogimet.com/cgi-bin/gsynres?lang=en&ind=", station_nr, "&ndays=32&ano=", year, "&mes=", month, "&day=", day, "&hora=", hour, "&ord=REV&Send=Send", sep="") + year = format(dates[i], "%Y") + month = format(dates[i], "%m") + day = format(dates[i], "%d") + ndays = day + linkpl2 = paste("https://www.ogimet.com/cgi-bin/gsynres?lang=en&ind=", station_nr, "&ndays=32&ano=", year, "&mes=", month, "&day=", day, "&hora=", hour,"&ord=REV&Send=Send", sep="") + if(month == 1) linkpl2 = paste("https://www.ogimet.com/cgi-bin/gsynres?lang=en&ind=", station_nr, "&ndays=32&ano=", year, "&mes=", month, "&day=", day, "&hora=", hour, "&ord=REV&Send=Send", sep="") - temp <- tempfile() + temp = tempfile() test_url(linkpl2, temp) # run only if downloaded file is valid if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { - a <- readHTMLTable(temp, stringsAsFactors = FALSE) + a = readHTMLTable(temp, stringsAsFactors = FALSE) unlink(temp) - b <- a[[length(a)]] + b = a[[length(a)]] # check no data situations: - tst <- sum(grepl(x = b[[1]], pattern = "No valid data")) + tst = sum(grepl(x = b[[1]], pattern = "No valid data")) if(tst) { message(paste(b[[1]], dates[i])) } else { if (sum(b[1,]=="Dailyweather summary", na.rm = TRUE)) { - b <- b[,1:(length(b) - 8)] + b = b[,1:(length(b) - 8)] } else { - b <- b[, 1:length(b)] + b = b[, 1:length(b)] } - test <- b[1:2, ] + test = b[1:2, ] if (is.null(test) ) { warning(paste0("Wrong station ID: ", station_nr, " You can check station ID at https://ogimet.com/display_stations.php?lang=en&tipo=AND&isyn=&oaci=&nombre=&estado=&Send=Send")) @@ -121,7 +121,7 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, if ((length(test[2, !is.na(test[2, ])]) == 6 & test[2, 5] == "Int.")) { - names_col <- unlist(c( + names_col = unlist(c( test[1, 1], paste(test[1, 2], test[2, 1:3], sep = "_"), test[1, 3:4], @@ -133,7 +133,7 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, names_col = unlist(c(test[1, 1:2], paste(test[1, 3], test[2, 1:2], sep = "_"), test[1, c(4:(length(test) - 1))])) } else if ((length(test[2, !is.na(test[2, ])]) == 5 & test[2, 5] == "Int.")) { - names_col <- unlist(c( + names_col = unlist(c( test[1, 1], paste(test[1, 2], test[2, 1:3], sep = "_"), test[1, 3:4], @@ -142,13 +142,13 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, )) } else if ((length(test[2, !is.na(test[2, ])]) == 3 & test[2, 2] == "Int.")) { - names_col <- unlist(c( + names_col = unlist(c( test[1, 1:2], paste(test[1, 3], test[2, 1:3], sep = "_"), test[1, c(4:(length(test) - 2))] )) } else { - names_col <- "Error_column" + names_col = "Error_column" } @@ -158,25 +158,25 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, "", as.character(lapply(names_col, as.character), stringsAsFactors = FALSE)) - colnames(b) <- names_col - b <- b[-c(1:2), ] - b["station_ID"] <- station_nr + colnames(b) = names_col + b = b[-c(1:2), ] + b["station_ID"] = station_nr # adding year to date - b$Date <- as.character(paste0(b$Date, "/", year)) + b$Date = as.character(paste0(b$Date, "/", year)) # to avoid gtools::smartbind function or similar from another package.. if (ncol(data_station) >= ncol(b)) { - b[setdiff(names(data_station), names(b))] <- NA # adding missing columns - data_station <- rbind(data_station, b) # joining data + b[setdiff(names(data_station), names(b))] = NA # adding missing columns + data_station = rbind(data_station, b) # joining data } else { # when b have more columns then data_station if(nrow(data_station) == 0){ - data_station <- b + data_station = b } else { # adding missing columns - data_station <- merge(b, data_station, all = TRUE)# joining data + data_station = merge(b, data_station, all = TRUE)# joining data } } @@ -185,9 +185,9 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, # coords można lepiej na samym koncu dodać kolumne # wtedy jak zmienia się lokalizacja na dacie to tutaj tez if (coords){ - coord <- a[[1]][2,1] - data_station["Lon"] <- get_coord_from_string(coord, "Longitude") - data_station["Lat"] <- get_coord_from_string(coord, "Latitude") + coord = a[[1]][2,1] + data_station["Lon"] = get_coord_from_string(coord, "Longitude") + data_station["Lat"] = get_coord_from_string(coord, "Latitude") } } # end of checking for: no values in column names @@ -202,12 +202,12 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, if (nrow(data_station) > 0){ - data_station <- data_station[!duplicated(data_station), ] + data_station = data_station[!duplicated(data_station), ] # converting character to proper field representation: # get rid off "---" standing for missing/blank fields: - data_station[which(data_station == "--" | data_station == "---" | data_station == "----" | data_station == "-----", arr.ind = TRUE)] <- NA + data_station[which(data_station == "--" | data_station == "---" | data_station == "----" | data_station == "-----", arr.ind = TRUE)] = NA # other columns to numeric: suppressWarnings(data_station[,c("TemperatureCMax", "TemperatureCMin", "TemperatureCAvg","TdAvgC" ,"HrAvg", @@ -219,20 +219,20 @@ ogimet_daily <- function(date = c(Sys.Date() - 30, Sys.Date()), coords = FALSE, # changing order of columns and removing blank records: if(coords){ - ord1 <- c("station_ID", "Lon", "Lat", "Date", "TemperatureCAvg") - ord1 <- c(ord1, setdiff(names(data_station), c("station_ID", "Lon", "Lat", "Date", "TemperatureCAvg"))) - data_station <- data_station[, ord1] + ord1 = c("station_ID", "Lon", "Lat", "Date", "TemperatureCAvg") + ord1 = c(ord1, setdiff(names(data_station), c("station_ID", "Lon", "Lat", "Date", "TemperatureCAvg"))) + data_station = data_station[, ord1] } else { - ord1 <- c("station_ID", "Date", "TemperatureCAvg") - ord1 <- c(ord1, setdiff(names(data_station), c("station_ID", "Date", "TemperatureCAvg"))) - data_station <- data_station[, ord1] + ord1 = c("station_ID", "Date", "TemperatureCAvg") + ord1 = c(ord1, setdiff(names(data_station), c("station_ID", "Date", "TemperatureCAvg"))) + data_station = data_station[, ord1] } # setdiff(names(df), c("station_ID", "Date", "TC")) # date to as.Date() - data_station$Date <- as.Date(as.character(data_station$Date), format = "%m/%d/%Y") + data_station$Date = as.Date(as.character(data_station$Date), format = "%m/%d/%Y") # clipping to interesting period as we're downloading slightly more than needed: - data_station <- data_station[which(data_station$Date >= as.Date(min(date)) & as.Date(data_station$Date) <= as.Date(max(date))), ] + data_station = data_station[which(data_station$Date >= as.Date(min(date)) & as.Date(data_station$Date) <= as.Date(max(date))), ] } # end of checking whether no. of rows > 0 diff --git a/R/ogimet_hourly.R b/R/ogimet_hourly.R index 887fe9d..9d83b5d 100644 --- a/R/ogimet_hourly.R +++ b/R/ogimet_hourly.R @@ -16,17 +16,17 @@ #' @examples #' \donttest{ #' # downloading data for Poznan-Lawica -#' poznan <- ogimet_hourly(station = 12330, coords = TRUE, precip_split = TRUE) +#' poznan = ogimet_hourly(station = 12330, coords = TRUE, precip_split = TRUE) #' head(poznan) #' } #' -ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, station = c(12326, 12330), precip_split = TRUE){ +ogimet_hourly = function(date = c("2019-06-01","2019-07-31"), coords = FALSE, station = c(12326, 12330), precip_split = TRUE){ #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl - dates <- seq.Date(min(as.Date(date)), max(as.Date(date)), by = "1 month") - 1 - dates <- unique(c(dates, as.Date(max(date)))) + dates = seq.Date(min(as.Date(date)), max(as.Date(date)), by = "1 month") - 1 + dates = unique(c(dates, as.Date(max(date)))) # initalizing empty data frame for storing results: data_station <- @@ -60,19 +60,19 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s for (station_nr in station){ print(station_nr) # adding progress bar if at least 3 iterations are needed - if(length(dates)*length(station) >=3 ) pb <- txtProgressBar(min = 0, max = length(dates)*length(station)-1, style = 3) + if(length(dates)*length(station) >=3 ) pb = txtProgressBar(min = 0, max = length(dates)*length(station)-1, style = 3) # print(station_nr) for (i in length(dates):1) { if(length(dates) >=3 ) paste(setTxtProgressBar(pb, abs(length(dates)*length(station) - i)),"\n") - year <- format(dates[i], "%Y") - month <- format(dates[i], "%m") - day <- format(dates[i], "%d") - ndays <- day - linkpl2 <- paste("https://www.ogimet.com/cgi-bin/gsynres?ind=",station_nr,"&lang=en&decoded=yes&ndays=",ndays,"&ano=",year,"&mes=",month,"&day=",day,"&hora=23",sep="") - if(month=="01") linkpl2 <- paste("http://ogimet.com/cgi-bin/gsynres?ind=",station_nr,"&lang=en&decoded=yes&ndays=31&ano=",year,"&mes=02&day=1&hora=00",sep="") + year = format(dates[i], "%Y") + month = format(dates[i], "%m") + day = format(dates[i], "%d") + ndays = day + linkpl2 = paste("https://www.ogimet.com/cgi-bin/gsynres?ind=",station_nr,"&lang=en&decoded=yes&ndays=",ndays,"&ano=",year,"&mes=",month,"&day=",day,"&hora=23",sep="") + if(month=="01") linkpl2 = paste("http://ogimet.com/cgi-bin/gsynres?ind=",station_nr,"&lang=en&decoded=yes&ndays=31&ano=",year,"&mes=02&day=1&hora=00",sep="") @@ -82,34 +82,34 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s # run only if downloaded file is valid if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { - #a <- getURL(linkpl2) - a <- readHTMLTable(temp, stringsAsFactors = FALSE) + #a = getURL(linkpl2) + a = readHTMLTable(temp, stringsAsFactors = FALSE) unlink(temp) - #a <- readHTMLTable(a, stringsAsFactors=FALSE) + #a = readHTMLTable(a, stringsAsFactors=FALSE) - b <- a[[length(a)]] + b = a[[length(a)]] if (is.null(b)) { warning(paste0("Wrong station ID: ", station_nr, " You can check station ID at https://ogimet.com/display_stations.php?lang=en&tipo=AND&isyn=&oaci=&nombre=&estado=&Send=Send")) return(data_station) } - colnames(b) <- gsub("[^A-Za-z0-9]", "", as.character(lapply(b[1, ], as.character), stringsAsFactors = FALSE)) - colnames(b) <- c("Date", "hour", colnames(b)[2:(ncol(b) - 1)]) # workaround for adding hour which is wrongly recognized - b <- b[-1, ] - b["station_ID"] <- station_nr + colnames(b) = gsub("[^A-Za-z0-9]", "", as.character(lapply(b[1, ], as.character), stringsAsFactors = FALSE)) + colnames(b) = c("Date", "hour", colnames(b)[2:(ncol(b) - 1)]) # workaround for adding hour which is wrongly recognized + b = b[-1, ] + b["station_ID"] = station_nr # to avoid gtools::smartbind function or similar from another package.. if (ncol(data_station) >= ncol(b)) { - b[setdiff(names(data_station), names(b))] <- NA # adding missing columns - data_station <- rbind(data_station, b) # joining data + b[setdiff(names(data_station), names(b))] = NA # adding missing columns + data_station = rbind(data_station, b) # joining data } else { # when b have more columns then data_station if(nrow(data_station) == 0){ data_station = b } else { # adding missing columns - data_station <- merge(b, data_station, all = TRUE)# joining data + data_station = merge(b, data_station, all = TRUE)# joining data } } @@ -119,9 +119,9 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s # coords można lepiej na samym koncu dodać kolumne # wtedy jak zmienia się lokalizacja na dacie to tutaj tez if (coords){ - coord <- a[[1]][2,1] - data_station["Lon"] <- get_coord_from_string(coord, "Longitude") - data_station["Lat"] <- get_coord_from_string(coord, "Latitude") + coord = a[[1]][2,1] + data_station["Lon"] = get_coord_from_string(coord, "Longitude") + data_station["Lat"] = get_coord_from_string(coord, "Latitude") } } # end of checking for empty files / problems with connection @@ -132,16 +132,16 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s if(nrow(data_station) > 0){ - data_station <- data_station[!duplicated(data_station), ] + data_station = data_station[!duplicated(data_station), ] # converting character to proper field representation: # get rid off "---" standing for missing/blank fields: - data_station[which(data_station == "--" | data_station == "---" | data_station == "----" | data_station == "-----", arr.ind = TRUE)] <- NA + data_station[which(data_station == "--" | data_station == "---" | data_station == "----" | data_station == "-----", arr.ind = TRUE)] = NA # changing time.. data_station$Date <-strptime(paste(data_station$Date, data_station$hour), "%m/%d/%Y %H:%M", tz = 'UTC') - data_station$hour <- NULL + data_station$hour = NULL # other columns to numeric: suppressWarnings(data_station[, c("TC", "TdC", "ffkmh", "Gustkmh", "P0hPa", "PseahPa", "PTnd", "Nt", "Nh", @@ -152,28 +152,28 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s # TODO: # changing order of columns and removing blank records: if(coords){ - ord1 <- c("station_ID", "Lon", "Lat", "Date", "TC") - ord1 <- c(ord1, setdiff(names(data_station), c("station_ID", "Lon", "Lat", "Date", "TC"))) - ord1 <- ord1[!(ord1 %in% c("WW", "W1","W2","W3"))] - data_station <- data_station[, ord1] + ord1 = c("station_ID", "Lon", "Lat", "Date", "TC") + ord1 = c(ord1, setdiff(names(data_station), c("station_ID", "Lon", "Lat", "Date", "TC"))) + ord1 = ord1[!(ord1 %in% c("WW", "W1","W2","W3"))] + data_station = data_station[, ord1] } else { - ord1 <- c("station_ID", "Date", "TC") - ord1 <- c(ord1, setdiff(names(data_station), c("station_ID", "Date", "TC"))) - ord1 <- ord1[!(ord1 %in% c("WW", "W1","W2","W3"))] - data_station <- data_station[, ord1] + ord1 = c("station_ID", "Date", "TC") + ord1 = c(ord1, setdiff(names(data_station), c("station_ID", "Date", "TC"))) + ord1 = ord1[!(ord1 %in% c("WW", "W1","W2","W3"))] + data_station = data_station[, ord1] } # setdiff(names(df), c("station_ID", "Date", "TC")) # splitting precipitation into 6-12-24 hours from a default string in the Precmm column: if(precip_split){ - data_station$pr6 <- precip_split(data_station$Precmm, pattern = "/6") - data_station$pr12 <- precip_split(data_station$Precmm, pattern = "/12") - data_station$pr24 <- precip_split(data_station$Precmm, pattern = "/24") + data_station$pr6 = precip_split(data_station$Precmm, pattern = "/6") + data_station$pr12 = precip_split(data_station$Precmm, pattern = "/12") + data_station$pr24 = precip_split(data_station$Precmm, pattern = "/24") } # clipping to interesting period as we're downloading slightly more than needed: - data_station <- data_station[which(as.Date(data_station$Date) >= as.Date(min(date)) & as.Date(data_station$Date) <= as.Date(max(date))), ] + data_station = data_station[which(as.Date(data_station$Date) >= as.Date(min(date)) & as.Date(data_station$Date) <= as.Date(max(date))), ] } # end of checking whether object is empty diff --git a/R/onAttach.R b/R/onAttach.R index 3816c04..a79c8f2 100644 --- a/R/onAttach.R +++ b/R/onAttach.R @@ -3,7 +3,7 @@ #' @importFrom stats runif #' @export -.onAttach <- function(libname, pkgname) { +.onAttach = function(libname, pkgname) { if((runif(1) < 0.2) & interactive()) { # activate occasionally and only if not run as Rscript ver = as.character(packageVersion("climate")) packageStartupMessage(paste0(c("\n______________________________________________________________\n", diff --git a/R/precip_split.R b/R/precip_split.R index 05f6e35..fe99d73 100644 --- a/R/precip_split.R +++ b/R/precip_split.R @@ -8,13 +8,13 @@ #' #' @examples #' \donttest{ -#' df <- climate:::ogimet_hourly(station = 12330) +#' df = climate:::ogimet_hourly(station = 12330) #' climate:::precip_split(df$Precmm, pattern = "/12") # to get 12h precipitation amounts #' } #' -precip_split <- function(precip, pattern = "/12"){ - b <- strsplit(precip, "h", fixed = TRUE) - b <- lapply(b, function(x) x[grepl(x, pattern = pattern, fixed = TRUE)]) - b <- unlist(lapply(b, function(x) ifelse(length(x) > 0, gsub(x = x, pattern = pattern, replacement = ""), NA))) +precip_split = function(precip, pattern = "/12"){ + b = strsplit(precip, "h", fixed = TRUE) + b = lapply(b, function(x) x[grepl(x, pattern = pattern, fixed = TRUE)]) + b = unlist(lapply(b, function(x) ifelse(length(x) > 0, gsub(x = x, pattern = pattern, replacement = ""), NA))) suppressWarnings(as.numeric(as.character(b))) } diff --git a/R/sounding_wyoming.R b/R/sounding_wyoming.R index 2a62b02..317c11d 100644 --- a/R/sounding_wyoming.R +++ b/R/sounding_wyoming.R @@ -44,7 +44,7 @@ #' } #' -sounding_wyoming <- function(wmo_id, yy, mm, dd, hh){ +sounding_wyoming = function(wmo_id, yy, mm, dd, hh){ if (length(yy)!=1 || length(mm)!=1 || length(dd)!=1 || length(hh)!=1) { stop("The function supports downloading data for a given day. Please change arguments yy, mm, dd, hh to single values") @@ -54,38 +54,38 @@ sounding_wyoming <- function(wmo_id, yy, mm, dd, hh){ stop("The function supports downloading data for one station at the time. Please change the `wmo_id` argument to a single value") } - mm <- formatC(mm, width = 2, format = "d", flag = "0") - dd <- formatC(dd, width = 2, format = "d", flag = "0") - hh <- formatC(hh, width = 2, format = "d", flag = "0") + mm = formatC(mm, width = 2, format = "d", flag = "0") + dd = formatC(dd, width = 2, format = "d", flag = "0") + hh = formatC(hh, width = 2, format = "d", flag = "0") - url <- paste0("http://weather.uwyo.edu/cgi-bin/sounding?region=europe&TYPE=TEXT%3ALIST&YEAR=", + url = paste0("http://weather.uwyo.edu/cgi-bin/sounding?region=europe&TYPE=TEXT%3ALIST&YEAR=", yy, "&MONTH=", mm, "&FROM=", dd, hh, "&TO=", dd, hh, "&STNM=", wmo_id) - temp <- tempfile() + temp = tempfile() test_url(url, temp) # run only if downloaded file is valid df = NULL if(!is.na(file.size(temp)) & (file.size(temp) > 800)) { - txt <- read.fwf(file = temp, widths = 1000) - sects <- grep(pattern = "PRE>", x = txt$V1) + txt = read.fwf(file = temp, widths = 1000) + sects = grep(pattern = "PRE>", x = txt$V1) if (length(sects) == 0){ stop("HTTP status was '503 Service Unavailable'. Have you provided a correct station id? Please check wmo_id numbers at: http://weather.uwyo.edu/upperair/sounding.html") } - df <- read.fwf(file = temp, skip = sects[1] + 4, widths = rep(7, 11), + df = read.fwf(file = temp, skip = sects[1] + 4, widths = rep(7, 11), n = (sects[2] - (sects[1] + 5))) - colnames(df) <- c("PRES", "HGHT", "TEMP", "DWPT", "RELH", + colnames(df) = c("PRES", "HGHT", "TEMP", "DWPT", "RELH", "MIXR", "DRCT", "SKNT", "THTA", "THTE", "THTV") - txt <- read.fwf(file = temp, skip = sects[2] + 1, widths = 1000, + txt = read.fwf(file = temp, skip = sects[2] + 1, widths = 1000, n = (sects[3] - (sects[2] + 2)), stringsAsFactors = FALSE)$V1 - df2 <- as.data.frame(matrix(data = unlist(strsplit(txt, split = ": ")), ncol = 2, byrow = TRUE)) - colnames(df2) <- c("parameter"," value") - df <- list(df, df2) + df2 = as.data.frame(matrix(data = unlist(strsplit(txt, split = ": ")), ncol = 2, byrow = TRUE)) + colnames(df2) = c("parameter"," value") + df = list(df, df2) } else { # end of checking file size / problems with internet connection cat(paste0("Service not working or wmo_id or date not correct. Check url:\n", url)) diff --git a/R/stations_ogimet.R b/R/stations_ogimet.R index 303e4ed..daabd87 100644 --- a/R/stations_ogimet.R +++ b/R/stations_ogimet.R @@ -15,7 +15,7 @@ #' stations_ogimet(country = "Australia", add_map = TRUE) #' } #' -stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_map = FALSE){ +stations_ogimet = function(country = "United+Kingdom", date = Sys.Date(), add_map = FALSE){ #options(RCurlOptions = list(ssl.verifypeer = FALSE)) # required on windows for RCurl @@ -28,14 +28,14 @@ stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_m } # initalizing empty data frame for storing results: - year <- format(date, "%Y") - month <- format(date, "%m") - day <- format(date, "%d") - ndays <- 1 - linkpl2 <- paste0("http://ogimet.com/cgi-bin/gsynres?lang=en&state=",country,"&osum=no&fmt=html&ord=REV&ano=",year,"&mes=",month,"&day=",day,"&hora=06&ndays=1&Send=send") + year = format(date, "%Y") + month = format(date, "%m") + day = format(date, "%d") + ndays = 1 + linkpl2 = paste0("http://ogimet.com/cgi-bin/gsynres?lang=en&state=",country,"&osum=no&fmt=html&ord=REV&ano=",year,"&mes=",month,"&day=",day,"&hora=06&ndays=1&Send=send") - #a <- getURL(linkpl2) + #a = getURL(linkpl2) temp = tempfile() test_url(link = linkpl2, output = temp) @@ -46,54 +46,54 @@ stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_m a = readLines(temp) a = paste(a, sep="", collapse="") - b <- strsplit(a, "Decoded synops since") + b = strsplit(a, "Decoded synops since") - b1 <- lapply(b, function(x) substr(x, 1, 400)) - b1[[1]] <- b1[[1]][-1] # header + b1 = lapply(b, function(x) substr(x, 1, 400)) + b1[[1]] = b1[[1]][-1] # header - b21 <- unlist(lapply(gregexpr('Lat=', b1[[1]], fixed = TRUE), function(x) x[1])) + b21 = unlist(lapply(gregexpr('Lat=', b1[[1]], fixed = TRUE), function(x) x[1])) - pattern <- paste0(" (", gsub(x = country, pattern = "+", replacement = " ", fixed = TRUE)) - b22 <- unlist(lapply(gregexpr(pattern = pattern, b1[[1]], fixed = TRUE), function(x) x[1])) + pattern = paste0(" (", gsub(x = country, pattern = "+", replacement = " ", fixed = TRUE)) + b22 = unlist(lapply(gregexpr(pattern = pattern, b1[[1]], fixed = TRUE), function(x) x[1])) - b1 <- data.frame(str = b1[[1]], start = b21, stop = b22, stringsAsFactors = FALSE) + b1 = data.frame(str = b1[[1]], start = b21, stop = b22, stringsAsFactors = FALSE) - res <- substr(b1$str, b1$start, b1$stop) + res = substr(b1$str, b1$start, b1$stop) - station_names <- unlist(lapply(strsplit(res, " - "), function(x) x[length(x)])) + station_names = unlist(lapply(strsplit(res, " - "), function(x) x[length(x)])) - res <- gsub(x = res, pattern = ", CAPTION, '", replacement = '', fixed = TRUE) - res <- gsub(x = res, pattern = " m'", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = " - ", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = "Lat=", replacement = '', fixed = TRUE) - res <- gsub(x = res, pattern = "Lon=", replacement = ' ', fixed = TRUE) - res <- gsub(x = res, pattern = "Alt=", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = ", CAPTION, '", replacement = '', fixed = TRUE) + res = gsub(x = res, pattern = " m'", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = " - ", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = "Lat=", replacement = '', fixed = TRUE) + res = gsub(x = res, pattern = "Lon=", replacement = ' ', fixed = TRUE) + res = gsub(x = res, pattern = "Alt=", replacement = ' ', fixed = TRUE) - res <- suppressWarnings(do.call("rbind", strsplit(res, " "))) + res = suppressWarnings(do.call("rbind", strsplit(res, " "))) - res1 <- res[, c(1, 3, 5:7)] + res1 = res[, c(1, 3, 5:7)] - lat <- as.numeric(substr(res1[, 1], 1, 2)) + + lat = as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[,1], 4, 5))/100) * 1.6667 - lon_hemisphere <- gsub("[0-9]", "\\1", res1[, 2]) - lon_hemisphere <- gsub("-", "", lon_hemisphere) - lon_hemisphere <- ifelse(lon_hemisphere == "W", -1, 1) + lon_hemisphere = gsub("[0-9]", "\\1", res1[, 2]) + lon_hemisphere = gsub("-", "", lon_hemisphere) + lon_hemisphere = ifelse(lon_hemisphere == "W", -1, 1) - lat_hemisphere <- gsub("[0-9]", "\\1", res1[, 1]) - lat_hemisphere <- gsub("-", "", lat_hemisphere) - lat_hemisphere <- ifelse(lat_hemisphere == "S", -1, 1) + lat_hemisphere = gsub("[0-9]", "\\1", res1[, 1]) + lat_hemisphere = gsub("-", "", lat_hemisphere) + lat_hemisphere = ifelse(lat_hemisphere == "S", -1, 1) - lon <- as.numeric(substr(res1[, 2], 1, 3)) + (as.numeric(substr(res1[, 2], 5, 6)) / + lon = as.numeric(substr(res1[, 2], 1, 3)) + (as.numeric(substr(res1[, 2], 5, 6)) / 100) * 1.6667 - lon <- lon * lon_hemisphere + lon = lon * lon_hemisphere - lat <- as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[, 1], 4, 5)) / + lat = as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[, 1], 4, 5)) / 100) * 1.6667 - lat <- lat * lat_hemisphere + lat = lat * lat_hemisphere - res <- data.frame(wmo_id = res1[, 4], station_names = station_names, + res = data.frame(wmo_id = res1[, 4], station_names = station_names, lon = lon, lat = lat, alt = as.numeric(res1[, 3])) } else { @@ -110,9 +110,9 @@ if (!is.null(res)) { stop("package maps required, please install it first") } # plot labels a little bit higher... - addfactor <- as.numeric(diff(stats::quantile(res$lat, na.rm = TRUE, c(0.48, 0.51)))) - addfactor <- ifelse(addfactor > 0.2, 0.2, addfactor) - addfactor <- ifelse(addfactor < 0.05, 0.05, addfactor) + addfactor = as.numeric(diff(stats::quantile(res$lat, na.rm = TRUE, c(0.48, 0.51)))) + addfactor = ifelse(addfactor > 0.2, 0.2, addfactor) + addfactor = ifelse(addfactor < 0.05, 0.05, addfactor) graphics::plot(res$lon, res$lat, col='red', pch=19, xlab = 'longitude', ylab = 'latitude') graphics::text(res$lon, res$lat + addfactor, labels = res$station_names, diff --git a/R/test_url.R b/R/test_url.R index 54dab8d..06169b3 100644 --- a/R/test_url.R +++ b/R/test_url.R @@ -24,16 +24,16 @@ -test_url <- function(link, output, quiet = FALSE) { +test_url = function(link, output, quiet = FALSE) { print(link) - try_GET <- function(x, ...) { + try_GET = function(x, ...) { tryCatch( curl::curl_download(url = link, destfile = output, mode = "wb", quiet = quiet, ...), error = function(e) conditionMessage(e), warning = function(w) conditionMessage(w) ) } - is_response <- function(x) { + is_response = function(x) { class(x) == "response" } @@ -43,7 +43,7 @@ test_url <- function(link, output, quiet = FALSE) { return(invisible(NULL)) } # Then try for timeout problems - resp <- try_GET(link) + resp = try_GET(link) if (!is_response(resp)) { message(resp) return(invisible(NULL)) @@ -66,5 +66,5 @@ test_url <- function(link, output, quiet = FALSE) { # b = curl_download(url = "http://httpbin.org", destfile = tempfile()) # b = curl_download(url = "http://httpbin.org/status/404", destfile = tempfile()) # -# url <- "http://www2.census.gov/acs2011_5yr/pums/csv_pus.zip" +# url = "http://www2.census.gov/acs2011_5yr/pums/csv_pus.zip" # test_url(link = url, output = tempfile()) diff --git a/man/get_coord_from_string.Rd b/man/get_coord_from_string.Rd index a031cd3..1645e42 100644 --- a/man/get_coord_from_string.Rd +++ b/man/get_coord_from_string.Rd @@ -20,7 +20,7 @@ Internal function for cleaning coordinates' metadata provided by Ogimet } \examples{ \donttest{ - txt <- "12120: Leba (Poland)\nLatitude: 54-45N Longitude: 017-32E Altitude: 2 m." + txt = "12120: Leba (Poland)\nLatitude: 54-45N Longitude: 017-32E Altitude: 2 m." climate:::get_coord_from_string(txt, pattern = "Latitude") } diff --git a/man/hydro_imgw.Rd b/man/hydro_imgw.Rd index 14fb905..3318fd6 100644 --- a/man/hydro_imgw.Rd +++ b/man/hydro_imgw.Rd @@ -39,7 +39,7 @@ Downloading hourly, daily, and monthly hydrological data from the measurement st } \examples{ \donttest{ - x <- hydro_imgw("monthly", year = 1999) + x = hydro_imgw("monthly", year = 1999) head(x) } } diff --git a/man/hydro_imgw_monthly.Rd b/man/hydro_imgw_monthly.Rd index 37e3606..63343b7 100644 --- a/man/hydro_imgw_monthly.Rd +++ b/man/hydro_imgw_monthly.Rd @@ -29,7 +29,7 @@ Downloading monthly hydrological data from the danepubliczne.imgw.pl collection } \examples{ \donttest{ - monthly <- hydro_imgw_monthly(year = 2000) + monthly = hydro_imgw_monthly(year = 2000) head(monthly) } diff --git a/man/hydro_metadata_imgw.Rd b/man/hydro_metadata_imgw.Rd index 5023508..60c2ca2 100644 --- a/man/hydro_metadata_imgw.Rd +++ b/man/hydro_metadata_imgw.Rd @@ -15,9 +15,9 @@ By default, the function returns a list or data frame for a selected subset } \examples{ \donttest{ - meta <- climate:::hydro_metadata_imgw(interval = "daily") - meta <- climate:::hydro_metadata_imgw(interval = "monthly") - meta <- climate:::hydro_metadata_imgw(interval = "semiannual_and_annual") + meta = climate:::hydro_metadata_imgw(interval = "daily") + meta = climate:::hydro_metadata_imgw(interval = "monthly") + meta = climate:::hydro_metadata_imgw(interval = "semiannual_and_annual") } } \keyword{internal} diff --git a/man/hydro_shortening_imgw.Rd b/man/hydro_shortening_imgw.Rd index e2ef96d..cbfb9cf 100644 --- a/man/hydro_shortening_imgw.Rd +++ b/man/hydro_shortening_imgw.Rd @@ -18,9 +18,9 @@ Shortening column names of hydrological parameters to improve the readability of } \examples{ \donttest{ - monthly <- hydro_imgw("monthly", year = 1969) + monthly = hydro_imgw("monthly", year = 1969) colnames(monthly) - abbr <- climate:::hydro_shortening_imgw(data = monthly, + abbr = climate:::hydro_shortening_imgw(data = monthly, col_names = "full", remove_duplicates = TRUE) head(abbr) diff --git a/man/meteo_imgw.Rd b/man/meteo_imgw.Rd index 15fa0d8..c76c9f6 100644 --- a/man/meteo_imgw.Rd +++ b/man/meteo_imgw.Rd @@ -42,7 +42,7 @@ Downloading hourly, daily, and monthly meteorological data from the SYNOP / CLIM } \examples{ \donttest{ - x <- meteo_imgw("monthly", year = 2018, coords = TRUE) + x = meteo_imgw("monthly", year = 2018, coords = TRUE) head(x) } } diff --git a/man/meteo_imgw_daily.Rd b/man/meteo_imgw_daily.Rd index eedaae0..66007ea 100644 --- a/man/meteo_imgw_daily.Rd +++ b/man/meteo_imgw_daily.Rd @@ -35,7 +35,7 @@ Downloading daily (meteorological) data from the SYNOP / CLIMATE / PRECIP statio } \examples{ \donttest{ - daily <- meteo_imgw_daily(rank = "climate", year = 2000) + daily = meteo_imgw_daily(rank = "climate", year = 2000) head(daily) } diff --git a/man/meteo_imgw_hourly.Rd b/man/meteo_imgw_hourly.Rd index a4a2972..f6bda2a 100644 --- a/man/meteo_imgw_hourly.Rd +++ b/man/meteo_imgw_hourly.Rd @@ -35,7 +35,7 @@ Downloading hourly (meteorological) data from the SYNOP / CLIMATE / PRECIP stati } \examples{ \donttest{ - hourly <- meteo_imgw_hourly(rank = "climate", year = 1984) + hourly = meteo_imgw_hourly(rank = "climate", year = 1984) head(hourly) } diff --git a/man/meteo_imgw_monthly.Rd b/man/meteo_imgw_monthly.Rd index 8bddc48..825997a 100644 --- a/man/meteo_imgw_monthly.Rd +++ b/man/meteo_imgw_monthly.Rd @@ -35,11 +35,11 @@ Downloading monthly (meteorological) data from the SYNOP / CLIMATE / PRECIP stat } \examples{ \donttest{ - monthly <- meteo_imgw_monthly(rank = "climate", year = 1969) + monthly = meteo_imgw_monthly(rank = "climate", year = 1969) head(monthly) # a descriptive (long) column names: - monthly2 <- meteo_imgw_monthly(rank = "synop", year = 2018, + monthly2 = meteo_imgw_monthly(rank = "synop", year = 2018, col_names = "full") head(monthly2) diff --git a/man/meteo_metadata_imgw.Rd b/man/meteo_metadata_imgw.Rd index 762558b..6827d0f 100644 --- a/man/meteo_metadata_imgw.Rd +++ b/man/meteo_metadata_imgw.Rd @@ -17,9 +17,9 @@ By default, the function returns a list or data frame for a selected subset } \examples{ \donttest{ - meta <- climate:::meteo_metadata_imgw(interval = "hourly", rank = "synop") - meta <- climate:::meteo_metadata_imgw(interval = "daily", rank = "synop") - meta <- climate:::meteo_metadata_imgw(interval = "monthly", rank = "precip") + meta = climate:::meteo_metadata_imgw(interval = "hourly", rank = "synop") + meta = climate:::meteo_metadata_imgw(interval = "daily", rank = "synop") + meta = climate:::meteo_metadata_imgw(interval = "monthly", rank = "precip") } } \keyword{internal} diff --git a/man/meteo_noaa_co2.Rd b/man/meteo_noaa_co2.Rd index e2b4c57..5f21101 100644 --- a/man/meteo_noaa_co2.Rd +++ b/man/meteo_noaa_co2.Rd @@ -38,7 +38,7 @@ CO2 expressed as a mole fraction in dry air, micromol/mol, abbreviated as ppm } \examples{ \donttest{ - #co2 <- meteo_noaa_co2() + #co2 = meteo_noaa_co2() #head(co2) #plot(co2$yy_d, co2$co2_avg, type='l') } diff --git a/man/meteo_shortening_imgw.Rd b/man/meteo_shortening_imgw.Rd index 15825bf..48dfd17 100644 --- a/man/meteo_shortening_imgw.Rd +++ b/man/meteo_shortening_imgw.Rd @@ -18,9 +18,9 @@ Shortening column names of meteorological parameters to improve the readability } \examples{ \donttest{ - monthly <- meteo_imgw("monthly", rank = "climate", year = 1969) + monthly = meteo_imgw("monthly", rank = "climate", year = 1969) colnames(monthly) - abbr <- climate:::meteo_shortening_imgw(data = monthly, + abbr = climate:::meteo_shortening_imgw(data = monthly, col_names = "full", remove_duplicates = TRUE) head(abbr) diff --git a/man/ogimet_daily.Rd b/man/ogimet_daily.Rd index eab54ca..4444b92 100644 --- a/man/ogimet_daily.Rd +++ b/man/ogimet_daily.Rd @@ -27,7 +27,7 @@ Downloading daily (meteorological) data from the Synop stations available in the \examples{ \donttest{ # downloading data for Poznan-Lawica - poznan <- ogimet_daily(station = 12330, + poznan = ogimet_daily(station = 12330, date = c("2019-01-01", "2019-03-31"), coords = TRUE) head(poznan) diff --git a/man/ogimet_hourly.Rd b/man/ogimet_hourly.Rd index c3a2a64..9002d27 100644 --- a/man/ogimet_hourly.Rd +++ b/man/ogimet_hourly.Rd @@ -27,7 +27,7 @@ Downloading hourly (meteorological) data from the Synop stations available in th \examples{ \donttest{ # downloading data for Poznan-Lawica - poznan <- ogimet_hourly(station = 12330, coords = TRUE, precip_split = TRUE) + poznan = ogimet_hourly(station = 12330, coords = TRUE, precip_split = TRUE) head(poznan) } diff --git a/man/precip_split.Rd b/man/precip_split.Rd index e53026a..f19c770 100644 --- a/man/precip_split.Rd +++ b/man/precip_split.Rd @@ -16,7 +16,7 @@ Internal function for splitting precipitation field provided by Ogimet and conve } \examples{ \donttest{ - df <- climate:::ogimet_hourly(station = 12330) + df = climate:::ogimet_hourly(station = 12330) climate:::precip_split(df$Precmm, pattern = "/12") # to get 12h precipitation amounts } diff --git a/tests/testthat/test-hydro_imgw.R b/tests/testthat/test-hydro_imgw.R index c0b0ea2..ee7cb21 100644 --- a/tests/testthat/test-hydro_imgw.R +++ b/tests/testthat/test-hydro_imgw.R @@ -12,7 +12,7 @@ test_that("hydro_imgw works!", { x <- hydro_imgw("semiannual_and_annual", year = y, coords = TRUE, col_names = "full") x <- hydro_imgw("semiannual_and_annual", year = y, col_names = "polish") x <- hydro_imgw("semiannual_and_annual", year = y, coords = TRUE, col_names = "polish") - x <- hydro_imgw("semiannual_and_annual", year = y, station = "BOGUSŁAW") + x <- hydro_imgw("semiannual_and_annual", year = y, station = "BORUCINO") x2 <- hydro_imgw("semiannual_and_annual", year = y, station = 149180020) }) diff --git a/vignettes/getstarted.Rmd b/vignettes/getstarted.Rmd index ba1a367..b0c2b00 100644 --- a/vignettes/getstarted.Rmd +++ b/vignettes/getstarted.Rmd @@ -95,7 +95,7 @@ Summary of stations available in Ogimet repository for a selected country: ``` {r stations, eval=T, fig.width=7, fig.height=7, fig.fullwidth=T} library(climate) -PL = stations_ogimet(country ="Poland", add_map = TRUE) +PL = stations_ogimet(country = "Poland", add_map = TRUE) head(PL) ``` @@ -142,11 +142,11 @@ kable(head(df2,10), caption = "Examplary data frame of sounding preprocessing") ### Example 5 Preparing an annual summary of air temperature and precipitation, processing with **dplyr** -```{r imgw_meteo, fig.width=7, fig.height=7, fig.fullwidth=TRUE} +```{r imgw_meteo, fig.width=7, fig.height=7, fig.fullwidth=TRUE, error=TRUE} library(climate) library(dplyr) -df = meteo_imgw(interval = 'monthly', rank='synop', year = 1991:2019, station = "ŁEBA") +df = meteo_imgw(interval = "monthly", rank = "synop", year = 1991:2019, station = "ŁEBA") # please note that sometimes 2 names are used for the same station in different years df2 = select(df, station:t2m_mean_mon, rr_monthly) @@ -164,7 +164,7 @@ colnames(monthly_summary) = month.abb ``` -```{r imgw_meto2, echo=FALSE} +```{r imgw_meto2, echo=FALSE, error=TRUE} library(knitr) kable(head(monthly_summary), caption = "Examplary data frame of meteorological preprocessing.") ```