Merge pull request #64 from bczernecki/dev

Dev

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: climate
 Title: Interface to Download Meteorological (and Hydrological) Datasets
-Version: 1.0.1
+Version: 1.0.3
 Authors@R: c(person(given = "Bartosz",
            family = "Czernecki",
            role = c("aut", "cre"),

NEWS.md

@@ -1,3 +1,8 @@
+# climate 1.0.3
+
+* Adding possibility to download BUFR vertical sounding dataset from `http://weather.uwyo.edu/upperair/sounding.html`; extra information with supporting example added to the `sounding_wyoming`'s documentation
+* `hydro_imgw` supports now exception for current year which has no flow data until it is verified by the IMGW-PIB
+
 # climate 1.0.1
 
 * Adding `data.table` package to read CP1250 on machines that do not support this encoding (translit used instead)

R/hydro_imgw_daily.R

@@ -60,7 +60,7 @@ hydro_imgw_daily = function(year, coords = FALSE, station = NULL, col_names= "sh
 
     iterator = c("01", "02", "03", "04", "05", "06",
                 "07", "08", "09", "10", "11", "12")
-    data=NULL
+    data = NULL
     for (j in seq_along(iterator)) {
       address = paste0(base_url, interval_pl, "/", catalog, "/codz_", catalog,"_", iterator[j], ".zip")
       temp = tempfile()
@@ -76,8 +76,26 @@ hydro_imgw_daily = function(year, coords = FALSE, station = NULL, col_names= "sh
         data1 = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, fileEncoding = "CP1250")
       }
 
+      # extra exception for a current year according to information provided by IMGW-PIB:
+      # i.e.:
+      # "Do czasu zakończenia kontroli przepływów z roku hydrologicznego 2020 (do około poczatku sierpnia 2021), rekordy z  danymi z roku 2020 mają format:
+      #Kod stacji
+      #Nazwa stacji
+      #Nazwa rzeki/jeziora
+      #Rok hydrologiczny
+      #Wskaźnik miesiąca w roku hydrologicznym
+      #Dzień
+      #Stan wody [cm]
+      #Temperatura wody [st. C]
+      #Miesiąc kalendarzowy
+
+      if (ncol(data1) == 9) {
+        data1$flow = NA
+        data1 = data1[, c(1:7, 10, 8:9)]
+      }
+
       colnames(data1) = meta[[1]][,1]
-      data=rbind(data,data1)
+      data = rbind(data, data1)
     }
     address = paste0(base_url, interval_pl, "/", catalog, "/zjaw_", catalog, ".zip")
 

R/nearest_stations_imgw.R

@@ -74,11 +74,12 @@ nearest_stations_imgw = function(type = "meteo",
   orderd_distance = result[order(result$distance), ]
   result = orderd_distance[1:no_of_stations, ]
 
+  message('Currently "climate" package use approximate distance calculation\nIn order to get accurate results please use GIS-based solutions')
+
   # 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),]
 
-
   if(add_map == TRUE){
     if (!requireNamespace("maps", quietly = TRUE)){
       stop("package maps required, please install it first")

R/sounding_wyoming.R

@@ -1,12 +1,14 @@
 #' Sounding data
 #'
-#' Downloading the mea (i.e., measurements of the vertical profile of atmosphere) sounding data
+#' Downloading the measurements of the vertical profile of atmosphere (also known as sounding data). Data can be retrieved using TEMP and BUFR sounding formatting.
 #'
 #' @param wmo_id international WMO station code (World Meteorological Organization ID); For Polish stations: Łeba - 12120, Legionowo - 12374, Wrocław- 12425
 #' @param yy year - single number
 #' @param mm month - single number denoting month
 #' @param dd day - single number denoting day
 #' @param hh hour - single number denoting initial hour of sounding; for most stations this measurement is done twice a day (i.e. at 12 and 00 UTC), sporadically 4 times a day
+#' @param min minute - single number denoting initial minute of sounding; applies only to BUFR soundings. 
+#' @param bufr - BUFR or TEMP sounding to be decoded. By default TEMP is used. For BUFR soundings use `bufr = TRUE`
 #' @importFrom utils read.fwf
 #' @return Returns two lists with values described at: weather.uwyo.edu ; The first list contains:
 #' \enumerate{
@@ -22,17 +24,29 @@
 #'  \item THTE = (K)
 #'  \item THTV = (K)
 #'  }
-#'  The second list contains metadata and calculated thermodynamic / atmospheric instability indices
+#'  The second list contains metadata and calculated thermodynamic / atmospheric instability indices (for TEMP soundings only)
 #'
 #' @return A list of 2 data.frames where first data frame represents parameters of upper parts o with columns describing the meteorogical parameters (e.g. temperature, air pressure) where each row represent a measurement,
-#' depending on the height. Secound data.frame present a description of the conditions under which the sounding was carried out. 
+#' depending on the height. Second data.frame presents a description of the conditions under which the sounding was carried out. 
 #'
 #' @source http://weather.uwyo.edu/upperair/sounding.html
 #' @export
 #'
 #' @examples 
 #' \donttest{
-#' # generate the date to download randomly:
+#' ##############################################################################
+#' # download data for Station 45004 starting 1120Z 11 Jul 2021; Kowloon, HONG KONG, CHINA
+#' # using TEMP and BUFR sounding formats
+#' ##############################################################################
+#' TEMP = sounding_wyoming(wmo_id = 45004, yy = 2021, mm = 07, dd = 17, hh = 12, min = 00)
+#' head(TEMP[[1]])
+#' BUFR = sounding_wyoming(wmo_id = 45004, yy = 2021, mm = 07, dd = 17, hh = 12, min = 00, bufr = TRUE)
+#' head(BUFR[[1]])
+#' 
+#' 
+#' ##############################################################################
+#' ### example with a random date to download sounding from LEBA, PL station: ###
+#' ##############################################################################
 #' 
 #'   profile = sounding_wyoming(wmo_id = 12120, 
 #'                              yy = sample(2000:2019,1),
@@ -44,7 +58,9 @@
 #' }
 #'
 
-sounding_wyoming = function(wmo_id, yy, mm, dd, hh){
+sounding_wyoming = function(wmo_id, 
+                            yy, mm, dd, hh, min = 00, 
+                            bufr = FALSE) {
 
   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")
@@ -57,10 +73,16 @@ sounding_wyoming = function(wmo_id, yy, mm, dd, hh){
   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")
+  min = formatC(min, width = 2, format = "d", flag = "0")
 
-  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)
-
+  if(bufr) {
+    url = paste0("http://weather.uwyo.edu/cgi-bin/bufrraob.py?datetime=", 
+                 yy, "-", mm, "-", dd, "+", hh, ":", min, ":00&id=", wmo_id, "&type=TEXT:LIST")
+  } else {
+    url = paste0("http://weather.uwyo.edu/cgi-bin/sounding?TYPE=TEXT%3ALIST&YEAR=",
+                 yy, "&MONTH=", mm, "&FROM=", dd, hh, "&TO=", dd, hh, "&STNM=", wmo_id)
+  }
+
   temp = tempfile()
   test_url(url, temp)
 
@@ -75,23 +97,35 @@ sounding_wyoming = function(wmo_id, yy, mm, dd, hh){
       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")
+
+    if(bufr == FALSE) {
+      # the section below is not valid for BUFR decoded data:
+      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")
+    } else {
+      # for bufr data try to read only the most essential metadata
+      ind = grep(pattern = "Observations", txt$V1)
+      df2 = data.frame(bufr_metadata = gsub("<.*?>", "", txt$V1[ind:(ind+1)]), 
+                       stringsAsFactors = FALSE)
+      # and convert m/s to knots to stay in alignment with the default format used:
+      df$SKNT = round(df$SKNT * 1.9438, 1)
+    }
 
-    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
+
+  } 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)