update server.R code

asheshwor · Jun 2, 2015 · 2fd773b · 2fd773b
1 parent ba43aed
commit 2fd773b
Show file tree

Hide file tree

Showing 8 changed files with 31,094 additions and 37 deletions.
diff --git a/about.txt b/about.txt
@@ -0,0 +1,17 @@
+<p>This is a simple implementation of Shiny dashboard to explore the Nepal earthquake (http://en.wikipedia.org/wiki/April_2015_Nepal_earthquake) data. The earthquake data used here is NOT real-time. The data was downloaded from USGS (csv format) and can be updated by replacing the file in the data folder. To filter the quakes in the vicinity of Nepal, only the quakes within the bounding box of Nepal map are used. (2/6/2015)
+You can try the app live at: [not live yet] asheshwor.shinyapps.io/np-quake</p>
+<h2>R packages used</h2>
+<ul>
+<li>shinydashboard</li>
+<li>leaflet</li>
+<li>dplyr</li>
+<li>scales</li>
+<li>ggplot2</li>
+<li>htmltools</li>
+<li>rcolorbrewer</li>
+</ul>
+<h2>Source code</h2>
+<p>Full source code is available from the following github repo: https://github.com/asheshwor/quake</p>
+<h2>Attribution</h2>
+<p><b>Earthquake data:</b> This app uses earthquake data from USGS http://earthquake.usgs.gov/earthquakes/feed/v1.0/csv.php<br>
+<b>Map data:</b> Map tiles from Mapbox https://www.mapbox.com/ Mapbox uses map data from Open Street Maps (http://www.openstreetmap.org/)</p>
diff --git a/data/all_month2.csv b/data/all_month2.csv
diff --git a/data/all_month_merged.csv b/data/all_month_merged.csv
diff --git a/server.R b/server.R
@@ -1,47 +1,65 @@
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#*          Nepal quake dashboard                                      *
+#*  2015-05-31                                                         *
+#*                                                                     *
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#*     Load packages
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 library(shinydashboard)
 library(leaflet)
 library(dplyr)
 library(scales)
 require(ggplot2)
-require(htmltools)
-#quake data
-quake.file <- "C:/Users/Lenovo/github/quake/data/all_month.csv"  
+# require(htmltools)
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#*     Read and prepare data
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+quake.file <- "C:/Users/Lenovo/github/quake2/data/all_month_merged.csv"  
 quake <- read.csv(quake.file,
                   colClasses = c("character", "numeric", "numeric",
                                  "numeric", "numeric", "character",
                                  "numeric", "numeric", "numeric",
                                  "numeric", "character", "character",
                                  "character", "character", "character"))
-#filter quakes within bounding box of Nepal map
+# filter quakes within bounding box of Nepal map
 quake <- quake[(quake$longitude > 80.000 & quake$longitude < 88.183) &
                  (quake$latitude > 25.767 & quake$latitude < 30.450),]
-#fn format dateTime
+# fn format dateTime
 formatTime <- function(timeString) {
   split1 <- strsplit(paste(timeString), "T")
   split2 <- strsplit(split1[[1]][2], "Z")
   fin <- paste0(split1[[1]][1], " ",split2[[1]][1])
 }
 quake$dateTime <- as.POSIXlt(sapply(quake$time, formatTime)) + 5.75*60*60
 # quake <- quake[with(quake, order(dateTime)), ]
-quake.sub <- quake[ ,c(2:5, 16)]
+quake.sub <- quake[ ,c(2:5, 16, 6:12, 14)]
 quake.sub$size <- cut(quake.sub$mag,
                       c(2, 3.9, 4.9, 5.9, 6.9, 7.9),
                       labels=c("3.3 to 3.9", "3.9 to 4.9", "4.9 to 5.9", "5.9 to 6.9", "6.9 to 7.9"))
+# colour pallet
 pallet <- colorFactor(c("gray32", "dodgerblue4", "purple", "slateblue4", "firebrick1"),
                    domain = c("3.3 to 3.9", "3.9 to 4.9", "4.9 to 5.9", "5.9 to 6.9", "6.9 to 7.9"))
+# create html for popup
 pu <- paste("<b>Mag:</b>", as.character(quake.sub$mag), "<br>",
-            "<b>Depth:</b>", as.character(quake.sub$depth),
-            "<br>", "<b>Time:</b>", as.character.POSIXt(quake.sub$dateTime),
-            "NST")
+            "<b>Depth:</b>", as.character(quake.sub$depth), "km<br>",
+            "<b>Time:</b>", as.character.POSIXt(quake.sub$dateTime), "NST",
+            "<br>","<b>ID:</b>", quake.sub$id,"<br>",
+            "<b>Place:</b>", quake.sub$place)
+# shiny session
 function(input, output, session) {
+  ##  get date range
+  # this.date <- reactive(input$daterange)
+  ## leaflet map
  qm <- leaflet(data=quake.sub) %>% addProviderTiles() %>%
    setView((80.000 + 88.183)/2, (25.767 + 30.450)/2,  zoom = 7) %>%
    addCircleMarkers(~longitude, ~latitude,
                     popup = pu,
                     radius = ~ifelse(mag < 3.9, 4, 5),
                     color = ~pallet(size),
                     stroke = FALSE, fillOpacity = 0.6)
-
+ ## timeline
  drawHist <-    eventReactive(input$refreshButton, {
    ggplot(quake.sub, aes(dateTime, mag, colour=size)) +
      geom_bar(stat="identity", colour="gray60",
@@ -67,7 +85,7 @@ function(input, output, session) {
          panel.border = element_blank(),
          legend.position = "none")
  })
- #table output
+ #  frequency table
  output$outFrequency <- renderTable({
    freq <- table(quake.sub$size)
    ftab <- data.frame(cbind(names(freq),
@@ -79,7 +97,7 @@ function(input, output, session) {
    ftab
  })
  quakeHist <- eventReactive(input$histButton, {
-   #draw quake histogram
+   #  draw quake histogram
    ggplot(data=quake.sub, aes(x=mag)) +
      geom_histogram(aes(fill = ..count..), binwidth=0.25,
                     colour = "white") +
@@ -96,11 +114,24 @@ function(input, output, session) {
            legend.position = "right")
  }
  )
+ #update map
  output$quakemap <- renderLeaflet(qm)
- output$countQuake <- renderText(paste("Total quakes: ", nrow(quake.sub), "<br><br>"))
+ #count total quakes
+ output$countQuake <- renderText(paste("There were a total of<b>",
+                                       nrow(quake.sub),
+                                       "</b> quakes recorded from <b>",
+                                       as.character(input$daterange[1]),
+                                       "to", as.character(input$daterange[2]),
+                                       "</b>.<br>"))
+ output$adf <- renderText({
+   paste(as.character(input$daterange))
+ })
+ #update timeline
  output$magHist <- renderPlot(
    drawHist()
  )
+ #update histogram
  output$quakeHist <- renderPlot(quakeHist())
- output$quaketable <- renderDataTable(quake.sub[,c(1:4)])
+ #update table
+ output$quaketable <- renderDataTable(quake.sub[,c(5, 4, 3, 6, 8:10, 12:13)])
 }
diff --git a/ui.R b/ui.R
@@ -1,36 +1,42 @@
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#*          Nepal quake dashboard                                      *
+#*  2015-05-31                                                         *
+#*                                                                     *
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+#*     Load packages
+#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 library(shinydashboard)
-# library(ShinyDash)
 library(leaflet)
 # library(shinythemes)
 
 header <- dashboardHeader(
   title = "Nepal quake"
-#   dropdownMenu(type="messages",
-#                messageItem(
-#                  from = "Data source",
-#                  message="Earthquake data downloaded from http://earthquake.usgs.gov/earthquakes/feed/v1.0/csv.php"
-#                ))
 )
 # ntext <- eventReactive(input$goButton, {
 #   input$n
 # })
 sidebar <- dashboardSidebar(
   sidebarMenu(
-    menuItem("Dashboard", tabName="dashboard"),
-    menuItem("Data",tabName="help"),
-    menuItem("Source code", tabName="source")
+    menuItem("Dashboard", tabName="dashboard", icon = icon("tachometer")),
+    menuItem("Data",tabName="help", icon = icon("table")),
+    menuItem("About", tabName="source", icon = icon("info"))
   )
 )
 body <- dashboardBody(
+  tags$head(
+    tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
+  ),
   tabItems(
     tabItem(tabName ="dashboard",
             # h2("Map"),
             fluidRow(
-              column(width = 12,
-                     box(width = NULL, solidHeader = TRUE,
-                         leafletOutput("quakemap", height = 400)
-                     )
-              ),
+#               column(width = 12,
+#                      box(width = NULL, solidHeader = TRUE,
+#                          leafletOutput("quakemap", height = 400)
+#                      )
+#               ),
               column(width=12,
                      box(title='Timeline', solidHeader=TRUE,
                          background = "light-blue",
@@ -44,18 +50,20 @@ body <- dashboardBody(
               ),
               column(width=3,
                      box(title="Select time window",
-                         background = "olive",
+                         background = "green",
                          solidHeader = TRUE,
                          width=NULL,
                          collapsible=TRUE,
-                         dateRangeInput("daterange", "Date range:",
-                                        start = "2015-04-30",
-                                        end   = "2015-05-29"),
-                         actionButton("updateButton", "Update daterange")
+                         dateRangeInput("daterange", "Select date range:",
+                                        start = "2015-04-12",
+                                        end   = "2015-06-02"),
+                         actionButton("updateButton", "Update daterange"),
+                         verbatimTextOutput("adf")
                          )),
               column(width=3,
                      box(title="Frequency table",
                          background = "black",
+                         status="success",
                          solidHeader = TRUE,
                          width=NULL,
                          collapsible=TRUE,
@@ -66,6 +74,7 @@ body <- dashboardBody(
                          background = "green",
                          solidHeader = TRUE,
                          width=NULL,
+                         status = "success",
                          collapsible=TRUE,
                          plotOutput("quakeHist", height = 200),
                          actionButton("histButton", "Draw histogram")
@@ -104,10 +113,11 @@ body <- dashboardBody(
   ),
   ## Source tab
   tabItem(tabName ="source",
-          h2("Source code"),
-          includeText("source.txt"),
-          br(),
-          p("github.com/asheshwor/quake")
+          h1("About"),
+          includeHTML("about.txt")
+          # includeText("about.txt"),
+#           br(),
+#           p("github.com/asheshwor/quake")
   )
 ))