Skip to content

citizenair
citizenair
Commit 9e9272cf by Jan Wijffels
Options

Change comparison graphs to functionality from the citizenair package

parent 705d8345
Showing with 154 additions and 108 deletions
citizenair/R/comparisons.R
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
#' Defaults to 'citizen' #' Defaults to 'citizen'
#' @return an object of class \code{citizenair_comparison_ircel} which is a list with elements #' @return an object of class \code{citizenair_comparison_ircel} which is a list with elements
#' \enumerate{ #' \enumerate{
#' \item{valid: logical indicating if we have enough data to do the regression}
#' \item{data: the data containing columns time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e} #' \item{data: the data containing columns time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e}
#' \item{model: an object of class lm represendint the model SENSOR ~ REF} #' \item{model: an object of class lm represendint the model SENSOR ~ REF}
#' \item{overview: a data.frame with columns statistic, time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e with the #' \item{overview: a data.frame with columns statistic, time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e with the
...@@ -20,6 +21,18 @@ ...@@ -20,6 +21,18 @@
#' value = rnorm(365*2)) #' value = rnorm(365*2))
#' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen") #' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
#' plot(comparison) #' plot(comparison)
#'
#' x <- data.frame(
#' time = rep(seq.POSIXt(from = Sys.time()-364, to = Sys.time(), by = "sec"), 2),
#' group = sample(c("official", "citizen"), size = 365*2, replace = TRUE),
#' value = rnorm(365*2))
#' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
#'
#' x <- data.frame(
#' time = as.Date(character()),
#' group = character(),
#' value = numeric())
#' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
citizenair_compare <- function(x, reference = "official", sensor = "citizen"){ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){
# r cmd check happiness # r cmd check happiness
.SD <- OLSQ <- REF <- SENSOR <- lower_CI <- lower_PI <- upper_CI <- upper_PI <- NULL .SD <- OLSQ <- REF <- SENSOR <- lower_CI <- lower_PI <- upper_CI <- upper_PI <- NULL
...@@ -32,11 +45,49 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){ ...@@ -32,11 +45,49 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){
x$group <- txt_recode(x$group, from = c(reference, sensor), to = c("REF", "SENSOR")) x$group <- txt_recode(x$group, from = c(reference, sensor), to = c("REF", "SENSOR"))
x <- data.table::setDT(x) x <- data.table::setDT(x)
mydata <- data.table::dcast.data.table(data = x, formula = time ~ group, overview_statistics <- function(x){
fun.aggregate = mean, na.rm=TRUE, overview <- data.table::as.data.table(x)
value.var = "value") overview <- overview[, lapply(.SD, FUN=function(x){
mydata <- data.table::setDF(mydata) summarystats <- summary(x)
if(inherits(x, c("Date", "POSIXct", "POSIXlt"))){
summarystats <- as.character(summarystats)
}
list("min" = summarystats[["Min."]],
"25th Perc" = summarystats[["1st Qu."]],
"median" = summarystats[["Median"]],
"mean" = summarystats[["Mean"]],
"75th Perc" = summarystats[["3rd Qu."]],
"max" = summarystats[["Max."]],
"\u0023 Valid" = sum(!is.na(x)),
"\u0023 NA" = sum(is.na(x))
)
}), .SDcols = colnames(mydata)]
overview <- data.table::setDF(overview)
overview[["statistic"]] <- c("min", "25th Perc", "median", "mean", "75th Perc", "max", "\u0023 Valid", "\u0023 NA's")
overview <- overview[, c("statistic", setdiff(colnames(overview), "statistic"))]
overview
}
if(nrow(x) == 0){
mydata <- data.frame(time = as.Date(character()), SENSOR = numeric(), REF = numeric(),
OLSQ = numeric(),
lower_CI = numeric(),
upper_CI = numeric(),
lower_PI = numeric(),
upper_PI = numeric(),
stringsAsFactors = FALSE)
result <- list(valid = FALSE,
data = mydata,
overview = overview_statistics(mydata),
model = NULL)
class(result) <- "citizenair_comparison_ircel"
return(result)
}else{
mydata <- data.table::dcast.data.table(data = x, formula = time ~ group,
fun.aggregate = mean, na.rm=TRUE,
value.var = "value")
mydata <- data.table::setDF(mydata)
}
linear_model <- lm(SENSOR ~ REF, data = mydata) linear_model <- lm(SENSOR ~ REF, data = mydata)
PI <- predict(linear_model, interval = "predict", level = 0.95, newdata = mydata, na.action = na.pass) PI <- predict(linear_model, interval = "predict", level = 0.95, newdata = mydata, na.action = na.pass)
PI <- as.data.frame(PI) PI <- as.data.frame(PI)
...@@ -49,35 +100,12 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){ ...@@ -49,35 +100,12 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){
mydata[["upper_CI"]] <- CI[["upper CI"]] mydata[["upper_CI"]] <- CI[["upper CI"]]
mydata[["lower_PI"]] <- PI[["lower PI"]] mydata[["lower_PI"]] <- PI[["lower PI"]]
mydata[["upper_PI"]] <- PI[["upper PI"]] mydata[["upper_PI"]] <- PI[["upper PI"]]
mydata$OLSQ <- CI$OLSQ
mydata$OLSQ <- CI$OLSQ
mydata$OLSQ <- CI$OLSQ
mydata$OLSQ <- CI$OLSQ
mydata$OLSQ <- CI$OLSQ
mydata$e <- mydata$OLSQ - mydata$SENSOR mydata$e <- mydata$OLSQ - mydata$SENSOR
mydata <- mydata[order(mydata$time, decreasing = FALSE), ] mydata <- mydata[order(mydata$time, decreasing = FALSE), ]
overview <- overview_statistics(mydata)
overview <- data.table::as.data.table(mydata) result <- list(valid = TRUE,
overview <- overview[, lapply(.SD, FUN=function(x){ data = mydata,
summarystats <- summary(x)
if(inherits(x, c("Date", "POSIXct", "POSIXlt"))){
summarystats <- as.character(summarystats)
}
list("min" = summarystats[["Min."]],
"25th Perc" = summarystats[["1st Qu."]],
"median" = summarystats[["Median"]],
"mean" = summarystats[["Mean"]],
"75th Perc" = summarystats[["3rd Qu."]],
"max" = summarystats[["Max."]],
"\u0023 Valid" = sum(!is.na(x)),
"\u0023 NA" = sum(is.na(x))
)
}), .SDcols = colnames(mydata)]
overview <- data.table::setDF(overview)
overview[["statistic"]] <- c("min", "25th Perc", "median", "mean", "75th Perc", "max", "\u0023 Valid", "\u0023 NA's")
overview <- overview[, c("statistic", setdiff(colnames(overview), "statistic"))]
result <- list(data = mydata,
overview = overview, overview = overview,
model = linear_model) model = linear_model)
class(result) <- "citizenair_comparison_ircel" class(result) <- "citizenair_comparison_ircel"
...@@ -97,26 +125,37 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){ ...@@ -97,26 +125,37 @@ citizenair_compare <- function(x, reference = "official", sensor = "citizen"){
#' value = rnorm(365*2)) #' value = rnorm(365*2))
#' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen") #' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
#' plot(comparison) #' plot(comparison)
#'
#' x <- data.frame(
#' time = as.Date(character()),
#' group = character(),
#' value = numeric())
#' comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
#' plot(comparison)
plot.citizenair_comparison_ircel <- function(x, ...){ plot.citizenair_comparison_ircel <- function(x, ...){
OLSQ <- REF <- SENSOR <- lower_CI <- lower_PI <- upper_CI <- upper_PI <- NULL OLSQ <- REF <- SENSOR <- lower_CI <- lower_PI <- upper_CI <- upper_PI <- NULL
linear_model <- x$model linear_model <- x$model
mydata <- x$data mydata <- x$data
plot_PI_CI <- ggplot2::ggplot(data = mydata, ggplot2::aes(x = REF, y = SENSOR)) + if(!x$valid){
ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_CI, ymax=upper_CI, fill = "CI"), alpha = 0.6) + plot_PI_CI <- ggplot2::ggplot(data = mydata)
ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_PI, ymax=upper_PI, fill = "PI"), alpha = 0.4) + }else{
ggplot2::geom_point() + plot_PI_CI <- ggplot2::ggplot(data = mydata, ggplot2::aes(x = REF, y = SENSOR)) +
ggplot2::geom_line(ggplot2::aes(y = OLSQ,col = "OLSQ")) + ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_CI, ymax=upper_CI, fill = "CI"), alpha = 0.6) +
ggplot2::geom_line(ggplot2::aes(y = REF,col = "y=x")) + ggplot2::geom_ribbon(ggplot2::aes(ymin = lower_PI, ymax=upper_PI, fill = "PI"), alpha = 0.4) +
ggplot2::labs(title = paste("Scatterplot with regression estimates: intercept =", ggplot2::geom_point() +
format(summary(linear_model)$coefficients[1,1], digits = 3), ggplot2::geom_line(ggplot2::aes(y = OLSQ,col = "OLSQ")) +
", slope =",format(summary(linear_model)$coefficients[2,1], digits = 3), ggplot2::geom_line(ggplot2::aes(y = REF,col = "y=x")) +
", R\u00B2 =",format(summary(linear_model)$r.squared, digits = 3)), ggplot2::labs(title = paste("Scatterplot with regression estimates: intercept =",
x = "Reference value", format(summary(linear_model)$coefficients[1,1], digits = 3),
y = "Sensor") + ", slope =",format(summary(linear_model)$coefficients[2,1], digits = 3),
ggplot2::scale_fill_manual(name="",values=c("CI"="blue", ", R\u00B2 =",format(summary(linear_model)$r.squared, digits = 3)),
"PI"= "grey")) + x = "Reference value",
ggplot2::scale_colour_manual(name="", values = c("y=x"="red", y = "Sensor") +
"OLSQ"="black")) ggplot2::scale_fill_manual(name="",values=c("CI"="blue",
"PI"= "grey")) +
ggplot2::scale_colour_manual(name="", values = c("y=x"="red",
"OLSQ"="black"))
}
plot_PI_CI plot_PI_CI
} }
......
citizenair/inst/apps/citizenair/page02-exploratory.Rmd
...@@ -161,6 +161,7 @@ reactive({ ...@@ -161,6 +161,7 @@ reactive({
input$uiInput_aggregationlevel input$uiInput_aggregationlevel
input$uiInput_sheet input$uiInput_sheet
input$uiInput_period input$uiInput_period
input$uiInput_dayofweek
#showNotification("Herberekening wordt uitgevoerd") #showNotification("Herberekening wordt uitgevoerd")
#input$uiInput_phenomena #input$uiInput_phenomena
...@@ -172,69 +173,54 @@ reactive({ ...@@ -172,69 +173,54 @@ reactive({
x <- subset(x, type %in% "official" | (type %in% "citizen" & timeseries_id %in% input$uiInput_sheet)) 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 <- 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])), ]
if(input$uiInput_dayofweek %in% c("weekdays", "weekend")){
if(input$uiInput_dayofweek %in% "weekdays"){
x <- x[format(as.Date(x$time), "%u") %in% c(1, 2, 3, 4, 5), ]
}else if(input$uiInput_dayofweek %in% "weekend"){
x <- x[format(as.Date(x$time), "%u") %in% c(6, 7), ]
}
}
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))
try({ comparison_phenomena <- head(input$uiInput_phenomena, 1)
mydata <- subset(x, phenomena_id %in% head(input$uiInput_phenomena, 1)) mydata <- subset(x, phenomena_id %in% comparison_phenomena)
if(all(c("citizen", "official") %in% mydata$type) & input$uiInput_aggregationlevel %in% c("min", "hour", "day", "week", "month")){ comparison_phenomena <- APPDATA$getPhenomenaLabel(comparison_phenomena)
## DATE/REF/SENSOR if(input$uiInput_aggregationlevel %in% c("min", "hour", "day", "week", "month") && nrow(mydata) > 0 && all(c("citizen", "official") %in% mydata$type)){
mydata <- x mydata <- data.frame(time = mydata$time,
mydata$group <- ifelse(mydata$type %in% "official", "REF", "SENSOR") group = ifelse(mydata$type %in% "citizen", "SENSOR", ifelse(mydata$type %in% "official", "REFERENCE", NA)),
mydata$date <- mydata$time value = mydata$value,
mydata <- dcast.data.table(data = mydata, formula = date ~ group, fun.aggregate = mean, na.rm=TRUE, value.var = "value") stringsAsFactors = FALSE)
#mydata <- data.frame(date = as.POSIXct(seq.Date(Sys.Date(), Sys.Date()-999, by = "-1 day"), tz = "UTC"), comparison <- try(citizenair_compare(x = mydata, reference = "REFERENCE", sensor = "SENSOR"))
# REF = rnorm(1000), if(inherits(comparison, "try-error")){
# SENSOR = rnorm(1000)) showNotification(sprintf("Er loopt iets fout bij de vergelijking %s", error_message(comparison)),
linear_model <- lm(mydata$SENSOR ~ mydata$REF) type = "error", duration = 15)
PI <- data.frame(predict(linear_model, interval="predict", level = 0.95)) output$data <- renderTable(NULL)
colnames(PI) <- c("OLSQ", "lower PI", "upper PI") output$summaryRaw <- renderTable(NULL)
CI <- data.frame(predict(linear_model, interval="confidence", level = 0.95)) output$uiOutput_comparison <- renderPlot(NULL)
colnames(CI) <- c("OLSQ", "lower CI", "upper CI") output$uiOutput_comparison_measurement <- renderUI(tags$h4("We analyseren hier uw meting van ", comparison_phenomena, " ... probleem met de regressie"))
mydata <- cbind(mydata, "OLSQ" = CI$OLSQ, }else{
"lower_CI" = CI$`lower CI`, output$uiOutput_comparison_measurement <- renderUI(tags$h4("We analyseren hier uw meting van ", comparison_phenomena))
"upper_CI"=CI$`upper CI`, output$data <- renderTable({
"lower_PI" = PI$`lower PI`, comparison$data <- data.table::setnames(comparison$data, old = "time", new = "date")
"upper_PI" = PI$`upper PI`) mydata <- timeAverage(comparison$data,
mydata$e <- mydata$OLSQ - mydata$SENSOR avg.time=input$uiInput_aggregationlevel, data.thresh = 85, statistic = "mean")
mydata <- mydata[order(mydata[,1]), ] mydata$date <- as.character(as.POSIXct(mydata$date, origin = "1970-01-01"))
summary <- data.frame(do.call(cbind, lapply(mydata, summary)))[-7,] mydata
summary$date <- as.character(as.POSIXct(summary$date, origin="1970-01-01")) })
summary <- rbind(summary,"# Valid"=colSums(!is.na(mydata))) output$summaryRaw <- renderTable(comparison$overview)
summary <- rbind(summary,"# NA's"=colSums(is.na(mydata))) output$uiOutput_comparison <- renderPlot(plot(comparison))
variables <- c("min", "25th Perc", "median", "mean","75th Perc", "max","# Valid", "# NA's") }
summary <- cbind("statistiek"=variables,summary) }else{
if(length(comparison_phenomena) > 0){
# outputs of dataframe & summaries output$uiOutput_comparison_measurement <- renderUI(tags$h4("We analyseren hier uw meting van ", comparison_phenomena, " - We hebben geen meting van zowel u als een officieel station. Selecteer een andere meetwaarde die u wilt vergelijken en zorg ervoor dat de vergelijkingsbasis per uur/dag of maand is."))
output$data <- renderTable({ }else{
mydata <- timeAverage(mydata, avg.time=input$uiInput_aggregationlevel, data.thresh=85, statistic="mean") output$uiOutput_comparison_measurement <- renderUI(tags$h4("We hebben geen meting van zowel u als een officieel station. Selecteer een andere meetwaarde die u wilt vergelijken, haal data op van een officieel meetstation en zorg ervoor dat de vergelijkingsbasis per uur/dag of maand is."))
mydata$date <- as.character(as.POSIXct(mydata$date, origin="1970-01-01")) }
mydata output$data <- renderTable(NULL)
}) output$summaryRaw <- renderTable(NULL)
output$summaryRaw <- renderTable(summary) output$uiOutput_comparison <- renderPlot(NULL)
# Scatterplot of linear regression + CI & PI }
output$uiOutput_comparison <- renderPlot({
mydata <- mydata
linear_model <- linear_model
plot_PI_CI <- ggplot(data = mydata, aes(x = REF, y = SENSOR)) +
geom_ribbon(aes(ymin = lower_CI, ymax=upper_CI, fill = "CI"),alpha = 0.6) +
geom_ribbon(aes(ymin = lower_PI, ymax=upper_PI, fill = "PI"), alpha = 0.4) +
geom_point() +
geom_line(aes(y = OLSQ,col = "OLSQ")) +
geom_line(aes(y = REF,col = "y=x")) +
labs(title = paste("Scatterplot with regression estimates: intercept =",
format(summary(linear_model)$coefficients[1,1], digits = 3),
",slope =",format(summary(linear_model)$coefficients[2,1], digits = 3),
",R² =",format(summary(linear_model)$r.squared, digits = 3)),
x = "Reference value",
y = "Sensor") +
scale_fill_manual(name="",values=c("CI"="blue","PI"= "grey")) +
scale_colour_manual(name="", values = c("y=x"="red","OLSQ"="black"))
#plots[["scatter"]] <- plot_PI_CI
plot_PI_CI
})
}
})
}) })
``` ```
...@@ -260,7 +246,8 @@ fillCol( ...@@ -260,7 +246,8 @@ fillCol(
tags$div( tags$div(
tags$h4("De Vlaamse Milieu Maatschappij heeft meetresultaten die aan de strengste kwaliteitseisen voldoen. Hieronder tonen tags$h4("De Vlaamse Milieu Maatschappij heeft meetresultaten die aan de strengste kwaliteitseisen voldoen. Hieronder tonen
we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van jouw. Verander ook de VMM-meetplaats eens, een andere meetplaats komt misschien beter met de jouwe overeen!"), we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van jouw. Verander ook de VMM-meetplaats eens, een andere meetplaats komt misschien beter met de jouwe overeen!"),
tags$h5("Onderstaande grafiek toont alle meetwaardes van uw toestel uitgezet tov alle meetwaardes van een toestel van de Vlaamse Milieu Maatschappij")), tags$h5("Onderstaande grafiek toont alle meetwaardes van uw toestel uitgezet tov alle meetwaardes van een toestel van de Vlaamse Milieu Maatschappij. Uw toestel moet in lijn liggen met een officieel toestel. Dit kunt u zien door te kijken of uw meetpunten op 1 lijn liggen en heel dicht liggen tegen de rode lijn.")),
htmlOutput(outputId = "uiOutput_comparison_measurement"),
fillRow(dropdownButton( fillRow(dropdownButton(
tags$h3("Selectie dagen van de week"), tags$h3("Selectie dagen van de week"),
radioButtons(inputId = "uiInput_dayofweek", label = "Vergelijk op basis van", radioButtons(inputId = "uiInput_dayofweek", label = "Vergelijk op basis van",
...@@ -273,7 +260,7 @@ we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van ...@@ -273,7 +260,7 @@ we een eenvoudige statistische vergelijking tussen onze meetgegevens en die van
plotOutput("uiOutput_comparison", height = "100%"), plotOutput("uiOutput_comparison", height = "100%"),
flex = c(NA, 2) flex = c(NA, 2)
), ),
flex = c(NA, 2) flex = c(NA, NA, 2)
) )
``` ```
......
citizenair/man/citizenair_compare.Rd
...@@ -18,6 +18,7 @@ Defaults to 'citizen'} ...@@ -18,6 +18,7 @@ Defaults to 'citizen'}
\value{ \value{
an object of class \code{citizenair_comparison_ircel} which is a list with elements an object of class \code{citizenair_comparison_ircel} which is a list with elements
\enumerate{ \enumerate{
\item{valid: logical indicating if we have enough data to do the regression}
\item{data: the data containing columns time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e} \item{data: the data containing columns time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e}
\item{model: an object of class lm represendint the model SENSOR ~ REF} \item{model: an object of class lm represendint the model SENSOR ~ REF}
\item{overview: a data.frame with columns statistic, time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e with the \item{overview: a data.frame with columns statistic, time, REF, SENSOR, OLSQ, lower_CI, upper_CI, lower_PI, upper_PI and e with the
...@@ -34,4 +35,16 @@ x <- data.frame( ...@@ -34,4 +35,16 @@ x <- data.frame(
value = rnorm(365*2)) value = rnorm(365*2))
comparison <- citizenair_compare(x, reference = "official", sensor = "citizen") comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
plot(comparison) plot(comparison)
x <- data.frame(
time = rep(seq.POSIXt(from = Sys.time()-364, to = Sys.time(), by = "sec"), 2),
group = sample(c("official", "citizen"), size = 365*2, replace = TRUE),
value = rnorm(365*2))
comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
x <- data.frame(
time = as.Date(character()),
group = character(),
value = numeric())
comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
} }
citizenair/man/plot.citizenair_comparison_ircel.Rd
...@@ -22,4 +22,11 @@ x <- data.frame( ...@@ -22,4 +22,11 @@ x <- data.frame(
value = rnorm(365*2)) value = rnorm(365*2))
comparison <- citizenair_compare(x, reference = "official", sensor = "citizen") comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
plot(comparison) plot(comparison)
x <- data.frame(
time = as.Date(character()),
group = character(),
value = numeric())
comparison <- citizenair_compare(x, reference = "official", sensor = "citizen")
plot(comparison)
} }
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