basic app is working

.Rbuildignore

@@ -1,2 +1,3 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+data-raw/zika

.gitignore

@@ -1,3 +1,4 @@
 .Rproj.user
 .Rhistory
 .RData
+data-raw/zika

DESCRIPTION

@@ -1,9 +1,18 @@
 Package: zikar
-Title: What the Package Does (one line, title case)
+Title: Tools for exploring publicly available Zika data
 Version: 0.0.0.9000
-Authors@R: Carson Sievert <cpsievert1@gmail.com> [aut, cre]
-Description: What the package does (one paragraph).
-Depends: R (>= 3.3.1)
-License: file LICENSE
+Authors@R: person("Carson", "Sievert", role = c("aut", "cre"),
+    email = "cpsievert1@gmail.com")
+Description: Tools for exploring publicly available Zika data
+Depends:
+    R (>= 3.3.1)
+Imports:
+    shiny,
+    leaflet,
+    plotly (> 4.0.0),
+    dplyr,
+    broom
+License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,2 +1,8 @@
-# Generated by roxygen2: fake comment so roxygen2 overwrites silently.
-exportPattern("^[^\\.]")
+# Generated by roxygen2: do not edit by hand
+
+export(add_summary)
+export(explore)
+import(dplyr)
+import(leaflet)
+import(plotly)
+import(shiny)

R/data.R

@@ -0,0 +1,29 @@
+#' Zika reports
+#'
+#' Curated data set from this GitHub repo -- \url{https://github.com/cdcepi/zika}
+#'
+#' @format A data frame with the following variables:
+#' \itemize{
+#'   \item report_date: Date of the report
+#'   \item location: Location
+#    \item country: Country
+#    \item locationA: Location within country
+#    \item locationB: Location within locationA
+#    \item location_type: Type of location
+#    \item data_field: Type of report
+#    \item data_field_code: Code for type of report
+#    \item value: Number of cases
+#' }
+"zika"
+
+#' Latitude and longitude for Zika locations
+#'
+#' Curated data set from this GitHub repo -- \url{https://github.com/cdcepi/zika}
+#'
+#' @format A data frame with the following variables:
+#' \itemize{
+#'   \item lat: Latitude
+#'   \item lng: Longitude
+#'   \item location: Location
+#' }
+"zika"

R/explore.R

@@ -0,0 +1,97 @@
+#' Shiny app for exploring zika data
+#'
+#' @export
+#' @examples
+#' explore()
+#'
+
+explore <- function() {
+
+  data(zika)
+  data(latLonDat)
+
+  z <- zika %>%
+    # some locations (e.g. "Brazil-Amapa") seem to consistenly report NAs
+    dplyr::filter(!is.na(value)) %>%
+    dplyr::left_join(latLonDat, by = "location") %>%
+    dplyr::filter(!is.na(lat)) %>%
+    # column to track selections
+    dplyr::mutate(region = "All Regions")
+
+  ui <- fluidPage(
+    leafletOutput("map"),
+    tabsetPanel(
+      tabPanel("Summary", plotlyOutput("summary"))
+    )
+  )
+
+  server <- function(input, output, session, ...) {
+
+    output$map <- renderLeaflet({
+      leaflet(latLonDat) %>%
+        addTiles() %>%
+        fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat)) %>%
+        addCircleMarkers(
+          lng = ~lng, lat = ~lat, label = ~location, layerId = ~location,
+          color = "black", clusterOptions = markerClusterOptions()
+        )
+    })
+
+    # A reactive expression that returns the locations that are
+    # in bounds right now
+    mapClickData <- reactive({
+      print(input$map_marker_click)
+
+    })
+
+    mapZoomData <- reactive({
+      if (is.null(input$map_bounds)) {
+        return(data.frame())
+      }
+      bounds <- input$map_bounds
+      latRng <- range(bounds$north, bounds$south)
+      lngRng <- range(bounds$east, bounds$west)
+      idx <- with(z, latRng[1] <= lat & lat <= latRng[2] & lngRng[1] <= lng & lng <= lngRng[2])
+      if (all(idx)) {
+        return(data.frame())
+      }
+      z %>% filter(idx) %>% mutate(region = "Inside Map")
+    })
+
+
+    retrieveSelection <- reactive({
+      selection <- mapZoomData()
+      rbind(z, selection)
+    })
+
+
+    output$summary <- renderPlotly({
+
+      plot_area <- function(.) {
+        # TODO: this needs to be fixed in plotly!
+        cols <- if (length(unique(.$region)) > 1)  c("black", "green", "red") else "black"
+        plot_ly(., x = ~x, ymax = ~y, color = ~region, colors = cols) %>%
+          add_area() %>%
+          layout(yaxis = list(title = ~unique(confirmed)))
+      }
+
+      data <- retrieveSelection()
+
+      data %>%
+        group_by(confirmed, region) %>%
+        do(n = NROW(.), d = density(log(.$value), adjust = 3, n = 32)) %>%
+        tidy(d) %>%
+        ungroup() %>%
+        group_by(confirmed) %>%
+        do(p = plot_area(.)) %>%
+        .[["p"]] %>%
+        subplot(nrows = 2, shareX = TRUE, titleY = TRUE) %>%
+        layout(xaxis = list(title = "log(number of cases per week)"))
+
+    })
+
+  }
+
+  shinyApp(ui, server)
+
+}

R/imports.R

@@ -0,0 +1,5 @@
+#' @import shiny
+#' @import leaflet
+#' @import plotly
+#' @import dplyr
+NULL

R/utils.R

@@ -0,0 +1,42 @@
+#' Plot a running 5 number summary of zika data
+#'
+#' @param p a plotly visualization
+#' @param location a regular expression matching the location column in the \link{zika} dataset.
+#' @param a valid R colour.
+#' @export
+#' @examples
+#'
+#' brazil <- dplyr::filter(zika, country == "Brazil")
+#'
+#' plot_ly(zika, x = ~report_date) %>%
+#'   add_summary() %>%
+#'   add_summary(data = brazil, "red")
+
+add_summary <- function(p, data = NULL, color = "black") {
+
+  data <- if (!is.null(data)) data else plotly_data(p)
+
+  d <- data %>%
+    group_by(report_date) %>%
+    summarise(
+      min = min(value, na.rm = TRUE),
+      q1 = quantile(value, 0.25, na.rm = TRUE),
+      med = median(value, na.rm = TRUE),
+      q3 = quantile(value, 0.75, na.rm = TRUE),
+      max = max(value, na.rm = TRUE)
+    )
+
+    # # http://stackoverflow.com/questions/22523131/dplyr-summarise-equivalent-of-drop-false-to-keep-groups-with-zero-length-in
+    # tidyr::complete(report_date, fill = list(min = 0, q1 = 0, med = 0, q3 = 0, max = 0))
+
+  add_data(p, d) %>%
+    add_ribbons(
+      ymin = ~min, ymax = ~max, name = "Range", hoverinfo = "none",
+      fillcolor = toRGB(color, 0.1), line = list(color = color)
+    ) %>%
+    add_ribbons(
+      ymin = ~q1, ymax = ~q3, name = "IQR", hoverinfo = "none",
+      fillcolor = toRGB(color, 0.5), line = list(color = color)
+    ) %>%
+    add_lines(y = ~med, line = list(color = color), name = "median")
+}