Commit d22dbb4f by Jan Wijffels

Wip, using now the R6 class CitizenAir in the webapp

parent deeea4a8
...@@ -9,4 +9,19 @@ Authors@R: c( ...@@ -9,4 +9,19 @@ Authors@R: c(
Description: Utilities for the Citizen Air application. Description: Utilities for the Citizen Air application.
License: CC BY-SA 4.0 License: CC BY-SA 4.0
RoxygenNote: 6.0.1 RoxygenNote: 6.0.1
Imports: readxl, cellranger, data.table, fasttime, rmarkdown, tools, utils, sensorweb4R, httr, methods, sp, lubridate, R6 Imports:
tools,
utils,
methods,
R6,
data.table,
sp,
readxl,
cellranger,
fasttime,
rmarkdown,
sensorweb4R,
httr,
lubridate,
rgeos
Suggests: BelgiumMaps.StatBel
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
S3method(as.data.frame,citizenair_userdata) S3method(as.data.frame,citizenair_userdata)
S3method(error_message,default)
export(CitizenAir) export(CitizenAir)
export(error_message)
export(read_citizenair) export(read_citizenair)
export(read_stations) export(read_stations)
export(run_app) export(run_app)
...@@ -21,6 +23,7 @@ importFrom(httr,content) ...@@ -21,6 +23,7 @@ importFrom(httr,content)
importFrom(lubridate,as.interval) importFrom(lubridate,as.interval)
importFrom(readxl,excel_sheets) importFrom(readxl,excel_sheets)
importFrom(readxl,read_excel) importFrom(readxl,read_excel)
importFrom(rgeos,gIntersects)
importFrom(rmarkdown,run) importFrom(rmarkdown,run)
importFrom(sensorweb4R,Station) importFrom(sensorweb4R,Station)
importFrom(sensorweb4R,as.Endpoint) importFrom(sensorweb4R,as.Endpoint)
......
...@@ -25,11 +25,13 @@ citizenair_userdata_empty <- function(){ ...@@ -25,11 +25,13 @@ citizenair_userdata_empty <- function(){
#' @field endpoint object of class \code{Endpoint} as returned by \code{as.Endpoint} #' @field endpoint object of class \code{Endpoint} as returned by \code{as.Endpoint}
#' @field stations object of class \code{citizenair_stations} as returned by \code{\link{read_stations}} #' @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 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.
#' @format The CitizenAir object is an R6Class #' @format The CitizenAir object is an R6Class
#' @section Methods: #' @section Methods:
#' \describe{ #' \describe{
#' \item{\code{fetch_timeseries(id = "123", time_span)}}{Get timeseries for Station with \code{id} and a certain time_span The argument \code{timespan.} Passed on to \code{sensorweb4R::getData}} #' \item{\code{fetch_timeseries(id = "123", time_span)}}{Get timeseries for Station with \code{id} and a certain time_span The argument \code{timespan.} Passed on to \code{sensorweb4R::getData}}
#' \item{\code{getStations()}}{Get a SpatialPointsDataFrame of all stations} #' \item{\code{getStations()}}{Get a SpatialPointsDataFrame of all stations}
#' \item{TODO}{TODO}
#' } #' }
#' @export #' @export
#' @examples #' @examples
...@@ -37,12 +39,19 @@ citizenair_userdata_empty <- function(){ ...@@ -37,12 +39,19 @@ citizenair_userdata_empty <- function(){
#' e <- as.Endpoint("http://geo.irceline.be/sos/api/v1") #' e <- as.Endpoint("http://geo.irceline.be/sos/api/v1")
#' ca <- CitizenAir$new(e) #' ca <- CitizenAir$new(e)
#' ca #' ca
#' library(BelgiumMaps.StatBel)
#' data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel")
#' vlaanderen <- subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL %in% "Vlaams Gewest")
#' ca <- CitizenAir$new(e, stations_area = vlaanderen)
#' ca
#' ca$getPhenomena() #' ca$getPhenomena()
#' ca$getPhenomenaLabel("20")
#' #'
#' ## get stations #' ## get stations
#' library(sp) #' library(sp)
#' x <- ca$getStations() #' x <- ca$getStations()
#' plot(x) #' plot(x)
#' plot(ca$getStationsArea())
#' #'
#' ## get official measurements #' ## get official measurements
#' library(lubridate) #' library(lubridate)
...@@ -52,18 +61,45 @@ citizenair_userdata_empty <- function(){ ...@@ -52,18 +61,45 @@ citizenair_userdata_empty <- function(){
#' ## set citizen measurements #' ## set citizen measurements
#' filename <- system.file(package = "citizenair", "data-raw", "citizenair-example.xls") #' filename <- system.file(package = "citizenair", "data-raw", "citizenair-example.xls")
#' ca$setCitizenData(filename) #' ca$setCitizenData(filename)
#' x <- ca$getCitizenData("meta")
#' x <- ca$getCitizenData("timeseries")
#' x <- ca$getCitizenData("phenomena")
#' x <- ca$getCitizenData("fileinfo")
#' ca$getClosestStation()
#' id <- ca$getClosestStation()
#' ca$setComparisonStation(id)
#' x <- ca$fetch_timeseries(id)
#' x <- ca$fetch_timeseries()
CitizenAir <- R6::R6Class("CitizenAir", CitizenAir <- R6::R6Class("CitizenAir",
public = list( public = list(
endpoint = NULL, endpoint = NULL,
stations = NULL, stations = NULL,
data = NULL, data = NULL,
initialize = function(endpoint) { closest_station = NA_character_,
initialize = function(endpoint, stations_area) {
self$endpoint <- endpoint self$endpoint <- endpoint
self$stations <- read_stations(endpoint) self$stations <- read_stations(endpoint)
if(!missing(stations_area)){
private$stations_area <- stations_area
stations_in_region <- self$getStations()
stations_in_region <- stations_in_region[sapply(1:nrow(stations_in_region),
FUN=function(idx) rgeos::gIntersects(stations_area, stations_in_region[idx, ])), ]
self$stations$stations <- self$stations$stations[self$stations$stations$id %in% stations_in_region$id, ]
}
self$data <- citizenair_userdata_empty() self$data <- citizenair_userdata_empty()
self$closest_station <- NA_character_
},
setCitizenData = function(file, name=basename(file)){
x <- read_citizenair(file)
self$setComparisonStation()
self$data <- x
}, },
fetch_timeseries = function(id, time_span=NULL) { setComparisonStation = function(id = NA_character_){
self$closest_station <- as.character(id)
},
fetch_timeseries = function(id = self$getComparisonStation(), time_span=NULL) {
stopifnot(length(id) == 1) stopifnot(length(id) == 1)
stopifnot(!is.na(id))
## Find and create a stations object ## Find and create a stations object
x <- self$stations$stations x <- self$stations$stations
x <- as.data.frame(x) x <- as.data.frame(x)
...@@ -91,28 +127,83 @@ CitizenAir <- R6::R6Class("CitizenAir", ...@@ -91,28 +127,83 @@ CitizenAir <- R6::R6Class("CitizenAir",
df <- as.data.frame(df) df <- as.data.frame(df)
df$date <- as.Date(df$time) df$date <- as.Date(df$time)
df$phenomena_id <- sensorweb4R::id(sensorweb4R::phenomenon(x)) df$phenomena_id <- sensorweb4R::id(sensorweb4R::phenomenon(x))
df$phenomena <- self$phenomena_label(df$phenomena_id) df$phenomena <- self$getPhenomenaLabel(df$phenomena_id)
df$phenomena_label <- sensorweb4R::label(x) df$phenomena_label <- sensorweb4R::label(x)
result[[i]] <- df[, c("phenomena_id", "phenomena", "phenomena_label", "time", "value")] result[[i]] <- df[, c("phenomena_id", "phenomena", "phenomena_label", "time", "value")]
} }
result <- rbindlist(result) result <- rbindlist(result)
result result
}, },
phenomena_label = function(id){
txt_recode(id, from = self$stations$phenomena$id, to = self$stations$phenomena$label)
},
getStations = function(){ getStations = function(){
x <- as.data.frame(self$stations$stations) x <- as.data.frame(self$stations$stations)
x <- sp::SpatialPointsDataFrame(coords = x[, c("lon", "lat")], x <- sp::SpatialPointsDataFrame(coords = x[, c("lon", "lat")],
data = x, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")) data = x, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
x x
}, },
getStationsArea = function(){
private$stations_area
},
getPhenomena = function(){ getPhenomena = function(){
self$stations$phenomena$id self$stations$phenomena$id
}, },
setCitizenData = function(file, name=basename(file)){ getPhenomenaLabel = function(id){
self$data <- read_citizenair(file) stopifnot(all(id %in% self$stations$phenomena$id))
txt_recode(id, from = self$stations$phenomena$id, to = self$stations$phenomena$label)
},
getComparisonStation = function(){
self$closest_station
},
getClosestStation = function(){
## Get locations of own measurements
point <- self$getCitizenData(type = "meta")
point <- point[!is.na(point$lon) & !is.na(point$lat), ]
station <- NA_character_
if(nrow(point) > 0){
point <- head(point, 1)
station <- private$nearest_station(stations = self$getStations(), as.matrix(point[, c("lon", "lat")]))
station <- station$id
}
station
},
getCitizenData = function(type = c("meta", "timeseries", "phenomena", "fileinfo")){
type <- match.arg(type)
if(type == "meta"){
if(is.na(self$data$filename)){
x <- data.frame(sheet_id = integer(), sheet = character(), device = character(),
lat = numeric(), lon = numeric(),
phenomena = character(), stringsAsFactors = FALSE)
}else{
x <- as.data.frame(self$data, type = "meta")
}
}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)
}else{
x <- as.data.frame(self$data, type = "measurements")
}
}else if(type == "phenomena"){
if(is.na(self$data$filename)){
x <- character()
}else{
x <- self$data$phenomena
}
}else if(type == "fileinfo"){
if(is.na(self$data$filename)){
x <- data.frame(name = character(), file = character(), stringsAsFactors = FALSE)
}else{
x <- data.frame(name = self$data$filename, file = self$data$file, stringsAsFactors = FALSE)
}
}
x
} }
), ),
private = list() private = list(
stations_area = NULL,
nearest_station = function(stations, x){
d <- sp::spDistsN1(stations, x, longlat = TRUE)
stations[which.min(d), ]
}
)
) )
...@@ -9,6 +9,7 @@ ...@@ -9,6 +9,7 @@
#' @importFrom lubridate as.interval #' @importFrom lubridate as.interval
#' @importFrom httr GET content #' @importFrom httr GET content
#' @importFrom sp CRS SpatialPointsDataFrame #' @importFrom sp CRS SpatialPointsDataFrame
#' @importFrom rgeos gIntersects
#' @import methods #' @import methods
#' @import R6 #' @import R6
NULL NULL
......
...@@ -85,7 +85,7 @@ as.data.frame.citizenair_userdata <- function(x, row.names, optional, ..., type ...@@ -85,7 +85,7 @@ as.data.frame.citizenair_userdata <- function(x, row.names, optional, ..., type
x x
}) })
x <- rbindlist(x) x <- rbindlist(x)
}else{ }else if(type == "measurements"){
x <- lapply(x$content, FUN=function(x){ x <- lapply(x$content, FUN=function(x){
meta <- x$meta meta <- x$meta
x <- x$data x <- x$data
......
#' @title Get the error message of a try-error object
#' @description Get the error message of a try-error object
#' @param x an object
#' @param ... not used
#' @export
#' @return a character string with the error message or an empty character string
#' @examples
#' x <- try(log("a"))
#' error_message(x)
#' x <- try(log(10))
#' error_message(x)
error_message <- function(x, ...){
UseMethod("error_message")
}
#' @export
#' @describeIn error_message Default functionality
error_message.default <- function(x, ...){
if(inherits(x, "try-error")){
as.character(attributes(x)$condition)
}else{
character()
}
}
txt_recode <- function (x, from = c(), to = c()) { txt_recode <- function (x, from = c(), to = c()) {
stopifnot(length(from) == length(to)) stopifnot(length(from) == length(to))
nongiven <- unique(x[!is.na(x)]) nongiven <- unique(x[!is.na(x)])
......
No preview for this file type
...@@ -30,14 +30,12 @@ library(openair) ...@@ -30,14 +30,12 @@ library(openair)
data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel") data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel")
data("ca", package = "citizenair") data("ca", package = "citizenair")
dashinput <- list() #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"))
dashinput$endpoint <- as.Endpoint("http://geo.irceline.be/sos/api/v1") #save(ca, file = "citizenair/data/ca.RData")
dashinput$appdata <- ca
#dashinput$appdata <- CitizenAir$new(endpoint = dashinput$endpoint) APPDATA <- ca
dashinput$region <- subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL %in% "Vlaams Gewest") APPDATA <- CitizenAir$new(endpoint = as.Endpoint("http://geo.irceline.be/sos/api/v1"),
dashinput$stations_sp <- dashinput$appdata$getStations() stations_area = subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL %in% "Vlaams Gewest"))
dashinput$stations_sp <- dashinput$stations_sp[sapply(1:nrow(dashinput$stations_sp),
FUN=function(idx) gIntersects(dashinput$region, dashinput$stations_sp[idx, ])), ]
``` ```
...@@ -52,57 +50,35 @@ popups$cleaned_data <- modalDialog( ...@@ -52,57 +50,35 @@ popups$cleaned_data <- modalDialog(
DT::dataTableOutput("uiOutput_rawdata", width = "100%", height = "auto"), DT::dataTableOutput("uiOutput_rawdata", width = "100%", height = "auto"),
size = "l", footer = modalButton("Sluit"), easyClose = TRUE) size = "l", footer = modalButton("Sluit"), easyClose = TRUE)
## MAIN REACTIVE WHICH LOADS THE EXCEL FILE
citizenair_userdata <- reactive({ citizenair_userdata <- reactive({
input$uiInput_xl input$uiInput_xl
isolate({ result <- list()
default <- data.frame(name = character(), size = integer(), type = character(), datapath = character(), stringsAsFactors = FALSE) result$appdata <- APPDATA
result <- list() result$nearest_station <- result$appdata$getClosestStation()
result$stations <- dashinput$stations_sp if(!is.null(input$uiInput_xl)){
result$name <- input$uiInput_xl$name showNotification("We lezen uw Excel bestand in wacht even...", duration = 5)
result$file <- input$uiInput_xl$datapath x <- try(result$appdata$setCitizenData(file = input$uiInput_xl$datapath, name = input$uiInput_xl$name))
result$data <- list() if(inherits(x, "try-error")){
result$data$phenomena <- character() showNotification(sprintf("Er loopt iets fout, is uw data bestand wel een correct bestand? %s", error_message(x)),
result$data$meta <- data.frame(sheet_id = integer(), sheet = character(), device = character(), type = "error", duration = 15)
lat = numeric(), lon = numeric(),
phenomena = character(), stringsAsFactors = FALSE)
result$data$phenomena <- data.frame(sheet_id = integer(), time = as.POSIXct(character()), date = as.Date(character()),
phenomena = character(), value = numeric(), stringsAsFactors = FALSE)
if(is.null(input$uiInput_xl)){
result$file <- default
}else{ }else{
showNotification("We lezen uw Excel bestand in wacht even...") result$nearest_station <- result$appdata$getClosestStation()
x <- try(dashinput$appdata$setCitizenData(result$file)) APPDATA$setComparisonStation(result$nearest_station)
if(inherits(x, "try-error")){ output$uiOutput_rawmeta <- renderTable(APPDATA$getCitizenData("meta"))
showNotification(sprintf("Er loopt iets fout, is uw data bestand wel een correct bestand? %s", as.character(attributes(x)$condition))) output$uiOutput_rawdata <- renderDT(datatable(APPDATA$getCitizenData("timeseries"), rownames = FALSE,
}else{ caption = 'Overzicht van alle meetgegevens per sheet/tijdstip/type meting',
x <- dashinput$appdata$data filter = 'top', options = list(pageLength = 5, autoWidth = TRUE, searching = FALSE)))
result$data$polluenten <- x$phenomena showModal(popups$cleaned_data)
result$data$meta <- as.data.frame(x, type = "meta")
result$data$phenomena <- as.data.frame(x, type = "measurements")
nearest_station <- function(stations, x){
d <- sp::spDistsN1(stations, x, longlat = TRUE)
stations[which.min(d), ]
}
point <- as.matrix(data.frame(lon = 51.20, lat = 4.54))
point <- subset(result$data$meta, !is.na(lon))
if(nrow(point) > 0){
result$nearest_station <- nearest_station(stations = dashinput$stations_sp, as.matrix(point[1, c("lon", "lat")]))
result$nearest_station <- result$nearest_station$id
}else{
result$nearest_station <- character()
}
output$uiOutput_rawmeta <- renderTable(result$data$meta)
output$uiOutput_rawdata <- renderDT(datatable(result$data$phenomena, rownames = FALSE,
caption = 'Overzicht van alle meetgegevens per sheet/tijdstip/type meting',
filter = 'top', options = list(pageLength = 5, autoWidth = TRUE)))
showModal(popups$cleaned_data)
}
} }
}) }
result result
}) })
reactive({
## On click on the station selection leaflet user interface, change the comparison station
input$uiOutput_select_station_marker_click
APPDATA$setComparisonStation(input$uiOutput_select_station_marker_click$id)
})
``` ```
```{r} ```{r}
......
...@@ -38,9 +38,10 @@ fileInput("uiInput_xl", label = "Selecteer het bestand met uw metingen: ", accep ...@@ -38,9 +38,10 @@ fileInput("uiInput_xl", label = "Selecteer het bestand met uw metingen: ", accep
leafletOutput("uiOutput_stations") leafletOutput("uiOutput_stations")
output$uiOutput_stations <- renderLeaflet({ output$uiOutput_stations <- renderLeaflet({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
meta <- userdata$data$meta meta <- userdata$appdata$getCitizenData("meta")
stations <- userdata$stations stations <- APPDATA$getStations()
map <- leaflet(data = dashinput$region) region <- APPDATA$getStationsArea()
map <- leaflet(data = region)
map <- addTiles(map) map <- addTiles(map)
map <- addPolygons(map, weight = 3, fillOpacity = 0) map <- addPolygons(map, weight = 3, fillOpacity = 0)
map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3, map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3,
...@@ -48,7 +49,7 @@ output$uiOutput_stations <- renderLeaflet({ ...@@ -48,7 +49,7 @@ output$uiOutput_stations <- renderLeaflet({
FUN=function(id, label, phenomena){ FUN=function(id, label, phenomena){
sprintf("<b>Station %s: %s</b> <br>Meetwaardes:<br> %s", id, label, paste(sprintf(" - %s ", phenomena), collapse = "<br>")) sprintf("<b>Station %s: %s</b> <br>Meetwaardes:<br> %s", id, label, paste(sprintf(" - %s ", phenomena), collapse = "<br>"))
}))) })))
if(length(userdata$nearest_station) > 0){ if(!is.na(userdata$nearest_station)){
stations <- subset(stations, id %in% userdata$nearest_station) stations <- subset(stations, id %in% userdata$nearest_station)
stations <- head(stations, 1) 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 meetstation<br>%s: %s", stations$id, stations$label))
...@@ -74,7 +75,7 @@ output$uiOutput_stations <- renderLeaflet({ ...@@ -74,7 +75,7 @@ output$uiOutput_stations <- renderLeaflet({
```{r} ```{r}
renderValueBox({ renderValueBox({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
n <- nrow(userdata$data$meta) n <- nrow(userdata$appdata$getCitizenData("meta"))
if(n > 0){ if(n > 0){
valueBox(n, caption = "Uw meetpunten", icon = "fa-thumbs-up", color = "green") valueBox(n, caption = "Uw meetpunten", icon = "fa-thumbs-up", color = "green")
}else{ }else{
...@@ -88,10 +89,14 @@ renderValueBox({ ...@@ -88,10 +89,14 @@ renderValueBox({
```{r} ```{r}
renderValueBox({ renderValueBox({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
stations <- userdata$stations stations <- userdata$appdata$getStations()
stations <- subset(stations, id %in% userdata$nearest_station) stations <- subset(stations, id %in% userdata$nearest_station)
if(nrow(stations) > 0){ if(nrow(stations) > 0){
vb <- valueBox(stations$label, caption = "Dichtste officieel meetstation") txt <- stations$label
txt <- strsplit(txt, "-")[[1]]
txt <- trimws(txt)
txt <- HTML(paste(txt, collapse = "<br>"))
vb <- valueBox(txt, caption = "Dichtste officieel meetstation")
}else{ }else{
vb <- NULL vb <- NULL
} }
...@@ -111,7 +116,7 @@ eventReactive(input$uiInput_showdata, { ...@@ -111,7 +116,7 @@ eventReactive(input$uiInput_showdata, {
```{r} ```{r}
renderText({ renderText({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
userdata$data$polluenten userdata$appdata$getCitizenData("phenomena")
}) })
``` ```
...@@ -120,7 +125,7 @@ renderText({ ...@@ -120,7 +125,7 @@ renderText({
```{r} ```{r}
renderTable({ renderTable({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
x <- as.data.table(userdata$data$phenomena) x <- as.data.table(userdata$appdata$getCitizenData("timeseries"))
if(nrow(x) > 0){ if(nrow(x) > 0){
x <- x[, list(start = as.character(min(date, na.rm=TRUE)), x <- x[, list(start = as.character(min(date, na.rm=TRUE)),
stop = as.character(max(date, na.rm=TRUE)))] stop = as.character(max(date, na.rm=TRUE)))]
...@@ -137,14 +142,14 @@ renderTable({ ...@@ -137,14 +142,14 @@ renderTable({
```{r} ```{r}
renderTable({ renderTable({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
x <- as.data.table(userdata$data$phenomena) x <- as.data.table(userdata$appdata$getCitizenData("timeseries"))
if(nrow(x) > 0){ if(nrow(x) > 0){
x <- x[, meetfrequentie := as.numeric(difftime(time, shift(time, type = "lag", n = 1L), units = "mins")), by = list(sheet_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[, list(n = .N), by = list(sheet_id, meetfrequentie)]
x <- x[, pct := round(100 * n / sum(n), 1), by = list(sheet_id)] x <- x[, pct := round(100 * n / sum(n), 1), by = list(sheet_id)]
x <- subset(x, !is.na(meetfrequentie)) x <- subset(x, !is.na(meetfrequentie))
x <- x[order(n, decreasing=TRUE), ] x <- x[order(n, decreasing=TRUE), ]
x <- merge(x, userdata$data$meta, by = "sheet_id") x <- merge(x, userdata$appdata$getCitizenData("meta"), by = "sheet_id")
x <- as.data.frame(x) x <- as.data.frame(x)
x <- x[!duplicated(x$sheet_id), c("sheet_id", "device", "meetfrequentie")] x <- x[!duplicated(x$sheet_id), c("sheet_id", "device", "meetfrequentie")]
x$meetfrequentie <- sprintf("elke %s minuten", round(x$meetfrequentie, 2)) x$meetfrequentie <- sprintf("elke %s minuten", round(x$meetfrequentie, 2))
...@@ -154,9 +159,3 @@ renderTable({ ...@@ -154,9 +159,3 @@ renderTable({
x x
}) })
``` ```
## Sidebar {.sidebar} ## Sidebar {.sidebar}
#### Selectiecriteria #### Vergelijkingsbasis
```{r} ```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient") 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"),
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} ```{r}
radioButtons(inputId = "uiInput_periode", label = "Vergelijk op basis van", actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient")
choices = c("Per minuut" = "minute", "Per uur" = "hour", "Per dag" = "day", "Per maand" = "month"),
selected = "day")
dateRangeInput(inputId = "uiInput_period", label = "Verander de periode", start = Sys.Date()-365, end = Sys.Date())
actionButton(inputId = "uiInput_refresh", label = "Herbereken")
``` ```
## Verken je metingen {.tabset} ## Verken je metingen {.tabset}
### Verken je metingen ### Verken je metingen
...@@ -22,23 +27,48 @@ actionButton(inputId = "uiInput_refresh", label = "Herbereken") ...@@ -22,23 +27,48 @@ actionButton(inputId = "uiInput_refresh", label = "Herbereken")
```{r} ```{r}
fillCol( fillCol(
tags$div("Hieronder tonen we een overzicht van jouw meting en de dichtstbijzijnde VMM-meetplaats in 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 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."), uur, per dag enz. Als je een goed zicht hebt op je data, ga dan naar de volgende stap."),
dygraphOutput("uiOutput_timeseries"), dygraphOutput("uiOutput_timeseries"),
flex = c(NA, 1) flex = c(NA, 1)
) )
output$uiOutput_timeseries <- renderDygraph({ output$uiOutput_timeseries <- renderDygraph({
x <- dashinput$appdata$fetch_timeseries("1030") userdata <- citizenair_userdata()
x <- setDT(x) x <- userdata$appdata$getCitizenData("timeseries")
ts <- dcast.data.table(data = x, formula = time ~ phenomena_label, fun.aggregate = mean, value.var = "value") if(nrow(x) > 0){
ts <- setDF(ts) x <- setDT(x)
g <- xts(ts[, -1], order.by=ts[,1]) x$phenomena_label <- paste("Sheet ", x$sheet_id, ": ", x$phenomena, sep = "")
g <- dygraph(g, main = "Tijdreeks van 1030 - Under construction") ts <- dcast.data.table(data = x, formula = time ~ phenomena_label, fun.aggregate = mean, value.var = "value")
g <- dyRangeSelector(g, height = 20) ts <- setDF(ts)
g 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
})
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
}
})
})
``` ```
...@@ -49,8 +79,7 @@ g ...@@ -49,8 +79,7 @@ g
```{r} ```{r}
leafletOutput("uiOutput_select_station", width = "100%", height = 400) leafletOutput("uiOutput_select_station", width = "100%", height = 400)
output$uiOutput_select_station <- renderLeaflet({ output$uiOutput_select_station <- renderLeaflet({
ca <- dashinput$appdata stations <- APPDATA$getStations()
stations <- ca$getStations()
map <- leaflet(data = stations) map <- leaflet(data = stations)
map <- addTiles(map) map <- addTiles(map)
map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3, map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3,
...@@ -137,17 +166,25 @@ output$summaryRaw <- renderTable({reactive[["summaryRaw"]]}) ...@@ -137,17 +166,25 @@ output$summaryRaw <- renderTable({reactive[["summaryRaw"]]})
output$summaryValid <- renderTable({reactive[["summaryValid"]]}) output$summaryValid <- renderTable({reactive[["summaryValid"]]})
``` ```
## Inputs {data-width=150} ## Inputs {data-width=150}
###
###
```{r} ```{r}
renderValueBox({ renderValueBox({
input$uiOutput_select_station_marker_click
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
stations <- userdata$stations userdata$nearest_station <- userdata$appdata$getComparisonStation()
stations <- userdata$appdata$getStations()
stations <- subset(stations, id %in% userdata$nearest_station) stations <- subset(stations, id %in% userdata$nearest_station)
if(nrow(stations) > 0){ if(nrow(stations) > 0){
ui <- valueBox(stations$label, caption = "Vergelijk met officieel meetstation") txt <- stations$label
txt <- strsplit(txt, "-")[[1]]
txt <- trimws(txt)
txt <- HTML(paste(txt, collapse = "<br>"))
ui <- valueBox(txt, caption = "Vergelijk met officieel meetstation")
}else{ }else{
ui <- NULL ui <- NULL
} }
...@@ -155,11 +192,13 @@ renderValueBox({ ...@@ -155,11 +192,13 @@ renderValueBox({
}) })
``` ```
### ###
```{r} ```{r}
renderValueBox({ renderValueBox({
filename <- citizenair_userdata()$name userdata <- citizenair_userdata()
filename <- userdata$appdata$getCitizenData("fileinfo")$name
if(length(filename) > 0){ if(length(filename) > 0){
ui <- valueBox("Uw excel file", caption = citizenair_userdata()$name) ui <- valueBox("Uw excel file", caption = citizenair_userdata()$name)
}else{ }else{
...@@ -174,10 +213,9 @@ renderValueBox({ ...@@ -174,10 +213,9 @@ renderValueBox({
```{r} ```{r}
renderUI({ renderUI({
userdata <- citizenair_userdata() userdata <- citizenair_userdata()
x <- userdata$data$meta x <- userdata$appdata$getCitizenData("meta")
if(is.data.frame(x) && nrow(x) > 0){ if(is.data.frame(x) && nrow(x) > 0){
choices <- as.list(x$sheet_id) choices <- structure(as.list(x$sheet_id), .Names = x$sheet)
names(choices) <- x$sheet
ui <- selectInput(inputId = "uiInput_sheet", label = "Selecteer sheet", choices = choices, selected = choices, multiple = TRUE) ui <- selectInput(inputId = "uiInput_sheet", label = "Selecteer sheet", choices = choices, selected = choices, multiple = TRUE)
}else{ }else{
ui <- NULL ui <- NULL
...@@ -185,11 +223,3 @@ renderUI({ ...@@ -185,11 +223,3 @@ renderUI({
ui ui
}) })
``` ```
###
```{r}
renderPrint({
input$uiOutput_select_station_marker_mouseover
})
```
\ No newline at end of file
...@@ -19,6 +19,8 @@ CitizenAir app data ...@@ -19,6 +19,8 @@ CitizenAir app data
\item{\code{stations}}{object of class \code{citizenair_stations} as returned by \code{\link{read_stations}}} \item{\code{stations}}{object of class \code{citizenair_stations} as returned by \code{\link{read_stations}}}
\item{\code{data}}{object of class \code{citizenair_userdata} as returned by \code{\link{read_citizenair}}} \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.}
}} }}
\section{Methods}{ \section{Methods}{
...@@ -26,6 +28,7 @@ CitizenAir app data ...@@ -26,6 +28,7 @@ CitizenAir app data
\describe{ \describe{
\item{\code{fetch_timeseries(id = "123", time_span)}}{Get timeseries for Station with \code{id} and a certain time_span The argument \code{timespan.} Passed on to \code{sensorweb4R::getData}} \item{\code{fetch_timeseries(id = "123", time_span)}}{Get timeseries for Station with \code{id} and a certain time_span The argument \code{timespan.} Passed on to \code{sensorweb4R::getData}}
\item{\code{getStations()}}{Get a SpatialPointsDataFrame of all stations} \item{\code{getStations()}}{Get a SpatialPointsDataFrame of all stations}
\item{TODO}{TODO}
} }
} }
...@@ -34,12 +37,19 @@ library(sensorweb4R) ...@@ -34,12 +37,19 @@ library(sensorweb4R)
e <- as.Endpoint("http://geo.irceline.be/sos/api/v1") e <- as.Endpoint("http://geo.irceline.be/sos/api/v1")
ca <- CitizenAir$new(e) ca <- CitizenAir$new(e)
ca ca
library(BelgiumMaps.StatBel)
data("BE_ADMIN_REGION", package = "BelgiumMaps.StatBel")
vlaanderen <- subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL \%in\% "Vlaams Gewest")
ca <- CitizenAir$new(e, stations_area = vlaanderen)
ca
ca$getPhenomena() ca$getPhenomena()
ca$getPhenomenaLabel("20")
## get stations ## get stations
library(sp) library(sp)
x <- ca$getStations() x <- ca$getStations()
plot(x) plot(x)
plot(ca$getStationsArea())
## get official measurements ## get official measurements
library(lubridate) library(lubridate)
...@@ -49,5 +59,14 @@ x <- ca$fetch_timeseries(id = "1030", time_span = period) ...@@ -49,5 +59,14 @@ x <- ca$fetch_timeseries(id = "1030", time_span = period)
## set citizen measurements ## set citizen measurements
filename <- system.file(package = "citizenair", "data-raw", "citizenair-example.xls") filename <- system.file(package = "citizenair", "data-raw", "citizenair-example.xls")
ca$setCitizenData(filename) ca$setCitizenData(filename)
x <- ca$getCitizenData("meta")
x <- ca$getCitizenData("timeseries")
x <- ca$getCitizenData("phenomena")
x <- ca$getCitizenData("fileinfo")
ca$getClosestStation()
id <- ca$getClosestStation()
ca$setComparisonStation(id)
x <- ca$fetch_timeseries(id)
x <- ca$fetch_timeseries()
} }
\keyword{datasets} \keyword{datasets}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{error_message}
\alias{error_message}
\alias{error_message.default}
\title{Get the error message of a try-error object}
\usage{
error_message(x, ...)
\method{error_message}{default}(x, ...)
}
\arguments{
\item{x}{an object}
\item{...}{not used}
}
\value{
a character string with the error message or an empty character string
}
\description{
Get the error message of a try-error object
}
\section{Methods (by class)}{
\itemize{
\item \code{default}: Default functionality
}}
\examples{
x <- try(log("a"))
error_message(x)
x <- try(log(10))
error_message(x)
}
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