App now allows to read in Excel files and find closest station to the station in the excel file.

apps/citizenair.Rmd

@@ -18,54 +18,15 @@ library(httr)
 library(readxl)
 library(sp)
 library(leaflet)
-library(magrittr)
 library(BelgiumMaps.StatBel)
 library(rgeos)
+library(citizenair)
+library(DT)
+library(sp)
 data("BE_ADMIN_REGION")
-settings <- list()
-
-read_citizenair <- function(file = file.path(getwd(), "apps/data/test.xls")){
-  fname <- file
-  sheets <- readxl::excel_sheets(fname)
-  read_one_meta <- function(file, sheet){
-    x <- readxl::read_excel(path = file, sheet = sheet, 
-                               range = "A1:B7", 
-                               col_names = c("key", "value"), col_types = "text")
-    x <- x[!is.na(x$key), ]
-    x <- list(device = x$value[grepl(pattern = "meettoestel", x$key, ignore.case = TRUE)],
-                 gps = x$value[grepl(pattern = "meetpunt", x$key, ignore.case = TRUE)])
-    x$latlon <- as.numeric(unlist(strsplit(x$gps, split = ",")))
-    x$lat <- head(x$latlon, 1)
-    x$lon <- tail(x$latlon, 1)
-    x[c("device", "lat", "lon")]
-    x
-  }
-  read_one_measurements <- function(file, sheet){
-    units <- readxl::read_excel(path = file, sheet = 1, skip = 9, col_names = TRUE, n_max = 1, col_types = "text")
-    units <- as.list(units)
-    #range <- sprintf("A12:%s100000000", cellranger::num_to_letter(length(units)))
-    x <- readxl::read_excel(path = file, sheet = 1, skip = 10, guess_max = 10000#, col_names = names(units), range = range,
-                            #col_types = c("text", "date", "text", rep("numeric", length(units) - 3))
-                            )
-    x <- readxl::read_excel(path = file, sheet = 1, range = cell_limits("A:H"), skip = 11)
-    colnames(x) <- names(units)
-  }
-
-  lapply(sheets, FUN=function(sheet){
-    read_one_meta(fname, sheet)
-  })
-  
-  
-  if(tools::file_ext(fname) %in% "xls"){
-      
-  }else if(tools::file_ext(fname) %in% "xlsx"){
-    x <- readxl::read_xlsx(path = fname, sheet = sheets[1], range = "A1:B7")  
-  }
-  
-  
-}
 
 dashinput <- list()
+dashinput$user_file <- system.file(package = "citizenair", "data-raw", "test_dummy.xls")
 dashinput$stationinfo <- content(GET("http://geo.irceline.be/sos/api/v1/stations?expanded=true"))
 dashinput$meetstations <- lapply(dashinput$stationinfo, FUN=function(x){
   data.frame(id = x$properties$id, 
@@ -73,7 +34,6 @@ dashinput$meetstations <- lapply(dashinput$stationinfo, FUN=function(x){
              phenomena = sort(unique(sapply(x$properties$timeseries, FUN=function(x) x$phenomenon$label))), stringsAsFactors = FALSE)
 })
 dashinput$meetstations <- rbindlist(dashinput$meetstations) 
-#dashinput$meetstations[, list(phenomena = ), by = list(id)]
 dashinput$region <- subset(BE_ADMIN_REGION, TX_RGN_DESCR_NL %in% "Vlaams Gewest")
 dashinput$endpoint <- as.Endpoint("http://sosrest.irceline.be/api/v1")
 dashinput$endpoint <- as.Endpoint("http://geo.irceline.be/sos/api/v1")
@@ -81,22 +41,29 @@ dashinput$srv <- fetch(services(dashinput$endpoint))
 dashinput$stations <- stations(dashinput$endpoint, service = dashinput$srv)
 dashinput$stations_sp <- as.SpatialPointsDataFrame(dashinput$stations)
 dashinput$stations_sp <- dashinput$stations_sp[sapply(1:nrow(dashinput$stations_sp), FUN=function(idx) gIntersects(dashinput$region, dashinput$stations_sp[idx, ])), ]
+
+
 ```
 
+
 ```{r}
 popups <- list()
-popups$data_import <- modalDialog(title = "Data upload", 
-                                  "Some information",
-                                  actionButton("uiInput_start", label = "OK", icon = icon("ok")),
-                                  footer = NULL, easyClose = FALSE)  
+popups$cleaned_data <- modalDialog(
+  title = "Uw meetgegevens", 
+  h4("Uw heeft de volgende gegevens opgeladen:"),
+  tableOutput("uiOutput_rawmeta"),
+  h4("Dit zijn de gegevens die we uit uw Excel file hebben gehaald: "),
+  tags$hr(),
+  DT::dataTableOutput("uiOutput_rawdata", width = "100%", height = "auto"),
+  size = "l", footer = modalButton("Sluit"), easyClose = TRUE)
 ```
 
 # Data {data-icon="fa-cloud-upload"}
 
-```{r child="pages_citizenair/page01-introduction.Rmd"}
+```{r child="pages_citizenair/page01-introduction.Rmd", eval=TRUE}
 ```
 
 # Exploreer en vergelijk {data-icon="fa-toggle-on"}
 
-```{r child="pages_citizenair/page02-exploratory.Rmd"}
+```{r child="pages_citizenair/page02-exploratory.Rmd", eval=TRUE}
 ```

apps/pages_citizenair/page01-introduction.Rmd

@@ -16,18 +16,55 @@ tags$ul(
 ```{r}
 fileInput("uiInput_xl", label = "Selecteer het bestand met uw metingen: ", accept = "application/excel",
           buttonLabel = div("excel: ", icon("file-excel-o")), placeholder = "Nog geen bestand geselecteerd")
-citizenair_userdata <- eventReactive(input$uiInput_xl, {
-  default <- data.frame(name = character(), 
-                        size = integer(), 
-                        type = character(), 
-                        datapath = character(), 
-                        stringsAsFactors = FALSE)
+citizenair_userdata <- reactive({
+  input$uiInput_xl
+  isolate({
+    default <- data.frame(name = character(), size = integer(), type = character(), datapath = character(), stringsAsFactors = FALSE)
     result <- list()
+    result$stations <- dashinput$stations_sp
     result$name <- input$uiInput_xl$name
     result$file <- input$uiInput_xl$datapath
+    result$data <- list()
+    result$data$phenomena <- character()
+    result$data$meta <- data.frame(sheet_id = integer(), sheet = character(), device = character(), 
+                                   lat = numeric(), lon = numeric(), 
+                                   phenomena = character(), stringsAsFactors = FALSE)
+    result$data$phenomena <- data.frame(sheet_id = integer(), timepoint = as.POSIXct(character()), date = as.Date(character()), 
+                                        phenomena = character(), value = numeric(), stringsAsFactors = FALSE)
     if(is.null(input$uiInput_xl)){
       result$file <- default
+    }else{
+      showNotification("We lezen uw Excel bestand in wacht even...")
+      x <- try(read_citizenair(result$file))
+      if(inherits(x, "try-error")){
+        showNotification(sprintf("Er loopt iets fout, is uw data bestand wel een correct bestand? %s", as.character(attributes(x)$condition)))
+      }else{
+        result$data$polluenten <- x$phenomena
+        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
 })
 ```
@@ -37,16 +74,24 @@ citizenair_userdata <- eventReactive(input$uiInput_xl, {
 ```{r}
 leafletOutput("uiOutput_stations")
 output$uiOutput_stations <- renderLeaflet({
-  stations <- dashinput$stations_sp
-  
-  map <- leaflet(data = dashinput$region) %>% 
-    addTiles() %>% 
-    addPolygons(weight = 3, fillOpacity = 0) %>%
-    addPolygons(weight = 3, fillOpacity = 0) %>%
-    addPopups(lng=4.366354, lat=50.86619, popup = "BNOSAC office")
-  map <- addCircleMarkers(map = map, data = stations, 
-                          radius = 5, opacity = 0.3, weight = 3,
-                          popup = as.character(stations$label))
+  userdata <- citizenair_userdata()
+  meta <- userdata$data$meta
+  stations <- userdata$stations
+  map <- leaflet(data = dashinput$region)
+  map <- addTiles(map)
+  map <- addPolygons(map, weight = 3, fillOpacity = 0)
+  map <- addCircleMarkers(map = map, data = stations, radius = 5, opacity = 0.3, fillOpacity = 1, weight = 3, popup = as.character(stations$label))
+  if(length(userdata$nearest_station) > 0){
+    stations <- subset(stations, id %in% userdata$nearest_station)
+    map <- addPopups(map, data = stations, popup = "Dichtstbijzijnde officiële meetstation")
+  }
+  if(nrow(meta) > 0){
+    map <- addPopups(map, lng = meta$lon, lat = meta$lat, popup = "Uw meetpunten")
+    map <- addCircleMarkers(map, lng = meta$lon, lat = meta$lat, color = "red", 
+                            popup = sprintf("Sheet: %s\nDevice: %s", meta$sheet, meta$device), 
+                            radius = 5, weight = 3, fillOpacity = 1)
+  }
+  
   map
 })
 ```
@@ -56,45 +101,92 @@ output$uiOutput_stations <- renderLeaflet({
 ## Overall {data-width=150}
 
 
-### Opgeladen meetpunt
+### Opgeladen meetpunten
 
 ```{r}
 renderValueBox({
-  n <- 0
-  vb_icon <- NULL
-  vb_col <- NULL
+  userdata <- citizenair_userdata()
+  n <- nrow(userdata$data$meta)
   if(n > 0){
-    vb_col <- "green"
-    vb_icon <- "fa-thumbs-up"
+    valueBox(n, caption = "Uw meetpunten", icon = "fa-thumbs-up", color = "green")
+  }else{
+    valueBox(n, caption = "Uw meetpunten", color = NULL)
+  }
+})
+```
+
+### Dichtste officieel meetstation
+
+```{r}
+renderValueBox({
+  userdata <- citizenair_userdata()
+  stations <- userdata$stations
+  stations <- subset(stations, id %in% userdata$nearest_station)
+  if(nrow(stations) > 0){
+    vb <- valueBox(stations$label, caption = "Dichtste officieel meetstation")  
+  }else{
+    vb <- NULL
   }
-  valueBox(n, caption = "Uw meetpunten", icon = vb_icon, color = vb_col)
+  vb
 })
 ```
 
+```{r, eval=FALSE}
+actionBttn("uiInput_showdata", label = "Toon je opgeladen data", block = TRUE, icon = icon("table"), size = "sm")
+eventReactive(input$uiInput_showdata, {
+  showModal(popups$cleaned_data)
+})
+```
+
+### Polluenten door u gemeten
+
 ```{r}
-actionButton("uiInput_xl", label = "Toon je data", icon = icon("table"))
+renderText({
+  userdata <- citizenair_userdata()
+  userdata$data$polluenten
+})
 ```
 
 ### Meetperiode
 
 ```{r}
-showModal(popups$data_import)
-renderPrint({
-  inputdata <- citizenair_userdata()
-  inputdata
+renderTable({
+  userdata <- citizenair_userdata()
+  x <- as.data.table(userdata$data$phenomena)
+  if(nrow(x) > 0){
+    x <- x[, list(start = as.character(min(date, na.rm=TRUE)),
+                  stop = as.character(max(date, na.rm=TRUE)))]
+    x <- as.data.frame(x)  
+  }else{
+    x <- NULL
+  }
+  x
 })
 ```
 
+### Frequentie van uw metingen (in minuten)
 
+```{r}
+renderTable({
+  userdata <- citizenair_userdata()
+  x <- as.data.table(userdata$data$phenomena)
+  if(nrow(x) > 0){
+    x <- x[, frequentie := as.numeric(difftime(timepoint, shift(timepoint, type = "lag", n = 1L), units = "mins")), 
+           by = list(sheet_id)]
+    x <- x[!is.na(frequentie), list(n = .N), by = list(sheet_id, frequentie)]
+    x <- x[order(n, decreasing=TRUE), ]
+    x <- merge(x, userdata$data$meta, by = "sheet_id")
+    x <- as.data.frame(x)  
+    x <- x[!duplicated(x$sheet_id), c("sheet_id", "device", "frequentie")]
+  }else{
+    x <- NULL
+  }
+  x
+})
+```
 
-### Meetperiode
 
-Sequentie van metingen
-bvb elke seconde / 5 seconden
 
 
-### Polluenten
 
-PM2.5
-PM10