Skip to content

citizenair
citizenair
Commit 3b0e41b0 by Jan Wijffels
Options

Aggregate implementation + selection of sheets + phenomena

parent dcb938bf
Showing with 147 additions and 33 deletions
citizenair/NAMESPACE
......@@ -16,6 +16,7 @@ importFrom(data.table,as.data.table)
importFrom(data.table,data.table)
importFrom(data.table,melt.data.table)
importFrom(data.table,rbindlist)
importFrom(data.table,setDT)
importFrom(data.table,setnames)
importFrom(fasttime,fastPOSIXct)
importFrom(httr,GET)
......
citizenair/R/appdata.R
......@@ -66,6 +66,7 @@ citizenair_userdata_empty <- function(){
#' x <- ca$getCitizenData("timeseries")
#' x <- ca$getCitizenData("phenomena")
#' x <- ca$getCitizenData("fileinfo")
#' x <- ca$getPhenomena("citizen")
#' ca$getClosestStation()
#' id <- ca$getClosestStation()
#' ca$setComparisonStation(id)
......@@ -93,7 +94,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
self$closest_station <- NA_character_
},
setCitizenData = function(file, name=basename(file)){
x <- read_citizenair(file)
x <- read_citizenair(file, name = name)
self$setComparisonStation()
self$data <- x
},
......@@ -108,6 +109,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
}else{
self$timeseries <- data
}
self$timeseries <- setkeyv(self$timeseries, cols = c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena"))
},
fetch_timeseries = function(id = self$getComparisonStation(), time_span=NULL) {
if(length(id) == 0){
......@@ -149,8 +151,25 @@ CitizenAir <- R6::R6Class("CitizenAir",
result[[i]] <- df[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
}
result <- rbindlist(result)
result <- setDT(result)
result
},
recode_phenomena = function(x){
x <- as.character(x)
from <- unique(x)
from_cleaned <- trimws(tolower(from))
## ONLY PM-10/PM-2.5/PM1 and Temperature are covered in this setup
idx <- which(from_cleaned %in% c("pm10", "pm2.5", "pm1", "t"))
to <- from
if(length(idx) > 0){
to[idx] <- txt_recode(from_cleaned[idx],
from = c("pm10", "pm2.5", "pm1", "t"),
to = c("5", "6001", "6002", "62101"))
}
txt_recode(x,
from = from,
to = to)
},
getStations = function(){
x <- as.data.frame(self$stations$stations)
x <- sp::SpatialPointsDataFrame(coords = x[, c("lon", "lat")],
......@@ -160,11 +179,17 @@ CitizenAir <- R6::R6Class("CitizenAir",
getStationsArea = function(){
private$stations_area
},
getPhenomena = function(){
self$stations$phenomena$id
getPhenomena = function(type = c("official", "citizen")){
type <- match.arg(type)
if(type == "official"){
self$stations$phenomena$id
}else if(type == "citizen"){
ts <- self$getCitizenData("timeseries")
sort(unique(ts$phenomena_id))
}
},
getPhenomenaLabel = function(id){
stopifnot(all(id %in% self$stations$phenomena$id))
#stopifnot(all(id %in% self$stations$phenomena$id))
txt_recode(id, from = self$stations$phenomena$id, to = self$stations$phenomena$label)
},
getComparisonStation = function(){
......@@ -182,8 +207,33 @@ CitizenAir <- R6::R6Class("CitizenAir",
}
station
},
getCombinedTimeseries = function(){
self$timeseries
getCombinedTimeseries = function(data = self$timeseries, type = c("rawdata", "minute", "hour", "day", "week", "month"), limit = FALSE){
type <- match.arg(type)
x <- data
x <- setDT(x)
if(type == "minute"){
x <- x[, list(value = mean(value, na.rm=TRUE)),
by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = fasttime::fastPOSIXct(format(time, "%Y-%m-%d %H:%M"), tz = "UTC"))]
}else if(type == "hour"){
x <- x[, list(value = mean(value, na.rm=TRUE)),
by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = fasttime::fastPOSIXct(format(time, "%Y-%m-%d %H"), tz = "UTC"))]
}else if(type == "day"){
x <- x[, list(value = mean(value, na.rm=TRUE)),
by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = date)]
}else if(type == "week"){
x <- x[, list(value = mean(value, na.rm=TRUE)),
by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = mondayofweek(date))]
}else if(type == "month"){
x <- x[, list(value = mean(value, na.rm=TRUE)),
by = list(type, timeseries_id, timeseries_label, phenomena_id, phenomena, time = startofmonth(date))]
}
if(limit){
citizen_timepoints <- x$time[x$type %in% "citizen"]
if(length(citizen_timepoints) > 0){
x <- x[as.Date(x$time) >= (as.Date(min(citizen_timepoints))) & as.Date(x$time) <= (as.Date(max(citizen_timepoints))), ]
}
}
x
},
getCitizenData = function(type = c("meta", "timeseries", "phenomena", "fileinfo")){
type <- match.arg(type)
......@@ -204,10 +254,16 @@ CitizenAir <- R6::R6Class("CitizenAir",
}
x$type <- rep("citizen", nrow(x))
x$phenomena_id <- rep(NA_character_, nrow(x))
x$phenomena_id <- self$recode_phenomena(x$phenomena)
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)
if(nrow(x) > 0){
x$timeseries_label <- txt_recode(x$sheet_id, from = sheetinfo$sheet_id, to = sheetinfo$sheet)
}else{
x$timeseries_label <- character()
}
x <- x[, c("type", "timeseries_id", "timeseries_label", "phenomena_id", "phenomena", "time", "date", "value")]
x <- setDT(x)
}else if(type == "phenomena"){
if(is.na(self$data$filename)){
x <- character()
......@@ -230,7 +286,7 @@ CitizenAir <- R6::R6Class("CitizenAir",
d <- sp::spDistsN1(stations, x, longlat = TRUE)
stations[which.min(d), ]
},
default_timeseries = data.frame(type = character(),
default_timeseries = data.table(type = character(),
timeseries_id = character(), timeseries_label = character(),
phenomena_id = character(), phenomena = character(),
time = as.POSIXct(character()), date = as.Date(character(), tz = "UTC"),
......
citizenair/R/pkg.R
......@@ -2,7 +2,7 @@
#' @importFrom cellranger cell_rows cell_cols cell_limits
#' @importFrom utils head tail capture.output
#' @importFrom tools file_path_sans_ext
#' @importFrom data.table rbindlist melt.data.table setnames as.data.table data.table
#' @importFrom data.table rbindlist melt.data.table setnames as.data.table data.table setDT
#' @importFrom fasttime fastPOSIXct
#' @importFrom rmarkdown run
#' @importFrom sensorweb4R resourceURL id label as.Endpoint fetch timeseries phenomenon as.Timeseries getData time lastValue firstValue Station
......
citizenair/R/read-stations.R
......@@ -52,6 +52,7 @@ read_stations <- function(x = sensorweb4R::as.Endpoint("http://geo.irceline.be/s
stat$timeseries <- lapply(sta, FUN=function(x) x$timeseries)
result <- list()
result$phenomena <- phe
result$phenomena$label <- iconv(result$phenomena$label, from = "UTF-8", to = "LATIN1")
result$stations <- stat
class(result) <- "citizenair_stations"
result
......
citizenair/R/utils.R
......@@ -36,4 +36,21 @@ txt_recode <- function (x, from = c(), to = c()) {
to <- append(x = to, values = nongiven)
}
to[match(x, from)]
}
\ No newline at end of file
}
sundayofweek <- function(x){
xweekday <- as.integer(format(x, "%w"))
idx <- which(xweekday != 0)
x[idx] <- x[idx] + (7 - xweekday[idx])
x
}
mondayofweek <- function(x){
sundayofweek(x) - 6
}
startofmonth <- function(x){
x - as.integer(format(x, "%d")) + 1
}
citizenair/data/ca.RData
No preview for this file type
citizenair/inst/apps/citizenair/page02-exploratory.Rmd
## Sidebar {.sidebar}
```{r}
plot_timeseries <- function(x){
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")
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 <- dygraph(g, ...)
g <- dyRangeSelector(g, height = 20)
g <- dyLegend(g, show = "always")
g
......@@ -16,35 +21,63 @@ plot_timeseries <- function(x){
}
g
}
# isolate({
# input$uiInput_aggregationlevel
# input$uiInput_sheet
# input$uiInput_period
# input$uiOutput_select_station_marker_click
# })
```
#### Vergelijk met ...
#### Officieel meetstation
```{r}
actionBttn(inputId = "uiInput_selectstation", label = "Vergelijk met ander officieel station", style = "gradient")
actionBttn(inputId = "uiInput_selectstation", label = "Haal data op van officieel station", style = "gradient")
```
#### Vergelijkingsbasis
```{r}
inputPanel(
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")
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)
}else{
ui <- NULL
}
ui
}),
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 grafiek")
)
```
```{r}
## MAIN REACTIVE WHICH COMBINES CITIZEN DATA + OFFICIAL DATA
observeEvent(input$uiInput_refresh, {
showNotification("Herberekening wordt uitgevoerd")
input$uiInput_phenomena
input$uiInput_aggregationlevel
input$uiInput_sheet
input$uiInput_period
#input$uiOutput_select_station_marker_click
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 <- APPDATA$getCombinedTimeseries(x, type = input$uiInput_aggregationlevel, limit = TRUE)
output$uiOutput_timeseries <- renderDygraph(
plot_timeseries(x))
})
```
```{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")
......@@ -67,10 +100,17 @@ observeEvent(input$uiInput_refresh, {
result$data$official <- official
result$data <- rbindlist(result$data, use.names = TRUE)
APPDATA$setCombinedTimeseries(result$data)
output$uiOutput_timeseries <- renderDygraph(plot_timeseries(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}
......@@ -88,12 +128,12 @@ output$uiOutput_timeseries <- renderDygraph({
## Default call when user only uploaded his own data
userdata <- citizenair_userdata()
x <- userdata$appdata$getCombinedTimeseries()
plot_timeseries(x)
plot_timeseries(x, main = "De tijdreeks van al uw meetgegevens")
})
```
### Selecteer een officieel meetstation om te vergelijken
### Selecteer een ander officieel meetstation om te vergelijken
```{r}
......@@ -213,7 +253,6 @@ renderValueBox({
})
```
###
```{r}
......@@ -221,7 +260,7 @@ renderValueBox({
userdata <- citizenair_userdata()
filename <- userdata$appdata$getCitizenData("fileinfo")$name
if(length(filename) > 0){
ui <- valueBox("Uw excel file", caption = citizenair_userdata()$name)
ui <- valueBox("Uw excel file", caption = filename)
}else{
ui <- NULL
}
......
citizenair/man/CitizenAir.Rd
......@@ -65,6 +65,7 @@ x <- ca$getCitizenData("meta")
x <- ca$getCitizenData("timeseries")
x <- ca$getCitizenData("phenomena")
x <- ca$getCitizenData("fileinfo")
x <- ca$getPhenomena("citizen")
ca$getClosestStation()
id <- ca$getClosestStation()
ca$setComparisonStation(id)
......
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