Skip to content

citizenair
citizenair
Commit 056468c2 by Jan Wijffels
Options

Comparison station as popup

parent a4a43a41
Showing with 174 additions and 97 deletions
citizenair/R/appdata.R
......@@ -176,6 +176,10 @@ CitizenAir <- R6::R6Class("CitizenAir",
data = x, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
x
},
getStationLabel = function(id){
x <- self$stations$stations$label[self$stations$stations$id %in% id]
x
},
getStationsArea = function(){
private$stations_area
},
......
citizenair/data/ca.RData
No preview for this file type
citizenair/inst/apps/citizenair/citizenair.Rmd
......@@ -28,21 +28,50 @@ library(dygraphs)
library(ggplot2)
library(openair)
data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel")
data("BE_ADMIN_BELGIUM", package = "BelgiumMaps.StatBel")
data("ca", package = "citizenair")
#ca <- 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"))
#ca <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"), stations_area = BE_ADMIN_BELGIUM)
#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"))
#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"))
APPDATA <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"), stations_area = BE_ADMIN_BELGIUM)
```
```{r}
plot_timeseries <- function(x, ...){
if(nrow(x) > 0){
x <- setDT(x)
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 <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
g
}else{
g <- NULL
}
g
}
```
```{r}
popups <- list()
popups$download <- modalDialog(title = "Download",
"We connecteren nu naar de IRCEL webservice om data af te halen en te combineren met uw meetgegevens, eventjes geduld, dit scherm sluit vanzelf wanneer dit afgelopen is.",
size = "s", footer = NULL, easyClose = FALSE)
popups$cleaned_data <- modalDialog(
title = "Uw meetgegevens",
h4("Uw heeft de volgende gegevens opgeladen:"),
......@@ -51,6 +80,33 @@ popups$cleaned_data <- modalDialog(
tags$hr(),
DT::dataTableOutput("uiOutput_rawdata", width = "100%", height = "auto"),
size = "l", footer = modalButton("Sluit"), easyClose = TRUE)
popups$select_station <- modalDialog(
title = "Selecteer met welk officieel station u uw meetgegevens wilt vergelijken",
tags$div(tags$blockquote("Op de kaart hieronder kunt u meetstations vinden van de Vlaamse Milieu Maatschappij die dezelfde elementen meten als uw metingen. Selecteer het meetstation waarmee u uw eigen gegevens wil vergelijken door te klikken op een meetstation. Wanneer u klaar bent, klik op Go!, waarna we de gegevens van de VMM webservice afhalen en combineren met uw gegevens.")),
renderUI(tags$h3("Uw selecteerde te vergelijken met: ", citizenair_vmmstation()$label)),
radioGroupButtons(
inputId = "uiInput_selectmeasurement",
label = "Selecteer welke van uw sensorgegevens u wilt vergelijken met een officieel meetstation",
choices = sort(APPDATA$getCitizenData(type = "phenomena"), decreasing = TRUE),
direction = "horizontal", size = "sm",
justified = FALSE, individual = FALSE, status = "primary",
checkIcon = list(yes = icon("ok", lib = "glyphicon"))
),
actionButton(inputId = "uiInput_downloadtimeseries",
label = "Go! Haal de meetgegevens af vanaf de VMM webservice en start de vergelijking",
"data-dismiss"="modal",
icon = icon("arrow-circle-down")),
tags$hr(),
leafletOutput("uiOutput_select_station", width = "100%", height = 300),
size = "l", footer = NULL, easyClose = FALSE)
citizenair_vmmstation <- reactive({
input$uiOutput_select_station_marker_click
id <- input$uiOutput_select_station_marker_click$id
list(id = id, label = APPDATA$getStationLabel(id))
})
## MAIN REACTIVE WHICH LOADS THE EXCEL FILE
citizenair_userdata <- reactive({
......@@ -76,6 +132,10 @@ citizenair_userdata <- reactive({
caption = 'Overzicht van alle meetgegevens per sheet/tijdstip/type meting',
filter = 'top', options = list(pageLength = 5, autoWidth = TRUE, searching = FALSE)))
showModal(popups$cleaned_data)
output$uiOutput_timeseries <- renderDygraph({
plot_timeseries(result$appdata$getCombinedTimeseries(), main = "De tijdreeks van al uw meetgegevens")
})
}
}
result
......@@ -96,3 +156,30 @@ reactive({
```{r child="page02-exploratory.Rmd", eval=TRUE}
```
# Hidden {.hidden}
## Main event
```{r}
## Main trigger for updating graphs
numericInput(inputId = 'uiInput_refresh_counter', label = "How many updates are done", value = 0)
```
## Debugging
```{r}
tags$h3("Input")
renderPrint({
names(input)
})
tags$h3("Output")
renderPrint({
names(output)
})
tags$h3("session")
renderPrint({
names(session)
})
```
citizenair/inst/apps/citizenair/page01-introduction.Rmd
......@@ -32,7 +32,7 @@ fileInput("uiInput_xl", label = "Selecteer het bestand met uw metingen: ", accep
#materialSwitch(inputId = "uiInput_addexcel", label = "Combineer excel met vorige excel", value = FALSE, status = "info")
```
### Meetstations van de Vlaamse Overheid {data-height=500}
### Meetstations van de overheid {data-height=500}
```{r}
leafletOutput("uiOutput_stations")
......@@ -52,7 +52,7 @@ output$uiOutput_stations <- renderLeaflet({
if(!is.na(userdata$nearest_station)){
stations <- subset(stations, id %in% userdata$nearest_station)
stations <- head(stations, 1)
map <- addPopups(map, data = stations, popup = sprintf("Dichtste meetstation<br>%s: %s", stations$id, stations$label))
map <- addPopups(map, data = stations, popup = sprintf("Dichtste officieel meetstation<br>%s: %s", stations$id, stations$label))
}
if(nrow(meta) > 0){
map <- addPopups(map, lng = meta$lon, lat = meta$lat, popup = sprintf("<b>Sheet %s: %s</b>", meta$sheet_id, meta$sheet))
......
citizenair/inst/apps/citizenair/page02-exploratory.Rmd
## Sidebar {.sidebar}
#### Officieel meetstation
```{r}
plot_timeseries <- function(x, ...){
if(nrow(x) > 0){
x <- setDT(x)
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))
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van officieel station", style = "gradient")
tags$hr()
## Show input to select the station
observeEvent(input$uiInput_selectstation, {
userdata <- citizenair_userdata()
showModal(popups$select_station)
choices <- sort(userdata$appdata$getCitizenData(type = "phenomena"), decreasing = TRUE)
if(length(choices) > 0){
updateRadioGroupButtons(session, inputId = "uiInput_selectmeasurement", choices = choices,
size = "sm", status = "primary",
checkIcon = list(yes = icon("ok", lib = "glyphicon")))
}
output$uiOutput_select_station <- renderLeaflet({
input$uiInput_selectmeasurement
stations <- APPDATA$getStations()
official_measurements <- APPDATA$recode_phenomena(input$uiInput_selectmeasurement)
stations <- stations[sapply(stations$phenomena, FUN=function(x) any(x %in% official_measurements)), ]
if(nrow(stations) == 0){
showNotification("We vonden geen meetstations voor uw selectie")
}
map <- leaflet(data = stations)
map <- addControl(map, html = input$uiInput_selectmeasurement, position = "topleft")
map <- addTiles(map)
map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3,
layerId = stations$id,
popup = as.character(mapply(id = stations$id, label = stations$label, phenomena = stations$phenomena_label,
FUN=function(id, label, phenomena){
sprintf("<b>Station %s: %s</b> <br>Meetwaardes:<br> %s", id, label, paste(sprintf(" - %s ", phenomena), collapse = "<br>"))
})))
map
})
})
## MAIN REACTIVE WHICH COMBINES CITIZEN DATA + OFFICIAL DATA -- USES THE POPUP
observeEvent(input$uiInput_downloadtimeseries, {
result <- list()
result$userdata <- citizenair_userdata()
citizen <- result$userdata$appdata$getCitizenData("timeseries")
result$station <- result$userdata$appdata$getComparisonStation()
if(length(result$station) > 0){
showModal(popups$download)
showNotification("Haalt data af vanaf de IRCEL webservice")
}
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 <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
g
period <- lubridate::as.interval(as.POSIXct(input$uiInput_period[1] - 1), as.POSIXct(input$uiInput_period[1] + 1))
#official <- try(result$userdata$appdata$fetch_timeseries(result$station, time_span = period))
official <- try(result$userdata$appdata$fetch_timeseries(result$station))
removeModal()
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{
g <- NULL
if(nrow(official) > 0){
showNotification("Data werd afgehaald vanaf de IRCEL webservice en werd gecombineerd met uw meetgegevens", type = "message")
}
g
}
```
}
result$data <- list()
result$data$citizen <- citizen
result$data$official <- official
result$data <- rbindlist(result$data, use.names = TRUE)
APPDATA$setCombinedTimeseries(result$data)
updateNumericInput(session, inputId = 'uiInput_refresh_counter', value = input$uiInput_refresh_counter + 1)
#### Officieel meetstation
#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}
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van officieel station", style = "gradient")
```
#### Vergelijkingsbasis
#### Selecteer meetwaardes
```{r}
inputPanel(
renderUI({
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)
#ui <- checkboxGroupButtons(inputId = "uiInput_phenomena", label = "Selecteer meetwaardes", choices = choices, selected = choices, direction = "vertical", size = "sm", justified = FALSE, individual = FALSE, status = "warning", checkIcon = list(yes = icon("ok", lib = "glyphicon"), no = icon("remove", lib = "glyphicon")))
ui <- selectInput(inputId = "uiInput_phenomena", label = NULL, choices = choices, selected = choices, multiple = TRUE)
}else{
ui <- NULL
}
ui
}),
})
tags$hr()
```
#### Vergelijkingsbasis
```{r}
inputPanel(
radioButtons(inputId = "uiInput_aggregationlevel", label = "Vergelijk",
choices = c("Per minuut" = "min",
"Per uur" = "hour",
......@@ -63,13 +112,15 @@ observe({
if(timerange$valid){
updateDateRangeInput(session, inputId = "uiInput_period", start = as.Date(timerange$start), end = as.Date(timerange$end))
}
})
```
```{r}
observeEvent(input$uiInput_refresh, {
updateNumericInput(session, inputId = 'uiInput_refresh_counter', value = input$uiInput_refresh_counter + 1)
})
observeEvent(input$uiInput_refresh_counter, {
showNotification("Herberekening wordt uitgevoerd")
#input$uiInput_phenomena
#input$uiInput_aggregationlevel
......@@ -145,44 +196,6 @@ observeEvent(input$uiInput_refresh, {
})
```
```{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")
result$station <- result$userdata$appdata$getComparisonStation()
if(length(result$station) > 0){
showNotification("Haalt data af vanaf de IRCEL webservice")
}
period <- lubridate::as.interval(as.POSIXct(input$uiInput_period[1] - 1), as.POSIXct(input$uiInput_period[1] + 1))
#official <- try(result$userdata$appdata$fetch_timeseries(result$station, time_span = period))
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)
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}
......@@ -196,32 +209,6 @@ fillCol(
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$getCombinedTimeseries()
plot_timeseries(x, main = "De tijdreeks van al uw meetgegevens")
})
```
### Selecteer een ander officieel meetstation om te vergelijken
```{r}
leafletOutput("uiOutput_select_station", width = "100%", height = 400)
output$uiOutput_select_station <- renderLeaflet({
stations <- APPDATA$getStations()
map <- leaflet(data = stations)
map <- addTiles(map)
map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3,
layerId = stations$id,
popup = as.character(mapply(id = stations$id, label = stations$label, phenomena = stations$phenomena_label,
FUN=function(id, label, phenomena){
sprintf("<b>Station %s: %s</b> <br>Meetwaardes:<br> %s", id, label, paste(sprintf(" - %s ", phenomena), collapse = "<br>"))
})))
map
})
```
......@@ -239,7 +226,6 @@ we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van
radioButtons(inputId = "uiInput_dayofweek", label = "Vergelijk op basis van",
choices = c("Alle dagen van de week" = "all", "Enkel weekdagen" = "weekdays", "Enkel weekend" = "weekend"),
selected = "all"),
#tags$h3("Input voor de grafiek"),
#sliderInput(inputId = "uiInput_slider", label = "TODO", value = 25, min = 5, max = 100, step = 1L, round = TRUE),
circle = TRUE, status = "info", icon = icon("gear"), width = "300px", size = "sm",
......
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