Species cosmetics

shinyapp/app.R

@@ -142,8 +142,9 @@ ui <- bootstrapPage(
           plotOutput("blockhours")
         ),
         div(class="col-md-3 panel",
-          h4("Species Accumulation"),
-          plotOutput("spp_accumulation")
+           h4("Breeding Species Accumulation"),
+           conditionalPanel(condition = "input.season_radio == 'Breeding'",
+                           plotOutput("spp_accumulation"))
         ),
         div(class="col-md-6 panel",
           h4("Species"),
@@ -471,22 +472,38 @@ server <- function(input, output, session) {
     sa_list <- spp_accumulation_results()$spp_unique
 
     spp_total <- nrow(sa_list["spp"])
+    coded_total <- nrow(filter(sa_list, bcat != "C1"))
     confirmed_total <- nrow(filter(sa_list, bcat == "C4" ))
-    if ((spp_total*0.5)<confirmed_total) {
+    probable_total <- nrow(filter(sa_list, bcat == "C3"))
+    possible_total <- nrow(filter(sa_list, bcat == "C2"))
+
+    # conditional formatting for # confirmed species
+    if ((coded_total*0.5)<confirmed_total) {
       confirmed_class = "success"
     } else {
       confirmed_class = "failed"
     }
+
+    # conditional formatting for # possible species
+    if ((coded_total*0.25)<possible_total) {
+      possible_class = "failed"
+    } else {
+      possible_class = "success"
+    }
 
-    # add conditional formatting if criteria met
-    num_spp_total <- paste("Species: ", nrow(sa_list["spp"]) )
+    # add conditional formatting if confirmed criteria met
+    num_spp_total <- paste("<u> Total Coded: </u>", coded_total)
     num_breed_confirm <- paste(
-      "Confirmed (C4):<span class='", confirmed_class, "'>",
-      confirmed_total, "</span>")
+      "<u> Confirmed (C4, 50% Minimum): </u> <br> <span class='", confirmed_class, "'>",
+      signif((confirmed_total/coded_total)*100,3),"%</span>,", confirmed_total, "Species")
+
     num_breed_prob <- paste(
-      "Probable (C3):", nrow(filter(sa_list, bcat == "C3" )))
+      "<u> Probable (C3): </u> <br> ", signif((probable_total/coded_total)*100,3),"%,",probable_total, "Species")
+
+    # add conditional formatting if possible criteria met
     num_breed_poss <- paste(
-      "Possible (C2):", nrow(filter(sa_list, bcat == "C2" )))
+      "<u> Possible (C2, 25% Maximum): </u> <br> <span class='", possible_class, "'>",
+      signif((possible_total/coded_total)*100,3), "%</span>,", possible_total, "Species")
 
     ### Block Hours ----------------------------------------------------
     diurnal_hours <- block_hrs_results()$total_hr - block_hrs_results()$noc_hr
@@ -508,15 +525,15 @@ server <- function(input, output, session) {
 
     num_diurnal_hours <- paste(
       "Diurnal:<span class='",diurnal_hours_class, "'>",
-      format(diurnal_hours, trim=TRUE, digits=1),
-      " hrs</span>")
+      format(diurnal_hours, trim=TRUE, digits=2),
+      "</span>")
     num_nocturnal_hours <- paste(
       "Nocturnal:<span class='", nocturnal_hours_class, "'>",
-      format(block_hrs_results()$noc_hr, trim=TRUE, digits=1),
-      " hrs</span>")
+      format(block_hrs_results()$noc_hr, trim=TRUE, digits=2),
+      "</span>")
     num_total_hours <- paste(
       "Total:<span class=''>",
-      format(block_hrs_results()$total_hr, trim=TRUE, digits=1),
+      format(block_hrs_results()$total_hr, trim=TRUE, digits=2),
       " hrs</span>")
 
     print("troubleshooting duplicate block stats:")

shinyapp/blocks.r

@@ -5,7 +5,7 @@
 #
 plot_spp_accumulation <- function(block_recs, spp_bcs) {
   # TODO - list highest behavior code by spp
-  # TODO - collecct data for categories
+  # TODO - collect data for categories
   #  C1 – Observed; C2 – Possible; C3 – Probable; C4 – Confirmed
   #  observed can be "" or "C1"
   # print(head(block_recs))
@@ -103,36 +103,39 @@ plot_spp_accumulation <- function(block_recs, spp_bcs) {
   spp_acc[nrow(spp_acc)+1,]<-c(obs_min,length(spp_unique$spp),c1,c2, c3, c4)
 
 
-  spp_tot <- nrow(spp_unique)
+  spp_tot <- nrow(spp_unique) 
+  spp_coded <- nrow(spp_unique[!"bcat" == "C1"])
+  spp_coded_half <- spp_coded * 0.5
   spp_tot_half <- spp_tot * 0.5
   hrs_convert <- 60.0
   hrs_total = obs_min/hrs_convert
 
   #plot the data
   plot_response <- ggplot(data=spp_acc,aes((min), all)) +
     geom_hline(
-      aes(yintercept=(spp_tot_half),
-      colour = "50% total")) +
+      aes(yintercept=(spp_coded_half),
+      colour = "50% Total Coded")) +
     geom_text(
-      aes(0,spp_tot_half),
-      label = "50% total spp",
-      vjust = -1) +
+      aes(0,spp_coded_half),
+      label = "50% Total Coded",
+      vjust = 0,
+      hjust = -2) +
     geom_smooth(
       method = 'loess',
       formula = 'y ~ x',
-      aes(y = all, colour="all")) +
+      aes(y = all, colour="All Observed")) +
     geom_smooth(
       method = 'loess',
       formula = 'y ~ x',
-      aes(y = c4, colour="confirmed")) +
+      aes(y = c4, colour="Confirmed")) +
     geom_smooth(
       method = 'loess',
       formula = 'y ~ x',
-      aes(y = c3, color="probable")) +
+      aes(y = c3, color="Probable")) +
     geom_smooth(
       method = 'loess',
       formula = 'y ~ x',
-      aes(y = c2, color="possible")) +
+      aes(y = c2, color="Possible")) +
     scale_colour_manual(
       name="",
       values = c(
@@ -142,7 +145,7 @@ plot_spp_accumulation <- function(block_recs, spp_bcs) {
         "#ffbf00",
         "#ccccff")) +
     xlim(0,obs_min) +
-    ylab("# Species") + xlab("Observation Time")
+    ylab("# Species") + xlab("Observation Time (Minutes)")
     # geom_line() +
 
   #figure out how to provide multiple return data

shinyapp/utils.r

@@ -38,6 +38,11 @@ m_sd <- mongo(
   url = URI,
   options = ssl_options(weak_cert_validation = T))
 
+m_blocksum <- mongo(
+  "BLOCK_SUMMARIES",
+  url = URI,
+  options = ssl_options(weak_cert_validation = T))
+
 get_safe_dates <- function(){
   sd <- m_sd$find("{}","{}")
 
@@ -367,3 +372,21 @@ get_block_hours <- function(id_ncba_block) {
 
   }
 }
+
+### Retrieving Mongo Block Summary Table
+
+blocksum <- m_blocksum$find(
+  fields = '{ "ID_NCBA_BLOCK": true, "county": true, "region": true, "portal.breeding.hrsDiurnal": true, "portal.breeding.hrsNocturnal": true,
+              "portal.wintering.hrsDiurnal": true, "portal.wintering.hrsNocturnal": true, "portal.breeding.sppCountConfirmed": true, "portal.breeding.sppPctConfirmed":true,
+              "portal.breeding.sppCountProbable": true, "portal.breeding.sppCountPossible": true, "portal.breeding.sppCountCoded": true, "portal.breeding.sppCountDetected": true }',)
+
+blocksum <-  tibble(blocksum)
+
+names(blocksum)
+
+blocksum <- blocksum %>%
+  unnest_wider("portal", names_sep = "_") %>% 
+  unnest_wider("portal_breeding", names_sep = "_") %>% 
+  unnest_wider("portal_wintering", names_sep = "_")
+
+blocksum <- as.data.frame(blocksum)