Skip to content

citizenair
citizenair
Commit 7b17b6aa by Jan Wijffels
Options

popup of station selection uses now selection in main user interface

parent 392af353
Showing with 84 additions and 47 deletions
citizenair/inst/apps/citizenair/citizenair.Rmd
......@@ -83,13 +83,13 @@ popups$cleaned_data <- modalDialog(
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 overheid die dezelfde elementen meten als uw metingen. Selecteer het meetstation waarmee u uw eigen gegevens wil vergelijken door een type meting te selecteren en dan te klikken op de locatie van 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)),
renderUI(tags$h3("We zullen uw meetgegevens 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),
choices = c("U heeft nog geen excel bestand opgeladen, u dient eerst een bestand op te laden op de eerste pagina"),
direction = "horizontal", size = "sm",
direction = "horizontal", size = "sm", selected = NULL,
justified = FALSE, individual = FALSE, status = "primary",
checkIcon = list(yes = icon("ok", lib = "glyphicon"))
),
......
citizenair/inst/apps/citizenair/page02-exploratory.Rmd
## Sidebar {.sidebar}
#### Officieel meetstation
#### Selecteer meetwaardes
```{r}
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 <- checkboxGroupButtons(inputId = "uiInput_phenomena", #label = "Selecteer meetwaardes",
choices = choices, selected = choices,
direction = "vertical", size = "sm", justified = FALSE, individual = FALSE, status = "primary",
checkIcon = list(#no = icon("remove", lib = "glyphicon",
yes = icon("ok", lib = "glyphicon")))
#ui <- selectInput(inputId = "uiInput_phenomena", label = NULL, choices = choices, selected = choices, multiple = TRUE)
}else{
ui <- NULL
}
ui
})
tags$hr()
```
#### Vergelijk met officieel meetstation
```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van officieel station", style = "gradient")
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van een officieel station", style = "gradient")
tags$hr()
## Show input to select the station
observeEvent(input$uiInput_selectstation, {
......@@ -11,9 +34,24 @@ observeEvent(input$uiInput_selectstation, {
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")))
#Match citizen phenomena (choices) to ircel phenomena
choices_ircel <- userdata$appdata$recode_phenomena(choices)
choices_ircel <- userdata$appdata$getPhenomenaLabel(choices_ircel)
#User interface input selects ircel identifiers, get the IRCEL labels
selection <- userdata$appdata$getPhenomenaLabel(input$uiInput_phenomena)
selection <- head(selection, 1)
selection <- which(choices_ircel %in% selection)
selection <- head(selection, 1)
if(length(selection) > 0){
updateRadioGroupButtons(session, inputId = "uiInput_selectmeasurement",
choices = choices, selected = choices[selection],
size = "sm", status = "primary", checkIcon = list(yes = icon("ok", lib = "glyphicon")))
}else{
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
......@@ -41,11 +79,11 @@ observeEvent(input$uiInput_downloadtimeseries, {
result$userdata <- citizenair_userdata()
citizen <- result$userdata$appdata$getCitizenData("timeseries")
result$station <- result$userdata$appdata$getComparisonStation()
period <- lubridate::as.interval(as.POSIXct(input$uiInput_period[1] - 1), as.POSIXct(input$uiInput_period[1] + 1))
if(length(result$station) > 0){
showModal(popups$download)
showNotification("Haalt data af vanaf de IRCEL webservice")
showNotification(sprintf("We halen nu data af vanaf de IRCEL webservice van meetstation %s %s", result$station, result$userdata$appdata$getStationLabel(result$station)))
}
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()
......@@ -70,42 +108,23 @@ observeEvent(input$uiInput_downloadtimeseries, {
#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"))
})
```
#### Selecteer meetwaardes
```{r}
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 <- 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(
#inputPanel(
radioButtons(inputId = "uiInput_aggregationlevel", label = "Vergelijk",
choices = c("Per minuut" = "min",
"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")
)
selected = "rawdata")
dateRangeInput(inputId = "uiInput_period", label = "Verander de periode", start = Sys.Date()-365, end = Sys.Date())
#actionButton(inputId = "uiInput_refresh", label = "Herbereken grafiek")
#)
observe({
userdata <- citizenair_userdata()
timerange <- userdata$appdata$getCitizenData("timerange")
......@@ -117,11 +136,33 @@ observe({
```
```{r}
observeEvent(input$uiInput_refresh, {
updateNumericInput(session, inputId = 'uiInput_refresh_counter', value = input$uiInput_refresh_counter + 1)
#observeEvent(input$uiInput_refresh, {
# updateNumericInput(session, inputId = 'uiInput_refresh_counter', value = input$uiInput_refresh_counter + 1)
#})
reactive({
input$uiInput_refresh_counter
input$uiInput_phenomena
input$uiInput_aggregationlevel
input$uiInput_sheet
input$uiInput_period
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 <- x[as.Date(x$time) >= (as.Date(input$uiInput_period[1])) & as.Date(x$time) <= (as.Date(input$uiInput_period[2])), ]
x <- APPDATA$getCombinedTimeseries(x, type = input$uiInput_aggregationlevel, limit = TRUE)
output$uiOutput_timeseries <- renderDygraph(plot_timeseries(x))
})
observeEvent(input$uiInput_refresh_counter, {
showNotification("Herberekening wordt uitgevoerd")
reactive({
input$uiInput_refresh_counter
input$uiInput_phenomena
input$uiInput_aggregationlevel
input$uiInput_sheet
input$uiInput_period
#showNotification("Herberekening wordt uitgevoerd")
#input$uiInput_phenomena
#input$uiInput_aggregationlevel
#input$uiInput_sheet
......@@ -132,8 +173,7 @@ observeEvent(input$uiInput_refresh_counter, {
x <- subset(x, phenomena_id %in% input$uiInput_phenomena)
x <- x[as.Date(x$time) >= (as.Date(input$uiInput_period[1])) & as.Date(x$time) <= (as.Date(input$uiInput_period[2])), ]
x <- APPDATA$getCombinedTimeseries(x, type = input$uiInput_aggregationlevel, limit = TRUE)
output$uiOutput_timeseries <- renderDygraph(
plot_timeseries(x))
#output$uiOutput_timeseries <- renderDygraph(plot_timeseries(x))
try({
mydata <- subset(x, phenomena_id %in% head(input$uiInput_phenomena, 1))
......@@ -163,7 +203,7 @@ observeEvent(input$uiInput_refresh_counter, {
summary <- rbind(summary,"# Valid"=colSums(!is.na(mydata)))
summary <- rbind(summary,"# NA's"=colSums(is.na(mydata)))
variables <- c("min", "25th Perc", "median", "mean","75th Perc", "max","# Valid", "# NA's")
summary <- cbind("variable"=variables,summary)
summary <- cbind("statistiek"=variables,summary)
# outputs of dataframe & summaries
output$data <- renderTable({
......@@ -195,7 +235,6 @@ observeEvent(input$uiInput_refresh_counter, {
})
}
})
})
```
......@@ -206,9 +245,7 @@ observeEvent(input$uiInput_refresh_counter, {
```{r}
fillCol(
tags$div("Hieronder tonen we een overzicht van jouw metingen en de dichtstbijzijnde VMM-meetplaats in
functie van de tijd. Verken je meting hieronder en kijk eens wat er gebeurt als je uitmiddelt per
uur, per dag enz. Als je een goed zicht hebt op je data, ga dan naar de volgende stap."),
tags$div("Hieronder tonen we een overzicht van jouw metingen. Verken je meting hieronder en kijk eens wat er gebeurt als je uitmiddelt per uur, per dag enz. Als je een goed zicht hebt op je data, haal dan data op van een officieel meetstation om uw metingen mee te vergelijken."),
dygraphOutput("uiOutput_timeseries"),
flex = c(NA, 1)
)
......@@ -244,10 +281,10 @@ we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van
```{r}
fillCol(
tableOutput("data"),
tags$hr(),
tableOutput("summaryRaw"),
flex = c(1, NA, 1)
tags$hr(),
tableOutput("data"),
flex = c(NA, NA, 1)
)
```
......
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