Merge pull request emf-creaf#16 from AntoineCabon/master

miquelcaceres · web-flow · commit 662cadc53131 · 2019-04-29T10:35:14.000+02:00
Download historical SMC data
diff --git a/R/download_currentday.R b/R/download_currentday.R
@@ -120,6 +120,7 @@ downloadSMCvarmetadata <- function(api){
 # save(SMCvarcode_df, file ="data/SMCvarcode_df.RData")
 # SMCstation_sp <- downloadSMChistoricalstationlist(api)
 # save(SMCstation_sp, file = "data/SMCstation_sp.RData")
+
 # download the met data
 downloadSMCcurrentday <- function(api, daily_meteoland=TRUE, variable_code=NULL, station_id=NULL, date = Sys.Date(), verbose=TRUE){
 
diff --git a/R/download_historical.R b/R/download_historical.R
@@ -220,4 +220,111 @@ downloadAEMEThistorical <- function(api, dates, station_id, export = FALSE, expo
 
 
 #### SMC
-# a implementar...
+# download the variables metadata
+# Note that they are different than that of current day 
+downloadSMChistvarmetadata <- function(api){
+  apidest <- "/variables/estadistics/diaris/metadades"
+  data <- .get_data_smc(apidest,api)
+  rownames(data) <- data$codi
+  return(data)
+}
+# SMChistvarcodes <- downloadSMChistvarmetadata(api)
+# save(SMChistvarcodes, file= "data/temp.RData")
+
+# download the met data
+downloadSMChistorical <- function(api, dates, station_id=NULL, variable_code=NULL, 
+                                  # export = FALSE, exportDir = getwd(),exportFormat = "meteoland/txt",metadatafile = "MP.txt", 
+                                  verbose=TRUE, daily_meteoland=TRUE){
+
+  load("data/temp.RData")
+  if(daily_meteoland){
+    variable_code <- c(1000, 1001, 1002, 1100, 1101, 1102, 1300, 1400, 1505,1511)
+  }else if(is.null(variable_code)) stop("variable_code must be specified")
+  
+  if(verbose)cat("Downloading daily data from all available stations\n")
+  dates_round <- regmatches(dates,regexpr("[[:digit:]]{4}-[[:digit:]]{2}", dates))
+  dates_round <- unique(dates_round)
+  dates_split <- lapply(dates_round, function(x)strsplit(x, split = "-")[[1]])
+  
+  # download variable per variable
+  for(i in 1:length(variable_code)){
+    
+    data_i <- data.frame()
+    for(j in 1:length(dates_split)){
+      apidest <- paste0("/variables/estadistics/diaris/", variable_code[i], "?any=", dates_split[[j]][1], 
+                       "&mes=", dates_split[[j]][2])
+
+      data_list <- .get_data_smc(apidest, api)
+      # data_list$variables <- sapply(data_list$variables, FUN = function(x)x$lectures)
+      
+      data_j <- data.frame()
+      for(k in 1:length(data_list$codiEstacio)){
+        data_k <- data_list$valors[[k]][,c("data", "valor")]
+        data_k$ID <- data_list$codiEstacio[[k]]
+        # data_k$variable_code <- data_list$codiVariable[[k]]
+        data_j <- rbind(data_j,data_k)
+      }
+      data_i <- rbind(data_i,data_j)
+    }
+    
+  colnames(data_i)[1:2] <- c("date", as.character(variable_code[i]))
+  if(i == 1) {data <- data_i}else{data <- merge(data, data_i, all=T)}
+  }
+  
+  # data$date <- sub("T", " ", data$date)
+  data$date <- sub("Z", "", data$date)
+  data$date <- as.Date(data$date)
+  data <- data[data$date %in% as.Date(dates),]
+  
+  if(daily_meteoland){
+    if(verbose)cat("\nDownloading station info\n")
+    SMCstation_sp = downloadSMCstationlist(api)
+    
+    if(verbose)cat("\nFormating data\n")
+    data_df <- data.frame(ID = data$ID, name = SMCstation_sp@data[data$ID,"name"], 
+                          long = SMCstation_sp@coords[data$ID,"long"],
+                          lat = SMCstation_sp@coords[data$ID,"lat"], 
+                          elevation = SMCstation_sp@data[data$ID,"elevation"],
+                          date = data[ ,"date"],
+                          MeanTemperature = data[ ,"1000"], 
+                          MinTemperature = data[ ,"1002"], 
+                          MaxTemperature = data[ ,"1001"],
+                          Precipitation = data[ ,"1300"], 
+                          WindSpeed = data[ ,"1505"], 
+                          WindDirection = data[ ,"1511"],
+                          MeanRelativeHumidity = data[ ,"1100"], 
+                          MinRelativeHumidity = data[ ,"1102"], 
+                          MaxRelativeHumidity = data[ ,"1101"],
+                          Radiation = data[ ,"1400"])
+    
+    data_df <- as.data.frame(lapply(data_df,function(x){
+      x. <- x
+      if(is.numeric(x.))x.[is.nan(x.)|is.infinite(x.)] <- NA
+      return(x.)
+    }))
+    
+    data_sp <- SpatialPointsDataFrame(coords = data_df[,c("long", "lat")],
+                                      data = data_df[,which(!colnames(data_df) %in% c("long", "lat", "name", "ID"))],
+                                      proj4string = CRS("+proj=longlat"))
+    
+    # vars <- colnames(data_df)
+    # vars <- vars[!vars %in% c("ID","name","long","lat","elevation")]
+    # ID <- unique(data_df$ID)
+    # data_list <- list()
+    # for(i in 1:length(ID)){
+    #   data_list[[i]] <- data_df[data$ID == ID[i],vars]
+    #   rownames(data_list[[i]]) <- data_list[[i]]$date
+    # }
+    # names(data_list) <- ID
+    # 
+    # data_sp <- SpatialPointsMeteorology(SMCstation_sp[ID,],
+    #                                     data = data_list, dates = data_list[[1]]$date)
+    
+    return(data_sp)
+  }else{
+    if(verbose)cat("\nNon-formated results are returned\n")
+    colsel <- !colnames(data) %in% c("date", "ID")
+    colnames(data)[colsel] <- SMChistvarcodes[colnames(data)[colsel], "nom"]
+    return(data)
+  }
+}
diff --git a/data/temp.RData b/data/temp.RData
