diff --git a/shinyapp/app.R b/shinyapp/app.R index 3533898..3b1d7b4 100644 --- a/shinyapp/app.R +++ b/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) Total Coded: ", coded_total) num_breed_confirm <- paste( - "Confirmed (C4):", - confirmed_total, "") + " Confirmed (C4, 50% Minimum):
", + signif((confirmed_total/coded_total)*100,3),"%,", confirmed_total, "Species") + num_breed_prob <- paste( - "Probable (C3):", nrow(filter(sa_list, bcat == "C3" ))) + " Probable (C3):
", 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" ))) + " Possible (C2, 25% Maximum):
", + signif((possible_total/coded_total)*100,3), "%,", 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:", - format(diurnal_hours, trim=TRUE, digits=1), - " hrs") + format(diurnal_hours, trim=TRUE, digits=2), + "") num_nocturnal_hours <- paste( "Nocturnal:", - format(block_hrs_results()$noc_hr, trim=TRUE, digits=1), - " hrs") + format(block_hrs_results()$noc_hr, trim=TRUE, digits=2), + "") num_total_hours <- paste( "Total:", - format(block_hrs_results()$total_hr, trim=TRUE, digits=1), + format(block_hrs_results()$total_hr, trim=TRUE, digits=2), " hrs") print("troubleshooting duplicate block stats:") diff --git a/shinyapp/blocks.r b/shinyapp/blocks.r index f9b57a2..79ab2f6 100644 --- a/shinyapp/blocks.r +++ b/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,7 +103,9 @@ 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 @@ -111,28 +113,29 @@ plot_spp_accumulation <- function(block_recs, spp_bcs) { #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 diff --git a/shinyapp/utils.r b/shinyapp/utils.r index 47499ab..d3c1637 100644 --- a/shinyapp/utils.r +++ b/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) \ No newline at end of file