From 32efbdeff98addaa995ef3862aaa7ae1ad3f1021 Mon Sep 17 00:00:00 2001 From: chene7 <45438012+chene7@users.noreply.github.com> Date: Fri, 3 Mar 2023 14:44:48 -0500 Subject: [PATCH 1/5] hiding Species Accumulation Curve if breeding button is not clicked, changed number of species in first panel to # Coded Species --- shinyapp/app.R | 17 +++++++++-------- shinyapp/blocks.r | 4 ++-- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/shinyapp/app.R b/shinyapp/app.R index 3533898..7ec596f 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") + conditionalPanel(condition = "input.season_radio == 'Breeding'", + h4("Species Accumulation"), + plotOutput("spp_accumulation")) ), div(class="col-md-6 panel", h4("Species"), @@ -479,7 +480,7 @@ server <- function(input, output, session) { } # add conditional formatting if criteria met - num_spp_total <- paste("Species: ", nrow(sa_list["spp"]) ) + num_spp_total <- paste("Coded Species: ", nrow(filter(sa_list, bcat != "C1"))) num_breed_confirm <- paste( "Confirmed (C4):", confirmed_total, "") @@ -508,15 +509,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..f075e97 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)) @@ -142,7 +142,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 From 0c7867b75a575fa6ad00144d25e79ffaf4426f90 Mon Sep 17 00:00:00 2001 From: chene7 <45438012+chene7@users.noreply.github.com> Date: Fri, 3 Mar 2023 15:38:32 -0500 Subject: [PATCH 2/5] Made Species Accumulation Graph Cleaner, changed 50% line to 50% of coded species --- shinyapp/app.R | 4 ++-- shinyapp/blocks.r | 21 ++++++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/shinyapp/app.R b/shinyapp/app.R index 7ec596f..ca64dbe 100644 --- a/shinyapp/app.R +++ b/shinyapp/app.R @@ -142,8 +142,8 @@ ui <- bootstrapPage( plotOutput("blockhours") ), div(class="col-md-3 panel", - conditionalPanel(condition = "input.season_radio == 'Breeding'", - h4("Species Accumulation"), + h4("Breeding Species Accumulation"), + conditionalPanel(condition = "input.season_radio == 'Breeding'", plotOutput("spp_accumulation")) ), div(class="col-md-6 panel", diff --git a/shinyapp/blocks.r b/shinyapp/blocks.r index f075e97..68dfbf3 100644 --- a/shinyapp/blocks.r +++ b/shinyapp/blocks.r @@ -104,6 +104,8 @@ plot_spp_accumulation <- function(block_recs, spp_bcs) { 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( From a359cc1eeac43cc904aa1ea58583332be84494e3 Mon Sep 17 00:00:00 2001 From: chene7 <45438012+chene7@users.noreply.github.com> Date: Fri, 3 Mar 2023 15:39:07 -0500 Subject: [PATCH 3/5] making SAC graph cleaner --- shinyapp/blocks.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shinyapp/blocks.r b/shinyapp/blocks.r index 68dfbf3..79ab2f6 100644 --- a/shinyapp/blocks.r +++ b/shinyapp/blocks.r @@ -103,7 +103,7 @@ 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 From 57b06f8395868c4cc9473812b04c6e194dc895b6 Mon Sep 17 00:00:00 2001 From: chene7 <45438012+chene7@users.noreply.github.com> Date: Mon, 6 Mar 2023 15:21:38 -0500 Subject: [PATCH 4/5] get information from mongo block summary table --- shinyapp/utils.r | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/shinyapp/utils.r b/shinyapp/utils.r index 47499ab..7ea203a 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,19 @@ 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, "breeding.hrsDiurnal": true, "breeding.hrsNocturnal": true, + "wintering.hrsDiurnal": true, "wintering.hrsNocturnal": true, + "breeding.sppCountConfirmed": true, "breeding.sppCountProbable": true, "breeding.sppCountPossible": true, "breeding.sppCountDetected": true }',) + +blocksum <- tibble(blocksum) + +blocksum <- blocksum %>% + unnest_wider("breeding", names_sep = "_") %>% + unnest_wider("wintering", names_sep = "_") + + +blocksum <- as.data.frame(blocksum) \ No newline at end of file From 99595098ffd31b76babee0dfbcbe755757c4750d Mon Sep 17 00:00:00 2001 From: chene7 <45438012+chene7@users.noreply.github.com> Date: Fri, 10 Mar 2023 13:29:04 -0500 Subject: [PATCH 5/5] adding % guideline to species statistics --- shinyapp/app.R | 30 +++++++++++++++++++++++------- shinyapp/utils.r | 14 ++++++++------ 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/shinyapp/app.R b/shinyapp/app.R index ca64dbe..3b1d7b4 100644 --- a/shinyapp/app.R +++ b/shinyapp/app.R @@ -472,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 diff --git a/shinyapp/utils.r b/shinyapp/utils.r index 7ea203a..d3c1637 100644 --- a/shinyapp/utils.r +++ b/shinyapp/utils.r @@ -376,15 +376,17 @@ 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, "breeding.hrsDiurnal": true, "breeding.hrsNocturnal": true, - "wintering.hrsDiurnal": true, "wintering.hrsNocturnal": true, - "breeding.sppCountConfirmed": true, "breeding.sppCountProbable": true, "breeding.sppCountPossible": true, "breeding.sppCountDetected": true }',) + 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) -blocksum <- blocksum %>% - unnest_wider("breeding", names_sep = "_") %>% - unnest_wider("wintering", names_sep = "_") +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