diff --git a/DESCRIPTION b/DESCRIPTION index 08a25ed..fbb1d16 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: climate Title: Interface to Download Meteorological (and Hydrological) Datasets -Version: 0.9.7 +Version: 0.9.8 Authors@R: c(person(given = "Bartosz", family = "Czernecki", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index ef64a1b..d46ba3c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,11 @@ -# climate 0.9.7 +# climate 0.9.8 * Adding informative message if problems with NOAA hourly dataset occur -* Informative message if problems with downloading detected +* Informative message if problems with downloading detected for non-IMGW dataset + +# climate 0.9.7 + +* stop working if no internet connection detected # climate 0.9.6 diff --git a/R/meteo_noaa_co2.R b/R/meteo_noaa_co2.R index 72d03b6..6259231 100644 --- a/R/meteo_noaa_co2.R +++ b/R/meteo_noaa_co2.R @@ -49,8 +49,16 @@ meteo_noaa_co2 <- function(){ temp = tempfile() test_url(link = base_url, output = temp) - co2 = read.table(temp, na.strings = "-99.99") - colnames(co2) = c("yy", "mm", "yy_d","co2_avg", "co2_interp", "co2_seas", "ndays") + # run only if downloaded file is valid + co2 = NULL + if(!is.na(file.size(temp)) & (file.size(temp) > 800)) { + + co2 = read.table(temp, na.strings = "-99.99") + colnames(co2) = c("yy", "mm", "yy_d","co2_avg", "co2_interp", "co2_seas", "ndays") + + } else { + cat(paste0("Service not working or problems with internet connection. Check url:\n", base_url)) + } unlink(temp) return(co2) diff --git a/R/nearest_stations_noaa.R b/R/nearest_stations_noaa.R index de39774..d72ed57 100644 --- a/R/nearest_stations_noaa.R +++ b/R/nearest_stations_noaa.R @@ -49,6 +49,10 @@ nearest_stations_nooa <- function(country, #a <- getURL(linkpl2) temp = tempfile() test_url(link = linkpl2, output = temp) + + # check connection: + if(!is.na(file.size(temp)) & (file.size(temp) > 800)) { + a = readLines(temp) a = trimws(a, which = "right") b = strsplit(a, " ") @@ -144,5 +148,11 @@ nearest_stations_nooa <- function(country, } + + } else { # end of checking connection + cat(paste0("Service not working, wrong query or problems with internet connection.\n")) + result = NULL + } + return(result) } diff --git a/R/nearest_stations_ogimet.R b/R/nearest_stations_ogimet.R index ae8c2ef..2bdb973 100644 --- a/R/nearest_stations_ogimet.R +++ b/R/nearest_stations_ogimet.R @@ -62,62 +62,70 @@ nearest_stations_ogimet <- function(country = "United+Kingdom", #a <- getURL(linkpl2) temp = tempfile() test_url(link = linkpl2, output = temp) - a = readLines(temp) - a = paste(a, sep="", collapse="") - b <- strsplit(a, "Decoded synops since") + # run only if downloaded file is valid + if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { - 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])) - - 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) - - res <- substr(b1$str, b1$start, b1$stop) - - 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 <- suppressWarnings(do.call("rbind", strsplit(res, " "))) - - res1 <- res[,c(1,3,5:7)] - - 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) - - 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 - - lat <- as.numeric(substr(res1[, 1], 1, 2)) + (as.numeric(substr(res1[, 1], 4, 5)) / 100)*1.6667 - lat <- lat * lat_hemisphere + a = readLines(temp) + a = paste(a, sep="", collapse="") + + b <- strsplit(a, "Decoded synops since") + + 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])) + + 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) + + res <- substr(b1$str, b1$start, b1$stop) + + 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 <- suppressWarnings(do.call("rbind", strsplit(res, " "))) + + res1 <- res[,c(1,3,5:7)] + + 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) + + 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 + + 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, + lon = lon, lat = lat, alt = as.numeric(res1[, 3])) + result=rbind(result,res) + } else { + 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 - res <- data.frame(wmo_id = res1[, 4], station_names = station_names, - lon = lon, lat = lat, alt = as.numeric(res1[, 3])) - result=rbind(result,res) -} - if (dim(result)[1]==0) { - stop("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") } + + if (!is.null(result)) { point = as.data.frame(t(point)) names(point) = c("lon", "lat") @@ -176,6 +184,8 @@ nearest_stations_ogimet <- function(country = "United+Kingdom", } + } # end of checking whether result is null + return(result) } diff --git a/R/ogimet_daily.R b/R/ogimet_daily.R index a95c1b1..7002a0a 100644 --- a/R/ogimet_daily.R +++ b/R/ogimet_daily.R @@ -82,146 +82,142 @@ ogimet_daily <- function(date = c(Sys.Date()-30, Sys.Date()), coords = FALSE, st 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="") - # if (!httr::http_error(linkpl2)) { - # a = getURL(linkpl2, - # ftp.use.epsv = FALSE, - # dirlistonly = TRUE) - # } else { - # stop(call. = FALSE, - # paste0("\nDownload failed. ", - # "Check your internet connection or validate this url in your browser: ", - # linkpl2, "\n")) - # } - temp = tempfile() test_url(linkpl2, temp) - #a <- getURL(linkpl2) - a <- readHTMLTable(temp, stringsAsFactors = FALSE) - unlink(temp) - - b <- a[[length(a)]] - if (sum(b[1,]=="Dailyweather summary", na.rm = TRUE)) { - b <- b[,1:(length(b) - 8)] - } else { - b <- b[, 1:length(b)] - } - - 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")) - return(data_station) - } - #exeptions diferent names_col - if ((length(test[2, !is.na(test[2, ])]) == 6 & - test[2, 5] == "Int.")) { - names_col = unlist(c( - test[1, 1], - paste(test[1, 2], test[2, 1:3], sep = "_"), - test[1, 3:4], - paste(test[1, 5], test[2, 4:6], sep = "_"), - test[1, c(6:(length(test) - 4))] - )) - } else if ((length(test[2, !is.na(test[2, ])]) == 2 & - test[2, 2] == "Int.")) { - 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( - test[1, 1], - paste(test[1, 2], test[2, 1:3], sep = "_"), - test[1, 3:4], - paste(test[1, 5], test[2, 4:5], sep = "_"), - test[1, c(6:(length(test) - 3))] - )) - } else if ((length(test[2, !is.na(test[2, ])]) == 3 & - test[2, 2] == "Int.")) { - 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 <- - gsub("[^A-Za-z0-9]", - "", - as.character(lapply(names_col, as.character), stringsAsFactors = FALSE)) - - colnames(b) <- names_col - b <- b[-c(1:2), ] - b["station_ID"] <- station_nr - - # adding year to date - b$Date <- 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 - - } else { # when b have more columns then data_station - if(nrow(data_station) == 0){ - data_station = b + # run only if downloaded file is valid + if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { + + a <- readHTMLTable(temp, stringsAsFactors = FALSE) + unlink(temp) + + b <- a[[length(a)]] + if (sum(b[1,]=="Dailyweather summary", na.rm = TRUE)) { + b <- b[,1:(length(b) - 8)] } else { - # adding missing columns - data_station <- merge(b,data_station, all = TRUE)# joining data + b <- b[, 1:length(b)] } - + + 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")) + return(data_station) + } + #exeptions diferent names_col + if ((length(test[2, !is.na(test[2, ])]) == 6 & + test[2, 5] == "Int.")) { + names_col = unlist(c( + test[1, 1], + paste(test[1, 2], test[2, 1:3], sep = "_"), + test[1, 3:4], + paste(test[1, 5], test[2, 4:6], sep = "_"), + test[1, c(6:(length(test) - 4))] + )) + } else if ((length(test[2, !is.na(test[2, ])]) == 2 & + test[2, 2] == "Int.")) { + 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( + test[1, 1], + paste(test[1, 2], test[2, 1:3], sep = "_"), + test[1, 3:4], + paste(test[1, 5], test[2, 4:5], sep = "_"), + test[1, c(6:(length(test) - 3))] + )) + } else if ((length(test[2, !is.na(test[2, ])]) == 3 & + test[2, 2] == "Int.")) { + 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 <- + gsub("[^A-Za-z0-9]", + "", + as.character(lapply(names_col, as.character), stringsAsFactors = FALSE)) + + 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)) + + # 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 + + } 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 + } + + } + + # cat(paste(year,month,"\n")) + # 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") } + + + } # end of checking for empty files / problems with connection + + } # end of looping for dates - # cat(paste(year,month,"\n")) - # 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") - } - - - } # koniec petli daty - - data_station <- data_station[!duplicated(data_station), ] - - - }# koniec petli stacje - - # 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 - - # other columns to numeric: - suppressWarnings(data_station[,c("TemperatureCMax", "TemperatureCMin", "TemperatureCAvg","TdAvgC" ,"HrAvg", - "WindkmhInt","WindkmhGust" ,"PresslevHp", "Precmm" , - "TotClOct", "lowClOct" ,"VisKm","station_ID")] <- - as.data.frame(sapply(data_station[,c("TemperatureCMax", "TemperatureCMin", "TemperatureCAvg","TdAvgC" ,"HrAvg", - "WindkmhInt","WindkmhGust" ,"PresslevHp", "Precmm" , - "TotClOct", "lowClOct" ,"VisKm","station_ID")], as.numeric))) - # date to as.Date() - data_station$Date <- as.Date(data_station$Date, format = "%m/%d/%Y") - - # TODO: - # 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] - } else { - 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")) - - - # 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))), ] + }# end of looping for stations + + if(nrow(data_station) > 0){ + + 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 + + # other columns to numeric: + suppressWarnings(data_station[,c("TemperatureCMax", "TemperatureCMin", "TemperatureCAvg","TdAvgC" ,"HrAvg", + "WindkmhInt","WindkmhGust" ,"PresslevHp", "Precmm" , + "TotClOct", "lowClOct" ,"VisKm","station_ID")] <- + as.data.frame(sapply(data_station[,c("TemperatureCMax", "TemperatureCMin", "TemperatureCAvg","TdAvgC" ,"HrAvg", + "WindkmhInt","WindkmhGust" ,"PresslevHp", "Precmm" , + "TotClOct", "lowClOct" ,"VisKm","station_ID")], as.numeric))) + + # TODO: + # 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] + } else { + 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(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))), ] + + } # end of checking whether no. of rows > 0 return(data_station) diff --git a/R/ogimet_hourly.R b/R/ogimet_hourly.R index 235d95c..887fe9d 100644 --- a/R/ogimet_hourly.R +++ b/R/ogimet_hourly.R @@ -74,110 +74,108 @@ ogimet_hourly <- function(date = c("2019-06-01","2019-07-31"), coords = FALSE, s 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="") - # if (!httr::http_error(linkpl2)) { - # a = getURL(linkpl2, - # ftp.use.epsv = FALSE, - # dirlistonly = TRUE) - # } else { - # stop(call. = FALSE, - # paste0("\nDownload failed. ", - # "Check your internet connection or validate this url in your browser: ", - # linkpl2, "\n")) - # } - # + temp = tempfile() test_url(linkpl2, temp) - #a <- getURL(linkpl2) - a <- readHTMLTable(temp, stringsAsFactors = FALSE) - unlink(temp) - - #a <- readHTMLTable(a, stringsAsFactors=FALSE) - - 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) - } + # run only if downloaded file is valid + if(!is.na(file.size(temp)) & (file.size(temp) > 0)) { - 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 - - } 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 + #a <- getURL(linkpl2) + a <- readHTMLTable(temp, stringsAsFactors = FALSE) + unlink(temp) + + #a <- readHTMLTable(a, stringsAsFactors=FALSE) + + 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 + # 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 + + } 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 + } + } - - } - - #cat(paste(year, month, "\n")) - - # 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") - } - - } # koniec petli daty - - data_station <- data_station[!duplicated(data_station), ] - - - }# koniec petli stacje - - # 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 - - # changing time.. - data_station$Date <-strptime(paste(data_station$Date, data_station$hour), "%m/%d/%Y %H:%M", tz = 'UTC') - data_station$hour <- NULL - - # other columns to numeric: - suppressWarnings(data_station[, c("TC", "TdC", "ffkmh", "Gustkmh", "P0hPa", "PseahPa", "PTnd", "Nt", "Nh", - "HKm", "InsoD1", "Viskm", "Snowcm","station_ID")] <- - as.data.frame(sapply(data_station[,c("TC", "TdC", "ffkmh", "Gustkmh", "P0hPa", "PseahPa", "PTnd", "Nt","Nh", - "HKm", "InsoD1", "Viskm", "Snowcm","station_ID")], as.numeric))) - - # 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] - } 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] - } - # 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") - } - - # 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))), ] + + #cat(paste(year, month, "\n")) + + # 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") + } + + } # end of checking for empty files / problems with connection + + } # end of looping for dates + + }# end of looping for stations + + if(nrow(data_station) > 0){ + + 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 + + # changing time.. + data_station$Date <-strptime(paste(data_station$Date, data_station$hour), "%m/%d/%Y %H:%M", tz = 'UTC') + data_station$hour <- NULL + + # other columns to numeric: + suppressWarnings(data_station[, c("TC", "TdC", "ffkmh", "Gustkmh", "P0hPa", "PseahPa", "PTnd", "Nt", "Nh", + "HKm", "InsoD1", "Viskm", "Snowcm","station_ID")] <- + as.data.frame(sapply(data_station[,c("TC", "TdC", "ffkmh", "Gustkmh", "P0hPa", "PseahPa", "PTnd", "Nt","Nh", + "HKm", "InsoD1", "Viskm", "Snowcm","station_ID")], as.numeric))) + + # 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] + } 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] + } + # 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") + } + + # 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))), ] + + } # end of checking whether object is empty return(data_station) diff --git a/R/sounding_wyoming.R b/R/sounding_wyoming.R index 2d726ca..2a62b02 100644 --- a/R/sounding_wyoming.R +++ b/R/sounding_wyoming.R @@ -63,25 +63,35 @@ sounding_wyoming <- function(wmo_id, yy, mm, dd, hh){ temp <- tempfile() test_url(url, temp) - #download.file(url, temp) - - 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 - https://ogimet.com/display_stations.php?lang=en&tipo=AND&isyn=&oaci=&nombre=&estado=&Send=Send") - } - 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", - "MIXR", "DRCT", "SKNT", "THTA", "THTE", "THTV") + # run only if downloaded file is valid + df = NULL + if(!is.na(file.size(temp)) & (file.size(temp) > 800)) { - 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) + 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), + n = (sects[2] - (sects[1] + 5))) + + 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, + 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) + + } 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)) + } + + unlink(temp) return(df) diff --git a/R/stations_ogimet.R b/R/stations_ogimet.R index da8aeed..303e4ed 100644 --- a/R/stations_ogimet.R +++ b/R/stations_ogimet.R @@ -38,6 +38,11 @@ stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_m #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="") @@ -90,10 +95,16 @@ stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_m res <- data.frame(wmo_id = res1[, 4], station_names = station_names, lon = lon, lat = lat, alt = as.numeric(res1[, 3])) - if (dim(res)[1]==0) { - stop("Wrong name of country, please check station index database at - https://ogimet.com/display_stations.php?lang=en&tipo=AND&isyn=&oaci=&nombre=&estado=&Send=Send") - } + + } else { + res = 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 problems with internet connection: + + +if (!is.null(res)) { + if(add_map == TRUE){ if (!requireNamespace("maps", quietly = TRUE)){ stop("package maps required, please install it first") @@ -109,6 +120,7 @@ stations_ogimet <- function(country = "United+Kingdom", date = Sys.Date(), add_m maps::map(add = TRUE) } +} # end of checking if res is NULL return(res)