Aggregate implementation + selection of sheets + phenomena

citizenair/NAMESPACE

@@ -16,6 +16,7 @@ importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
 importFrom(data.table,melt.data.table)
 importFrom(data.table,rbindlist)
+importFrom(data.table,setDT)
 importFrom(data.table,setnames)
 importFrom(fasttime,fastPOSIXct)
 importFrom(httr,GET)

citizenair/R/appdata.R

@@ -66,6 +66,7 @@ citizenair_userdata_empty <- function(){
 #' x <- ca$getCitizenData("timeseries")
 #' x <- ca$getCitizenData("phenomena")
 #' x <- ca$getCitizenData("fileinfo")
+#' x <- ca$getPhenomena("citizen")
 #' ca$getClosestStation()
 #' id <- ca$getClosestStation()
 #' ca$setComparisonStation(id)
@@ -93,7 +94,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
                           self$closest_station <- NA_character_
                         },
                         setCitizenData = function(file, name=basename(file)){
-                          x <- read_citizenair(file)
+                          x <- read_citizenair(file, name = name)
                           self$setComparisonStation()
                           self$data <- x
                         },
@@ -108,6 +109,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
                           }else{
                             self$timeseries <- data  
                           }
+                          self$timeseries <- setkeyv(self$timeseries, cols = c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena"))
                         },
                         fetch_timeseries = function(id = self$getComparisonStation(), time_span=NULL) {
                           if(length(id) == 0){
@@ -149,8 +151,25 @@ CitizenAir <- R6::R6Class("CitizenAir",
                             result[[i]] <- df[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
                           }
                           result <- rbindlist(result)
+                          result <- setDT(result)
                           result
                         },
+                        recode_phenomena = function(x){
+                          x <- as.character(x)
+                          from <- unique(x)
+                          from_cleaned <- trimws(tolower(from))
+                          ## ONLY PM-10/PM-2.5/PM1 and Temperature are covered in this setup
+                          idx <- which(from_cleaned %in% c("pm10", "pm2.5", "pm1", "t"))
+                          to <- from
+                          if(length(idx) > 0){
+                            to[idx] <- txt_recode(from_cleaned[idx], 
+                                                  from = c("pm10", "pm2.5", "pm1", "t"),
+                                                  to = c("5", "6001", "6002", "62101"))  
+                          }
+                          txt_recode(x, 
+                                     from = from,
+                                     to = to)
+                        },
                         getStations = function(){
                           x <- as.data.frame(self$stations$stations)
                           x <- sp::SpatialPointsDataFrame(coords = x[, c("lon", "lat")], 
@@ -160,11 +179,17 @@ CitizenAir <- R6::R6Class("CitizenAir",
                         getStationsArea = function(){
                           private$stations_area
                         },
-                        getPhenomena = function(){
-                          self$stations$phenomena$id
+                        getPhenomena = function(type = c("official", "citizen")){
+                          type <- match.arg(type)
+                          if(type == "official"){
+                            self$stations$phenomena$id  
+                          }else if(type == "citizen"){
+                            ts <- self$getCitizenData("timeseries")
+                            sort(unique(ts$phenomena_id))
+                          }
                         },
                         getPhenomenaLabel = function(id){
-                          stopifnot(all(id %in% self$stations$phenomena$id))
+                          #stopifnot(all(id %in% self$stations$phenomena$id))
                           txt_recode(id, from = self$stations$phenomena$id, to = self$stations$phenomena$label)
                         },
                         getComparisonStation = function(){
@@ -182,8 +207,33 @@ CitizenAir <- R6::R6Class("CitizenAir",
                           }
                           station
                         },
-                        getCombinedTimeseries = function(){
-                          self$timeseries
+                        getCombinedTimeseries = function(data = self$timeseries, type = c("rawdata", "minute", "hour", "day", "week", "month"), limit = FALSE){
+                          type <- match.arg(type)
+                          x <- data
+                          x <- setDT(x)
+                          if(type == "minute"){
+                            x <- x[, list(value = mean(value, na.rm=TRUE)), 
+                                   by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = fasttime::fastPOSIXct(format(time, "%Y-%m-%d %H:%M"), tz = "UTC"))] 
+                          }else if(type == "hour"){
+                            x <- x[, list(value = mean(value, na.rm=TRUE)), 
+                                   by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = fasttime::fastPOSIXct(format(time, "%Y-%m-%d %H"), tz = "UTC"))] 
+                          }else if(type == "day"){
+                            x <- x[, list(value = mean(value, na.rm=TRUE)), 
+                                   by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = date)] 
+                          }else if(type == "week"){
+                            x <- x[, list(value = mean(value, na.rm=TRUE)), 
+                                   by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = mondayofweek(date))] 
+                          }else if(type == "month"){
+                            x <- x[, list(value = mean(value, na.rm=TRUE)), 
+                                   by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = startofmonth(date))] 
+                          }
+                          if(limit){
+                            citizen_timepoints <- x$time[x$type %in% "citizen"]
+                            if(length(citizen_timepoints) > 0){
+                              x <- x[as.Date(x$time) >= (as.Date(min(citizen_timepoints))) & as.Date(x$time) <= (as.Date(max(citizen_timepoints))), ]
+                            }
+                          }
+                          x
                         },
                         getCitizenData = function(type = c("meta", "timeseries", "phenomena", "fileinfo")){
                           type <- match.arg(type)
@@ -204,10 +254,16 @@ CitizenAir <- R6::R6Class("CitizenAir",
                             }
                             x$type <- rep("citizen", nrow(x))
                             x$phenomena_id <- rep(NA_character_, nrow(x))
+                            x$phenomena_id <- self$recode_phenomena(x$phenomena)
                             x$timeseries_id <- as.character(x$sheet_id)
                             sheetinfo <- self$getCitizenData("meta")
-                            x$timeseries_label <- txt_recode(x$sheet_id, from = sheetinfo$sheet_id, to = sheetinfo$sheet)
+                            if(nrow(x) > 0){
+                              x$timeseries_label <- txt_recode(x$sheet_id, from = sheetinfo$sheet_id, to = sheetinfo$sheet)  
+                            }else{
+                              x$timeseries_label <- character()
+                            }
                             x <- x[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
+                            x <- setDT(x)
                           }else if(type == "phenomena"){
                             if(is.na(self$data$filename)){
                               x <- character()
@@ -230,7 +286,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
                           d <- sp::spDistsN1(stations, x, longlat = TRUE)
                           stations[which.min(d), ]
                         },
-                        default_timeseries = data.frame(type = character(), 
+                        default_timeseries = data.table(type = character(), 
                                                         timeseries_id = character(), timeseries_label = character(), 
                                                         phenomena_id = character(), phenomena = character(), 
                                                         time = as.POSIXct(character()), date = as.Date(character(), tz = "UTC"), 

citizenair/R/pkg.R

@@ -2,7 +2,7 @@
 #' @importFrom cellranger cell_rows cell_cols cell_limits
 #' @importFrom utils head tail capture.output
 #' @importFrom tools file_path_sans_ext
-#' @importFrom data.table rbindlist melt.data.table setnames as.data.table data.table
+#' @importFrom data.table rbindlist melt.data.table setnames as.data.table data.table setDT 
 #' @importFrom fasttime fastPOSIXct
 #' @importFrom rmarkdown run
 #' @importFrom sensorweb4R resourceURL id label as.Endpoint fetch timeseries phenomenon as.Timeseries getData time lastValue firstValue Station

citizenair/R/read-stations.R

@@ -52,6 +52,7 @@ read_stations <- function(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/s
   stat$timeseries <- lapply(sta, FUN=function(x) x$timeseries)
   result <- list()
   result$phenomena <- phe
+  result$phenomena$label <- iconv(result$phenomena$label, from = "UTF-8", to = "LATIN1")
   result$stations <- stat
   class(result) <- "citizenair_stations"
   result

citizenair/R/utils.R

@@ -36,4 +36,21 @@ txt_recode <- function (x, from = c(), to = c()) {
     to <- append(x = to, values = nongiven)
   }
   to[match(x, from)]
-}
+}
\ No newline at end of file
+
+
+
+sundayofweek <- function(x){
+  xweekday <- as.integer(format(x, "%w"))
+  idx <- which(xweekday != 0)
+  x[idx] <- x[idx] + (7 - xweekday[idx])
+  x
+}
+
+mondayofweek <- function(x){
+  sundayofweek(x) - 6
+}
+
+startofmonth <- function(x){	
+  x - as.integer(format(x, "%d")) + 1 
+}

citizenair/inst/apps/citizenair/page02-exploratory.Rmd

 ## Sidebar {.sidebar}
 
 ```{r}
-plot_timeseries <- function(x){
+plot_timeseries <- function(x, ...){
   if(nrow(x) > 0){
     x <- setDT(x)
-    ts <- dcast.data.table(data = x, formula = time ~ phenomena, fun.aggregate = mean, value.var = "value")
+    x$ts_id <- paste(x$type, x$phenomena, sep = "-")
+    period_citizen <- x$time[x$type %in% "citizen"]
+    if(length(period_citizen) > 0){
+      #x <- subset(x, date >= (as.Date(min(period_citizen)) - 1) & date <= (as.Date(max(period_citizen)) + 1))  
+    }
+    ts <- dcast.data.table(data = x, formula = time ~ ts_id, fun.aggregate = mean, na.rm=TRUE, value.var = "value")
     ts <- setDF(ts)
     g <- xts(ts[, -1], order.by=ts[,1])
-    g <- dygraph(g)
+    g <- dygraph(g, ...)
     g <- dyRangeSelector(g, height = 20)
     g <- dyLegend(g, show = "always")
     g  
@@ -16,35 +21,63 @@ plot_timeseries <- function(x){
   }
   g
 }
-# isolate({
-#     input$uiInput_aggregationlevel
-#     input$uiInput_sheet
-#     input$uiInput_period 
-#     input$uiOutput_select_station_marker_click
-#   })
 ```
 
-#### Vergelijk met ...
+#### Officieel meetstation
 
 ```{r}
-actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient")
+actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van officieel station", style = "gradient")
 ```
 
 #### Vergelijkingsbasis
 
 ```{r}
 inputPanel(
-radioButtons(inputId = "uiInput_aggregationlevel", label = "Vergelijk", 
-             choices = c("Per minuut" = "minute", "Per uur" = "hour", "Per dag" = "day", "Per maand" = "month", "Op basis van ruwe data" = "rawdata"), 
-             selected = "rawdata"),
-dateRangeInput(inputId = "uiInput_period", label = "Verander de periode", start = Sys.Date()-365, end = Sys.Date()),
-actionButton(inputId = "uiInput_refresh", label = "Herbereken")
+  renderUI({
+    userdata <- citizenair_userdata()
+    polluent_id <- userdata$appdata$getPhenomena("citizen")
+    polluent_label <- userdata$appdata$getPhenomenaLabel(polluent_id)
+    if(length(polluent_id) > 0){
+      choices <- structure(as.list(polluent_id), .Names = polluent_label)
+      ui <- selectInput(inputId = "uiInput_phenomena", label = "Selecteer meetwaardes",
+                        choices = choices, selected = choices, multiple = TRUE)
+    }else{
+      ui <- NULL
+    }
+    ui
+  }),
+  radioButtons(inputId = "uiInput_aggregationlevel", label = "Vergelijk", 
+               choices = c("Per minuut" = "minute", 
+                           "Per uur" = "hour", 
+                           "Per dag" = "day", 
+                           "Per maand" = "month", 
+                           "Op basis van ruwe data" = "rawdata"), 
+               selected = "rawdata"),
+  #dateRangeInput(inputId = "uiInput_period", label = "Verander de periode", start = Sys.Date()-365, end = Sys.Date()),
+  actionButton(inputId = "uiInput_refresh", label = "Herbereken grafiek")
 )
 ```
 
 ```{r}
-## MAIN REACTIVE WHICH COMBINES CITIZEN DATA + OFFICIAL DATA
 observeEvent(input$uiInput_refresh, {
+  showNotification("Herberekening wordt uitgevoerd")
+  input$uiInput_phenomena
+  input$uiInput_aggregationlevel
+  input$uiInput_sheet
+  input$uiInput_period 
+  #input$uiOutput_select_station_marker_click
+  x <- APPDATA$getCombinedTimeseries(type = "rawdata")
+  x <- subset(x, type %in% "official" | (type %in% "citizen" & timeseries_id %in% input$uiInput_sheet))
+  x <- subset(x, phenomena_id %in% input$uiInput_phenomena)
+  x <- APPDATA$getCombinedTimeseries(x, type = input$uiInput_aggregationlevel, limit = TRUE)
+  output$uiOutput_timeseries <- renderDygraph(
+    plot_timeseries(x))
+})
+```
+
+```{r}
+## MAIN REACTIVE WHICH COMBINES CITIZEN DATA + OFFICIAL DATA
+observeEvent(input$uiInput_selectstation, {
   result <- list()
   result$userdata <- citizenair_userdata()
   citizen <- result$userdata$appdata$getCitizenData("timeseries")
@@ -67,10 +100,17 @@ observeEvent(input$uiInput_refresh, {
   result$data$official <- official
   result$data <- rbindlist(result$data, use.names = TRUE)
   APPDATA$setCombinedTimeseries(result$data)
-  output$uiOutput_timeseries <- renderDygraph(plot_timeseries(result$data))
+  x <- APPDATA$getCombinedTimeseries(type = "rawdata", limit = TRUE)
+  x <- subset(x, phenomena_id %in% input$uiInput_phenomena)
+  output$uiOutput_timeseries <- renderDygraph(plot_timeseries(x, 
+                                                              main = "De tijdreeks van al uw meetgegevens samen met de gegevens van de Vlaamse Milieu Maatschappij"))
 })
 ```
 
+```{r}
+#observeEvent(input$uiInput_refresh, {
+#output$uiOutput_timeseries <- renderDygraph(plot_timeseries(result$data))
+```
 
 ## Verken je metingen {.tabset}
 
@@ -88,12 +128,12 @@ output$uiOutput_timeseries <- renderDygraph({
   ## Default call when user only uploaded his own data
   userdata <- citizenair_userdata()
   x <- userdata$appdata$getCombinedTimeseries()
-  plot_timeseries(x)
+  plot_timeseries(x, main = "De tijdreeks van al uw meetgegevens")
 })
 ```
 
 
-### Selecteer een officieel meetstation om te vergelijken
+### Selecteer een ander officieel meetstation om te vergelijken
 
 
 ```{r}
@@ -213,7 +253,6 @@ renderValueBox({
 })
 ```
 
-
 ### 
 
 ```{r}
@@ -221,7 +260,7 @@ renderValueBox({
   userdata <- citizenair_userdata()
   filename <- userdata$appdata$getCitizenData("fileinfo")$name
   if(length(filename) > 0){
-    ui <- valueBox("Uw excel file", caption = citizenair_userdata()$name)    
+    ui <- valueBox("Uw excel file", caption = filename)    
   }else{
     ui <- NULL 
   }

citizenair/man/CitizenAir.Rd

@@ -65,6 +65,7 @@ x <- ca$getCitizenData("meta")
 x <- ca$getCitizenData("timeseries")
 x <- ca$getCitizenData("phenomena")
 x <- ca$getCitizenData("fileinfo")
+x <- ca$getPhenomena("citizen")
 ca$getClosestStation()
 id <- ca$getClosestStation()
 ca$setComparisonStation(id)