inst/shiny/server.r

data(ctdmeta)
data(inflows)
data(tides)
data(wll)
data(habgrids)
data(willowcreek)

shinyServer(function(input, output, session){

reactivehab = reactiveValues(grid = habgrids)
  observe({
    if(input$navbar == "stop")
      stopApp()
  })

########## Explore Transect ###################################################  

########## side bar ###########

  # drop-down selection box for transect date
  output$transect_date = renderUI({
    selectInput("transect_date", "Select transect", size = 10, selected = 1, 
      selectize = FALSE, choices = setNames(seq(nrow(ctdmeta)), 
        paste(strftime(ctdmeta$start, "%Y-%m-%d"), 
          paste0(strftime(ctdmeta$start, "%H:%M"), "--",  
            strftime(ctdmeta$end, "%H:%M")), 
          paste0("(", ctdmeta$code,")")))
    )
  })

 # prep for flow/tide/wll plots
  intervalstart = reactive(ctdmeta[input$transect_date, "start"] - 3.5*86400)
  intervalend = reactive(ctdmeta[input$transect_date, "start"] + 3.5*86400)
  x.scale = reactive(scale_x_datetime("", limits = c(intervalstart(), 
    intervalend())))
  transect.lines = reactive({
    d = data.frame(date = as.numeric(ctdmeta[input$transect_date, "start"]),
      availability = ifelse(ctdmeta[input$transect_date, "numcasts"] < 12, 
        "partial", "complete"))
    list(
      geom_vline(data = d, aes(xintercept = date, linetype = availability)),
      scale_linetype_manual(values = c("complete" = "solid", 
        "partial" = "dashed"), guide = FALSE)
    )
  })
  
  # plot the flows
  inflowdata = reactive(filter(inflows, datetime >= intervalstart(),
    datetime <= intervalend(), gauge == "russian river"))
  output$transect_flows = renderPlot({
    ggplot(inflowdata(), aes(x = datetime, y = flow)) + 
    geom_line(color = "#377eb8") + ggtitle("Russian River Flow") +
    transect.lines() + ylab("inflow (m3/s)") + x.scale()
  })
  
  # plot the tides
  tidedata = reactive(filter(tides, datetime >= intervalstart(),
    datetime <= intervalend()))
  output$transect_tides = renderPlot({
    ggplot(tidedata(), aes(x = datetime, y = height)) + 
    geom_line(color = "#377eb8") + ggtitle("Point Reyes Tide Height") +
    transect.lines() + ylab("tide height (MLLW, m)") + x.scale() 
  })    
  
  # plot the water level
  wlldata = reactive(filter(wll2, mtime >= intervalstart(),
    mtime <= intervalend()))
  output$transect_wll = renderPlot({
    ggplot(wlldata(), aes(x = mtime, y = wll)) + 
    geom_line(color = "#377eb8") + ggtitle("Water surface elevation at Jenner") +
    transect.lines() + ylab("water surface elevation (NGVD29, m)") + x.scale()
  })    

########## main panel ##########

  # get the grid for selected transect
  transectdate = reactive(strftime(ctdmeta[input$transect_date, "start"], 
    "%Y-%m-%d", tz = "US/Pacific"))
  transectid = reactive(ctdmeta[input$transect_date, "id"])
  griddata = reactive(mutate_(filter(reactivehab$grid, date == transectdate(), 
    id == transectid()), habitat = input$habitat_type))

  # plot settings
  plot.settings = list(
    xlim(min(habgrids$dist), max(habgrids$dist)),
    ylim(-15.8, 3.3),
    ylab("elevation above NAVD29 (m)"),
    xlab("distance from river mouth (m)")
  )
  overall.colors = c(
    "optimal" = "#66c2a5",
    "growth limited" = "#ffff99",
    "impaired" = "#fdbf6f",
    "energy demanding" = "#cab2d6",
    "growth limited, impaired" = "#fb9a99",
    "growth limited, energy demanding" = "#6a3d9a",
    "impaired, energy demanding" = "#ff7f00",
    "growth limited, impaired, energy demanding" = "#b15928",
    "unsuitable" = "#000000"
  )
  ta.colors = setNames(brewer.pal(4, "RdYlGn"), c("unsuitable", 
    "negative/no growth", "positive growth", "optimal growth"))
  sa.colors = setNames(c("#c51b7d", "#f1b6da", "#92c5de", "#2166ac"), 
    c("marine", "brackish", "isotonic", "freshwater"))
  oa.colors = setNames(brewer.pal(4, "BrBG"), c("unsuitable", 
    "severe impairment", "some impairment", "minimal impairment"))
  depth.colors = setNames(brewer.pal(5, "BuPu"), c("littoral",
    "surface limnetic", "epibenthic", "subsurface limnetic", "profundal")
)
  habitat.colors = reactive({
    switch(input$habitat_type, 
      "habitat.fwa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "habitat.swa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "ta.qual" = scale_fill_manual("Temperature quality", 
        values = ta.colors, drop = FALSE),
      "sa.qual" = scale_fill_manual("Salinity quality", 
        values = sa.colors, drop = FALSE),
      "oa.qual" = scale_fill_manual("Dissolved oxygen quality", 
        values = oa.colors, drop = FALSE),
      "ta" = scale_fill_distiller("Temperature\n", type = "div", 
        palette = "RdYlBu", guide = "colourbar"),
      "sa" = scale_fill_distiller("Salinity\n", type = "div", 
        palette = "PRGn", guide = "colourbar"),
      "oa" = scale_fill_distiller("Dissolved Oxygen\n", type = "div", 
        palette = "BrBG", direction = 1, guide = "colourbar")
    )
  })

landmarkdat = data.frame(landmark = c("Penny Island", "CA-1 Bridge", 
  "Heron Rookery","Mos. Rd. Bridge"), dist = c(1250, 3800, 8000, 10600), 
  elev = 3.3)
landmarks = geom_label(data = landmarkdat, aes(x = dist, y = elev, 
  label = landmark), inherit.aes = FALSE)
  
  # plot the main grid
  habitat.plot = reactive(ggplot(griddata(), aes(x = dist, y = elev, 
      fill = habitat)) + geom_raster() + landmarks +
      plot.settings + habitat.colors() + 
      theme(legend.position = "none")  
  )
  output$grid_plot = renderPlot({
    habitat.plot()
  })
  
  # plot the categories
  cat.settings = list(
    scale_y_continuous("total volume (m3)\n", labels = comma),
    theme(axis.text.x = element_blank(), axis.title.x = element_blank(), 
      axis.ticks.x = element_blank())
  )

  catdata = reactive(summarize(group_by(griddata(), date, habitat), 
    volume = sum(volume.total)))

  cat.plot = reactive(ggplot(arrange(catdata(), -as.numeric(habitat)), 
    aes(x = date, y = volume, fill = habitat)) + 
    geom_bar(stat = "identity", position = "stack") + 
    habitat.colors() + cat.settings + theme(legend.position = "left")
  )
  output$category_bar = renderPlot({
    cat.plot()
  })

  # overall volume
  depthvoldata = reactive({
    depthvoldata = gather(summarize(group_by(griddata(), date, habitat), 
      volume.littoral = sum(volume.littoral),
      volume.limnetic = sum(volume.limnetic), 
      volume.epibenthic = sum(volume.epibenthic),
      volume.sublimnetic = sum(volume.sublimnetic),
      volume.profundal = sum(volume.profundal)
      ), depth.cat, volume, -habitat, -date)
  depthvoldata["depth.cat"] = factor(depthvoldata$depth.cat, 
      levels = c("volume.littoral", "volume.limnetic", "volume.epibenthic",
        "volume.sublimnetic", "volume.profundal"), 
      labels = c("littoral", "surface limnetic", "epibenthic", 
        "subsurface limnetic", "profundal"))
  depthvoldata
  })
  vol.depth = reactive(ggplot(arrange(depthvoldata(), -as.numeric(depth.cat)), 
    aes(x = date, y = volume, fill = depth.cat)) + 
    geom_bar(stat = "identity") + 
    scale_fill_manual("depth category", values = depth.colors, 
      drop = FALSE) + cat.settings +
    theme(axis.text.y = element_blank(), axis.title.y = element_blank(), 
      axis.ticks.y = element_blank())
      
  )
  output$depth_vol = renderPlot({
    vol.depth()
  })
  
  # plot by depth
  depthdata = reactive({
    depthdata = summarize(group_by(gather(griddata(), depth.zone, 
      volume, volume.littoral, volume.limnetic, volume.epibenthic, 
      volume.sublimnetic, volume.profundal), date, depth.zone, habitat), 
      volume = sum(volume))
    depthdata["depth.zone"] = factor(depthdata$depth.zone, 
      levels = c("volume.littoral", "volume.limnetic", "volume.epibenthic",
        "volume.sublimnetic", "volume.profundal"), 
      labels = c("littoral", "surface limnetic", "epibenthic", 
        "subsurface limnetic", "profundal"))
    depthdata
  })
      

  cat.depth = reactive(ggplot(arrange(depthdata(), -as.numeric(habitat)), 
    aes(x = date, y = volume, fill = habitat)) + 
    geom_bar(stat = "identity", position = "stack") + 
    habitat.colors() + cat.settings + theme(legend.position = "none") + 
    facet_wrap(~ depth.zone, nrow = 1) + theme(axis.title.y = element_blank())
  )
  
  output$depth_cat = renderPlot({
    cat.depth()
  })
    
  
########### Explore Periods ###################################################

########## side bar ###########

  output$period = renderUI({
    selectInput("period_date", "Select transects", size = 10, selected = c(1,2), 
      multiple = TRUE, selectize = FALSE, choices = setNames(seq(nrow(ctdmeta)), 
        paste(strftime(ctdmeta$start, "%Y-%m-%d"), 
          paste0(strftime(ctdmeta$start, "%H:%M"), "--",  
            strftime(ctdmeta$end, "%H:%M")), 
          paste0("(", ctdmeta$code,")")))
    )
  })
  
 # prep for flow/tide/wll plots
  periodrange = reactive(sort(input$period_date))
  periodstart = reactive(ctdmeta[periodrange()[1], "start"] - 3.5*86400)
  periodend = reactive(ctdmeta[rev(periodrange())[1], "start"] + 3.5*86400)
  periodinflow = reactive(filter(inflows, datetime >= periodstart(),
    datetime <= periodend(), gauge == "russian river"))
  periodtide = reactive(filter(tides, datetime >= periodstart(),
    datetime <= periodend()))
  periodwll = reactive(filter(wll2, mtime >= periodstart(),
    mtime <= periodend()))
  period.x.scale = reactive(scale_x_datetime("", limits = c(periodstart(), 
    periodend())))
  
  region.setting = reactive({
    d = data.frame(date = as.numeric(ctdmeta[periodrange(), "start"]),
      availability = ifelse(ctdmeta[periodrange(), "numcasts"] < 12, 
        "partial", "complete"))
    list(
      geom_vline(data = d, aes(xintercept = date, linetype = availability)),
      scale_linetype_manual(values = c("complete" = "solid", 
        "partial" = "dashed"), guide = FALSE)
    )
  })
  
  # plot the flows
  output$period_flows = renderPlot({
    ggplot(periodinflow(), aes(x = datetime, y = flow)) + 
    geom_line(color = "#377eb8") + ggtitle("Russian River Flow") +
    ylab("inflow (m3/s)") + period.x.scale() + region.setting()
  })
  
  # plot the tides
  output$period_tides = renderPlot({
    ggplot(periodtide(), aes(x = datetime, y = height)) + 
    geom_line(color = "#377eb8") + ggtitle("Point Reyes Tide Height") +
    ylab("tide height (MLLW, m)") + period.x.scale() + region.setting() 
  })    
  
  # plot the water level
  output$period_wll = renderPlot({
    ggplot(periodwll(), aes(x = mtime, y = wll)) + 
    geom_line(color = "#377eb8") + ggtitle("Water Surface Elevation at Jenner") +
    ylab("water surface elevation (NGVD29, m)") + period.x.scale() + region.setting()
  })
  
########## main panel ##########

  # get the grid for selected period
  perioddate = reactive(strftime(ctdmeta[periodrange(), "start"], 
    "%Y-%m-%d", tz = "US/Pacific"))
  periodtime = reactive(ctdmeta[periodrange(), "start"])
  periodid = reactive(ctdmeta[periodrange(), "id"])
  periodgrids = reactive(mutate_(filter(reactivehab$grid, date %in% as.Date(perioddate()), 
    id %in% periodid()), habitat = input$period_habitat_type))

    period.habitat.colors = reactive({
    switch(input$period_habitat_type, 
      "habitat.fwa" = overall.colors,
      "habitat.swa" = overall.colors,
      "ta.qual" = ta.colors,
      "sa.qual" = sa.colors,
      "oa.qual" = oa.colors
    )
  })
    
  # overall habitat plots
  overall.gathered = reactive({
    hablevels = levels(periodgrids()$habitat)
    overall = summarize(group_by(periodgrids(), date, id, 
      habitat, code, days.since.closure), 
      volume = sum(volume.total))
    ovlevels = as.character(unique(overall$habitat))
    overall.spread = spread_(overall, "habitat", "volume", fill = 0)
    overall.spread["total.volume"] = rowSums(overall.spread[ovlevels])
    overall.gathered = gather_(overall.spread, "habitat", "volume", 
      gather_cols = ovlevels)
    overall.gathered["habitat"] = factor(overall.gathered$habitat, 
      levels = hablevels)
    overall.gathered["volume.frac"] = overall.gathered$volume/
                                      overall.gathered$total.volume
    overall.gathered = left_join(overall.gathered, 
      unique(periodgrids()[c("date", "id", "wse")]), by = c("date", "id"))
    overall.gathered = left_join(overall.gathered,
      data.frame(date = as.Date(perioddate()), id = periodid(), 
        datetime = periodtime()), by = c("date", "id"))
    overall.gathered
  })
  output$period_overall = renderPlot({
    if(input$plot_type == "stacked area"){
      ggplot(arrange(overall.gathered(), -as.numeric(habitat)), 
        aes(x = datetime, y = volume, fill = habitat)) + 
        geom_area(position = "stack") + scale_x_datetime("") +
        scale_fill_manual("", values = period.habitat.colors(), drop = FALSE) +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma) + 
        region.setting()
    } else{
      ggplot(arrange(overall.gathered(), -as.numeric(habitat)), 
        aes(x = factor(datetime), y = volume, fill = habitat)) + xlab("") +
        geom_bar(stat = "identity", position = "stack") +
        scale_fill_manual("", values = period.habitat.colors(), drop = FALSE) +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma)    
    }
  })
  
  # depth plots
  alldepth = reactive({
    alldepth = summarize(group_by(gather(periodgrids(), depth.zone, 
      volume, volume.littoral, volume.limnetic, volume.epibenthic, 
      volume.sublimnetic, volume.profundal), date, id, 
      depth.zone, code, days.since.closure), 
      volume = sum(volume))
    alldepth["depth.zone"] = factor(alldepth$depth.zone, ordered = TRUE,
      levels = c("volume.littoral", "volume.limnetic", "volume.epibenthic",
        "volume.sublimnetic", "volume.profundal"), 
      labels = c("littoral", "surface limnetic", "epibenthic", 
        "subsurface limnetic", "profundal"))    
    alldepth = left_join(alldepth, 
      unique(periodgrids()[c("date", "id", "wse")]), by = c("date", "id"))
    alldepth = left_join(alldepth,
      data.frame(date = as.Date(perioddate()), id = periodid(), 
        datetime = periodtime()), by = c("date", "id"))
    alldepth
  })
  
  output$period_alldepth = renderPlot({
    if(input$plot_type == "stacked area"){
      ggplot(arrange(alldepth(), -as.numeric(depth.zone)), 
        aes(x = datetime, y = volume, fill = depth.zone)) + 
        geom_area(position = "stack") + scale_x_datetime("") +
        scale_fill_manual("", values = depth.colors, drop = FALSE) +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma) + 
        region.setting()
    } else{
      ggplot(arrange(alldepth(), -as.numeric(depth.zone)), 
        aes(x = factor(datetime), y = volume, fill = depth.zone)) + xlab("") +
        geom_bar(stat = "identity", position = "stack") +
        scale_fill_manual("", values = depth.colors, drop = FALSE) +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma)    
    }
  })
  
  # stratified habitat plots
  bydepth.gathered = reactive({
    hablevels = levels(periodgrids()$habitat)
    bydepth = summarize(group_by(gather(periodgrids(), depth.zone, 
      volume, volume.littoral, volume.limnetic, volume.epibenthic, 
      volume.sublimnetic, volume.profundal), date, id, 
      habitat, depth.zone, code, days.since.closure), 
      volume = sum(volume))
    ovlevels = as.character(unique(bydepth$habitat))
    bydepth.spread = spread_(bydepth, "habitat", "volume", fill = 0)
    bydepth.spread["total.volume"] = rowSums(bydepth.spread[ovlevels])
    bydepth.gathered = gather_(bydepth.spread, "habitat", "volume", 
      gather_cols = ovlevels)
    bydepth.gathered["habitat"] = factor(bydepth.gathered$habitat, 
      levels = hablevels)
    bydepth.gathered["volume.frac"] = bydepth.gathered$volume/
                                      bydepth.gathered$total.volume
    bydepth.gathered = left_join(bydepth.gathered, 
      unique(periodgrids()[c("date", "id", "wse")]), by = c("date", "id"))
    bydepth.gathered = left_join(bydepth.gathered,
      data.frame(date = as.Date(perioddate()), id = periodid(), 
        datetime = periodtime()), by = c("date", "id"))
    bydepth.gathered["depth.zone"] = factor(bydepth.gathered$depth.zone, 
      levels = c("volume.littoral", "volume.limnetic", "volume.epibenthic",
        "volume.sublimnetic", "volume.profundal"), 
      labels = c("littoral", "surface limnetic", "epibenthic", 
        "subsurface limnetic", "profundal"))
    bydepth.gathered
  })
  output$period_bydepth = renderPlot({
    if(input$plot_type == "stacked area"){
      ggplot(arrange(bydepth.gathered(), -as.numeric(habitat)), 
        aes(x = datetime, y = volume, fill = habitat)) + 
        geom_area(position = "stack") + scale_x_datetime("") +
        scale_fill_manual("", values = period.habitat.colors(), drop = FALSE) +
        theme(legend.position = "none") +
        scale_y_continuous(name="Volume (m3)", labels = comma) + 
        region.setting() + facet_wrap(~ depth.zone, ncol = 1, scales = "free_y")
    } else{
      ggplot(arrange(bydepth.gathered(), -as.numeric(habitat)), 
        aes(x = factor(datetime), y = volume, fill = habitat)) + xlab("") +
        geom_bar(stat = "identity", position = "stack") +
        scale_fill_manual("", values = period.habitat.colors(), drop = FALSE) +
        theme(legend.position = "none") +
        scale_y_continuous(name="Volume (m3)", labels = comma) + 
        facet_wrap(~ depth.zone, ncol = 1, scales = "free_y")
    }
  })

########## Perturbate Transect ###################################################  

########## main panel ##########
  output$perturb_date = renderUI({
    selectInput("perturb_date", "Select transect", size = 10, selected = 1, 
      selectize = FALSE, choices = setNames(seq(nrow(ctdmeta)), 
        paste(strftime(ctdmeta$start, "%Y-%m-%d"), 
          paste0(strftime(ctdmeta$start, "%H:%M"), "--",  
            strftime(ctdmeta$end, "%H:%M")), 
          paste0("(", ctdmeta$code,")")))
    )
  })

  # get the grid for selected transect
  perturbdate = reactive(strftime(ctdmeta[input$perturb_date, "start"], 
    "%Y-%m-%d", tz = "US/Pacific"))
  perturbid = reactive(ctdmeta[input$perturb_date, "id"])
  perturbdata = reactive({
    res = mutate_(filter(reactivehab$grid, date == perturbdate(), 
    id == perturbid()), habitat = input$perturb_var)
    updateSliderInput(session, "window_dist", 
      min = min(res$dist), max = max(res$dist), step = 100,
      value = c(min(res$dist), max(res$dist)))
    updateSliderInput(session, "window_elev", 
      min = min(res$elev), max = max(res$elev), step = 0.1,
      value = c(min(res$elev), max(res$elev)))
    res
    })
  
  perturb.habitat.colors = reactive({
    switch(input$perturb_var, 
      "ta" = scale_fill_distiller("Temperature", type = "div", 
        palette = "RdYlBu", guide = "colourbar"),
      "sa" = scale_fill_distiller("Salinity", type = "div", 
        palette = "PRGn", guide = "colourbar"),
      "oa" = scale_fill_distiller("Dissolved Oxygen", type = "div", 
        palette = "RdYlGn", guide = "colourbar", direction = -1)
    )
  })

  perturb.plot = reactive(ggplot(perturbdata(), aes(x = dist, y = elev, 
      fill = habitat)) + geom_raster() + 
      plot.settings + perturb.habitat.colors() 
  )
  
  perturb.window = reactive({
    d = data.frame(dist = rep(input$window_dist, each = 2),
      elev = c(input$window_elev, rev(input$window_elev)))
    geom_polygon(data = d, fill = NA, color = "black")
  })
  
  output$perturb_plot = renderPlot({
    perturb.plot() + perturb.window()
  })

  observeEvent(input$perturb_action, {
    perturbmask = ( reactivehab$grid$date == perturbdate() ) & 
      ( reactivehab$grid$id == perturbid() ) &
      ( reactivehab$grid$dist >= min(input$window_dist) ) & 
      ( reactivehab$grid$dist <= max(input$window_dist) ) &
      ( reactivehab$grid$elev >= min(input$window_elev) ) & 
      ( reactivehab$grid$elev <= max(input$window_elev) )
    reactivehab$grid[perturbmask, input$perturb_var] = reactivehab$grid[[input$perturb_var]][perturbmask] + input$perturb_val
    classfun = switch(input$perturb_var, 
      sa = habitatblueprint:::classify_sa, 
      ta = habitatblueprint:::classify_ta, 
      oa = habitatblueprint:::classify_oa)
    reactivehab$grid[perturbmask, paste0(input$perturb_var, ".qual")] = classfun(reactivehab$grid[[input$perturb_var]][perturbmask])
    reactivehab$grid[perturbmask, "habitat.fwa"] = habitatblueprint:::classify_freshwater(reactivehab$grid$ta.qual[perturbmask], 
      reactivehab$grid$sa.qual[perturbmask], reactivehab$grid$oa.qual[perturbmask])
    reactivehab$grid[perturbmask, "habitat.swa"] = habitatblueprint:::classify_saltwater(reactivehab$grid$ta.qual[perturbmask], 
      reactivehab$grid$sa.qual[perturbmask], reactivehab$grid$oa.qual[perturbmask])
  })

  observeEvent(input$perturb_reset, {
    reactivehab$grid = habgrids
  })

########## Willow Creek ###################################################  

########## side panel ##########

  output$wc_period = renderUI({
    dateRangeInput("wc_date", "Select dates", 
      min = min(as.Date(willowcreek$date)), 
      max = max(as.Date(willowcreek$date)) + 1,
      start = min(as.Date(willowcreek$date)), 
      end = max(as.Date(willowcreek$date)) + 1)
  }) 

 # prep for flow/tide/wll plots
  wcrange = reactive(as.POSIXct(sort(input$wc_date), tz = "UTC"))
  wcstart = reactive(wcrange()[1] - 3.5*86400)
  wcend = reactive(wcrange()[2] + 3.5*86400)
  wcinflow = reactive(filter(inflows, datetime >= wcstart(),
    datetime <= wcend(), gauge == "russian river"))
  wctide = reactive(filter(tides, datetime >= wcstart(),
    datetime <= wcend()))
  wcwll = reactive(filter(wll2, mtime >= wcstart(),
    mtime <= wcend()))
  wc.x.scale = reactive(scale_x_datetime("", limits = c(wcstart(), 
    wcend())))
  
  
  # plot the flows
  output$wc_flows = renderPlot({
    ggplot(wcinflow(), aes(x = datetime, y = flow)) + 
    geom_line(color = "#377eb8") + ggtitle("Russian River Flow") +
    ylab("inflow (m3/s)") + wc.x.scale()
  })
  
  # plot the tides
  output$wc_tides = renderPlot({
    ggplot(wctide(), aes(x = datetime, y = height)) + 
    geom_line(color = "#377eb8") + ggtitle("Point Reyes Tide Height") +
    ylab("tide height (MLLW, m)") + wc.x.scale() 
  })    
  
  # plot the water level
  output$wc_wll = renderPlot({
    ggplot(wcwll(), aes(x = mtime, y = wll)) + 
    geom_line(color = "#377eb8") + ggtitle("Water Surface Elevation at Jenner") +
    ylab("water surface elevation (NGVD29, m)") + wc.x.scale()
  })


########## main panel ##########

  # get subset of willow creek data
  wcselect = reactive({
    daterange = willowcreek$time >= wcrange()[1] &
      willowcreek$time <= wcrange()[2]
    d = willowcreek[daterange,]
    d["habitat"] = d[[input$wc_var]] 
    d
  })

  wc.habitat.fills = reactive({
    switch(input$wc_var,
      "habitat.fwa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "habitat.swa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "ta.qual" = scale_fill_manual("Temperature quality", 
        values = ta.colors, drop = FALSE),
      "sa.qual" = scale_fill_manual("Salinity quality", 
        values = sa.colors, drop = FALSE),
      "oa.qual" = scale_fill_manual("Dissolved oxygen quality", 
        values = oa.colors, drop = FALSE),
      "ta" = scale_fill_distiller("Temperature\n", type = "div", 
        palette = "RdYlBu", guide = "colourbar"),
      "sa" = scale_fill_distiller("Salinity\n", type = "div", 
        palette = "PRGn", guide = "colourbar"),
      "oa" = scale_fill_distiller("Dissolved Oxygen\n", type = "div", 
        palette = "BrBG", direction = 1, guide = "colourbar")
    )
  })

  wc.habitat.colors = reactive({
    switch(input$wc_var,
      "habitat.fwa" = scale_color_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "habitat.swa" = scale_color_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "ta.qual" = scale_color_manual("Temperature quality", 
        values = ta.colors, drop = FALSE),
      "sa.qual" = scale_color_manual("Salinity quality", 
        values = sa.colors, drop = FALSE),
      "oa.qual" = scale_color_manual("Dissolved oxygen quality", 
        values = oa.colors, drop = FALSE),
      "ta" = scale_color_distiller("Temperature\n", type = "div", 
        palette = "RdYlBu", guide = "colourbar"),
      "sa" = scale_color_distiller("Salinity\n", type = "div", 
        palette = "PRGn", guide = "colourbar"),
      "oa" = scale_color_distiller("Dissolved Oxygen\n", type = "div", 
        palette = "BrBG", direction = 1, guide = "colourbar")
    )
  })

  wc.habitat.fill = reactive({
    switch(input$wc_var,
      "habitat.fwa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "habitat.swa" = scale_fill_manual("Overall habitat quality", 
        values = overall.colors, drop = FALSE),
      "ta.qual" = scale_fill_manual("Temperature quality", 
        values = ta.colors, drop = FALSE),
      "sa.qual" = scale_fill_manual("Salinity quality", 
        values = sa.colors, drop = FALSE),
      "oa.qual" = scale_fill_manual("Dissolved oxygen quality", 
        values = oa.colors, drop = FALSE),
      "ta" = scale_color_distiller("Temperature\n", type = "div", 
        palette = "RdYlBu", guide = "colourbar"),
      "sa" = scale_color_distiller("Salinity\n", type = "div", 
        palette = "PRGn", guide = "colourbar"),
      "oa" = scale_color_distiller("Dissolved Oxygen\n", type = "div", 
        palette = "BrBG", direction = 1, guide = "colourbar")
    )
  })


  output$wc_overall = renderPlot({
    if (input$wc_var %in% c("ta", "sa", "oa")) {
      ggplot(wcselect(), aes(x = time,
          y = volume.total, group = 1L, color = habitat)) +
        geom_line() + wc.habitat.colors() +
        scale_x_datetime("") +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma)
    } else {
      wchab = gather(
        spread(
          select(wcselect(), time, volume.total, habitat),
            habitat, volume.total, fill = 0
        ),
        habitat, volume.total, -time
      )
      ggplot(wchab, aes(x = time,
          y = volume.total, fill = habitat)) +
        geom_area() + wc.habitat.fill() +
        scale_x_datetime("") +
        theme(legend.position = "left") +
        scale_y_continuous(name = "Volume (m3)", labels = comma)
    }
  })

  output$wc_depth = renderPlot({
    wcdepth = ungroup(summarize(group_by(gather(wcselect(), depth.zone, 
      volume, volume.littoral, volume.limnetic, volume.epibenthic, 
      volume.sublimnetic, volume.profundal), time, 
      depth.zone), volume = sum(volume)))
    wcdepth["depth.zone"] = factor(wcdepth$depth.zone, ordered = TRUE,
      levels = c("volume.littoral", "volume.limnetic", "volume.epibenthic",
        "volume.sublimnetic", "volume.profundal"), 
      labels = c("littoral", "surface limnetic", "epibenthic", 
        "subsurface limnetic", "profundal"))
    ggplot(wcdepth, aes(x = time, y = volume, fill = depth.zone)) +
      geom_area(position = "stack") + scale_x_datetime("") +
      scale_fill_manual("", values = depth.colors, drop = FALSE) +
      theme(legend.position = "left") +
      scale_y_continuous(name = "Volume (m3)", labels = comma)
  })


})
mkoohafkan/habitatblueprint documentation built on June 28, 2021, 9:45 a.m.