redid thermal_habitat_area to work with multiple thresholds. Updated …

…plots to show thermal profile instead of previous daily output
NOAA-EDAB · Jan 8, 2025 · 032acb8 · 032acb8
1 parent 36c2d5b
commit 032acb8
Show file tree

Hide file tree

Showing 5 changed files with 38,425 additions and 74 deletions.
diff --git a/R/plot_thermal_habitiat_area.R b/R/plot_thermal_habitiat_area.R
@@ -34,76 +34,33 @@ plot_thermal_habitat_area <- function(shadedRegion = NULL,
   # optional code to wrangle ecodata object prior to plotting
   # e.g., calculate mean, max or other needed values to join below
 
-  if(plottype == 'daily'){
-
-    fix <- ecodata::thermal_habitat_area |>
-      dplyr::filter(EPU == filterEPUs) |>
-      tidyr::pivot_wider(names_from = Source,values_from = Value) |>
-      dplyr::mutate(presentBoth = !is.na(GLORYS+PSY),
-                    PSYMask = dplyr::case_when(presentBoth == F ~ 1,
-                                               TRUE ~ NA_real_),
-                    PSY = PSY * PSYMask)  |>
-      tidyr::pivot_longer(c(GLORYS,PSY),names_to = "Source",values_to = "Value") |>
-      dplyr::select(-PSYMask,-presentBoth) |>
-      dplyr::filter(!is.na(Value)) |>
-      dplyr::mutate(Time = lubridate::yday(Time))
-
-
-    limits <- fix |>
-      dplyr::group_by(Depth,Var,Time) |>
-      dplyr::summarise(areaMinProportion = min(Value),
-                       areaMaxProportion = max(Value),
-                       .groups = "drop")
-
-    fix <- fix |>
-      dplyr::left_join(limits,by=c("Depth","Var","Time")) |>
-      dplyr::filter(year == max(year))
-
-
-    p <- fix |>
-      ggplot2::ggplot()+
-      ggplot2::geom_ribbon(data=fix, ggplot2::aes(x = Time, ymin = areaMinProportion, ymax = areaMaxProportion),fill = 'grey50')+
-      ggplot2::geom_line(data=fix,ggplot2::aes(x = Time, y= Value),color = 'black',alpha = 0.7,size =1)+
-      ggplot2::facet_grid(Var~Depth)+
-      ggplot2::theme_bw()+
-      ggplot2::xlab('Calendar Day')+
-      ggplot2::ylab('Proportion of EPU Area above threshold') +
-      ggplot2::ggtitle(filterEPUs)+
-      ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
-
-  }else if(plottype == 'annual'){
-
-    fix <- ecodata::thermal_habitat_area_annual |>
+  fix <- ecodata::thermal_habitat_area_annual |>
       dplyr::filter(EPU == filterEPUs)
 
-    limits <- fix |>
+  limits <- fix |>
       dplyr::group_by(Var,Time) |>
       dplyr::summarise(areaMinProportion = min(Value),
                        areaMaxProportion = max(Value),
                        .groups = "drop")
 
-    fix <- fix |>
-      dplyr::left_join(limits,by=c("Var","Time"))
-
-    fix.this.year = fix |>
-      dplyr::filter(Time == max(Time)) |>
-      dplyr::mutate(ReportYear = max(Time))
-
-    p <- ggplot2::ggplot()+
-      # ggplot2::geom_line(data=fix, ggplot2::aes(x = temp.threshold, ymin = areaMinProportion, ymax = areaMaxProportion))+
-      ggplot2::geom_line(data=fix,ggplot2::aes(x = temp.threshold, y= Value,group = Time,color = Time),alpha = 0.7,size =1.2)+
-      ggplot2::scale_color_gradient(name = "Year",low = 'grey70',high ='blue2')+
-      ggplot2::geom_line(data=dplyr::filter(fix.this.year,Time == max(Time)),ggplot2::aes(x = temp.threshold, y = Value, linetype = as.factor(ReportYear)), color = 'black',alpha = 0.7,size =2)+
-      ggplot2::scale_linetype_manual(name = 'Report Year',values = 1)+
-      ggplot2::theme_bw()+
-      ggplot2::xlab('Temperature Threshold (\u00B0C)')+
-      ggplot2::ylab('Proportion of EPU Area above threshold') +
-      ggplot2::ggtitle(filterEPUs)+
-      ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
-
-  }else{
-    error('plotttype must be either "daily" or "annual"')
-  }
+  fix <- fix |>
+    dplyr::left_join(limits,by=c("Var","Time"))
+
+  fix.this.year = fix |>
+    dplyr::filter(Time == max(Time)) |>
+    dplyr::mutate(ReportYear = max(Time))
+
+  p <- ggplot2::ggplot()+
+    # ggplot2::geom_line(data=fix, ggplot2::aes(x = temp.threshold, ymin = areaMinProportion, ymax = areaMaxProportion))+
+    ggplot2::geom_line(data=fix,ggplot2::aes(x = temp.threshold, y= Value,group = Time,color = Time),alpha = 0.7,linewidth =1.2)+
+    ggplot2::scale_color_gradient(name = "Year",low = 'grey70',high ='blue2')+
+    ggplot2::geom_line(data=dplyr::filter(fix.this.year,Time == max(Time)),ggplot2::aes(x = temp.threshold, y = Value, linetype = as.factor(ReportYear)), color = 'black',alpha = 0.7,size =2)+
+    ggplot2::scale_linetype_manual(name = 'Report Year',values = 1)+
+    ggplot2::theme_bw()+
+    ggplot2::xlab('Temperature Threshold (\u00B0C)')+
+    ggplot2::ylab('Proportion of EPU Area above threshold') +
+    ggplot2::ggtitle(filterEPUs)+
+    ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
 
   return(p)
 

diff --git a/data-raw/get_thermal_habitat_area.R b/data-raw/get_thermal_habitat_area.R
@@ -5,20 +5,11 @@
 
 get_thermal_habitat_area <- function(save_clean = F){
 
-  thermal_habitat_area<-readr::read_csv(here::here("data-raw/thermal_habitat_area_2023 - Joseph Caracappa - NOAA Federal.csv"),
+  thermal_habitat_area<-readr::read_csv(here::here("data-raw/thermal_habitat_area_2025.csv"),
                        show_col_types = F) |>
-    dplyr::mutate(Units = "Proportion",
-                  date = lubridate::as_date(date),
-                  Var = paste0(">",temp.threshold,"\u00B0C"),
-                  Depth = paste0(min.depth,"-",max.depth,"m")) |>
-    dplyr::select(-c(area, min.depth,max.depth)) |>
-    dplyr::rename(EPU = epu,
-                  Time = date,
-                  Value = area.prop,
-                  Source = source) |>
     dplyr::relocate(Time,EPU,Depth,Var,Value,Source)
 
-  thermal_habitat_area$Depth <- factor(thermal_habitat_area$Depth, levels = c('0-25m','25-100m','100-3000m'))
+  thermal_habitat_area$Depth <- factor(thermal_habitat_area$Depth, levels = c('0-25m','25-100m','100-3000m','AllDepths'))
 
 
   if (save_clean){