Commit d92216c5 by Jan Wijffels

Add local possibility + add docs + reorder based on input VMM

parent 9e9272cf
...@@ -79,9 +79,10 @@ CitizenAir <- R6::R6Class("CitizenAir", ...@@ -79,9 +79,10 @@ CitizenAir <- R6::R6Class("CitizenAir",
data = NULL, data = NULL,
timeseries = NULL, timeseries = NULL,
closest_station = NA_character_, closest_station = NA_character_,
initialize = function(endpoint, stations_area) { initialize = function(endpoint, stations_area, locale = c("nl", "fr", "en")) {
locale <- match.arg(locale)
self$endpoint <- endpoint self$endpoint <- endpoint
self$stations <- read_stations(endpoint) self$stations <- read_stations(endpoint, locale = locale)
if(!missing(stations_area)){ if(!missing(stations_area)){
private$stations_area <- stations_area private$stations_area <- stations_area
stations_in_region <- self$getStations() stations_in_region <- self$getStations()
......
...@@ -140,21 +140,21 @@ plot.citizenair_comparison_ircel <- function(x, ...){ ...@@ -140,21 +140,21 @@ plot.citizenair_comparison_ircel <- function(x, ...){
plot_PI_CI <- ggplot2::ggplot(data = mydata) plot_PI_CI <- ggplot2::ggplot(data = mydata)
}else{ }else{
plot_PI_CI <- ggplot2::ggplot(data = mydata, ggplot2::aes(x = REF, y = SENSOR)) + plot_PI_CI <- ggplot2::ggplot(data = mydata, ggplot2::aes(x = REF, y = SENSOR)) +
ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_CI, ymax=upper_CI, fill = "CI"), alpha = 0.6) + ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_CI, ymax=upper_CI, fill = "Betrouwbaarheidsinterval"), alpha = 0.6) +
ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_PI, ymax=upper_PI, fill = "PI"), alpha = 0.4) + ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_PI, ymax=upper_PI, fill = "Voorspellingsinterval"), alpha = 0.4) +
ggplot2::geom_point() + ggplot2::geom_point() +
ggplot2::geom_line(ggplot2::aes(y = OLSQ,col = "OLSQ")) + ggplot2::geom_line(ggplot2::aes(y = OLSQ, col = "Lineaire regressie")) +
ggplot2::geom_line(ggplot2::aes(y = REF,col = "y=x")) + ggplot2::geom_line(ggplot2::aes(y = REF, col = "y=x")) +
ggplot2::labs(title = paste("Scatterplot with regression estimates: intercept =", ggplot2::labs(title = paste("Puntgrafiek met lineaire regressie schatting: intercept =",
format(summary(linear_model)$coefficients[1,1], digits = 3), format(summary(linear_model)$coefficients[1,1], digits = 3),
", slope =",format(summary(linear_model)$coefficients[2,1], digits = 3), ", hellingsgraad =",format(summary(linear_model)$coefficients[2,1], digits = 3),
", R\u00B2 =",format(summary(linear_model)$r.squared, digits = 3)), ", R\u00B2 =",format(summary(linear_model)$r.squared, digits = 3)),
x = "Reference value", x = "Referentie waarde van officieel meettoestel",
y = "Sensor") + y = "Uw eigen meting") +
ggplot2::scale_fill_manual(name="",values=c("CI"="blue", ggplot2::scale_fill_manual(name="",values=c("Betrouwbaarheidsinterval"="blue",
"PI"= "grey")) + "Voorspellingsinterval"= "grey")) +
ggplot2::scale_colour_manual(name="", values = c("y=x"="red", ggplot2::scale_colour_manual(name="", values = c("y=x"="red",
"OLSQ"="black")) "Lineaire regressie"="black"))
} }
plot_PI_CI plot_PI_CI
} }
......
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
#' @title Get CitizenAir Stations #' @title Get CitizenAir Stations
#' @description Get CitizenAir Stations #' @description Get CitizenAir Stations
#' @param x an object of class \code{Endpoint} as returned by \code{as.Endpoint} #' @param x an object of class \code{Endpoint} as returned by \code{as.Endpoint}
#' @param locale a character string with the locale, either one of 'nl', 'fr', 'en'
#' @export #' @export
#' @return #' @return
#' an object of class \code{citizenair_stations} which is a list with elements \code{phenomena} and \code{stations}\cr #' an object of class \code{citizenair_stations} which is a list with elements \code{phenomena} and \code{stations}\cr
...@@ -23,20 +24,37 @@ ...@@ -23,20 +24,37 @@
#' @examples #' @examples
#' library(sensorweb4R) #' library(sensorweb4R)
#' e <- as.Endpoint("http://geo.irceline.be/sos/api/v1") #' e <- as.Endpoint("http://geo.irceline.be/sos/api/v1")
#' x <- read_stations(e) #' x <- read_stations(e, locale = "nl")
read_stations <- function(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/sos/api/v1")){ #' x$phenomena
#' str(x$x$phenomena)
#' x <- read_stations(e, locale = "fr")
#' x$phenomena
read_stations <- function(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/sos/api/v1"), locale = c("nl", "fr", "en")){
locale <- match.arg(locale)
stopifnot(inherits(x, "Endpoint")) stopifnot(inherits(x, "Endpoint"))
e <- x e <- x
url <- sensorweb4R::resourceURL(e) url <- sensorweb4R::resourceURL(e)
if(FALSE){
## sensorweb4R::phenomena can not cope with locale
phe <- data.table(id = sensorweb4R::id(sensorweb4R::phenomena(e)), phe <- data.table(id = sensorweb4R::id(sensorweb4R::phenomena(e)),
label = sensorweb4R::label(sensorweb4R::phenomena(e)), label = sensorweb4R::label(sensorweb4R::phenomena(e)),
stringsAsFactors = FALSE) stringsAsFactors = FALSE)
phe <- phe[order(phe$label, decreasing = FALSE), ] phe <- phe[order(phe$label, decreasing = FALSE), ]
}
## Query http://geo.irceline.be/sos/api/v1/stations?expanded=true ## Query http://geo.irceline.be/sos/api/v1/stations?expanded=true
sta <- httr::GET(url = sprintf("%s/%s", url, "stations"), query = list(expanded="true")) sta <- httr::GET(url = sprintf("%s/%s", url, "stations"), query = list(expanded = "true", locale = locale))
sta <- httr::content(sta) sta <- httr::content(sta)
phe <- lapply(sta, FUN=function(x){
out <- lapply(x$properties$timeseries, FUN=function(x) list(id = x$phenomenon$id, label = x$phenomenon$label))
out <- data.table::rbindlist(out)
out
})
phe <- data.table::rbindlist(phe)
phe <- data.table::setDF(phe)
phe <- unique(phe)
phe <- phe[order(phe$label, decreasing = FALSE), ]
sta <- lapply(sta, FUN=function(x){ sta <- lapply(sta, FUN=function(x){
out <- list(id = x$properties$id, out <- list(id = x$properties$id,
label = x$properties$label, label = x$properties$label,
......
--- ---
title: "Citizen Air - meet - evalueer - vergelijk" title: "Meet - Evalueer - Vergelijk"
runtime: shiny runtime: shiny
output: output:
flexdashboard::flex_dashboard: flexdashboard::flex_dashboard:
orientation: columns orientation: columns
logo: img/logo-irceline-small.png logo: img/logo-hoemeetiklucht-small.png
theme: lumen theme: lumen
--- ---
```{r setup, include=FALSE} ```{r setup, include=FALSE}
library(flexdashboard) library(flexdashboard)
library(shiny) library(shiny)
...@@ -27,27 +28,29 @@ library(xts) ...@@ -27,27 +28,29 @@ library(xts)
library(dygraphs) library(dygraphs)
library(ggplot2) library(ggplot2)
library(openair) library(openair)
data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel") #data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel")
data("BE_ADMIN_BELGIUM", package = "BelgiumMaps.StatBel") data("BE_ADMIN_BELGIUM", package = "BelgiumMaps.StatBel")
data("ca", package = "citizenair") #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 = 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) #ca <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"), stations_area = BE_ADMIN_BELGIUM, locale = "nl")
#save(ca, file = "citizenair/data/ca.RData") #save(ca, file = "citizenair/data/ca.RData")
APPDATA <- ca #APPDATA <- ca
#APPDATA$setCitizenData(file = system.file(package = "citizenair", "data-raw", "citizenair-example.xls")) #APPDATA$setCitizenData(file = system.file(package = "citizenair", "data-raw", "citizenair-example.xls"))
#APPDATA$setComparisonStation(id = "1155") #APPDATA$setComparisonStation(id = "1155")
#APPDATA <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"), #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")) # 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) APPDATA <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"),
stations_area = BE_ADMIN_BELGIUM,
locale = "nl")
``` ```
```{r} ```{r}
plot_timeseries <- function(x, ...){ plot_timeseries <- function(x, ...){
if(nrow(x) > 0){ if(nrow(x) > 0){
x <- setDT(x) x <- setDT(x)
x$ts_id <- paste(x$type, x$phenomena, sep = "-") x$ts_id <- paste(ifelse(x$type %in% "official", "VMM", ifelse(x$type %in% "citizen", "burger", x$type)), x$phenomena, sep = "-")
period_citizen <- x$time[x$type %in% "citizen"] period_citizen <- x$time[x$type %in% "citizen"]
if(length(period_citizen) > 0){ if(length(period_citizen) > 0){
#x <- subset(x, date >= (as.Date(min(period_citizen)) - 1) & date <= (as.Date(max(period_citizen)) + 1)) #x <- subset(x, date >= (as.Date(min(period_citizen)) - 1) & date <= (as.Date(max(period_citizen)) + 1))
...@@ -56,7 +59,7 @@ plot_timeseries <- function(x, ...){ ...@@ -56,7 +59,7 @@ plot_timeseries <- function(x, ...){
ts <- setDF(ts) ts <- setDF(ts)
g <- xts(ts[, -1], order.by=ts[,1]) g <- xts(ts[, -1], order.by=ts[,1])
g <- dygraph(g, ...) g <- dygraph(g, ...)
g <- dyRangeSelector(g, height = 20) g <- dyRangeSelector(g, height = 30)
g <- dyLegend(g, show = "always") g <- dyLegend(g, show = "always")
g g
}else{ }else{
...@@ -148,12 +151,12 @@ reactive({ ...@@ -148,12 +151,12 @@ reactive({
}) })
``` ```
# Data {data-icon="fa-cloud-upload"} # Data opladen {data-icon="fa-cloud-upload"}
```{r child="page01-introduction.Rmd", eval=TRUE} ```{r child="page01-introduction.Rmd", eval=TRUE}
``` ```
# Exploreer en vergelijk {data-icon="fa-toggle-on"} # Verken en vergelijk je data {data-icon="fa-toggle-on"}
```{r child="page02-exploratory.Rmd", eval=TRUE} ```{r child="page02-exploratory.Rmd", eval=TRUE}
``` ```
......
## Data ## Data
### Citizen Air - laadt je eigen metingen op {data-height=400} ### Laadt je eigen metingen op {data-height=400}
```{r} ```{r}
output[["citizenair-example.xls"]] <- downloadHandler( output[["citizenair-example.xls"]] <- downloadHandler(
...@@ -11,6 +11,10 @@ output[["citizenair-blank.xls"]] <- downloadHandler( ...@@ -11,6 +11,10 @@ output[["citizenair-blank.xls"]] <- downloadHandler(
filename = function() "citizenair-blank.xls", filename = function() "citizenair-blank.xls",
content = function(file) file.copy(from = system.file(package = "citizenair", "data-raw", "citizenair-blank.xls"), file) content = function(file) file.copy(from = system.file(package = "citizenair", "data-raw", "citizenair-blank.xls"), file)
) )
output[["Handleiding.pdf"]] <- downloadHandler(
filename = function() "Handleiding.pdf",
content = function(file) file.copy(from = system.file(package = "citizenair", "documentation", "Handleiding.pdf"), file)
)
tags$blockquote("Deze toepassing laat je toe om de kwaliteit van je eigen luchtmeting in te schatten. tags$blockquote("Deze toepassing laat je toe om de kwaliteit van je eigen luchtmeting in te schatten.
Hiervoor moet je je data plaatsen in het template dat je via", Hiervoor moet je je data plaatsen in het template dat je via",
...@@ -22,7 +26,7 @@ tags$ul( ...@@ -22,7 +26,7 @@ tags$ul(
tags$li("Download een lege excel file waarin je je data kan copy-pasten: ", tags$li("Download een lege excel file waarin je je data kan copy-pasten: ",
downloadLink("citizenair-blank.xls", "citizenair-blank.xls")), downloadLink("citizenair-blank.xls", "citizenair-blank.xls")),
tags$li("Ga naar de handleiding op ", tags$li("Ga naar de handleiding op ",
tags$a(href="https://hoemeetiklucht.eu", "hoemeetiklucht.eu")) downloadLink("Handleiding.pdf", "Handleiding.pdf"))
) )
``` ```
......
...@@ -20,14 +20,28 @@ renderUI({ ...@@ -20,14 +20,28 @@ renderUI({
} }
ui ui
}) })
```
```{r}
renderUI({
userdata <- citizenair_userdata()
x <- userdata$appdata$getCitizenData("meta")
if(is.data.frame(x) && nrow(x) > 0){
choices <- structure(as.list(x$sheet_id), .Names = x$sheet)
ui <- selectInput(inputId = "uiInput_sheet", label = "Uw meetlocaties", choices = choices, selected = choices, multiple = TRUE)
}else{
ui <- NULL
}
ui
})
tags$hr() tags$hr()
``` ```
#### Vergelijk met officieel meetstation #### Vergelijk met ...
```{r} ```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van een 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 ## Show input to select the station
observeEvent(input$uiInput_selectstation, { observeEvent(input$uiInput_selectstation, {
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
...@@ -150,7 +164,7 @@ reactive({ ...@@ -150,7 +164,7 @@ reactive({
x <- subset(x, phenomena_id %in% input$uiInput_phenomena) 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 <- 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) x <- APPDATA$getCombinedTimeseries(x, type = input$uiInput_aggregationlevel, limit = TRUE)
output$uiOutput_timeseries <- renderDygraph(plot_timeseries(x)) output$uiOutput_timeseries <- renderDygraph(plot_timeseries(x, main = sprintf("De tijdreeks van meetwaardes: %s", paste(APPDATA$getPhenomenaLabel(input$uiInput_phenomena), collapse = ", "))))
}) })
...@@ -225,7 +239,7 @@ reactive({ ...@@ -225,7 +239,7 @@ reactive({
``` ```
## Verken je metingen {.tabset} ## Verken je metingen {.tabset data-width=600}
### Verken je metingen ### Verken je metingen
...@@ -278,7 +292,7 @@ fillCol( ...@@ -278,7 +292,7 @@ fillCol(
## Inputs {data-width=150} ## Hoofdvergelijking {data-width=150}
### ###
...@@ -314,7 +328,7 @@ renderValueBox({ ...@@ -314,7 +328,7 @@ renderValueBox({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
filename <- userdata$appdata$getCitizenData("fileinfo")$name filename <- userdata$appdata$getCitizenData("fileinfo")$name
if(length(filename) > 0){ if(length(filename) > 0){
ui <- valueBox("geladen excel", caption = filename) ui <- valueBox(filename, caption = "door u opgeladen excel")
}else{ }else{
ui <- NULL ui <- NULL
} }
...@@ -322,18 +336,3 @@ renderValueBox({ ...@@ -322,18 +336,3 @@ renderValueBox({
}) })
``` ```
###
```{r}
renderUI({
userdata <- citizenair_userdata()
x <- userdata$appdata$getCitizenData("meta")
if(is.data.frame(x) && nrow(x) > 0){
choices <- structure(as.list(x$sheet_id), .Names = x$sheet)
ui <- selectInput(inputId = "uiInput_sheet", label = "Selecteer sheet - om te verwijderen selecteer een sheet en druk op je delete knop", choices = choices, selected = choices, multiple = TRUE)
}else{
ui <- NULL
}
ui
})
```
...@@ -5,10 +5,13 @@ ...@@ -5,10 +5,13 @@
\title{Get CitizenAir Stations} \title{Get CitizenAir Stations}
\usage{ \usage{
read_stations(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/sos/api/v1")) read_stations(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/sos/api/v1"),
locale = c("nl", "fr", "en"))
} }
\arguments{ \arguments{
\item{x}{an object of class \code{Endpoint} as returned by \code{as.Endpoint}} \item{x}{an object of class \code{Endpoint} as returned by \code{as.Endpoint}}
\item{locale}{a character string with the locale, either one of 'nl', 'fr', 'en'}
} }
\value{ \value{
an object of class \code{citizenair_stations} which is a list with elements \code{phenomena} and \code{stations}\cr an object of class \code{citizenair_stations} which is a list with elements \code{phenomena} and \code{stations}\cr
...@@ -34,5 +37,9 @@ Get CitizenAir Stations ...@@ -34,5 +37,9 @@ Get CitizenAir Stations
\examples{ \examples{
library(sensorweb4R) library(sensorweb4R)
e <- as.Endpoint("http://geo.irceline.be/sos/api/v1") e <- as.Endpoint("http://geo.irceline.be/sos/api/v1")
x <- read_stations(e) x <- read_stations(e, locale = "nl")
x$phenomena
str(x$x$phenomena)
x <- read_stations(e, locale = "fr")
x$phenomena
} }
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