Skip to content

citizenair
citizenair
Commit dcb938bf by Jan Wijffels
Options

Combine citizen + official timeseries

parent d22dbb4f
Showing with 109 additions and 49 deletions
citizenair/R/appdata.R
......@@ -26,6 +26,7 @@ citizenair_userdata_empty <- function(){
#' @field stations object of class \code{citizenair_stations} as returned by \code{\link{read_stations}}
#' @field data object of class \code{citizenair_userdata} as returned by \code{\link{read_citizenair}}
#' @field closest_station a character string with the id of the closest station.
#' @field timeseries timeseries
#' @format The CitizenAir object is an R6Class
#' @section Methods:
#' \describe{
......@@ -75,6 +76,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
endpoint = NULL,
stations = NULL,
data = NULL,
timeseries = NULL,
closest_station = NA_character_,
initialize = function(endpoint, stations_area) {
self$endpoint <- endpoint
......@@ -87,6 +89,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
self$stations$stations <- self$stations$stations[self$stations$stations$id %in% stations_in_region$id, ]
}
self$data <- citizenair_userdata_empty()
self$timeseries <- private$default_timeseries
self$closest_station <- NA_character_
},
setCitizenData = function(file, name=basename(file)){
......@@ -97,7 +100,19 @@ CitizenAir <- R6::R6Class("CitizenAir",
setComparisonStation = function(id = NA_character_){
self$closest_station <- as.character(id)
},
fetch_timeseries = function(id = self$getComparisonStation(), time_span=NULL) {
setCombinedTimeseries = function(data){
if(missing(data)){
self$timeseries <- private$default_timeseries
}else if(is.null(data)){
self$timeseries <- private$default_timeseries
}else{
self$timeseries <- data
}
},
fetch_timeseries = function(id = self$getComparisonStation(), time_span=NULL) {
if(length(id) == 0){
return(private$default_timeseries)
}
stopifnot(length(id) == 1)
stopifnot(!is.na(id))
## Find and create a stations object
......@@ -128,8 +143,10 @@ CitizenAir <- R6::R6Class("CitizenAir",
df$date <- as.Date(df$time)
df$phenomena_id <- sensorweb4R::id(sensorweb4R::phenomenon(x))
df$phenomena <- self$getPhenomenaLabel(df$phenomena_id)
df$phenomena_label <- sensorweb4R::label(x)
result[[i]] <- df[, c("phenomena_id", "phenomena", "phenomena_label", "time", "value")]
df$timeseries_id <- sensorweb4R::id(x)
df$timeseries_label <- sensorweb4R::label(x)
df$type <- rep("official", nrow(df))
result[[i]] <- df[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
}
result <- rbindlist(result)
result
......@@ -165,6 +182,9 @@ CitizenAir <- R6::R6Class("CitizenAir",
}
station
},
getCombinedTimeseries = function(){
self$timeseries
},
getCitizenData = function(type = c("meta", "timeseries", "phenomena", "fileinfo")){
type <- match.arg(type)
if(type == "meta"){
......@@ -178,11 +198,16 @@ CitizenAir <- R6::R6Class("CitizenAir",
}else if(type == "timeseries"){
if(is.na(self$data$filename)){
x <- data.frame(sheet_id = integer(), time = as.POSIXct(character()), date = as.Date(character()),
phenomena = character(), value = numeric(), stringsAsFactors = FALSE)
x <- private$default_timeseries
}else{
x <- as.data.frame(self$data, type = "measurements")
}
x$type <- rep("citizen", nrow(x))
x$phenomena_id <- rep(NA_character_, nrow(x))
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)
x <- x[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
}else if(type == "phenomena"){
if(is.na(self$data$filename)){
x <- character()
......@@ -204,6 +229,11 @@ CitizenAir <- R6::R6Class("CitizenAir",
nearest_station = function(stations, x){
d <- sp::spDistsN1(stations, x, longlat = TRUE)
stations[which.min(d), ]
}
},
default_timeseries = data.frame(type = character(),
timeseries_id = character(), timeseries_label = character(),
phenomena_id = character(), phenomena = character(),
time = as.POSIXct(character()), date = as.Date(character(), tz = "UTC"),
value = numeric(), stringsAsFactors = FALSE)
)
)
citizenair/data/ca.RData
No preview for this file type
citizenair/inst/apps/citizenair/citizenair.Rmd
......@@ -34,6 +34,8 @@ data("ca", package = "citizenair")
#save(ca, file = "citizenair/data/ca.RData")
APPDATA <- ca
#APPDATA$setCitizenData(file = system.file(package = "citizenair", "data-raw", "citizenair-example.xls"))
#APPDATA$setComparisonStation(id = "1155")
APPDATA <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"),
stations_area = subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL %in% "Vlaams Gewest"))
```
......@@ -66,7 +68,11 @@ citizenair_userdata <- reactive({
result$nearest_station <- result$appdata$getClosestStation()
APPDATA$setComparisonStation(result$nearest_station)
output$uiOutput_rawmeta <- renderTable(APPDATA$getCitizenData("meta"))
output$uiOutput_rawdata <- renderDT(datatable(APPDATA$getCitizenData("timeseries"), rownames = FALSE,
x <- APPDATA$getCitizenData("timeseries")
APPDATA$setCombinedTimeseries(x)
x$sheet <- x$timeseries_label
x <- x[, c("sheet", "phenomena", "time", "value")]
output$uiOutput_rawdata <- renderDT(datatable(x, rownames = FALSE,
caption = 'Overzicht van alle meetgegevens per sheet/tijdstip/type meting',
filter = 'top', options = list(pageLength = 5, autoWidth = TRUE, searching = FALSE)))
showModal(popups$cleaned_data)
......
citizenair/inst/apps/citizenair/page01-introduction.Rmd
......@@ -144,6 +144,7 @@ renderTable({
userdata <- citizenair_userdata()
x <- as.data.table(userdata$appdata$getCitizenData("timeseries"))
if(nrow(x) > 0){
x$sheet_id <- as.integer(x$timeseries_id)
x <- x[, meetfrequentie := as.numeric(difftime(time, shift(time, type = "lag", n = 1L), units = "mins")), by = list(sheet_id)]
x <- x[, list(n = .N), by = list(sheet_id, meetfrequentie)]
x <- x[, pct := round(100 * n / sum(n), 1), by = list(sheet_id)]
......
citizenair/inst/apps/citizenair/page02-exploratory.Rmd
## Sidebar {.sidebar}
```{r}
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")
ts <- setDF(ts)
g <- xts(ts[, -1], order.by=ts[,1])
g <- dygraph(g)
g <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
g
}else{
g <- NULL
}
g
}
# isolate({
# input$uiInput_aggregationlevel
# input$uiInput_sheet
# input$uiInput_period
# input$uiOutput_select_station_marker_click
# })
```
#### Vergelijk met ...
```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient")
```
#### Vergelijkingsbasis
```{r}
inputPanel(
radioButtons(inputId = "uiInput_periode", label = "Vergelijk op basis van",
choices = c("Per minuut" = "minute", "Per uur" = "hour", "Per dag" = "day", "Per maand" = "month", "Ruwe data" = "rawdata"),
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")
)
```
#### Vergelijk met ...
```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient")
## MAIN REACTIVE WHICH COMBINES CITIZEN DATA + OFFICIAL DATA
observeEvent(input$uiInput_refresh, {
result <- list()
result$userdata <- citizenair_userdata()
citizen <- result$userdata$appdata$getCitizenData("timeseries")
result$station <- result$userdata$appdata$getComparisonStation()
if(length(result$station) > 0){
showNotification("Haalt data af vanaf de IRCEL webservice")
}
official <- try(result$userdata$appdata$fetch_timeseries(result$station))
if(inherits(official, "try-error")){
showNotification(sprintf("Er loopt iets fout met het ophalen van de data vanaf de IRCEL webservice: %s", error_message(official)),
type = "error", duration = 15)
official <- result$userdata$appdata$fetch_timeseries(NULL)
}else{
if(nrow(official) > 0){
showNotification("Data werd afgehaald vanaf de IRCEL webservice en werd gecombineerd met uw meetgegevens", type = "message")
}
}
result$data <- list()
result$data$citizen <- citizen
result$data$official <- official
result$data <- rbindlist(result$data, use.names = TRUE)
APPDATA$setCombinedTimeseries(result$data)
output$uiOutput_timeseries <- renderDygraph(plot_timeseries(result$data))
})
```
......@@ -23,8 +76,6 @@ actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander offic
### Verken je metingen
```{r}
fillCol(
tags$div("Hieronder tonen we een overzicht van jouw metingen en de dichtstbijzijnde VMM-meetplaats in
......@@ -32,44 +83,13 @@ fillCol(
uur, per dag enz. Als je een goed zicht hebt op je data, ga dan naar de volgende stap."),
dygraphOutput("uiOutput_timeseries"),
flex = c(NA, 1)
)
)
output$uiOutput_timeseries <- renderDygraph({
## Default call when user only uploaded his own data
userdata <- citizenair_userdata()
x <- userdata$appdata$getCitizenData("timeseries")
if(nrow(x) > 0){
x <- setDT(x)
x$phenomena_label <- paste("Sheet ", x$sheet_id, ": ", x$phenomena, sep = "")
ts <- dcast.data.table(data = x, formula = time ~ phenomena_label, fun.aggregate = mean, value.var = "value")
ts <- setDF(ts)
g <- xts(ts[, -1], order.by=ts[,1])
g <- dygraph(g, main = "Tijdreeks van uw metingen")
g <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
ui <- g
}else{
ui <- NULL
}
ui
x <- userdata$appdata$getCombinedTimeseries()
plot_timeseries(x)
})
observeEvent(input$uiInput_refresh, {
output$uiOutput_timeseries <- renderDygraph({
## should depend on selected station
id <- APPDATA$getComparisonStation()
showNotification(sprintf("Getting data of station %s at the IRCEL web service", id))
if(!is.na(id)){
x <- APPDATA$fetch_timeseries(id)
x <- setDT(x)
ts <- dcast.data.table(data = x, formula = time ~ phenomena, fun.aggregate = mean, value.var = "value")
ts <- setDF(ts)
g <- xts(ts[, -1], order.by=ts[,1])
g <- dygraph(g, main = sprintf("Tijdreeks van officieel meetstation %s", id))
g <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
g
}
})
})
```
......@@ -174,6 +194,7 @@ output$summaryValid <- renderTable({reactive[["summaryValid"]]})
```{r}
renderValueBox({
## Triggers each time a user clicks on the leaflet app or when a user uploads new data
input$uiOutput_select_station_marker_click
userdata <- citizenair_userdata()
userdata$nearest_station <- userdata$appdata$getComparisonStation()
......
citizenair/man/CitizenAir.Rd
......@@ -21,6 +21,8 @@ CitizenAir app data
\item{\code{data}}{object of class \code{citizenair_userdata} as returned by \code{\link{read_citizenair}}}
\item{\code{closest_station}}{a character string with the id of the closest station.}
\item{\code{timeseries}}{timeseries}
}}
\section{Methods}{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment