diff --git a/.gitignore b/.gitignore index e0032c0b..5f7b6b6b 100644 --- a/.gitignore +++ b/.gitignore @@ -4,7 +4,6 @@ .Ruserdata MA Report Generation/data/ -MA Report Generation/output/ Coastal_Wetlands/output Coral/output Nekton/output diff --git a/MA Report Generation/CoastalWetlands.R b/MA Report Generation/CoastalWetlands.R deleted file mode 100644 index 377d97d4..00000000 --- a/MA Report Generation/CoastalWetlands.R +++ /dev/null @@ -1,386 +0,0 @@ -## Coastal Wetlands - -out_dir_cw <- "output/Data/CoastalWetlands" - -param_file <- "SpeciesRichness" - -data <- fread(cw_file_in, sep="|", header=TRUE, stringsAsFactors=FALSE, - na.strings=c("NULL","","NA")) - -# Only interested in Percent Cover measurements -data <- data[data$ParameterName=="Percent Cover - Species Composition"] -# Make species group name uniform -data$SpeciesGroup1[data$SpeciesGroup1=="Marsh Succulents"] <- "Marsh succulents" -# Only keep data rows that are Marsh, Marsh succulents, and Mangroves and assoc. -data <- data[SpeciesGroup1=="Marsh"| - SpeciesGroup1=="Marsh succulents"| - SpeciesGroup1=="Mangroves and associate", ] -setnames(data, "SpeciesGroup1", "SpeciesGroup") -# Create ParameterName Column -data$ParameterName <- "Species Richness" -parameter <- "Species Richness" - -# Sets units for species richness -unit <- "# of species" -data$ParameterUnits <- unit - -# Replace instances where NA values imported as blank character string or as "NA" -# data <- replace(data, data=="", NA) -# data <- replace(data, data=="NA", NA) - -# Remove rows with missing ManagedAreaName -data <- data[!is.na(data$ManagedAreaName),] -data <- data[data$ManagedAreaName!="NA",] -# Remove rows with missing GenusName -data <- data[!is.na(data$GenusName),] -# Remove rows with missing SpeciesName -data <- data[!is.na(data$SpeciesName),] -# Remove rows with missing Months -data <- data[!is.na(data$Month),] -# Remove rows with missing Years -data <- data[!is.na(data$Year),] -# Set ResultValue to be a number value -data$ResultValue <- as.numeric(data$ResultValue) -# Remove rows where ResultValue is 0 -data <- data[data$ResultValue!=0,] -# Remove duplicate rows -data <- data[data$MADup==1,] -# Create variable that combines the genus and species name -data$gensp <- paste(data$GenusName, data$SpeciesName, sep=" ") -# Corrects Managed Area names to be consistent with official names -data$ManagedAreaName[data$ManagedAreaName=="Apalachicola Bay"] <- - "Apalachicola Bay Aquatic Preserve" -data$ManagedAreaName[data$ManagedAreaName=="Big Bend Seagrasses"] <- - "Big Bend Seagrasses Aquatic Preserve" -data$ManagedAreaName[data$ManagedAreaName=="Cockroach Bay"] <- - "Cockroach Bay Aquatic Preserve" -data$ManagedAreaName[data$ManagedAreaName=="Guana River Marsh"] <- - "Guana River Marsh Aquatic Preserve" -data$ManagedAreaName[data$ManagedAreaName=="Guana Tolomato Matanzas NERR"] <- - "Guana Tolomato Matanzas National Estuarine Research Reserve" - -# Create Species Richness values for groups of unique combinations of -# ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, and SampleDate. -data <- data %>% - group_by(ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, - SampleDate, SpeciesGroup) %>% - summarise(ParameterName=parameter, - Year=unique(Year), Month=unique(Month), - SpeciesRichness=length(unique(gensp))) - -# Adds AreaID for each managed area by combining the MA_All datatable to the -# data based on ManagedAreaName -data <- merge.data.frame(MA_All[,c("AreaID", "ManagedAreaName")], - data, by="ManagedAreaName", all=TRUE) - -# Writes this data that is used by the rest of the script to a text file -fwrite(data, paste0(out_dir_cw,"/CoastalWetlands_", param_file, "_UsedData.txt"), - sep="|") - -# Makes sure SampleDate is being stored as a Date object -data$SampleDate <- as.Date(data$SampleDate) - -# Creates a variable with the names of all the managed areas that contain -# species observations -MA_Include <- unique(data$ManagedAreaName[!is.na(data$SpeciesRichness)]) - -# Puts the managed areas in alphabetical order -MA_Include <- MA_Include[order(MA_Include)] - -#create global CoastalWetland MA_Include for use in ReportRender.R -cw_managed_areas <- MA_Include - -# Determines the number of managed areas used -n <- length(MA_Include) - -################ -### MA STATS ### -################ - -# Create summary statistics for each managed area based on Year and Month -# intervals. -MA_YM_Stats <- data %>% - group_by(AreaID, ManagedAreaName, Year, Month, SpeciesGroup) %>% - summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName, Year, then Month -MA_YM_Stats <- as.data.table(MA_YM_Stats[order(MA_YM_Stats$ManagedAreaName, - MA_YM_Stats$Year, - MA_YM_Stats$Month), ]) -# Writes summary statistics to file -fwrite(MA_YM_Stats, paste0(out_dir_cw,"/CoastalWetlands_", param_file, - "_MA_MMYY_Stats.txt"), sep="|") -# Removes variable storing data to improve computer memory -rm(MA_YM_Stats) - -# Create summary statistics for each managed area based on Year intervals -MA_Y_Stats <- data %>% - group_by(AreaID, ManagedAreaName, Year, SpeciesGroup) %>% - summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName then Year -MA_Y_Stats <- as.data.table(MA_Y_Stats[order(MA_Y_Stats$ManagedAreaName, - MA_Y_Stats$Year), ]) -# Writes summary statistics to file -fwrite(MA_Y_Stats, paste0(out_dir_cw,"/CoastalWetlands_", param_file, - "_MA_Yr_Stats.txt"), sep="|") - -MA_Y_Stats_cw <- MA_Y_Stats - -# Create summary statistics for each managed area based on Month intervals. -MA_M_Stats <- data %>% - group_by(AreaID, ManagedAreaName, Month, SpeciesGroup) %>% - summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName then Month -MA_M_Stats <- as.data.table(MA_M_Stats[order(MA_M_Stats$ManagedAreaName, - MA_M_Stats$Month), ]) -# Writes summary statistics to file -fwrite(MA_M_Stats, paste0(out_dir_cw,"/CoastalWetlands_", param_file, - "_MA_Mo_Stats.txt"), sep="|") -# Removes variable storing data to improve computer memory -rm(MA_M_Stats) - -# Create summary overall statistics for each managed area. -MA_Ov_Stats <- data %>% - group_by(AreaID, ManagedAreaName, SpeciesGroup) %>% - summarize(ParameterName=parameter, - N_Years=length(unique(na.omit(Year))), - EarliestYear=min(Year), - LatestYear=max(Year), - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName -MA_Ov_Stats <- as.data.table(MA_Ov_Stats[order(MA_Ov_Stats$ManagedAreaName), ]) -# Creates Year_MinRichness and Year_MaxRichness columns -MA_Ov_Stats$Year_MinRichness <- NA -MA_Ov_Stats$Year_MaxRichness <- NA - -# Loops through each ManagedAreaName. -# Determines what year the minimum and maximum species richness occurred -for(m in 1:nrow(MA_Ov_Stats)){ - # Stores ManagedAreaName for this row - man <- MA_Ov_Stats$ManagedAreaName[m] - - # Skips to next row if there are no data for this combination - if(MA_Ov_Stats$N_Data[m]==0){ - next - } - # Gets subset of data from MA_Y_Stats (yearly summary stats) with this - # ManagedAreaName - ds <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==man,] - # Gets the minimum and maximum Mean (yearly averages) - min <- min(ds$Mean) - max <- max(ds$Mean) - #Determines what years those minimum and maximum values occured - year_min <- ds$Year[ds$Mean==min] - year_max <- ds$Year[ds$Mean==max] - # Stores the occurrence years of the minimum and maximum into the overall - # stats for this row - MA_Ov_Stats$Year_MinRichness[m] <- year_min - MA_Ov_Stats$Year_MaxRichness[m] <- year_max -} -# Replaces blank ProgramIDs with NA (missing values) -MA_Ov_Stats$ProgramIDs <- replace(MA_Ov_Stats$ProgramIDs, - MA_Ov_Stats$ProgramIDs=="", NA) -MA_Ov_Stats$Programs <- replace(MA_Ov_Stats$Programs, - MA_Ov_Stats$Programs=="", NA) -# Write overall statistics to file -fwrite(MA_Ov_Stats, paste0(out_dir_cw,"/CoastalWetlands_", param_file, - "_MA_Overall_Stats.txt"), sep="|") -# Removes entries from the overall statistics that do not have data. -# Based on presence or absence of EarliestYear -MA_Ov_Stats <- MA_Ov_Stats[!is.na(MA_Ov_Stats$EarliestYear), ] - -MA_Ov_Stats_cw <- MA_Ov_Stats - -# Defines standard plot theme: black and white, no major or minor grid lines, -# Arial font. Title is centered, size 12, and blue (hex coded). Subtitle is -# centered, size 10, and blue (hex coded). Legend title is size 10 and the -# legend is left-justified. X-axis title is size 10 and the margins are padded -# at the top and bottom to give more space for angled axis labels. Y-axis title -# is size 10 and margins are padded on the right side to give more space for -# axis labels. Axis labels are size 10 and the x-axis labels are rotated -45 -# degrees with a horizontal justification that aligns them with the tick mark -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text=element_text(family="Arial"), - plot.title=element_text(hjust=0.5, size=12, color="#314963"), - plot.subtitle=element_text(hjust=0.5, size=10, color="#314963"), - legend.title=element_text(size=10), - legend.text.align = 0, - axis.title.x = element_text(size=10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size=10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text=element_text(size=10), - axis.text.x=element_text(angle = -45, hjust = 0)) - -# Color palette for SEACAR -color_palette <- c("#005396", "#0088B1", "#00ADAE", "#65CCB3", "#AEE4C1", - "#FDEBA8", "#F8CD6D", "#F5A800", "#F17B00") - -# Defines and sets variable with standardized group colors for plots -group_colors <- c("Marsh"=color_palette[1], - "Marsh succulents"=color_palette[2], - "Mangroves and associate"=color_palette[3]) - -# Defines and sets variable with standardized group shapes for plots -group_shapes <- c("Marsh"=21, - "Marsh succulents"=22, - "Mangroves and associate"=24) - -## Plotting function for use in ReportTemplate.Rmd ## - -plot_cw <- function(ma, MA_Ov_Stats = "MA_Ov_Stats_cw", MA_Y_Stats = "MA_Y_Stats_cw"){ - - # Gets data for target managed area - plot_data <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==ma] - # Determines most recent year with available data for managed area - t_max <- max(MA_Ov_Stats$LatestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines earliest recent year with available data for managed area - t_min <- min(MA_Ov_Stats$EarliestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines how many years of data are present - t <- t_max-t_min - - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 5 years if between 30 and 10 years of data - brk <- -5 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - # Determine range of data values for the managed area - y_range <- max(plot_data$Mean) - min(plot_data$Mean) - - # Determines lower bound of y-axis based on data range. Set based on - # relation of data range to minimum value. Designed to set lower boundary - # to be 10% of the data range below the minimum value - y_min <- if(min(plot_data$Mean)-(0.1*y_range)<0){ - # If 10% of the data range below the minimum value is less than 0, - # set as 0 - y_min <- 0 - } else { - # Otherwise set minimum bound as 10% data range below minimum value - y_min <- min(plot_data$Mean)-(0.1*y_range) - } - - # Sets upper bound of y-axis to be 10% of the data range above the - # maximum value. - y_max <- max(plot_data$Mean)+(0.1*y_range) - - # Determines what combination of groups are present for managed area - # and subsets color and shape scheme to be used by plots. - # Used so only group combinations present for managed area appear in - # the legend. - group_colors_plot <- group_colors[unique(plot_data$SpeciesGroup)] - group_shapes_plot <- group_shapes[unique(plot_data$SpeciesGroup)] - - # Creates plot object using plot_data. - # Data is plotted as symbols with connected lines. - p1 <- ggplot(data=plot_data, group=as.factor(SpeciesGroup)) + - geom_line(aes(x=Year, y=Mean, color=as.factor(SpeciesGroup)), - size=0.75, alpha=1) + - geom_point(aes(x=Year, y=Mean, fill=as.factor(SpeciesGroup), - shape=as.factor(SpeciesGroup)), size=2, - color="#333333", alpha=1) + - labs(title="Coastal Wetlands Species Richness", - subtitle=ma, - x="Year", y="Richness (# of species)", - fill="Species group", color="Species group", - shape="Species group") + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max, t_min, brk)) + - scale_y_continuous(limits=c(y_min, y_max), - breaks=pretty_breaks(n=5)) + - scale_fill_manual(values=group_colors_plot) + - scale_color_manual(values=group_colors_plot) + - scale_shape_manual(values=group_shapes_plot) + - plot_theme - # Sets file name of plot created - outname <- paste0("CoastalWetlands_", param_file, "_", - gsub(" ", "", ma), ".png") - # Saves plot as a png image - # png(paste0(out_dir_cw, "/Figures/", outname), - # width = 8, - # height = 4, - # units = "in", - # res = 200) - # print(p1) - # dev.off() - - # Creates a data table object to be shown underneath plots in report - ResultTable <- - MA_Ov_Stats[MA_Ov_Stats$ManagedAreaName==ma,] - # Removes location, species group, and parameter information because it is - # in plot labels - ResultTable <- ResultTable[,-c("AreaID", "ManagedAreaName", - "ProgramIDs", "Programs", "ParameterName")] - # Renames StandardDeviation to StDev to save horizontal space - ResultTable <- ResultTable %>% - rename("StDev"="StandardDeviation") - # Converts all non-integer values to 2 decimal places for space - ResultTable$Min <- round(ResultTable$Min, digits=2) - ResultTable$Max <- round(ResultTable$Max, digits=2) - ResultTable$Median <- round(ResultTable$Median, digits=2) - ResultTable$Mean <- round(ResultTable$Mean, digits=2) - ResultTable$StDev <- round(ResultTable$StDev, digits=2) - # Stores as plot table object - t1 <- ggtexttable(ResultTable, rows = NULL, - theme=ttheme(base_size=7)) - # Combines plot and table into one figure - print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - cat(" \n") -} \ No newline at end of file diff --git a/MA Report Generation/Coral.R b/MA Report Generation/Coral.R deleted file mode 100644 index e2743ce0..00000000 --- a/MA Report Generation/Coral.R +++ /dev/null @@ -1,737 +0,0 @@ -library(knitr) -library(data.table) -library(dplyr) -library(lubridate) -library(ggplot2) -library(scales) -library(tidyr) -library(gridExtra) -library(hrbrthemes) -library(nlme) -library(ggpubr) - -data <- fread(coral_file_in, sep="|", header=TRUE, stringsAsFactors=FALSE, - na.strings=c("NULL","","NA")) -data2 <- data - -params_to_plot <- c("PercentCover", "SpeciesRichness") - - -###################### -### DATA FILTERING ### -###################### - -if("PercentCover" %in% params_to_plot){ - - out_dir <- "output/Data/Coral/PercentCover" - param_name <- "PercentCover" - param_file <- "PC" - seed <- 42 - - # Only keep data for Percent Cover - data <- data[data$ParameterName=="Percent Cover - Species Composition"] - - # Simplify ParameterName to Percent Cover - data$ParameterName <- "Percent Cover" - parameter <- "Percent Cover" - - # Sets units for percent cover - unit <- "%" - data$ParameterUnits <- unit - - # Remove any rows that are not corals - data <- data[SpeciesGroup1=="Octocoral"| - SpeciesGroup1=="Milleporans"| - SpeciesGroup1=="Scleractinian", ] - # Remove rows with missing ManagedAreaName - data <- data[!is.na(data$ManagedAreaName),] - data <- data[data$ManagedAreaName!="NA",] - # Remove rows with missing GenusName - data <- data[!is.na(data$GenusName),] - # Remove rows with missing SpeciesName - data <- data[!is.na(data$SpeciesName),] - # Remove rows with missing Months - data <- data[!is.na(data$Month),] - # Remove rows with missing Years - data <- data[!is.na(data$Year),] - # Remove rows with missing SpeciesGroup1 - data <- data[!is.na(data$SpeciesGroup1),] - # Remove rows with missing ResultValue - data <- data[!is.na(data$ResultValue),] - # Remove rows with missing SampleDate - data <- data[!is.na(data$SampleDate),] - # Remove duplicate rows - data <- data[data$MADup==1,] - # Create variable that combines the genus and species name - data$gensp <- paste(data$GenusName, data$SpeciesName, sep=" ") - # Corrects Managed Area names to be consistent with official names - data$ManagedAreaName[data$ManagedAreaName=="Florida Keys NMS"] <- - "Florida Keys National Marine Sanctuary" - data$ManagedAreaName[data$ManagedAreaName== - "Biscayne Bay-Cape Florida to Monroe County Line"] <- - "Biscayne Bay-Cape Florida to Monroe County Line Aquatic Preserve" - data$ManagedAreaName[data$ManagedAreaName=="Coupon Bight"] <- - "Coupon Bight Aquatic Preserve" - data$ManagedAreaName[data$ManagedAreaName=="Coral ECA"] <- - "Southeast Florida Coral Reef Ecosystem Conservation Area" - - # Adds AreaID for each managed area by combining the MA_All datatable to the - # data based on ManagedAreaName - data <- merge.data.frame(MA_All[,c("AreaID", "ManagedAreaName")], - data, by=c("AreaID", "ManagedAreaName"), all=TRUE) - ############### - ## SUM STATS ## - ############### - - # Create summary statistics for each managed area based on Year and Month - # intervals. - MA_YM_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year, Month) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(ResultValue)), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName, Year, then Month - MA_YM_Stats <- as.data.table(MA_YM_Stats[order(MA_YM_Stats$ManagedAreaName, - MA_YM_Stats$Year, - MA_YM_Stats$Month), ]) - # Writes summary statistics to file - fwrite(MA_YM_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_MMYY_Stats.txt"), sep="|") - # Removes variable storing data to improve computer memory - rm(MA_YM_Stats) - - # Create summary statistics for each managed area based on Year intervals - MA_Y_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(ResultValue)), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Year - MA_Y_Stats <- as.data.table(MA_Y_Stats[order(MA_Y_Stats$ManagedAreaName, - MA_Y_Stats$Year), ]) - # Writes summary statistics to file - fwrite(MA_Y_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Yr_Stats.txt"), sep="|") - - # Create summary statistics for each managed area based on Month intervals. - MA_M_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Month) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(ResultValue)), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Month - MA_M_Stats <- as.data.table(MA_M_Stats[order(MA_M_Stats$ManagedAreaName, - MA_M_Stats$Month), ]) - # Writes summary statistics to file - fwrite(MA_M_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Mo_Stats.txt"), sep="|") - # Removes variable storing data to improve computer memory - rm(MA_M_Stats) - - # Create summary overall statistics for each managed area. - MA_Ov_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName) %>% - dplyr::summarize(ParameterName=parameter, - N_Years=length(unique(na.omit(Year))), - SufficientData=ifelse(N_Years>=5, TRUE, FALSE), - EarliestYear=min(Year), - LatestYear=max(Year), - N_Data=length(na.omit(ResultValue)), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName - MA_Ov_Stats <- as.data.table(MA_Ov_Stats[order(MA_Ov_Stats$ManagedAreaName), ]) - - # Replaces blank ProgramIDs with NA (missing values) - MA_Ov_Stats$ProgramIDs <- replace(MA_Ov_Stats$ProgramIDs, - MA_Ov_Stats$ProgramIDs=="", NA) - MA_Ov_Stats$Programs <- replace(MA_Ov_Stats$Programs, - MA_Ov_Stats$Programs=="", NA) - # Write overall statistics to file - fwrite(MA_Ov_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Overall_Stats.txt"), sep="|") - # Creates a variable with the names of all the managed areas that contain - # species observations - MA_Include <- unique(MA_Ov_Stats$ManagedAreaName[!is.na(MA_Ov_Stats$Mean)& - MA_Ov_Stats$SufficientData== - TRUE]) - - # Puts the managed areas in alphabetical order - MA_Include <- MA_Include[order(MA_Include)] - - # Determines the number of managed areas used - n <- length(MA_Include) - - coral_pc_MA_Include <- MA_Include - - ############### - ##### LME ##### - ############### - - # Creates blank data frame with number of rows defined by how many managed areas - # are going to be analyzed - lme_stats <- data.frame(matrix(ncol = 5, nrow = n)) - # Sets column names for blank data frame - colnames(lme_stats) <- c("AreaID", "ManagedAreaName", "LME_Intercept", - "LME_Slope", "LME_p") - - # Begins to loop through each managed area for analysis - for(i in 1:n){ - # Gets data for current managegd area - lme_data <- data[data$ManagedAreaName==MA_Include[i],] - # Perform LME for relation between ResultValue and Year for current managed area - AnyCoral<-lme(ResultValue ~ Year, - random =~1|ProgramLocationID, - na.action = na.omit, - data = lme_data) - # Store information and model fits in appropriate row of data frame - lme_stats$AreaID[i] <- unique(lme_data$AreaID) - lme_stats$ManagedAreaName[i] <- MA_Include[i] - lme_stats$LME_Intercept[i] <- AnyCoral$coefficients$fixed[1] - lme_stats$LME_Slope[i] <- AnyCoral$coefficients$fixed[2] - lme_stats$LME_p[i] <- anova(AnyCoral)$p[2] - - # Clears temporary variables for memory - rm(lme_data) - (AnyCoral) - } - - # Merges LME stats with overall stats to complete stats for each managed area - lme_stats <- merge.data.frame(MA_Ov_Stats[,-c("Programs", "ProgramIDs")], - lme_stats, by=c("AreaID", "ManagedAreaName"), all=TRUE) - - # Puts the data in order based on ManagedAreaName - lme_stats <- as.data.frame(lme_stats[order(lme_stats$ManagedAreaName), ]) - - # Write lme statistics to file - fwrite(lme_stats, paste0(out_dir,"/Coral_", param_file, - "_LME_Stats.txt"), sep="|") - - # Gets lower x and y values based on LME fit to use in plot - lme_plot <- lme_stats %>% - dplyr::group_by(AreaID, ManagedAreaName) %>% - dplyr::summarize(x=EarliestYear, - y=LME_Slope*x+LME_Intercept) - # Gets upper x and y values based on LME fit to use in plot - lme_plot2 <- lme_stats %>% - dplyr::group_by(AreaID, ManagedAreaName) %>% - dplyr::summarize(x=LatestYear, - y=LME_Slope*x+LME_Intercept) - # Merges LME fit values for plot into one data frame - lme_plot <- bind_rows(lme_plot, lme_plot2) - rm(lme_plot2) - # Puts LME plot data fram in alphabetical order by managed area - lme_plot <- as.data.frame(lme_plot[order(lme_plot$ManagedAreaName), ]) - lme_plot <- lme_plot[!is.na(lme_plot$y),] - - # unqiue data filename for later access - data_pc <- data - lme_plot_pc <- lme_plot - MA_Ov_Stats_pc <- MA_Ov_Stats - -} - - -if("SpeciesRichness" %in% params_to_plot){ - - out_dir <- "output/Data/Coral/SpeciesRichness" - param_name <- "SpeciesRichness" - param_file <- "SpeciesRichness" - - # Only keep data for Presence of grazers and reef-dependent species - data <- data2[data2$ParameterName=="Presence - Grazers and Reef Dependent Species"] - - # Create ParameterName Column - data$ParameterName <- "Species Richness" - parameter <- "Species Richness" - title_param <- "Species Richness - Grazers and Reef-Dependent Species" - - # Sets units for species richness - unit <- "# of species" - data$ParameterUnits <- unit - - # Remove rows with missing ManagedAreaName - data <- data[!is.na(data$ManagedAreaName),] - data <- data[data$ManagedAreaName!="NA",] - # Remove rows with missing GenusName - data <- data[!is.na(data$GenusName),] - # Remove rows with missing SpeciesName - data <- data[!is.na(data$SpeciesName),] - # Remove rows with missing Months - data <- data[!is.na(data$Month),] - # Remove rows with missing Years - data <- data[!is.na(data$Year),] - # Remove rows with missing SpeciesGroup1 - data <- data[!is.na(data$SpeciesGroup1),] - # Remove rows with invasive species - data <- data[data$SpeciesGroup1!="Invasive",] - # Set ResultValue to be a number value - data$ResultValue <- as.numeric(data$ResultValue) - # Remove rows where ResultValue is 0 and missing - data <- data[data$ResultValue!=0,] - data <- data[!is.na(data$ResultValue),] - # Remove duplicate rows - data <- data[data$MADup==1,] - # Create variable that combines the genus and species name - data$gensp <- paste(data$GenusName, data$SpeciesName, sep=" ") - # Corrects Managed Area names to be consistent with official names - data$ManagedAreaName[data$ManagedAreaName=="Florida Keys NMS"] <- - "Florida Keys National Marine Sanctuary" - data$ManagedAreaName[data$ManagedAreaName== - "Biscayne Bay-Cape Florida to Monroe County Line"] <- - "Biscayne Bay-Cape Florida to Monroe County Line Aquatic Preserve" - data$ManagedAreaName[data$ManagedAreaName=="Coupon Bight"] <- - "Coupon Bight Aquatic Preserve" - data$ManagedAreaName[data$ManagedAreaName=="Coral ECA"] <- - "Southeast Florida Coral Reef Ecosystem Conservation Area" - - # Create Species Richness values for groups of unique combinations of - # ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, and SampleDate. - data <- data[data$ResultValue==1] %>% - dplyr::group_by(ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, - SampleDate) %>% - dplyr::summarise(ParameterName=parameter, - Year=unique(Year), Month=unique(Month), - SpeciesRichness=length(unique(gensp))) - - # Adds AreaID for each managed area by combining the MA_All datatable to the - # data based on ManagedAreaName - data <- merge.data.frame(MA_All[,c("AreaID", "ManagedAreaName")], - data, by="ManagedAreaName", all=TRUE) - - # Writes this data that is used by the rest of the script to a text file - fwrite(data, paste0(out_dir,"/Coral_", param_file, "_UsedData.txt"), - sep="|") - - # Makes sure SampleDate is being stored as a Date object - data$SampleDate <- as.Date(data$SampleDate) - - # Creates a variable with the names of all the managed areas that contain - # species observations - MA_Include <- unique(data$ManagedAreaName[!is.na(data$SpeciesRichness)]) - - # Puts the managed areas in alphabetical order - MA_Include <- MA_Include[order(MA_Include)] - - coral_sr_MA_Include <- MA_Include - - # Determines the number of managed areas used - n <- length(MA_Include) - - ##################### - ### SUMMARY STATS ### - ##################### - - # Create summary statistics for each managed area based on Year and Month - # intervals. - MA_YM_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year, Month) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName, Year, then Month - MA_YM_Stats <- as.data.table(MA_YM_Stats[order(MA_YM_Stats$ManagedAreaName, - MA_YM_Stats$Year, - MA_YM_Stats$Month), ]) - # Writes summary statistics to file - fwrite(MA_YM_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_MMYY_Stats.txt"), sep="|") - # Removes variable storing data to improve computer memory - rm(MA_YM_Stats) - - # Create summary statistics for each managed area based on Year intervals - MA_Y_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Year - MA_Y_Stats <- as.data.table(MA_Y_Stats[order(MA_Y_Stats$ManagedAreaName, - MA_Y_Stats$Year), ]) - # Writes summary statistics to file - fwrite(MA_Y_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Yr_Stats.txt"), sep="|") - - # Create summary statistics for each managed area based on Month intervals. - MA_M_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Month) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Month - MA_M_Stats <- as.data.table(MA_M_Stats[order(MA_M_Stats$ManagedAreaName, - MA_M_Stats$Month), ]) - # Writes summary statistics to file - fwrite(MA_M_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Mo_Stats.txt"), sep="|") - # Removes variable storing data to improve computer memory - rm(MA_M_Stats) - - # Create summary overall statistics for each managed area. - MA_Ov_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName) %>% - dplyr::summarize(ParameterName=parameter, - N_Years=length(unique(na.omit(Year))), - EarliestYear=min(Year), - LatestYear=max(Year), - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName - MA_Ov_Stats <- as.data.table(MA_Ov_Stats[order(MA_Ov_Stats$ManagedAreaName), ]) - # Creates Year_MinRichness and Year_MaxRichness columns - MA_Ov_Stats$Year_MinRichness <- NA - MA_Ov_Stats$Year_MaxRichness <- NA - - # Loops through each ManagedAreaName. - # Determines what year the minimum and maximum species richness occurred - for(m in 1:nrow(MA_Ov_Stats)){ - # Stores ManagedAreaName for this row - man <- MA_Ov_Stats$ManagedAreaName[m] - - # Skips to next row if there are no data for this combination - if(MA_Ov_Stats$N_Data[m]==0){ - next - } - # Gets subset of data from MA_Y_Stats (yearly summary stats) with this - # ManagedAreaName - ds <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==man,] - # Gets the minimum and maximum Mean (yearly averages) - min <- min(ds$Mean) - max <- max(ds$Mean) - #Determines what years those minimum and maximum values occured - year_min <- ds$Year[ds$Mean==min] - year_max <- ds$Year[ds$Mean==max] - # Stores the occurrence years of the minimum and maximum into the overall - # stats for this row - MA_Ov_Stats$Year_MinRichness[m] <- year_min - MA_Ov_Stats$Year_MaxRichness[m] <- year_max - } - # Replaces blank ProgramIDs with NA (missing values) - MA_Ov_Stats$ProgramIDs <- replace(MA_Ov_Stats$ProgramIDs, - MA_Ov_Stats$ProgramIDs=="", NA) - MA_Ov_Stats$Programs <- replace(MA_Ov_Stats$Programs, - MA_Ov_Stats$Programs=="", NA) - # Write overall statistics to file - fwrite(MA_Ov_Stats, paste0(out_dir,"/Coral_", param_file, - "_MA_Overall_Stats.txt"), sep="|") - # Removes entries from the overall statistics that do not have data. - # Based on presence or absence of EarliestYear - MA_Ov_Stats <- MA_Ov_Stats[!is.na(MA_Ov_Stats$EarliestYear), ] - - MA_Y_Stats_sr <- MA_Y_Stats - MA_Ov_Stats_sr <- MA_Ov_Stats - -} - -###################### -### START PLOTTING ### -###################### - -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text=element_text(family="Arial"), - plot.title=element_text(hjust=0.5, size=12, color="#314963"), - plot.subtitle=element_text(hjust=0.5, size=10, color="#314963"), - legend.title=element_text(size=10), - legend.text.align = 0, - axis.title.x = element_text(size=10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size=10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text=element_text(size=10), - axis.text.x=element_text(angle = -45, hjust = 0)) - -# Create jitter object that sets the height and width -# Sets seed to be reproducible -plot_jitter <- position_jitter(width = 0.2, height = 0.2, seed=seed) -# Color palette for SEACAR -color_palette <- c("#005396", "#0088B1", "#00ADAE", "#65CCB3", "#AEE4C1", - "#FDEBA8", "#F8CD6D", "#F5A800", "#F17B00") - -########################## -### PLOTTING FUNCTIONS ### -########################## - -plot_coral_pc <- function(ma, data = "data_pc", lme_plot = "lme_plot_pc", MA_Ov_Stats = "MA_Ov_Stats_pc"){ - # Gets data for target managed area - plot_data <- data[data$ManagedAreaName==ma,] - - lme_plot_data <- lme_plot[lme_plot$ManagedAreaName==ma,] - # Determines most recent year with available data for managed area - t_max <- max(MA_Ov_Stats$LatestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines earliest recent year with available data for managed area - t_min <- min(MA_Ov_Stats$EarliestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines how many years of data are present - t <- t_max-t_min - - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 5 years if between 30 and 10 years of data - brk <- -5 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - # Determine range of data values for the managed area - y_range <- max(plot_data$ResultValue) - min(plot_data$ResultValue) - - # Sets y_min to be -1 - y_min <- -1 - - # Sets upper bound of y-axis to be 10% of the data range above the - # maximum value. - y_max <- max(plot_data$ResultValue)+(0.1*y_range) - - - # Creates plot object using plot_data. - # Data is plotted as a point pot with jitter to show concentrations - # that overlap. LME fit is plotted as a line - p1 <- ggplot(data=plot_data) + - geom_point(aes(x=Year, y=ResultValue), - position=plot_jitter, shape=21, size=2, - color="#333333", fill="#cccccc", alpha=1) + - geom_line(data=lme_plot_data, aes(x=x, y=y), - color="#000099", size=2, alpha=0.8) + - labs(title="Coral Percent Cover", - subtitle=ma, - x="Year", y="Percent cover (%)") + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max, t_min, brk)) + - scale_y_continuous(limits=c(y_min, y_max), - breaks=pretty_breaks(n=5)) + - plot_theme - # Sets file name of plot created - outname <- paste0("Coral_", param_file, "_", gsub(" ", "", ma), - ".png") - # # Saves plot as a png image - # png(paste0(out_dir, "/Figures/", outname), - # width = 8, - # height = 4, - # units = "in", - # res = 200) - # print(p1) - # dev.off() - - # Creates a data table object to be shown underneath plots in report - ResultTable <- - lme_stats[lme_stats$ManagedAreaName==ma,] - # Removes location, and parameter information because it is in plot - # labels - ResultTable <- select(ResultTable, -c("AreaID", "ManagedAreaName", - "ParameterName")) - # Renames StandardDeviation to StDev to save horizontal space - ResultTable <- ResultTable %>% - dplyr::rename("StDev"="StandardDeviation") - # Converts all non-integer values to 2 decimal places for space - ResultTable$Min <- round(ResultTable$Min, digits=2) - ResultTable$Max <- round(ResultTable$Max, digits=2) - ResultTable$Median <- round(ResultTable$Median, digits=2) - ResultTable$Mean <- round(ResultTable$Mean, digits=2) - ResultTable$StDev <- round(ResultTable$StDev, digits=2) - ResultTable$LME_Intercept <- round(ResultTable$LME_Intercept, digits=2) - ResultTable$LME_Slope <- round(ResultTable$LME_Slope, digits=2) - ResultTable$LME_p <- round(ResultTable$LME_p, digits=4) - # Stores as plot table object - t1 <- ggtexttable(ResultTable, rows = NULL, - theme=ttheme(base_size=7)) %>% - tab_add_footnote(text="LME_p < 0.00005 appear as 0 due to rounding.", - size=10, face="italic") - # Combines plot and table into one figure - print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - - # Add extra space at the end to prevent the next figure from being too - # close. Does not add space after last plot - if(i!=n){ - cat("\n \n \n \n") - } -} - -plot_coral_sr <- function(ma, MA_Y_Stats = "MA_Y_Stats_sr", MA_Ov_Stats = "MA_Ov_Stats_sr"){ - # Gets data for target managed area - plot_data <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==ma] - # Determines most recent year with available data for managed area - t_max <- max(MA_Ov_Stats$LatestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines earliest recent year with available data for managed area - t_min <- min(MA_Ov_Stats$EarliestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines how many years of data are present - t <- t_max-t_min - - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 5 years if between 30 and 10 years of data - brk <- -5 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - # Determine range of data values for the managed area - y_range <- max(plot_data$Mean) - min(plot_data$Mean) - - # Determines lower bound of y-axis based on data range. Set based on - # relation of data range to minimum value. Designed to set lower boundary - # to be 10% of the data range below the minimum value - y_min <- if(min(plot_data$Mean)-(0.1*y_range)<0){ - # If 10% of the data range below the minimum value is less than 0, - # set as 0 - y_min <- 0 - } else { - # Otherwise set minimum bound as 10% data range below minimum value - y_min <- min(plot_data$Mean)-(0.1*y_range) - } - - # Sets upper bound of y-axis to be 10% of the data range above the - # maximum value. - y_max <- max(plot_data$Mean)+(0.1*y_range) - - - # Creates plot object using plot_data. - # Data is plotted as symbols with connected lines. - p1 <- ggplot(data=plot_data) + - geom_line(aes(x=Year, y=Mean), color=color_palette[1], - size=0.75, alpha=1) + - geom_point(aes(x=Year, y=Mean), fill=color_palette[1], - shape=21, size=2, color="#333333", alpha=1) + - labs(title="Grazers and Reef-Dependent Species Richness", - subtitle=ma, - x="Year", y="Richness (# of species)") + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max, t_min, brk)) + - scale_y_continuous(limits=c(y_min, y_max), - breaks=pretty_breaks(n=5)) + - plot_theme - # Sets file name of plot created - outname <- paste0("Coral_", param_file, "_", gsub(" ", "", ma), - ".png") - # Saves plot as a png image - # png(paste0(out_dir, "/Figures/", outname), - # width = 8, - # height = 4, - # units = "in", - # res = 200) - # print(p1) - # dev.off() - - # Creates a data table object to be shown underneath plots in report - ResultTable <- - MA_Ov_Stats[MA_Ov_Stats$ManagedAreaName==ma,] - # Removes location, and parameter information because it is in plot - # labels - ResultTable <- ResultTable[,-c("AreaID", "ManagedAreaName", - "ProgramIDs", "Programs", "ParameterName")] - # Renames StandardDeviation to StDev to save horizontal space - ResultTable <- ResultTable %>% - dplyr::rename("StDev"="StandardDeviation") - # Converts all non-integer values to 2 decimal places for space - ResultTable$Min <- round(ResultTable$Min, digits=2) - ResultTable$Max <- round(ResultTable$Max, digits=2) - ResultTable$Median <- round(ResultTable$Median, digits=2) - ResultTable$Mean <- round(ResultTable$Mean, digits=2) - ResultTable$StDev <- round(ResultTable$StDev, digits=2) - # Stores as plot table object - t1 <- ggtexttable(ResultTable, rows = NULL, - theme=ttheme(base_size=7)) - # Combines plot and table into one figure - print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - - # Add extra space at the end to prevent the next figure from being too - # close. Does not add space after last plot - if(i!=n){ - cat("\n \n \n \n") - } -} - -coral_managed_areas <- unique(c(coral_pc_MA_Include, coral_sr_MA_Include)) \ No newline at end of file diff --git a/MA Report Generation/Nekton.R b/MA Report Generation/Nekton.R deleted file mode 100644 index df405d0d..00000000 --- a/MA Report Generation/Nekton.R +++ /dev/null @@ -1,380 +0,0 @@ -library(knitr) -library(data.table) -library(dplyr) -library(lubridate) -library(ggplot2) -library(scales) -library(tidyr) -library(gridExtra) -library(ggpubr) -library(scales) - -#This script is designed to only determine species richness from the Nekton presence data -param_name <- "Presence" - -#Sets abbreviation or label to be used in file names -param_file <- "SpeciesRichness" - -# output path for data files -nek_data_out <- "output/Data/Nekton" - -#Import data from nekton file -data <- fread(nekton_file_in, sep="|", header=TRUE, stringsAsFactors=FALSE, - na.strings=c("NULL","","NA")) - -################# -### FILTERING ### -################# - -# Filter data for the desired parameter -data <- data[data$ParameterName==param_name, ] - -if (param_name=="Presence"){ - parameter <- "Species Richness" -} -# Makes sure EffortCorrection is numeric value -data$EffortCorrection_100m2 <- as.numeric(data$EffortCorrection_100m2) - -# Remove any data with missing EffortCorrection values -data <- data[!is.na(data$EffortCorrection_100m2),] - -# Only keep data that has non-zero EffortCorrection values -data <- data[data$EffortCorrection_100m2!=0,] - -# Remove any data with missing ResultValue entries -data <- data[!is.na(data$ResultValue),] - -# Create Species Richness values for groups of unique combinations of -# ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, SampleDate, -# GearType, and GearSize_m. -data <- data %>% - group_by(ManagedAreaName, ProgramID, ProgramName, ProgramLocationID, - SampleDate, GearType, GearSize_m) %>% - dplyr::summarize(ParameterName=parameter, - Year=unique(Year), Month=unique(Month), - N_Species=sum(ResultValue), - EffortCorrection_100m2=as.numeric(unique(EffortCorrection_100m2)), - SpeciesRichness=N_Species/unique(EffortCorrection_100m2)) - -# Adds AreaID for each managed area by combining the MA_All datatable to the -# data based on ManagedAreaName -data <- merge.data.frame(MA_All[,c("AreaID", "ManagedAreaName")], - data, by="ManagedAreaName", all=TRUE) - -# Writes this data that is used by the rest of the script to a text file -fwrite(data, paste0(nek_data_out,"/Nekton_", param_file, "_UsedData.txt"), sep="|") - -# Makes sure SampleDate is being stored as a Date object -data$SampleDate <- as.Date(data$SampleDate) - -# Creates a variable with the names of all the managed areas that contain -# species observations -MA_Include <- unique(data$ManagedAreaName[!is.na(data$N_Species)]) - -# Puts the managed areas in alphabetical order -MA_Include <- MA_Include[order(MA_Include)] - -# Determines the number of managed areas used -n <- length(MA_Include) - -################## -#### MA STATS #### -################## - -# Create summary statistics for each managed area based on Year and Month -# intervals, and each gear type and size. -MA_YM_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year, Month, GearType, GearSize_m) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName, Year, Month, then GearSize -MA_YM_Stats <- as.data.table(MA_YM_Stats[order(MA_YM_Stats$ManagedAreaName, - MA_YM_Stats$Year, - MA_YM_Stats$Month, - MA_YM_Stats$GearSize_m), ]) -# Writes summary statistics to file -fwrite(MA_YM_Stats, paste0(nek_data_out,"/Nekton_", param_file, - "_MA_MMYY_Stats.txt"), sep="|") -# Removes variable storing data to improve computer memory -rm(MA_YM_Stats) - -# Create summary statistics for each managed area based on Year intervals, -# and each gear type and size. -MA_Y_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Year, GearType, GearSize_m) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName, Year, then GearSize -MA_Y_Stats <- as.data.table(MA_Y_Stats[order(MA_Y_Stats$ManagedAreaName, - MA_Y_Stats$Year, - MA_Y_Stats$GearSize_m), ]) - -MA_Y_Stats <- na.omit(MA_Y_Stats) - -nekton_managed_areas <- unique(MA_Y_Stats$ManagedAreaName) - -# Writes summary statistics to file -fwrite(MA_Y_Stats, paste0(nek_data_out,"/Nekton_", param_file, - "_MA_Yr_Stats.txt"), sep="|") - -MA_Y_Stats_nek <- MA_Y_Stats - - -# Create summary statistics for each managed area based on Month intervals, -# and each gear type and size. -MA_M_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, Month, GearType, GearSize_m) %>% - dplyr::summarize(ParameterName=parameter, - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName, Month, then GearSize -MA_M_Stats <- as.data.table(MA_M_Stats[order(MA_M_Stats$ManagedAreaName, - MA_M_Stats$Month, - MA_M_Stats$GearSize_m), ]) -# Writes summary statistics to file -fwrite(MA_M_Stats, paste0(nek_data_out,"/Nekton_", param_file, - "_MA_Mo_Stats.txt"), sep="|") -# Removes variable storing data to improve computer memory -rm(MA_M_Stats) - -# Create summary overall statistics for each managed area based each gear type -# and size. -MA_Ov_Stats <- data %>% - dplyr::group_by(AreaID, ManagedAreaName, GearType, GearSize_m) %>% - dplyr::summarize(ParameterName=parameter, - N_Years=length(unique(na.omit(Year))), - EarliestYear=min(Year), - LatestYear=max(Year), - N_Data=length(na.omit(SpeciesRichness)), - Min=min(SpeciesRichness), - Max=max(SpeciesRichness), - Median=median(SpeciesRichness), - Mean=mean(SpeciesRichness), - StandardDeviation=sd(SpeciesRichness), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) -# Puts the data in order based on ManagedAreaName then GearSize -MA_Ov_Stats <- as.data.table(MA_Ov_Stats[order(MA_Ov_Stats$ManagedAreaName, - MA_Ov_Stats$GearSize_m), ]) - -MA_Ov_Stats <- na.omit(MA_Ov_Stats) -# Creates Year_MinRichness and Year_MaxRichness columns -MA_Ov_Stats$Year_MinRichness <- NA -MA_Ov_Stats$Year_MaxRichness <- NA - -# Loops through each ManagedAreaName, GearType, and GearSize_m. -# determines what year the minimum and maximum species richness occurred -for(m in 1:nrow(MA_Ov_Stats)){ - # Stores ManagedAreaName, GearType, and GearSize_m for this row - man <- MA_Ov_Stats$ManagedAreaName[m] - gear <- MA_Ov_Stats$GearType[m] - size <- MA_Ov_Stats$GearSize_m[m] - # Skips to next row if there are no data for this combination - if(MA_Ov_Stats$N_Data[m]==0){ - next - } - # Gets subset of data from MA_Y_Stats (yearly summary stats) with this - # combination of ManagedAreaName, GearType, and GearSize_m - ds <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==man & - MA_Y_Stats$GearType==gear & - MA_Y_Stats$GearSize_m==size,] - # Gets the minimum and maximum Mean (yearly averages) - min <- min(ds$Mean) - max <- max(ds$Mean) - #Determines what years those minimum and maximum values occured - year_min <- ds$Year[ds$Mean==min] - year_max <- ds$Year[ds$Mean==max] - # Stores the occurrence years of the minimum and maximum into the overall - # stats for this row - MA_Ov_Stats$Year_MinRichness[m] <- year_min - MA_Ov_Stats$Year_MaxRichness[m] <- year_max -} -# Replaces blank ProgramIDs with NA (missing values) -MA_Ov_Stats$ProgramIDs <- replace(MA_Ov_Stats$ProgramIDs, - MA_Ov_Stats$ProgramIDs=="", NA) -MA_Ov_Stats$Programs <- replace(MA_Ov_Stats$Programs, - MA_Ov_Stats$Programs=="", NA) -# Write overall statistics to file -fwrite(MA_Ov_Stats, paste0(nek_data_out,"/Nekton_", param_file, - "_MA_Overall_Stats.txt"), sep="|") -# Removes entries from the overall statistics that do not have data. -# Based on presence or absence of EarliestYear -MA_Ov_Stats <- MA_Ov_Stats[!is.na(MA_Ov_Stats$EarliestYear), ] - -MA_Ov_Stats_nek <- MA_Ov_Stats - -# Defines standard plot theme: black and white, no major or minor grid lines, -# Arial font. Title is centered, size 12, and blue (hex coded). Subtitle is -# centered, size 10, and blue (hex coded). Legend title is size 10 and the -# legend is left-justified. X-axis title is size 10 and the margins are padded -# at the top and bottom to give more space for angled axis labels. Y-axis title -# is size 10 and margins are padded on the right side to give more space for -# axis labels. Axis labels are size 10 and the x-axis labels are rotated -45 -# degrees with a horizontal justification that aligns them with the tick mark -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text=element_text(family="Arial"), - plot.title=element_text(hjust=0.5, size=12, color="#314963"), - plot.subtitle=element_text(hjust=0.5, size=10, color="#314963"), - legend.title=element_text(size=10), - legend.text.align = 0, - axis.title.x = element_text(size=10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size=10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text=element_text(size=10), - axis.text.x=element_text(angle = -45, hjust = 0)) - -# Color palette for SEACAR -color_palette <- c("#005396", "#0088B1", "#00ADAE", "#65CCB3", "#AEE4C1", "#FDEBA8", "#F8CD6D", "#F5A800", "#F17B00") - -# Defines and sets variable with standardized gear colors for plots -gear_colors <- c("Trawl (4.8 m)"=color_palette[1], - "Trawl (6.1 m)"=color_palette[2], - "Seine (183 m)"=color_palette[3]) - -# Defines and sets variable with standardized gear shapes for plots -gear_shapes <- c("Trawl (4.8 m)"=21, - "Trawl (6.1 m)"=22, - "Seine (183 m)"=24) - -plot_nekton <- function(ma, MA_Y_Stats = "MA_Y_Stats_nek", MA_Ov_Stats = "MA_Ov_Stats_nek"){ - # Gets data for target managed area - plot_data <- MA_Y_Stats[MA_Y_Stats$ManagedAreaName==ma] - - if(nrow(plot_data) > 0){ - # Gets the gear type(s) present for the managed area. - # Combine type and size into one label for plots - plot_data$GearType_Plot <- paste0(plot_data$GearType, " (", - plot_data$GearSize_m, " m)") - # Determines most recent year with available data for managed area - t_max <- max(MA_Ov_Stats$LatestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines earliest recent year with available data for managed area - t_min <- min(MA_Ov_Stats$EarliestYear[MA_Ov_Stats$ManagedAreaName== - ma]) - # Determines how many years of data are present - t <- t_max-t_min - - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 5 years if between 30 and 10 years of data - brk <- -5 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - # Determine range of data values for the managed area - y_range <- max(plot_data$Mean) - min(plot_data$Mean) - - # Determines lower bound of y-axis based on data range. Set based on - # relation of data range to minimum value. Designed to set lower boundary - # to be 10% of the data range below the minimum value - y_min <- if(min(plot_data$Mean)-(0.1*y_range)<0){ - # If 10% of the data range below the minimum value is less than 0, - # set as 0 - y_min <- 0 - } else { - # Otherwise set minimum bound as 10% data range below minimum value - y_min <- min(plot_data$Mean)-(0.1*y_range) - } - - # Sets upper bound of y-axis to be 10% of the data range above the - # maximum value. - y_max <- max(plot_data$Mean)+(0.1*y_range) - - # Determines what combination of gear are present for managed area - # and subsets color and shape scheme to be used by plots. - # Used so only gear combinations present for managed area appear in - # the legend. - gear_colors_plot <- gear_colors[unique(plot_data$GearType_Plot)] - gear_shapes_plot <- gear_shapes[unique(plot_data$GearType_Plot)] - - # Creates plot object using plot_data and grouping by the plot gear types. - # Data is plotted as symbols with connected lines. - p1 <- ggplot(data=plot_data, group=as.factor(GearType_Plot)) + - geom_line(aes(x=Year, y=Mean, color=as.factor(GearType_Plot)), - size=0.75, alpha=1) + - geom_point(aes(x=Year, y=Mean, fill=as.factor(GearType_Plot), - shape=as.factor(GearType_Plot)), size=2, - color="#333333", alpha=1) + - labs(title="Nekton Species Richness", - subtitle=ma, - x="Year", y=bquote('Richness (species/100'*~m^{2}*')'), - fill="Gear type", color="Gear type", shape="Gear type") + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max, t_min, brk)) + - scale_y_continuous(limits=c(y_min, y_max), - breaks=pretty_breaks(n=5)) + - scale_fill_manual(values=gear_colors_plot) + - scale_color_manual(values=gear_colors_plot) + - scale_shape_manual(values=gear_shapes_plot) + - plot_theme - - # Creates a data table object to be shown underneath plots in report - ResultTable <- MA_Ov_Stats[MA_Ov_Stats$ManagedAreaName==ma,] - - # Removes location, gear, and parameter information because it is in plot - # labels - ResultTable <- ResultTable[,-c("AreaID", "ManagedAreaName", - "ProgramIDs", "Programs", "GearType_Plot", - "ParameterName")] - # Renames StandardDeviation to StDev to save horizontal space - ResultTable <- ResultTable %>% - dplyr::rename("StDev"="StandardDeviation") - # Converts all non-integer values to 2 decimal places for space - ResultTable$Min <- round(ResultTable$Min, digits=2) - ResultTable$Max <- round(ResultTable$Max, digits=2) - ResultTable$Median <- round(ResultTable$Median, digits=2) - ResultTable$Mean <- round(ResultTable$Mean, digits=2) - ResultTable$StDev <- round(ResultTable$StDev, digits=2) - # Stores as plot table object - t1 <- ggtexttable(ResultTable, rows = NULL, - theme=ttheme(base_size=7)) - # Combines plot and table into one figure - combined_fig <- ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15)) - print(combined_fig) - } -} \ No newline at end of file diff --git a/MA Report Generation/ReportRender.R b/MA Report Generation/ReportRender.R index cac175e7..cc0e4b5d 100644 --- a/MA Report Generation/ReportRender.R +++ b/MA Report Generation/ReportRender.R @@ -48,7 +48,7 @@ MA_All <- fread("data/ManagedArea.csv", sep = ",", header = TRUE, stringsAsFacto #Imports SEACAR data file path information as variable "seacar_data_location" source("scripts/SEACAR_data_location.R") -files <- list.files(seacar_data_location, full=TRUE) +files <- list.files(seacar_data_location, full.names=TRUE) hab_files <- str_subset(files, "All_") cw_file_in <- str_subset(hab_files, "CW") @@ -85,6 +85,9 @@ source("scripts/SAV-Functions.R") source("scripts/Coral.R") ############################ +seacar_palette <- c("#005396", "#0088B1", "#00ADAE", "#65CCB3", "#AEE4C1", + "#FDEBA8", "#F8CD6D", "#F5A800", "#F17B00") + ################ ## file names ## # Pulls file names from discrete and cont. file list .txt rendered during .RDS object creation diff --git a/MA Report Generation/SAV-Functions.R b/MA Report Generation/SAV-Functions.R deleted file mode 100644 index 2d6f43c1..00000000 --- a/MA Report Generation/SAV-Functions.R +++ /dev/null @@ -1,115 +0,0 @@ -library(mgcv) - -############################## -### SAV PLOTTING FUNCTIONS ### -############################## - -#Managed areas that should have Halophila species combined: -ma_halspp <- c("Banana River", "Indian River-Malabar to Vero Beach", "Indian River-Vero Beach to Ft. Pierce", "Jensen Beach to Jupiter Inlet", - "Loxahatchee River-Lake Worth Creek", "Mosquito Lagoon", "Biscayne Bay", "Florida Keys NMS") - -files <- list.files(here::here("output/Figures/BB/")) #get file list -trendplots <- stringr::str_subset(files, "_trendplot") #identify map file -trendplots <- stringr::str_subset(trendplots, "_BBpct_") - -mods <- list.files(here::here("output/models/")) -models2 <- str_subset(mods, paste0(str_sub(trendplots[1], 1, str_locate_all(trendplots[1], "_")[[1]][2]))) - -malist <- c() -for(pl in trendplots){ - ma_p <- str_split(pl, "_")[[1]][3] - malist <- append(malist, ma_p) -} - -failedmodslist <- readRDS(here::here("output/models/failedmodslist.rds")) - -find_exact_matches <- function(pattern, filenames) { - regex <- paste0("(_|^)", pattern, "(_|$)") - matched_files <- str_subset(filenames, regex) - return(matched_files) -} - -plot_sav_trendplot <- function(ma_abrev){ - if(ma_abrev %in% malist){ - plot_file <- lapply(ma_abrev, find_exact_matches, filenames = trendplots) - plot <- readRDS(here::here(paste0("output/Figures/BB/", plot_file))) - print(plot) - } -} - -barplots <- stringr::str_subset(files, "_barplot") #identify map file - -malist2 <- c() -for(pl in barplots){ - ma_p <- str_split(pl, "_")[[1]][3] - malist2 <- append(malist2, ma_p) -} - - -plot_sav_barplot <- function(ma_abrev){ - if(ma_abrev %in% malist2){ - plot_file <- lapply(ma_abrev, find_exact_matches, filenames = barplots) - plot <- readRDS(here::here(paste0("output/Figures/BB/", plot_file))) - print(plot) - } -} - -sav_managed_areas <- unique(c(malist, malist2)) - -# GAM prediction function -get_gam_preds <- function(model, new_data){ - pred <- predict(model, newdata=new_data, type="link", se.fit=TRUE) - upper_bound <- pred$fit + (1.96 * pred$se.fit) - lower_bound <- pred$fit - (1.96 * pred$se.fit) - return(list(fit=pred$fit, upper=upper_bound, lower=lower_bound)) -} - -# Plot GAM function -plot_sav_gam <- function(ma_short){ - - ma_data <- SAV4 %>% filter(ManagedAreaName==ma_short) - - if(i %in% ma_halspp){ - species <- unique(ma_data$analysisunit) - au_col <- "analysisunit" - } else { - species <- unique(ma_data$analysisunit_halid) - au_col <- "analysisunit_halid" - } - - gam_models <- list() - - for (s in species){ - ma_data_species <- ma_data %>% filter(!!sym(au_col) == s) - gam_model <- gam(BB_pct ~ s(relyear), data = ma_data_species, family = gaussian()) - gam_models[[s]] <- gam_model - } - - xlims <- range(ma_data$relyear, na.rm = TRUE) - ylims <- range(ma_data$BB_pct, na.rm = TRUE) - - plot(NULL, xlim=xlims, ylim=ylims, xlab = "Year", ylab = "BB_pct", type = "n") - colors <- rainbow(length(species)) - - sp_to_skip <- c("Drift algae", "Total seagrass", "Attached algae") - inc_sp <- list() - - for (i in 1:length(species)){ - sp <- species[i] - time_range <- seq(min(ma_data$relyear, na.rm = TRUE), max(ma_data$relyear, na.rm = TRUE), length.out = 100) - - if(sp %in% sp_to_skip) { - next - } else { - preds <- get_gam_preds(gam_models[[sp]], data.frame(relyear = time_range)) - - lines(time_range, preds$fit, col=colors[i], lty=i) - - polygon(c(time_range, rev(time_range)), c(preds$lower, rev(preds$upper)), col=alpha(colors[i], 0.2), border=NA) - - inc_sp <- c(inc_sp, sp) - } - } - - legend("topright", legend=inc_sp, col=colors, lty=1:length(inc_sp)) -} diff --git a/MA Report Generation/SAV.R b/MA Report Generation/SAV.R deleted file mode 100644 index 29fecfcf..00000000 --- a/MA Report Generation/SAV.R +++ /dev/null @@ -1,818 +0,0 @@ -# Script to load SAV data for reports -library(brms) -library(broom.mixed) -library(tidybayes) -library(bayesplot) -library(sf) -library(gtable) -library(grid) -library(gridExtra) -library(tictoc) -library(nlme) -library(colorspace) -library(here) -library(patchwork) -library(extrafont) -library(magick) -library(dplyr) - -SAV <- fread(sav_file_in, sep = "|", header = TRUE, stringsAsFactors = FALSE, - na.strings=c("NULL","","NA")) -SAV <- SAV[!is.na(ResultValue), ] - -# Create data columns based on old parameter results to make script run -SAV$BB <- NA -SAV$mBB <- NA -SAV$PC <- NA -SAV$PO <- NA -SAV$SC <- NA -SAV$PA <- NA - -# Fill created columns with values based on parameter names -SAV$BB[SAV$ParameterName=="Braun Blanquet Score"] <- - SAV$ResultValue[SAV$ParameterName=="Braun Blanquet Score"] - -SAV$mBB[SAV$ParameterName=="Modified Braun Blanquet Score"] <- - SAV$ResultValue[SAV$ParameterName=="Modified Braun Blanquet Score"] - -SAV$PC[SAV$ParameterName=="Percent Cover"] <- - SAV$ResultValue[SAV$ParameterName=="Percent Cover"] - -SAV$PO[SAV$ParameterName=="Percent Occurrence"] <- - SAV$ResultValue[SAV$ParameterName=="Percent Occurrence"] - -SAV$SC[SAV$ParameterName=="Shoot Count"] <- - SAV$ResultValue[SAV$ParameterName=="Shoot Count"] - -SAV$PA[SAV$ParameterName=="Presence/Absence"] <- - SAV$ResultValue[SAV$ParameterName=="Presence/Absence"] - -#Rename "Total_SAV" to "Total SAV" -SAV$CommonIdentifier[SAV$CommonIdentifier=="Total_SAV"] <- "Total SAV" - -# Create a list of n years available for each managed area -SAV_sum <- SAV %>% group_by(ManagedAreaName) %>% summarize(n_yr = length(unique(Year)), yrs = list(sort(unique(Year)))) - -# Filtering and subsetting -SAV2 <- subset(SAV, !is.na(SAV$BB) | !is.na(SAV$mBB) | !is.na(SAV$PC) | !is.na(SAV$PO)) -SAV2 <- SAV2 %>% filter(BB >= 0 & BB <= 5 | is.na(BB)) -SAV2 <- SAV2 %>% filter(mBB >= 0 & mBB <= 5 | is.na(mBB)) -SAV2 <- SAV2 %>% filter(PC >= 0 & PC <= 100 | is.na(PC)) -SAV2 <- SAV2 %>% filter(PO >= 0 & PO <= 100 | is.na(PO)) -SAV2 <- SAV2 %>% filter(Month %in% c(4:10)) -setDT(SAV2) - -SAV2[!is.na(BB), BB_all := fcase(BB == 0, 0, - BB > 0 & BB <= 1, 1, - BB > 1, round(BB))] -SAV2[!is.na(mBB), BB_all := fcase(mBB == 0, 0, - mBB > 0 & mBB <= 1, 1, - mBB > 1, round(mBB))] -SAV2[!is.na(PC), BB_all := fcase(PC == 0, 0, - PC > 0 & PC <= (2.5 + (15-2.5)/2), 1, - PC <= (2.5 + (15-2.5) + (37.5-15)/2), 2, - PC <= (2.5 + (15-2.5) + (37.5-15) + (62.5 - 37.5)/2), 3, - PC <= (2.5 + (15-2.5) + (37.5-15) + (62.5 - 37.5) + (87.5 - 62.5)/2), 4, - PC > (2.5 + (15-2.5) + (37.5-15) + (62.5 - 37.5) + (87.5 - 62.5)/2), 5)] - - -#Replaces two blocks of code above by using the BB_all variable to create all estimates at once. -SAV2[!is.na(BB_all), BB_pct := fcase(BB_all == 0, 0, - BB_all > 0 & BB_all <= 0.1, rescale(BB_all, from=c(0, 0.1), to=c(0,0.02)), #Added by SRD 8/31/2021 - BB_all > 0.1 & BB_all <= 0.5, rescale(BB_all, from=c(0.1, 0.5), to=c(0.02,0.1)), - BB_all > 0.5 & BB_all <= 1, rescale(BB_all, from=c(0.5,1), to=c(0.1,2.5)), - BB_all > 1 & BB_all <= 2, rescale(BB_all, from=c(1,2), to=c(2.5,15)), - BB_all > 2 & BB_all <= 3, rescale(BB_all, from=c(2,3), to=c(15,37.5)), - BB_all > 3 & BB_all <= 4, rescale(BB_all, from=c(3,4), to=c(37.5,62.5)), - BB_all > 4 & BB_all <= 5, rescale(BB_all, from=c(4,5), to=c(62.5,87.5)))] - -SAV2[, BB_pct := as.numeric(BB_pct)] -SAV2[, BB_all := as.ordered(BB_all)] -SAV2[!is.na(PO), method := "Percent Occurrence"] -SAV2[!is.na(BB), method := "Braun Blanquet"] -SAV2[!is.na(mBB), method := "Modified Braun Blanquet"] -SAV2[!is.na(PC), method := "Percent Cover"] - -SAV2[!is.na(BB_all), PA := ifelse(BB_all == 0, 0, 1)] -SAV2[!is.na(PO), PA := ifelse(PO == 0, 0, 1)] - -SAV2[, relyear := Year - min(Year)] - -SAV3 <- SAV2 %>% filter(SpeciesGroup1 == "Seagrass" | SpeciesGroup1 == "Macroalgae") - -#Temporary fix to programs 570 and 571 - Group 1 should be "Total seagrass" instead of "Total SAV" -SAV3[ProgramID %in% c(570, 571) & CommonIdentifier == "Total SAV", CommonIdentifier := "Total seagrass"] - -#Temporary fix to cases where analysisunit is NA but CommonIdentifier is "Drift Algae" (and Drift_Attached is also NA); ~6,000 records -SAV3[CommonIdentifier == "Drift algae", Drift_Attached := "Drift"] - -species_reject <- c("All", "NA", - "Vallisneria americana", "Najas guadalupensis", - "Hydrilla verticillata", "Potamogeton pusillus", - "Zannichellia palustris") -SAV3[, `:=` (analysisunit_halid = ifelse(CommonIdentifier %in% species_reject, NA, - ifelse(str_detect(CommonIdentifier, "Halophila") & is.na(SpeciesName), "Unidentified Halophila", - ifelse(SpeciesGroup1 == "Seagrass", CommonIdentifier, Drift_Attached))), - analysisunit = ifelse(CommonIdentifier %in% species_reject, NA, - ifelse(str_detect(CommonIdentifier, "Halophila"), "Halophila spp.", - ifelse(SpeciesGroup1 == "Seagrass", CommonIdentifier, Drift_Attached))))] -SAV3[!is.na(Drift_Attached), `:=` (analysisunit_halid = paste0(analysisunit_halid, " algae"), - analysisunit = paste0(analysisunit, " algae"))] - -SAV4 <- subset(SAV3, !is.na(SAV3$analysisunit)) - -############################### -### SAV Plotting Functions #### -############################### - -# declaring addfits function which plots Percent Cover models on a single plot -addfits <- function(models, plot_i, param) { - # aucol determines whether analysisunit or analysisunit_halid is used - aucol <- as.name(names(plot_i$data)[1]) - # empty data frame to fill with regression data - regression_data <- data.frame() - plot_data <- data.frame() - - for (i in seq_along(models)) { - # finding model name, calling previously created model variable - model_name <- models[[i]] - model <- get(model_name) - - # selecting for Total SAV and Total Seagrass to apply aesthetic conditions later - is_ToSa <- grepl("ToSa", model_name) - is_ToSe <- grepl("ToSe", model_name) - exclude <- c("DrAl") - - # declaring species & managed area of each model - species <- unique(model$data[[aucol]]) - managed_area <- unique(model$data$ManagedAreaName) - - #extract p-value - p_val <- summary(model)$tTab[2,5] - - # exclude Drift algae from model plots - if(!grepl(paste(exclude, collapse='|'), model_name)) { - - linetypes <- "solid" - size <- 1 - alpha <- 1 - #alpha <- if (p_val <= 0.05) 1 else 0.8 - - # filter dataframe for managed_area & species - species_data <- SAV4 %>% - filter(ManagedAreaName == managed_area, - !is.na({{p}}), - {{ aucol }} == species) - - # plot_dat <- plotdat %>% - # filter({{ aucol }} == species) - - # create predicted values variable for each model - predicted_values <- predict(model, level = 0, newdata = species_data) - - # separate significant values - significant <- if (p_val <=0.05) TRUE else FALSE - - # Add predicted values to the regression_data dataframe, with species & relyear - regression_data <- rbind(regression_data, data.frame( - relyear = species_data$relyear, - fit = predicted_values, - species = unique(species_data[[aucol]]), - significance = significant)) - - # in case we separate Total SAV and Total seagrass and treat them differently - #if (is_ToSa || is_ToSe) {} else {} - # regression_data <- regression_data %>% - # filter(!species %in% c("Total SAV", "Total seagrass")) - - # Plot all other species - plot_i <- plot_i + - geom_line(data = regression_data, - aes(x = relyear, y = fit, color=species, linetype=factor(significance)), - size=size, alpha=alpha, inherit.aes = FALSE) + - # geom_bar(data = plot_dat, aes(x=relyear, y=npt), stat = "identity") + - scale_linetype_manual(name=NULL, - values=c("TRUE" = "solid", "FALSE" = "dotdash"), - labels=c("TRUE" = "Significant", "FALSE" = "Not significant")) + - # setting order of the legends, color first - guides(color = guide_legend(order=1), - linetype = guide_legend(order=2)) - } - } - - # creating color scale so names line up correctly in legend - species_list <- c("") - - for (l in plot_i[["layers"]]) { - new_species <- unique(l$data$species[!l$data$species %in% species_list]) - if (length(new_species) > 0) { - species_list <- append(species_list, new_species) - } - } - - # ordering species list to match spcols, with Total SAV & Total seagrass at bottom, otherwise alphabetical (Hal spp. at top) - species_list <- species_list[order(match(species_list, names(spcols)))] - - # determining if scientific or common names - species_labels <- modify_species_labels(species_list) - - plot_i <- plot_i + scale_color_manual(values = subset(spcols, names(spcols) %in% species_list), - breaks = species_list, - labels = species_labels) - - return(plot_i) -} - -# function to modify species labels prior to plotting (sci vs common names) -modify_species_labels <- function(species_list) { - if(usenames == "common") { - lab <- str_replace(species_list, "Unidentified Halophila", "Halophila, unk.") - } else { - lab <- sapply(species_list, function(name) { - match_idx <- match(name, spp_common) - if (!is.na(match_idx)) { - return(spp[match_idx]) - } - return(name) - }) - lab <- str_replace(lab, "Unidentified Halophila", "Halophila, unk.") - } - return(lab) -} - -## Choose which analyses to run, default is both trend and barplots -Analyses <- c("BB_pct", "PC", "PA") - -#Empty data.table to house names of any failed models generated below. -failedmods <- data.table(model = character(), - error = character()) - -############################### -### SAV Data Prep & Summary ### -############################### - -#Create a table of the proportion of present SAV types by managed area and year -props_halid <- SAV4 %>% - filter(str_detect(analysisunit_halid, "Total|Drift|spp\\.", negate = TRUE), !is.na(PA)) %>% - group_by(ManagedAreaName, analysisunit_halid, relyear) %>% - summarize(n_P = sum(PA), ntot_PA = n(), prop_P = n_P/ntot_PA) - -props <- SAV4 %>% - filter(str_detect(analysisunit, "Total|Drift|decipiens|engelmannii|johnsonii|Unidentified", negate = TRUE), !is.na(PA)) %>% - group_by(ManagedAreaName, analysisunit, relyear) %>% summarize(n_P = sum(PA), ntot_PA = n(), prop_P = n_P/ntot_PA) - -setDT(props_halid) -setDT(props) - -for(m in unique(props_halid$ManagedAreaName)){ - props_halid[ManagedAreaName == m, `:=` (n_allsp_P = sum(n_P), sp_prop = n_P/sum(n_P), sp_pct = (n_P/sum(n_P)) * 100), by = c("relyear")] -} -for(m in unique(props$ManagedAreaName)){ - props[ManagedAreaName == m, `:=` (n_allsp_P = sum(n_P), sp_prop = n_P/sum(n_P), sp_pct = (n_P/sum(n_P)) * 100), by = c("relyear")] -} - -setnames(props_halid, "analysisunit_halid", "analysisunit") -props2 <- distinct(rbind(props_halid, props)) -setorder(props2, ManagedAreaName, relyear, analysisunit) -props <- props2 - -spcollist <- c("#005396","#005396", - "#0088B1", - "#00ADAE", - "#65CCB3", - "#AEE4C1", - "#FDEBA8", - "#F8CD6D", - "#F5A800", - "#F17B00", - "#900667", - "#000099") - -spp <- c("Halophila spp.","Unidentified Halophila","Halophila johnsonii","Syringodium filiforme","Halophila decipiens","Halodule wrightii", - "Halophila engelmannii","Thalassia testudinum","Ruppia maritima","Attached algae", "Total SAV", "Total seagrass") - -spp_common <- c("Halophila spp.", "Unidentified Halophila", "Johnson's seagrass", "Manatee grass", "Paddle grass", - "Shoal grass", "Star grass", "Turtle grass", "Widgeon grass", "Attached algae", "Total SAV", "Total seagrass") - -usenames <- "common" #alternative is "scientific" - -spcols <- setNames(spcollist, spp_common) - -SAV4[, `:=` (analysisunit_halid = fcase(analysisunit_halid == "Thalassia testudinum", "Turtle grass", - analysisunit_halid == "Syringodium filiforme", "Manatee grass", - analysisunit_halid == "Halodule wrightii", "Shoal grass", - analysisunit_halid == "Ruppia maritima", "Widgeon grass", - analysisunit_halid == "Halophila decipiens", "Paddle grass", - analysisunit_halid == "Halophila engelmannii", "Star grass", - analysisunit_halid == "Halophila johnsonii", "Johnson's seagrass", - analysisunit_halid == "Unidentified Halophila", "Unidentified Halophila", - analysisunit_halid == "Halophila spp.", "Halophila spp.", - analysisunit_halid == "Total seagrass", "Total seagrass", - analysisunit_halid == "Attached algae", "Attached algae", - analysisunit_halid == "Drift algae", "Drift algae", - analysisunit_halid == "Total SAV", "Total SAV"), - analysisunit = fcase(analysisunit == "Thalassia testudinum", "Turtle grass", - analysisunit == "Syringodium filiforme", "Manatee grass", - analysisunit == "Halodule wrightii", "Shoal grass", - analysisunit == "Ruppia maritima", "Widgeon grass", - analysisunit == "Halophila decipiens", "Paddle grass", - analysisunit == "Halophila engelmannii", "Star grass", - analysisunit == "Halophila johnsonii", "Johnson's seagrass", - analysisunit == "Unidentified Halophila", "Unidentified Halophila", - analysisunit == "Halophila spp.", "Halophila spp.", - analysisunit == "Total seagrass", "Total seagrass", - analysisunit == "Attached algae", "Attached algae", - analysisunit == "Drift algae", "Drift algae", - analysisunit == "Total SAV", "Total SAV"))] - -props[, analysisunit := fcase(analysisunit == "Thalassia testudinum", "Turtle grass", - analysisunit == "Syringodium filiforme", "Manatee grass", - analysisunit == "Halodule wrightii", "Shoal grass", - analysisunit == "Ruppia maritima", "Widgeon grass", - analysisunit == "Halophila decipiens", "Paddle grass", - analysisunit == "Halophila engelmannii", "Star grass", - analysisunit == "Halophila johnsonii", "Johnson's seagrass", - analysisunit == "Unidentified Halophila", "Unidentified Halophila", - analysisunit == "Halophila spp.", "Halophila spp.", - analysisunit == "Attached algae", "Attached algae")] - -props <- props[, analysisunit := factor(analysisunit, levels = c("Unidentified Halophila", - "Halophila spp.", - "Johnson's seagrass", - "Manatee grass", - "Paddle grass", - "Shoal grass", - "Star grass", - "Turtle grass", - "Widgeon grass", - "Attached algae"))] - -# prcollist <- hcl.colors(n = length(unique(SAV4$ProgramID)), palette = "viridis") -prcollist_a <- sequential_hcl(length(unique(SAV4$ProgramName)), palette = "YlOrRd") -prcollist_b <- sequential_hcl(length(unique(SAV4$ProgramName)), palette = "YlGnBu", rev = TRUE) -prcollist <- append(prcollist_a[which(seq(1, length(prcollist_a)) %% 2 == 0)], - prcollist_b[which(seq(1, length(prcollist_b)) %% 2 != 0)]) -prcollist <- rev(prcollist) -set.seed(4691) -progs <- sample(sort(unique(SAV4$ProgramName))) -prcols <- setNames(prcollist, progs) - -parameters <- data.table(column = c(as.name("BB_pct"), as.name("PC"), as.name("PA")), - name = c("Median percent cover", "Visual percent cover", "Frequency of occurrence"), - type = c("BBpct", "PC", "PA")) - -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text = element_text(family = "Arial"), - # title = element_text(face="bold"), - plot.title = element_text(hjust = 0.5, size = 12, color = "#314963"), - plot.subtitle = element_text(hjust = 0.5, size = 10, color = "#314963"), - legend.title = element_text(size = 10), - legend.text.align = 0, - axis.title.x = element_text(size = 10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size = 10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text = element_text(size = 10), - axis.text.x = element_text(angle = -45, hjust = 0)) - -#Managed areas that should have Halophila species combined: -ma_halspp <- c("Banana River", "Indian River-Malabar to Vero Beach", "Indian River-Vero Beach to Ft. Pierce", "Jensen Beach to Jupiter Inlet", - "Loxahatchee River-Lake Worth Creek", "Mosquito Lagoon", "Biscayne Bay", "Florida Keys NMS") - -#save summary stats file -stats_pct <- SAV4[ManagedAreaName %in% ma_halspp, ] %>% - group_by(ManagedAreaName, analysisunit) %>% - summarize(ParameterName="Median percent cover (from BB scores)", - N_Programs=length(unique(ProgramID)), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', '), - N_Data=length(BB_pct[!is.na(BB_pct)]), - N_Years=length(unique(Year[!is.na(Year) & !is.na(BB_pct)])), - EarliestYear=min(Year[!is.na(BB_pct)]), - LatestYear=max(Year[!is.na(BB_pct)]), - SufficientData=ifelse(N_Data>0 & N_Years>=5, TRUE, FALSE)) -stats_pct2 <- SAV4[ManagedAreaName %in% setdiff(unique(SAV4$ManagedAreaName), ma_halspp), ] %>% - group_by(ManagedAreaName, analysisunit_halid) %>% - summarize(ParameterName="Median percent cover (from BB scores)", - N_Programs=length(unique(ProgramID)), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', '), - N_Data=length(BB_pct[!is.na(BB_pct)]), - N_Years=length(unique(Year[!is.na(Year) & !is.na(BB_pct)])), - EarliestYear=min(Year[!is.na(BB_pct)]), - LatestYear=max(Year[!is.na(BB_pct)]), - SufficientData=ifelse(N_Data>0 & N_Years>=5, TRUE, FALSE)) -setDT(stats_pct2) -setnames(stats_pct2, "analysisunit_halid", "analysisunit") -stats_pct <- distinct(rbind(stats_pct, stats_pct2)) -setcolorder(stats_pct, c("ManagedAreaName", "analysisunit")) -setDT(stats_pct) -stats_pct[N_Years == 0, `:=` (EarliestYear = NA, LatestYear = NA)] -stats_pct$ProgramIDs -data.table::fwrite(stats_pct, "output/Data/SAV/SAV_BBpct_Stats.txt", sep = "|") - -stats_pa <- SAV4[ManagedAreaName %in% ma_halspp, ] %>% - group_by(ManagedAreaName, analysisunit) %>% - summarize(ParameterName="Frequency of occurrence", - N_Programs=length(unique(ProgramID)), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', '), - N_Data=length(PA[!is.na(PA)]), - N_Years=length(unique(Year[!is.na(Year) & !is.na(PA)])), - EarliestYear=min(Year[!is.na(PA)]), - LatestYear=max(Year[!is.na(PA)]), - SufficientData=ifelse(N_Data>0 & N_Years>=5, TRUE, FALSE)) -stats_pa2 <- SAV4[ManagedAreaName %in% setdiff(unique(SAV4$ManagedAreaName), ma_halspp), ] %>% - group_by(ManagedAreaName, analysisunit_halid) %>% - summarize(ParameterName="Frequency of occurrence", - N_Programs=length(unique(ProgramID)), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', '), - N_Data=length(PA[!is.na(PA)]), - N_Years=length(unique(Year[!is.na(Year) & !is.na(PA)])), - EarliestYear=min(Year[!is.na(PA)]), - LatestYear=max(Year[!is.na(PA)]), - SufficientData=ifelse(N_Data>0 & N_Years>=5, TRUE, FALSE)) -setDT(stats_pa2) -setnames(stats_pa2, "analysisunit_halid", "analysisunit") -stats_pa <- distinct(rbind(stats_pa, stats_pa2)) -setcolorder(stats_pa, c("ManagedAreaName", "analysisunit")) -setDT(stats_pa) -stats_pa[N_Years == 0, `:=` (EarliestYear = NA, LatestYear = NA)] - -statpardat <- list("BB_pct" = stats_pct, "PA" = stats_pa) -openxlsx::write.xlsx(statpardat, here::here(paste0("output/Data/SAV/SAV_BBpct_PA_Stats_", Sys.Date(), ".xlsx")), colNames = c(TRUE, TRUE), colWidths = c("auto", "auto"), firstRow = c(TRUE, TRUE)) - -###################### -#### START SCRIPT #### -###################### - -sav_ma_include <- list() - -n <- 0 -seed <- 352 -set.seed(seed) - -for(p in parameters$column){ - cat(paste0("\nStarting indicator: ", p, "\n")) - - #List managed areas with at least 5 years of data - nyears <- SAV4[!is.na(eval(p)) & !is.na(analysisunit), ] %>% group_by(ManagedAreaName, analysisunit) %>% summarize(type = paste0(p), nyr = length(unique(Year))) - nyears2 <- SAV4[!is.na(eval(p)) & !is.na(analysisunit_halid), ] %>% group_by(ManagedAreaName, analysisunit_halid) %>% summarize(type = paste0(p), nyr = length(unique(Year))) - setDT(nyears2) - setnames(nyears2, "analysisunit_halid", "analysisunit") - nyears <- distinct(rbind(nyears, nyears2)) - ma_include <- unique(subset(nyears, nyears$nyr >= 5)$ManagedAreaName) - # sav_ma_include <- rbind(ma_include, sav_ma_include) - - #For each managed area, make sure there are multiple levels of BB scores per species; remove ones that don't from further consideration. - for(i in ma_include){ - - cat(paste0("\nStarting MA: ", i, "\n")) - - if(i %in% ma_halspp){ - species <- subset(nyears, nyears$ManagedAreaName == i & nyears$nyr >= 5 & analysisunit %in% c("Attached algae", "Drift algae", "Halophila spp.", "Manatee grass", - "Shoal grass", "Total seagrass", "Total SAV", "Turtle grass", - "Widgeon grass", "Syringodium filiforme", "Halodule wrightii", "Thalassia testudinum", - "Ruppia maritima"))$analysisunit - } else{ - species <- subset(nyears, nyears$ManagedAreaName == i & nyears$nyr >= 5 & analysisunit %in% c("Attached algae", "Drift algae", "Unidentified Halophila", - "Johnson's seagrass", "Manatee grass", "Paddle grass", - "Shoal grass", "Star grass", "Total seagrass", "Total SAV", - "Turtle grass", "Widgeon grass", "Syringodium filiforme", - "Halodule wrightii", "Thalassia testudinum","Ruppia maritima"))$analysisunit - } - - models <- c() - - #Create data.tables to hold model results for managed area i---------------------------------------------------- - lmemodresults <- data.table(managed_area = character(), - species = character(), - filename = character(), - effect = character(), - group = character(), - term = character(), - estimate = numeric(), - std.error = numeric(), - df = numeric(), - statistic = numeric(), - p.value = numeric()) - - - #In case model doesn't converge on the first try, attempt each model up to 5 times before moving on - for(j in species){ - - cat(paste0("\n Starting species: ", j, "\n")) - - if(paste0(p) %in% c("BB_pct", "PC") & ("BB_pct" %in% Analyses | "PC" %in% Analyses)){ - - formula_j <- as.formula(paste0(p, " ~ relyear")) - - set.seed(seed + n) - if(j %in% setdiff(unique(SAV4$analysisunit_halid), unique(SAV4$analysisunit))){ - model_j <- try(lme(formula_j, - random = list(SiteIdentifier = ~relyear), - control = list(msMaxIter = 1000, msMaxEval = 1000, sing.tol=1e-20), - na.action = na.omit, - data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & analysisunit_halid == j, ]), - silent = TRUE) - n <- n + 1 - x <- 0 - - while(class(model_j) == "try-error" & x < 5){ - if(x %% 25 == 0) print(paste0(" Model failed, starting attempt ", x, " of 5")) - - set.seed(seed + n) - model_j <- try(lme(formula_j, - random = list(SiteIdentifier = ~relyear), - control = list(msMaxIter = 1000, msMaxEval = 1000, sing.tol=1e-20), - na.action = na.omit, - data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & analysisunit_halid == j, ]), - silent = TRUE) - n <- n + 1 - x <- x + 1 - } - } else{ - model_j <- try(lme(formula_j, - random = list(SiteIdentifier = ~relyear), - control = list(msMaxIter = 1000, msMaxEval = 1000, sing.tol=1e-20), - na.action = na.omit, - data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & analysisunit == j, ]), - silent = TRUE) - n <- n + 1 - x <- 0 - - while(class(model_j) == "try-error" & x < 5){ - if(x %% 25 == 0) print(paste0(" Model failed, starting attempt ", x, " of 5")) - - set.seed(seed + n) - model_j <- try(lme(formula_j, - random = list(SiteIdentifier = ~relyear), - control = list(msMaxIter = 1000, msMaxEval = 1000, sing.tol=1e-20), - na.action = na.omit, - data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & analysisunit == j, ]), - silent = TRUE) - n <- n + 1 - x <- x + 1 - } - } - - - #Individual model objects are needed for plotting all species together - ##This allows get(model) functionality within addfits function - eval(call("<-", as.name(paste0(gsub('\\b(\\pL)\\pL{2,}|.', '\\U\\1', i, perl = TRUE), - "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))), - model_j)) - - #Save the model object as .rds - saveRDS(model_j, here::here(paste0("output/models/SAV_", parameters[column == p, type], "_", - gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - ifelse(stringr::str_detect(i, "NERR"), "ERR_lme_", - ifelse(stringr::str_detect(i, "NMS"), "MS_lme_", "AP_lme_")), - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), - ".rds"))) - - print(paste0(" Model object saved: ", - gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))) - - #record lme model results------------------------------------------------------ - if(class(try(eval(as.name(paste0(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))), silent = TRUE)) != "try-error"){ - models <- append(models, as.name(paste0(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))) - modj_i <- setDT(broom.mixed::tidy(eval(as.name(paste0(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))))) - modj_i[, `:=` (managed_area = ifelse(stringr::str_detect(i, "NERR"), paste0(str_sub(i, 1, -6), " National Estuarine Research Reserve"), - ifelse(stringr::str_detect(i, "NMS"), paste0(str_sub(i, 1, -5), " National Marine Sanctuary"), paste0(i, " Aquatic Preserve"))), - species = j, - filename = paste0("SAV_", parameters[column == p, type], "_", gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - ifelse(stringr::str_detect(i, "NERR"), "ERR_lme_", - ifelse(stringr::str_detect(i, "NMS"), "MS_lme_", "AP_lme_")), - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"))] - lmemodresults <- rbind(lmemodresults, modj_i) - - } else{ - failedmod <- data.table(model = paste0("SAV_", parameters[column == p, type], "_", - gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - ifelse(stringr::str_detect(i, "NERR"), "ERR_lme_", - ifelse(stringr::str_detect(i, "NMS"), "MS_lme_", "AP_lme_")), - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"), - error = model_j[1]) - - failedmods <- rbind(failedmods, failedmod) - - modj_i <- data.table(managed_area = ifelse(stringr::str_detect(i, "NERR"), paste0(str_sub(i, 1, -6), " National Estuarine Research Reserve"), - ifelse(stringr::str_detect(i, "NMS"), paste0(str_sub(i, 1, -5), " National Marine Sanctuary"), paste0(i, " Aquatic Preserve"))), - species = j, - filename = paste0("SAV_", parameters[column == p, type], "_", gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - ifelse(stringr::str_detect(i, "NERR"), "ERR_lme_", - ifelse(stringr::str_detect(i, "NMS"), "MS_lme_", "AP_lme_")), - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"), - effect = NA, - group = NA, - term = NA, - estimate = NA, - std.error = NA, - df = NA, - statistic = NA, - p.value = NA) - lmemodresults <- rbind(lmemodresults, modj_i) - } - } - } - - ###### TREND PLOTS ##### - if(paste0(p) %in% c("BB_pct", "PC") & ("BB_pct" %in% Analyses | "PC" %in% Analyses)){ - #Summarize # points per category - - if(i %in% ma_halspp){ - plotdat <- SAV4[ManagedAreaName == i & !is.na(eval(p)), ] %>% group_by(analysisunit, Year, relyear, eval(p)) %>% summarise(npt = n()) - } else{ - plotdat <- SAV4[ManagedAreaName == i & !is.na(eval(p)), ] %>% group_by(analysisunit_halid, Year, relyear, eval(p)) %>% summarise(npt = n()) - } - setDT(plotdat) - setnames(plotdat, "eval(p)", "data") - aucol <- names(plotdat[,1]) - - #split modeled vs unmodeled data - modeledsp <- c() - for(u in seq_along(models)){ - name_u <- fcase(str_detect(paste0(models[[u]]), "_ShGr"), "Shoal grass", - str_detect(paste0(models[[u]]), "_TuGr"), "Turtle grass", - str_detect(paste0(models[[u]]), "_MaGr"), "Manatee grass", - str_detect(paste0(models[[u]]), "_WiGr"), "Widgeon grass", - str_detect(paste0(models[[u]]), "_PaGr"), "Paddle grass", - str_detect(paste0(models[[u]]), "_StGr"), "Star grass", - str_detect(paste0(models[[u]]), "_JoSe"), "Johnson's seagrass", - str_detect(paste0(models[[u]]), "_UnHa"), "Unidentified Halophila", - str_detect(paste0(models[[u]]), "_HaSp"), "Halophila spp.", - str_detect(paste0(models[[u]]), "_ToSe"), "Total seagrass", - str_detect(paste0(models[[u]]), "_AtAl"), "Attached algae", - str_detect(paste0(models[[u]]), "_DrAl"), "Drift algae", - str_detect(paste0(models[[u]]), "_To"), "Total SAV") - modeledsp <- append(modeledsp, name_u) - } - - miny <- c() - for(v in seq_along(models)){ - miny_v <- try(predict(eval(models[[v]]), level = 0), silent = TRUE) - if(class(miny_v) == "try-error") next - miny <- append(miny, min(miny_v)) - } - miny <- ifelse(floor(min(miny)) < 0, floor(min(miny)), 0) - - # Scale x-axis data - breaks_seq <- seq(from = min(plotdat$relyear), - to = max(plotdat$relyear), - by = 3) - labels_seq <- seq(from = min(plotdat$Year), - to = max(plotdat$Year), - by = 3) - - #create base plot of seagrass percent cover data over time for managed area i - plot_i <- ggplot(data = droplevels(plotdat), - aes(x = relyear, y = data)) + - labs(title = parameters[column == p, name], - subtitle = ifelse(stringr::str_detect(i, "NERR"), paste0(str_sub(i, 1, -6), " National Estuarine Research Reserve"), - ifelse(stringr::str_detect(i, "NMS"), paste0(str_sub(i, 1, -5), " National Marine Sanctuary"), paste0(i, " Aquatic Preserve"))), - x = "Year", - y = parameters[column == p, name], - color = "Species model projections", - linetype = "Significance") + - plot_theme + - ylim(miny, 100) + - scale_x_continuous(breaks = breaks_seq, labels = labels_seq) + - scale_colour_manual(values = spcols) - - if(length(models) > 0){ - #make sure that no failed models slipped through - classes <- lapply(models, function(x) class(eval(x))) - models <- models[classes != "try-error"] - - plot_i <- addfits(models, plot_i, p) - } - - #Save the plot object as .rds - saveRDS(plot_i, here::here(paste0("output/Figures/BB/SAV_", parameters[column == p, type], "_", - ifelse(stringr::str_detect(i, "NERR"), - paste0(str_sub(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), 1, -2), "NERR_trendplot.rds"), - ifelse(stringr::str_detect(i, "NMS"), - paste0(str_sub(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), 1, -2), "NMS_trendplot.rds"), - paste0(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), "AP_trendplot.rds")))))) - - #Save the results table objects as .rds - saveRDS(lmemodresults, here::here(paste0("output/tables/SAV/SAV_", parameters[column == p, type], "_", - ifelse(stringr::str_detect(i, "NERR"), - paste0(str_sub(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), 1, -2), "NERR_lmeresults.rds"), - ifelse(stringr::str_detect(i, "NMS"), - paste0(str_sub(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), 1, -2), "NMS_lmeresults.rds"), - paste0(gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), "AP_lmeresults.rds")))))) - } - - ###### BAR PLOTS ###### - if(paste0(p) == "PA" & "PA" %in% Analyses){ - #Bar chart of proportions by analysisunit - breaks <- c(seq(min(SAV4[ManagedAreaName == i & !is.na(PA), relyear]), - max(SAV4[ManagedAreaName == i & !is.na(PA), relyear]), - by = 2)) - yrlist <- sort(unique(SAV4$Year)) - - labels <- c() - for(b in breaks){ - labels <- append(labels, yrlist[b + 1]) - } - - if(i %in% ma_halspp){ - - bpdat <- props[ManagedAreaName == i & !is.na(analysisunit) & str_detect(analysisunit, "decipiens|engelmannii|johnsonii|Unidentified|Star|Paddle|Johnson", negate = TRUE), ] - - sp_list <- unique(bpdat$analysisunit) - sp_list <- sp_list[order(match(sp_list, names(spcols)))] - - # add color scale, determining if scientific or common names - sp_labels <- modify_species_labels(sp_list) - - barplot_sp <- ggplot(data = bpdat, aes(x = relyear, y = sp_pct, fill = analysisunit)) + - geom_col(color = "grey20") + - scale_x_continuous(breaks = breaks, labels = labels) + - plot_theme + - labs(title = parameters[column == p, name], subtitle = paste0(ifelse(stringr::str_detect(i, "NERR"), paste0(str_sub(i, 1, -6), " National Estuarine Research Reserve"), - ifelse(stringr::str_detect(i, "NMS"), paste0(str_sub(i, 1, -5), " National Marine Sanctuary"), paste0(i, " Aquatic Preserve")))), - fill = "Species", - x = "Year", - y = "Occurrence frequency (%)") + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) + - scale_color_manual(values = subset(spcols, names(spcols) %in% sp_list), - labels = sp_labels, - aesthetics = c("color", "fill")) - } else{ - - bpdat <- props[ManagedAreaName == i & !is.na(analysisunit) & analysisunit != "Halophila spp.", ] - - sp_list <- unique(bpdat$analysisunit) - sp_list <- sp_list[order(match(sp_list, names(spcols)))] - - # add color scale, determining if scientific or common names - sp_labels <- modify_species_labels(sp_list) - - barplot_sp <- ggplot(data = bpdat, aes(x = relyear, y = sp_pct, fill = analysisunit)) + - geom_col(color = "grey20") + - scale_x_continuous(breaks = breaks, labels = labels) + - plot_theme + - labs(title = parameters[column == p, name], subtitle = paste0(ifelse(stringr::str_detect(i, "NERR"), paste0(str_sub(i, 1, -6), " National Estuarine Research Reserve"), - ifelse(stringr::str_detect(i, "NMS"), paste0(str_sub(i, 1, -5), " National Marine Sanctuary"), paste0(i, " Aquatic Preserve")))), - fill = "Species", - x = "Year", - y = "Occurrence frequency (%)") + - theme(axis.text.x = element_text(angle = 45, hjust = 1)) + - scale_color_manual(values = subset(spcols, names(spcols) %in% sp_list), - labels = sp_labels, - aesthetics = c("color", "fill")) - } - - saveRDS(barplot_sp, here::here(paste0("output/Figures/BB/SAV_", parameters[column == p, type], "_", - gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - ifelse(stringr::str_detect(i, "NERR"), "ERR_barplot_sp", - ifelse(stringr::str_detect(i, "NMS"), "MS_barplot_sp", "AP_barplot_sp")), - ".rds"))) - } - - print(paste0(" Plot objects and results tables saved: ", - gsub('\\b(\\pL)\\pL{2,}|.','\\U\\1', i, perl = TRUE), - "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))) - } -} - -#Save failedmodslist----------------------------------------------------- -saveRDS(failedmods, here::here("output/models/failedmodslist.rds")) - -#Get rid of eval(p)'s from plot file mappings--------------------------------------- -files <- list.files(here::here("output/Figures/BB/")) #get file list -files <- str_subset(files, ".rds") #exclude non-.RDS files - -filesupdated <- list() -for(f in seq_along(files)){ - file_f <- readRDS(here::here(paste0("output/Figures/BB/", files[f]))) - if(paste0(as_label(file_f$mapping$y)) == "eval(p)"){ - file_f$mapping$y <- parameters[name %in% file_f$labels$y, column][[1]] - saveRDS(file_f, here::here(paste0("output/Figures/BB/", files[f]))) - rm(file_f) - filesupdated <- append(filesupdated, files[f]) - } else { - rm(file_f) - } - if(round((f/length(files))*100, 1) %% 10 == 0){ - print(paste0(round((f/length(files))*100), "% done!")) - } -} \ No newline at end of file diff --git a/MA Report Generation/WQ_Continuous.R b/MA Report Generation/WQ_Continuous.R deleted file mode 100644 index 367b67bb..00000000 --- a/MA Report Generation/WQ_Continuous.R +++ /dev/null @@ -1,196 +0,0 @@ -cont_params_short <- c( - "DO", - "DOS", - "pH", - "Sal", - "Turb", - "TempW" -) - -# extract region for each MA to determine which cont. file to load -region <- MA_All %>% filter(ManagedAreaName == ma) %>% pull(Region) - -# Cont. Data exports do not contain full parameter names or units -# Create dataframe containing that info -cont_params_long <- c("Dissolved Oxygen","Dissolved Oxygen Saturation","pH", - "Salinity","Turbidity","Water Temperature") -cont_param_units <- c("mg/L","%","pH","ppt","NTU","Degrees C") - -cont_param_df <- data.frame(param_short = cont_params_short, - parameter = cont_params_long, - unit = cont_param_units) - -################# -### FUNCTIONS ### -################# - -# Provides a table for stations with Cont. Data -# and which stations passed the tests -station_count_table <- function(cont_data){ - - # create frame to show available stations - # show how many are included/excluded in the report - stations <- cont_data %>% - filter(ManagedAreaName == ma) %>% - distinct(ProgramLocationID, ProgramName, Use_In_Analysis) - - # table - stations_table <- kable(stations, - format="simple", - caption=paste0("Number of Continuous Stations in ", ma)) %>% - kable_styling(latex_options="scale_down", - position = "center") - - print(stations_table) - cat(" \n\n") - - # n stations total, n stations included (Use_In_Analysis) - n_stations <- nrow(stations) - n_stations_inc <- nrow(stations[stations$Use_In_Analysis==TRUE, ]) - - # print text statement - cat(paste0("There are ", n_stations, " stations in ", ma, ". \n\n")) - cat(paste0(n_stations_inc, " out of ", n_stations, " are included in this report.")) - cat(" \n\n") -} - -# For loading continuous data -# Load Data Table Function -load_cont_data_table <- function(param, region, table) { - - # Declaring RDS file list of respective tables - files <- list.files(here::here("output/tables/cont"),pattern = "\\.rds$") - file_path <- paste0("_",param,"_", region,"_", table) - - # subset file list to select desired table RDS file - table_file <- paste0("output/tables/cont/",str_subset(files, file_path)) - - # importing RDS files - df <- readRDS(table_file) - - return(df) -} - -# Unified continuous plotting function -plot_cont <- function(p, y_labels, parameter, cont_data) { - data <- cont_data %>% filter(ManagedAreaName == ma) - - Mon_YM_Stats <- as.data.frame(load_cont_data_table(p, region, "Mon_YM_Stats")) - skt_stats <- as.data.frame(load_cont_data_table(p, region, "skt_stats")) - - skt_stats <- skt_stats %>% - filter(ManagedAreaName==ma) - - # Checking for missing values - Mon_YM_Stats <- Mon_YM_Stats %>% - filter(ManagedAreaName == ma & ParameterName == parameter) - - ### SKT STATS ### - # Gets x and y values for starting point for trendline - KT.Plot <- skt_stats %>% - group_by(MonitoringID) %>% - summarize(x=decimal_date(EarliestSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Gets x and y values for ending point for trendline - KT.Plot2 <- skt_stats %>% - group_by(MonitoringID) %>% - summarize(x=decimal_date(LastSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Combines the starting and endpoints for plotting the trendline - KT.Plot <- bind_rows(KT.Plot, KT.Plot2) - rm(KT.Plot2) - KT.Plot <- as.data.table(KT.Plot[order(KT.Plot$MonitoringID), ]) - KT.Plot <- KT.Plot[!is.na(KT.Plot$y),] - - # unique monitoring location IDs for each managed area - MonIDs <- unique(data$MonitoringID) - n <- length(MonIDs) - - if (length(MonIDs) == 0){ - print("There are no monitoring locations that qualify.") - } else { - # Begins looping through each monitoring location - for (id in MonIDs) { - - ################## - ### TRENDPLOTS ### - ################## - - # Gets data to be used in plot for monitoring location - plot_data <- Mon_YM_Stats[Mon_YM_Stats$MonitoringID==id,] - - if (nrow(plot_data) > 0) { - # Gets trendline data for monitoring location - KT.plot_data <- KT.Plot[KT.Plot$MonitoringID==id,] - #Determine max and min time (Year) for plot x-axis - t_min <- min(plot_data$Year) - t_max <- max(plot_data$YearMonthDec) - t_max_brk <- as.integer(round(t_max, 0)) - t <- t_max-t_min - min_RV <- min(plot_data$Mean) - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 5 years if between 30 and 10 years of data - brk <- -5 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - # Get name of managed area - MA_name <- skt_stats$ManagedAreaName[skt_stats$MonitoringID==id] - # Get program location name - Mon_name <- paste0(skt_stats$ProgramID[skt_stats$MonitoringID==id], - "\n", skt_stats$ProgramName[skt_stats$MonitoringID==id], "\n", - skt_stats$ProgramLocationID[skt_stats$MonitoringID==id]) - mon_name_short <- skt_stats$ProgramLocationID[skt_stats$MonitoringID==id] - # Create plot object with data and trendline - p1 <- ggplot(data=plot_data, - aes(x=YearMonthDec, y=Mean)) + - geom_point(shape=21, size=3, color="#333333", fill="#cccccc", - alpha=0.75) + - geom_line(data=KT.plot_data, aes(x=x, y=y), - color="#000099", size=1.2, alpha=0.7) + - labs(title=paste0(MA_name, "\n", Mon_name), - subtitle=parameter, - x="Year", y=y_labels) + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max_brk, t_min, brk)) + - plot_theme - - # Creates ResultTable to display statistics below plot - ResultTable <- skt_stats[skt_stats$MonitoringID==id, ] %>% - select(RelativeDepth, N_Data, N_Years, Median, Independent, tau, p, - SennSlope, SennIntercept, ChiSquared, pChiSquared, Trend) - # Create table object - t1 <- ggtexttable(ResultTable, rows=NULL, - theme=ttheme(base_size=10)) %>% - tab_add_footnote(text="p < 0.00005 appear as 0 due to rounding.\n - SennIntercept is intercept value at beginning of - record for monitoring location", - size=10, face="italic") - - ### Monitoring Station Name Label ### - mon_title <- glue("### {mon_name_short}") - cat(mon_title, "\n\n") - - # Arrange and display plot and statistic table - print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - # Add extra space at the end to prevent the next figure from being too close - cat("\n \n \n") - } - } - } - } \ No newline at end of file diff --git a/MA Report Generation/WQ_Discrete.R b/MA Report Generation/WQ_Discrete.R deleted file mode 100644 index f010a8f6..00000000 --- a/MA Report Generation/WQ_Discrete.R +++ /dev/null @@ -1,524 +0,0 @@ -library(stringr) -library(dplyr) -library(data.table) -library(ggplot2) -library(grid) -library(kableExtra) - -all_depths <- c("Surface","Bottom","All") -all_activities <- c("Field","Lab","All") -all_params_short <- c( - "ChlaC", - "Chla", - "CDOM", - "DO", - "DOS", - "pH", - "Sal", - "Secchi", - "TN", - "TP", - "TSS", - "Turb", - "TempW" -) - -############################ -######## FUNCTIONS ######### -############################ - -# function of parameter, activity type, depth, with specified filetype -# retrieves RDS filepath to be loaded -get_files <- function(p, a, d, filetype) { - - # Declaring RDS file list of respective tables - files <- list.files(here::here("output/tables/disc"),pattern = "\\.rds$") - - # "data" contains overall data for each param, regardless of depth/activity - if (filetype == "data") { - pattern <- paste0(p,"_",filetype) - - } else { - pattern <- paste0(p,"_",a,"_",d,"_",filetype) - } - # subset directory files for given pattern - file_return <- str_subset(files, pattern) - return(file_return) -} - -#function to check the number of managed areas for each p,a,d combination -n_managedareas <- function(p, a, d) { - # Declaring n value as count of managed areas - # return 0 if unable to load file (activity/depth combo not available for that param) - n <- tryCatch( - { - ma_file <- get_files(p, a, d, "MA_Include") - ma_inclusion <- readRDS(paste0("output/tables/disc/", ma_file)) - n <- length(ma_inclusion) - rm(ma_inclusion) - n - }, - error = function(e) { - 0 - }, - warning = function(w) { - 0 - } - ) - return(n) -} - -#function to make a list of managed area names -get_managed_area_names <- function(p, a, d) { - ma_list <- with( - readRDS(paste0("output/tables/disc/",get_files(p, a, d, "MA_MMYY"))), - { - unique(ManagedAreaName) - } - ) - return(list(ma_list)) -} - -#results list to record managed areas for each combination -results_list <- list() - -for (param in all_params_short) { - if (param == "Secchi"){ - depth <- "Surface" - } else { - depth <- "All" - } - - # Choosing which analyses to plot, when to combine - if (param == "ChlaC" | - param == "Chla" | - param == "CDOM" | - param == "TN" | - param == "TP") {activity = "Lab"} else if ( - param == "DO" | - param == "DOS" | - param == "pH" | - param == "Secchi" | - param == "TempW") {activity = "Field"} else if ( - param == "Sal" | - param == "TSS" | - param == "Turb") {activity = "All"} - - n <- n_managedareas(param, activity, depth) - - if (n > 0) { - print(n) - managed_area_names <- get_managed_area_names(param, activity, depth) - - # Concatenate the managed area names into a single character vector - concatenated_names <- unlist(managed_area_names) - - # Create a data frame for the current combination - result_df <- data.frame(Parameter = param, - Depth = depth, - Activity = activity, - ManagedAreaName = paste(concatenated_names)) - - # Append the result data frame to the list - results_list <- c(results_list, list(result_df)) - rm(result_df, concatenated_names, managed_area_names, n) - - } else { - print(0) - } -} - -# Bind the list of data frames using bind_rows() -managed_area_df <- bind_rows(results_list) - -disc_managed_areas <- unique(managed_area_df$ManagedAreaName) - -## Setting plot theme for plots -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text=element_text(family="Arial"), - plot.title=element_text(hjust=0.5, size=12, color="#314963"), - plot.subtitle=element_text(hjust=0.5, size=10, color="#314963"), - legend.title=element_text(size=10), - legend.text.align = 0, - axis.title.x = element_text(size=10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size=10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text=element_text(size=10), - axis.text.x=element_text(angle = -45, hjust = 0)) - - -## Load Data Table Function -## For loading discrete data -load_data_table <- function(p, a="All", d="All", table) { - - # Declaring RDS file list of respective tables - files <- list.files(here::here("output/tables/disc"),pattern = "\\.rds$") - - if (table == "data") { - filename_string <- paste0(p,"_",table) - } else { - filename_string <- paste0(p,"_",a,"_",d,"_",table) - } - - # subset file list to select desired table RDS file - table_file <- paste0("output/tables/disc/",str_subset(files, filename_string)) - - # importing RDS files - df <- lapply(table_file, readRDS) - - return(df) -} - -## Kendall-Tau Trendlines Plot function ## -plot_trendlines <- function(p, a, d, activity_label, depth_label, y_labels, parameter, data) { - cat(" \n") - cat(glue("**Discrete Seasonal Kendall-Tau Trend Analysis**"), " \n") - - MA_YM_Stats <- as.data.frame(load_data_table(p, a, d, "MA_MMYY_Stats")) - skt_stats <- as.data.frame(load_data_table(p, a, d, "skt_stats")) - - ### SKT STATS ### - # Gets x and y values for starting point for trendline - KT.Plot <- skt_stats %>% - dplyr::group_by(ManagedAreaName) %>% - dplyr::summarize(x=decimal_date(EarliestSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Gets x and y values for ending point for trendline - KT.Plot2 <- skt_stats %>% - dplyr::group_by(ManagedAreaName) %>% - dplyr::summarize(x=decimal_date(LastSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Combines the starting and endpoints for plotting the trendline - KT.Plot <- bind_rows(KT.Plot, KT.Plot2) - rm(KT.Plot2) - KT.Plot <- as.data.table(KT.Plot[order(KT.Plot$ManagedAreaName), ]) - KT.Plot <- KT.Plot[!is.na(KT.Plot$y),] - - # Checking for missing values - check_ym <- MA_YM_Stats %>% - filter(ManagedAreaName == ma) - - if (nrow(check_ym) == 0) { - invisible() - # print("error") - } else { - # Gets data to be used in plot for managed area - plot_data <- MA_YM_Stats[MA_YM_Stats$ManagedAreaName==ma,] - - # Gets trendline data for managed area - KT.plot_data <- KT.Plot[KT.Plot$ManagedAreaName==ma,] - - #Determine max and min time (Year) for plot x-axis - t_min <- min(plot_data$Year) - t_max <- max(plot_data$YearMonthDec) - t_max_brk <- as.integer(round(t_max, 0)) - t <- t_max-t_min - min_RV <- min(plot_data$Mean) - - # Sets break intervals based on the number of years spanned by data - if(t>=30){ - brk <- -10 - }else if(t<30 & t>=10){ - brk <- -5 - }else if(t<10 & t>=4){ - brk <- -2 - }else if(t<4){ - brk <- -1 - } - - # Create plot object with data and trendline - p1 <- ggplot(data=plot_data, - aes(x=YearMonthDec, y=Mean)) + - # geom_line(size=0.75, color="#333333", alpha=0.6) + - geom_point(shape=21, size=3, color="#333333", fill="#cccccc", - alpha=0.75) + - geom_line(data=KT.plot_data, aes(x=x, y=y), - color="#000099", size=1.2, alpha=0.7) + - labs(title=paste0(parameter,", ",activity_label, ", ",depth_label), - subtitle=ma, - x="Year", y=y_labels) + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max_brk, t_min, brk)) + - plot_theme - # Creates ResultTable to display statistics below plot - ResultTable <- skt_stats[skt_stats$ManagedAreaName==ma, ] %>% - select(RelativeDepth, N_Data, N_Years, Median, Independent, tau, p, - SennSlope, SennIntercept, ChiSquared, pChiSquared, Trend) - # Create table object - t1 <- ggtexttable(ResultTable, rows=NULL, - theme=ttheme(base_size=10)) %>% - tab_add_footnote(text="p < 0.00005 appear as 0 due to rounding.\n - SennIntercept is intercept value at beginning of - record for monitoring location", - size=10, face="italic") - # Arrange and display plot and statistic table - print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - # Add extra space at the end to prevent the next figure from being too - # close. - cat(" \n") - - # Included Programs - program_table <- data %>% - filter(ManagedAreaName == ma) %>% - group_by(ProgramID) %>% - mutate(YearMin = min(Year), - YearMax = max(Year), - N_Data = length(ResultValue)) %>% - distinct(ProgramID, ProgramName, N_Data, YearMin, YearMax) %>% - select(ProgramID, ProgramName, N_Data, YearMin, YearMax) %>% - arrange(desc(N_Data)) - - program_kable <- kable(program_table %>% select(-ProgramName), - format="simple", - caption=paste0("Programs contributing data for ", parameter)) - - print(program_kable) - cat(" \n") - - # program names listed below (accounting for long names) - program_ids <- unique(program_table$ProgramID) - - cat("\n **Program names:** \n \n") - - # Display ProgramName below data table - for (p_id in program_ids) { - p_name <- program_table %>% filter(ProgramID == p_id) %>% pull(ProgramName) - cat(paste0("*",p_id,"*", " - ",p_name, " \n")) - } - - cat(" \n") - - rm(plot_data, program_kable, program_table) - rm(MA_YM_Stats) - # rm(KT.Plot) - rm(skt_stats) - } -} - -## Boxplots function ## -plot_boxplots <- function(p, a, d, activity_label, depth_label, y_labels, parameter, data) { - # data <- as.data.frame(load_data_table(p, a, d, "data")) - - plot_title <- paste0(parameter,", ",activity_label, ", ",depth_label) - - # Determine upper and lower bounds of time for x-axis - plot_data <- data[data$Include==TRUE & - data$ManagedAreaName==ma,] - # plot_data <- data[data$ManagedAreaName==ma,] - year_lower <- min(plot_data$Year) - year_upper <- max(plot_data$Year) - - # Determine upper and lower bounds of ResultValue for y-axis - min_RV <- min(plot_data$ResultValue) - mn_RV <- mean(plot_data$ResultValue[plot_data$ResultValue < - quantile(data$ResultValue, 0.98)]) - sd_RV <- sd(plot_data$ResultValue[plot_data$ResultValue < - quantile(data$ResultValue, 0.98)]) - # Sets x- and y-axis scale - x_scale <- ifelse(year_upper - year_lower > 30, 10, 5) - y_scale <- mn_RV + 4 * sd_RV - - ##Year plots - # Create plot object for auto-scaled y-axis plot - p1 <- ggplot(data=plot_data, - aes(x=Year, y=ResultValue, group=Year)) + - geom_boxplot(color="#333333", fill="#cccccc", outlier.shape=21, - outlier.size=3, outlier.color="#333333", - outlier.fill="#cccccc", outlier.alpha=0.75) + - labs(subtitle="By Year", - x="Year", y=y_labels) + - scale_x_continuous(limits=c(year_lower - 1, year_upper + 1), - breaks=rev(seq(year_upper, - year_lower, -x_scale))) + - plot_theme - - p4 <- ggplot(data=plot_data, - aes(x=YearMonthDec, y=ResultValue, - group=YearMonth, color=as.factor(Month))) + - geom_boxplot(fill="#cccccc", outlier.size=1.5, outlier.alpha=0.75) + - labs(subtitle="By Year and Month", - x="Year", y=y_labels, color="Month") + - scale_x_continuous(limits=c(year_lower - 1, year_upper + 1), - breaks=rev(seq(year_upper, - year_lower, -x_scale))) + - plot_theme + - theme(legend.position="none") - - # Month Plots - # Create plot object for auto-scaled y-axis plot - p7 <- ggplot(data=plot_data, - aes(x=Month, y=ResultValue, - group=Month, fill=as.factor(Month))) + - geom_boxplot(color="#333333", outlier.shape=21, outlier.size=3, - outlier.color="#333333", outlier.alpha=0.75) + - labs(subtitle="By Month", - x="Month", y=y_labels, fill="Month") + - scale_x_continuous(limits=c(0, 13), breaks=seq(3, 12, 3)) + - plot_theme + - theme(legend.position="none", - axis.text.x=element_text(angle = 0, hjust = 1)) - - set <- ggarrange(p1 + rremove("ylab"), p4 + rremove("ylab"), p7 + rremove("ylab"), ncol=1) - - p0 <- ggplot() + labs(title=plot_title, - subtitle=ma) + - plot_theme + - theme(panel.border=element_blank(), panel.grid.major=element_blank(), - panel.grid.minor=element_blank(), axis.line=element_blank()) - - annotate_figure(p0, left = textGrob(y_labels, rot = 90, vjust = 1, gp = gpar(cex = 1.3))) - - # Arrange title on plots - Yset <- ggarrange(p0, set, ncol=1, heights=c(0.07, 1)) - Yset_annotated <- annotate_figure(Yset, - left = text_grob(y_labels, rot = 90, family = "Arial", size = 10)) - - print(Yset_annotated) - - rm(plot_data) - rm(p1, p4, p7, p0, Yset, Yset_annotated) -} - -## VQ Summary Barplot ## -plot_vq_barplot <- function(p, a, d, activity_label, depth_label, y_labels, parameter, data) { - - VQ_Summary <- as.data.frame(load_data_table(p, a, d, "VQSummary")) - - # Filter and subset dataframe for managed area - ma_vq_summary <- VQ_Summary %>% filter(ManagedAreaName == ma) - - # VQSummary conditions for qualifying VQ values - vq_condition <- ma_vq_summary$N_H !=0 | ma_vq_summary$N_I != 0 | ma_vq_summary$N_Q != 0 | ma_vq_summary$N_S != 0 | ma_vq_summary$N_U != 0 - - # apply VQ_conditions to subset dataframe - filtered_vq <- ma_vq_summary[vq_condition, ] - - # check to see if there are any qualifying VQ values, if not, skip - if (nrow(filtered_vq) != 0) { - - # select respective perc_vq columns - plot_data <- filtered_vq %>% - dplyr::select(Year, N_Total, N_H, perc_H, N_I, perc_I, N_Q, perc_Q, N_S, perc_S, N_U, perc_U) %>% - dplyr::mutate_if(is.numeric, round, 2) - - # show only relevant columns for table display - plot_data <- plot_data %>% - dplyr::select(-where(~ all(. == 0))) - - # convert data format to "long" for plotting - plot_data_long <- tidyr::pivot_longer(plot_data, - cols = starts_with("perc_"), - names_to = "Category", - values_to = "Percentage") - - # remove values when their VQ not included - plot_data_long <- plot_data_long %>% - dplyr::filter(Percentage != 0) - - # set year bounds for upper and lower - year_lower <- min(plot_data_long$Year) - year_upper <- max(plot_data_long$Year) - - # Use similar x-scaling to previous charts # may change - x_scale <- ifelse(year_upper - year_lower > 30, 10, - ifelse(year_upper == year_lower, 1, 3)) - - # set title label - lab_title <- paste0("Percentage Distribution of Value Qualifiers by year for ", d," Depths - ", parameter) - - # plot results - vq_plot <- ggplot(plot_data_long, aes(x=Year, y=Percentage, fill=Category)) + - geom_bar(stat = "identity", position="stack") + - labs(title = lab_title, - subtitle = paste(ma), - x = "Year", - y = "Percentage") + - ylim(0, 100) + - scale_x_continuous(limits=c(year_lower - 1, year_upper + 1), - breaks=rev(seq(year_upper, - year_lower, -x_scale))) + - scale_fill_manual(values=c("#00ADAE","#65CCB3","#AEE4C1","#FDE8A8","#F8CD6D"), - breaks=c("perc_H","perc_I","perc_Q","perc_S","perc_U"), - labels=c("H", "I", "Q", "S", "U")) + - plot_theme - - # print plots - print(vq_plot) - - # Replace 0 values with NA, to be modified to empty string with kable function - plot_data[plot_data == 0] <- NA - options(knitr.kable.NA = "") - - # add text table beneath plot - vq_table <- kable(plot_data, - format="simple", - digits = 1, - caption=paste0("Value Qualifiers for ", parameter)) %>% - kable_styling(latex_options="scale_down", - position = "center") - - cat(" \n") - print(vq_table) - - # list of programs with VQ data - vq <- data %>% - filter(Include==TRUE, ManagedAreaName==ma, ValueQualifier!="NA") %>% - select(ProgramID, ProgramName) - - vq_program_id <- unique(vq$ProgramID) - - cat("\n **Programs containing Value Qualified data:** \n \n") - - # Display ProgramName below data table - for (p_id in vq_program_id) { - p_name <- unlist(unique(vq %>% filter(ProgramID == p_id) %>% select(ProgramName))) - cat(paste0("*",p_id,"*", " - ",p_name, " \n")) - } - - cat(" \n") - - # add description for each VQ shown - vq <- list("N_H","N_I","N_Q","N_S","N_U") - vq_desc <- list("H - Value based on field kit determiniation; results may not be accurate. - This code shall be used if a field screening test (e.g., field gas chromatograph data, - immunoassay, or vendor-supplied field kit) was used to generate the value and the field - kit or method has not been recognized by the Department as equivalent to laboratory methods.", - - "I - The reported value is greater than or equal to the laboratory method detection - limit but less than the laboratory practical quantitation limit.", - - "Q - Sample held beyond the accepted holding time. This code shall be used if the value is derived - from a sample that was prepared or analyzed after the approved holding time restrictions for sample - preparation or analysis.", - - "S - Secchi disk visible to bottom of waterbody. The value reported is the depth of the waterbody - at the location of the Secchi disk measurement.", - - "U - Indicates that the compound was analyzed for but not detected. This symbol shall be used to indicate - that the specified component was not detected. The value associated with the - qualifier shall be the laboratory method detection limit. Unless requested by the client, - less than the method detection limit values shall not be reported ") - - vq_list <- setNames(as.list(vq_desc), vq) - - cat(" \n") - cat("**Value Qualifiers** \n \n") - cat(" \n") - - # loop to add description if the corresponding VQ is listed above - for (vq in names(vq_list)) { - if (vq %in% names(plot_data)) { - cat(unlist(vq_list[vq]), sep = '\n') - cat("\n") - } - } - - rm(VQ_Summary, filtered_vq, plot_data, plot_data_long, vq_plot) - } else { - cat(paste0("There are no qualifying Value Qualifiers for ", parameter, " in ", ma)) - cat("\n \n \n") - } -} \ No newline at end of file diff --git a/MA Report Generation/WQ_Discrete_Data_Creation.R b/MA Report Generation/WQ_Discrete_Data_Creation.R deleted file mode 100644 index 2b40f8a2..00000000 --- a/MA Report Generation/WQ_Discrete_Data_Creation.R +++ /dev/null @@ -1,725 +0,0 @@ -# The purpose of this script is to generate modular .Rds files for each relevant combination of -# parameter, relative depth, and activity type for discrete WC data. -# Originally created by J.E. Panzik (jepanzik@usf.edu) for SEACAR -# Modified by T.G. Hill (Tyler.Hill@FloridaDEP.gov) in August, 2023 - - -## WHEN RUNNING IN RSTUDIO: -## Set working directory to "Source File Location" in "Session" menu -Start_time <- Sys.time() - -#Load libraries -library(data.table) -library(knitr) -library(readr) -library(dplyr) -library(lubridate) -library(rstudioapi) -library(tictoc) -library(ggplot2) -library(ggpubr) -library(scales) -library(EnvStats) -library(tidyr) -library(kableExtra) - -# Gets directory of this script and sets it as the working directory -wd <- dirname(getActiveDocumentContext()$path) -setwd(wd) - -tic() -#Sets whether to run documents with plots or not (APP_Plots==TRUE to include plots) -APP_Plots <- TRUE - -#Set output directory -out_dir <- "output" - -#Set number of unique years a location must have to be considered for analysis -suff_years <- 10 - -#Sets the list of parameter names to cycle through. This can be edited to limit the number of parameters. -#Easiest way to edit is to comment out undesired parameters. -#If only one parameter is desired, comment out all other parameters and delete comma after remaining parameter -all_params <- c( - "Chlorophyll_a_corrected_for_pheophytin", - "Chlorophyll_a_uncorrected_for_pheophytin", - "Colored_dissolved_organic_matter_CDOM", - "Dissolved_Oxygen", - "Dissolved_Oxygen_Saturation", - "pH", - "Salinity", - "Secchi_Depth", - "Total_Nitrogen", - "Total_Phosphorus", - "Total_Suspended_Solids_TSS", - "Turbidity", - "Water_Temperature" -) - -#Sets the list of parameter abbreviation names to cycle through. This can be edited to limit the number of parameters. -#Easiest way to edit is to comment out undesired parameters. -#If only one parameter is desired, comment out all other parameters and delete comma after remaining parameter -all_params_short <- c( - "ChlaC", - "Chla", - "CDOM", - "DO", - "DOS", - "pH", - "Sal", - "Secchi", - "TN", - "TP", - "TSS", - "Turb", - "TempW" -) - -#Sets the list of relative depths to cycle through. This can be edited to limit the number of depths. -#If only one depth is desired, comment out the other depth and delete comma after remaining depth -all_depths <- c( - "Surface", - "Bottom", - "All" -) - -#Sets the list of activity types to cycle through. This can be edited to limit the number of types. -#If only one type is desired, comment out the other type and delete comma after remaining type -all_activity <- c( - "Field", - "Lab", - "All" -) - -#Loads data file with list on managed area names and corresponding area IDs and short names -MA_All <- fread("data/ManagedArea.csv", sep = ",", header = TRUE, stringsAsFactors = FALSE, - na.strings = "") - -# Creates folders for outputs -folder_paths <- c("output/tables/disc") -for (path in folder_paths) {if(!dir.exists(path)){dir.create(path)}} - -# Defines standard plot theme: black and white, no major or minor grid lines, -# Arial font. Title is centered, size 12, and blue (hex coded). Subtitle is -# centered, size 10, and blue (hex coded). Legend title is size 10 and the -# legend is left-justified. X-axis title is size 10 and the margins are padded -# at the top and bottom to give more space for angled axis labels. Y-axis title -# is size 10 and margins are padded on the right side to give more space for -# axis labels. Axis labels are size 10 and the x-axis labels are rotated -45 -# degrees with a horizontal justification that aligns them with the tick mark -plot_theme <- theme_bw() + - theme(panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - text=element_text(family="Arial"), - plot.title=element_text(hjust=0.5, size=12, color="#314963"), - plot.subtitle=element_text(hjust=0.5, size=10, color="#314963"), - legend.title=element_text(size=10), - legend.text.align = 0, - axis.title.x = element_text(size=10, margin = margin(t = 5, r = 0, - b = 10, l = 0)), - axis.title.y = element_text(size=10, margin = margin(t = 0, r = 10, - b = 0, l = 0)), - axis.text=element_text(size=10), - axis.text.x=element_text(angle = 60, hjust = 1)) - -disc_file_list <- list() - -#Starts for loop that cycles through each parameter -for (j in 1:length(all_params)){ - param_name <- all_params[j] - param_abrev <- all_params_short[j] - print(paste0("Starting parameter: ", param_name)) - #Gets the file with the filename containing the desired parameter - file_in <- list.files("data/disc", pattern=param_name, full=TRUE) - - #Since Dissolved_Oxygen will return both Dissolved_Oxygen and Dissolved_Oxygen_Saturation, - #the if statement removes the entry for Dissolved_Oxygen_Saturation when trying to get Dissolved_Oxygen - if(param_name=="Dissolved_Oxygen" & length(grep("Saturation", file_in))>0){ - file_in <- file_in[-grep("Saturation", file_in)] - } - - # shortened filenames for display in report - file_short <- sub("data/disc/", "", file_in) - # append filenames to disc_file_list - disc_file_list[[param_abrev]] <- file_short - - # output directory (discrete) - out_dir_tables <- paste0(out_dir, "/tables/disc") - - #Starts for loop that cycles through each depth - for (depth in all_depths){ - #Because secchi depth is does not have a bottom measurement, this statement skips - #Secchi depth for bottom - if (param_name=="Secchi_Depth" & (depth=="Bottom" | depth=="All")){ - next - } - - #Starts for loop that cycles through activity types. - for (activity in all_activity){ - #Skips Field loops for parameters that only have Lab measurements - if ((param_name=="Chlorophyll_a_corrected_for_pheophytin" | - param_name=="Chlorophyll_a_uncorrected_for_pheophytin" | - param_name=="Colored_dissolved_organic_matter_CDOM" | - param_name=="Total_Nitrogen" | - param_name=="Total_Phosphorus" | - param_name=="Total_Suspended_Solids_TSS") & activity=="Field") { - next - #Skips Lab loops for parameters that only have Field measurements - } else if ((param_name=="Dissolved_Oxygen" | - param_name=="Dissolved_Oxygen_Saturation" | - param_name=="pH" | - param_name=="Secchi_Depth" | - param_name=="Water_Temperature") & activity=="Lab") { - next - } else if ((param_name=="Chlorophyll_a_corrected_for_pheophytin" | - param_name=="Chlorophyll_a_uncorrected_for_pheophytin" | - param_name=="Colored_dissolved_organic_matter_CDOM" | - param_name=="Dissolved_Oxygen" | - param_name=="Dissolved_Oxygen_Saturation" | - param_name=="pH" | - param_name=="Secchi_Depth" | - param_name=="Total_Nitrogen" | - param_name=="Total_Phosphorus" | - param_name=="Water_Temperature") & activity=="All") { - next - } - - ########################### - ### BEGIN DATA CREATION ### - ########################### - - ################### - ### FILE IMPORT ### - ################### - - data <- fread(file_in, sep="|", header=TRUE, stringsAsFactors=FALSE, - select=c("ManagedAreaName", "ProgramID", "ProgramName", - "ProgramLocationID", "SampleDate", "Year", "Month", - "RelativeDepth", "ActivityType", "ParameterName", - "ResultValue", "ParameterUnits", "ValueQualifier", - "SEACAR_QAQCFlagCode", "Include"), - na.strings=c("NULL","","NA")) - - parameter <- unique(data$ParameterName) - unit <- unique(data$ParameterUnits) - cat(paste("The data file(s) used:", file_short, sep="\n")) - - ################# - ### FILTERING ### - ################# - - # Removes data rows with missing ResultValue - data <- data[!is.na(data$ResultValue),] - # Changes "Sample" to "Lab" for ActivityType - data$ActivityType <- gsub("Sample", "Lab", data$ActivityType) - - # Gets data for the specific activity type if it is not All - if(activity!="All"){ - data <- data[grep(activity, data$ActivityType),] - } - - # Changes RelativeDepth to Bottom for the QAQC flag 12Q that indicates - # measurements are both surface and bottom if the relative depth is bottom - if(depth=="Bottom"){ - data$RelativeDepth[grep("12Q", data$SEACAR_QAQCFlagCode[ - data$RelativeDepth=="Surface"])] <- "Bottom" - } - # Removes missing RelativeDepth data and data for RelativeDepth not of interest - # from all parameters except Secchi_Depth - if(param_name!="Secchi_Depth" & depth!="All"){ - data <- data[!is.na(data$RelativeDepth),] - data <- data[data$RelativeDepth==depth,] - } - - # Removes data rows that have "Blank" as an ActivityType - if(length(grep("Blank", data$ActivityType))>0){ - data <- data[-grep("Blank", data$ActivityType),] - } - - # Removes data rows with ResultValue below 0, or -2 for Water_Temperature - if(param_name=="Water_Temperature"){ - data <- data[data$ResultValue>=-2,] - } else{ - data <- data[data$ResultValue>=0,] - } - # Changes Include to be either TRUE or FALSE - data$Include <- as.logical(data$Include) - # Changes Include to be TRUE for ProgramID 476 if it had the H value qualifier - data$Include[grep("H", data$ValueQualifier[data$ProgramID==476])] <- TRUE - # Change Include to be FALSE for Secchi_Depth with U value qualifier - if(param_name=="Secchi_Depth"){ - data$Include[grep("U", data$ValueQualifier)] <- FALSE - } - # Gets AreaID for data by merging data with the managed area list - data <- merge.data.frame(MA_All[,c("AreaID", "ManagedAreaName")], - data, by="ManagedAreaName", all=TRUE) - # Creates function to checks managed area for at least 2 years of - # continuous consecutive data - DiscreteConsecutiveCheck <- function(con_data){ - # Gets AreaIDs - IDs <- unique(con_data$AreaID[con_data$Include==TRUE & - !is.na(con_data$Include)]) - # Loops through each AreaID - for(i in 1:length(IDs)) { - # Gets list of Years for AreaID - Years <- unique(con_data$Year[con_data$AreaID==IDs[i] & - con_data$Include==TRUE & - !is.na(con_data$Include)]) - # Puts Years in order - Years <- Years[order(Years)] - # If there are fewer than 2 years, skip to next AreaID - if(length(Years)<2) { - next - } - # Starts loop to make sure there are at least 2 consecutive years - # with consecutive months of data - for(j in 2:length(Years)) { - # If adjacent year entries are not 1 year apart, skip to the - # next set of year entries - if(Years[j]-Years[j-1]!=1) { - next - } - # Gets the list of months from the first year - Months1 <- unique(con_data$Month[ - con_data$AreaID==IDs[i] & - con_data$Year==Years[j-1] & - con_data$Include==TRUE & - !is.na(con_data$Include)]) - # Gets list of months for the second year - Months2 <- unique(con_data$Month[ - con_data$AreaID==IDs[i] & - con_data$Year==Years[j] & - con_data$Include==TRUE & - !is.na(con_data$Include)]) - # If there are more than 2 months shared between the two - # years, the AreaID passes the check and is stored - if(length(intersect(Months1, Months2))>=2) { - # Creates variable for stored AreaID if it - # doesn't exist - if(exists("consecutive")==FALSE){ - consecutive <- IDs[i] - break - # Adds to variable for storing AreaID if does exist - } else{ - consecutive <- append(consecutive, IDs[i]) - break - } - } - } - } - # After going through all AreaID, return variable with list of all - # that pass - return(consecutive) - } - # Stores the AreaID that pass the consecutive year check - consMonthIDs <- DiscreteConsecutiveCheck(data) - - # Creates data frame with summary for each managed area - MA_Summ <- data %>% - group_by(AreaID, ManagedAreaName) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - N_Data=length(ResultValue[Include==TRUE & !is.na(ResultValue)]), - N_Years=length(unique(Year[Include==TRUE & !is.na(Year)])), - EarliestYear=min(Year[Include==TRUE & N_Data!=0]), - LatestYear=max(Year[Include==TRUE & N_Data!=0]), - EarliestSampleDate=min(SampleDate[Include==TRUE]), - LastSampleDate=max(SampleDate[Include==TRUE]), - ConsecutiveMonths=ifelse(unique(AreaID) %in% - consMonthIDs==TRUE, TRUE, FALSE), - # Determines if monitoring location is sufficient for analysis - # based on having more than 0 data entries, more than the - # sufficient number of year, and the consecutive month criteria - SufficientData=ifelse(N_Data>0 & N_Years>=suff_years & - ConsecutiveMonths==TRUE, TRUE, FALSE), - Median=median(ResultValue[Include==TRUE & N_Data!=0], na.rm=TRUE)) - - MA_Summ$ConsecutiveMonths <- NULL - # Creates column in data that determines how many years from the start for each - # managed area - data <- data %>% - group_by(AreaID, ManagedAreaName) %>% - mutate(YearFromStart=Year-min(Year)) - # Adds SufficientData column to data table based on managed area - data <- merge.data.frame(data, MA_Summ[,c("ManagedAreaName", "SufficientData")], - by="ManagedAreaName") - # Creates Use_In_Analysis column for data that is determined if the row has - # Include value of TRUE and SufficientData value of TRUE - data$Use_In_Analysis <- ifelse(data$Include==TRUE & data$SufficientData==TRUE, - TRUE, FALSE) - # Rearranges the summary data frame columns to be AreaID, ManagedAreaName, - # ParameterName RelativeDepth, ActivityType, SufficientData, everything else - MA_Summ <- MA_Summ %>% - select(AreaID, ManagedAreaName, ParameterName, RelativeDepth, ActivityType, - SufficientData, everything()) - # Puts summary data in order based on managed area - MA_Summ <- as.data.frame(MA_Summ[order(MA_Summ$ManagedAreaName), ]) - # Put SampleDate as date object - data$SampleDate <- as.Date(data$SampleDate) - # Creates character object for Month and Year - data$YearMonth <- paste0(data$Month, "-", data$Year) - # Creates variable that puts year and month into a decimal year format - data$YearMonthDec <- data$Year + ((data$Month-0.5) / 12) - # Converts ampleDate to a decimal date - data$DecDate <- decimal_date(data$SampleDate) - - # Get list of and number of managed areas that are to be used in analysis - MA_Include <- MA_Summ$ManagedAreaName[MA_Summ$SufficientData==TRUE] - - saveRDS(MA_Include, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_MA_Include.rds")) - - ################################# - # MA_Include <- MA_Include[c(1,2)] - ################################# - - n <- length(MA_Include) - # Get list of and number of managed areas that are excluded from analysis - MA_Exclude <- MA_Summ[MA_Summ$N_Years<10 & MA_Summ$N_Years>0,] - MA_Exclude <- MA_Exclude[,c("ManagedAreaName", "N_Years")] - z <- nrow(MA_Exclude) - - ################################ - ### DETERMING ValueQualifers ### - ################################ - - # Find out how much total data exists and how much passed the initial filters - total <- length(data$Include) - pass_filter <- length(data$Include[data$Include==TRUE]) - # Get the number and percentage of data entries impacted by value qualifier H - count_H <- length(grep("H", data$ValueQualifier[data$ProgramID==476])) - perc_H <- 100*count_H/length(data$ValueQualifier) - # Get the number and percentage of data entries impacted by value qualifier I - count_I <- length(grep("I", data$ValueQualifier)) - perc_I <- 100*count_I/length(data$ValueQualifier) - # Get the number and percentage of data entries impacted by value qualifier Q - count_Q <- length(grep("Q", data$ValueQualifier)) - perc_Q <- 100*count_Q/length(data$ValueQualifier) - # Get the number and percentage of data entries impacted by value qualifier S - count_S <- length(grep("S", data$ValueQualifier)) - perc_S <- 100*count_S/length(data$ValueQualifier) - # Get the number and percentage of data entries impacted by value qualifier U - count_U <- length(grep("U", data$ValueQualifier)) - perc_U <- 100*count_U/length(data$ValueQualifier) - # Copy ValueQualifier to a new VQ_Plot to create codes for plots - data$VQ_Plot <- data$ValueQualifier - # Determine if data with value qualifier H should be included for plots based - # on the parameter being observed - inc_H <- ifelse(param_name=="pH" | param_name=="Dissolved_Oxygen" | - param_name=="Dissolved_Oxygen_Saturation", TRUE, FALSE) - # Loops through conditions to determine what indicators to include in plots. - # If H should be included - if (inc_H==TRUE){ - # Remove any Value qualifiers that aren't H or U - data$VQ_Plot <- gsub("[^HU]+", "", data$VQ_Plot) - # Standardize order of qualifiers. Puts UH as HU - data$VQ_Plot <- gsub("UH", "HU", data$VQ_Plot) - # Remove anything from ValueQualifier that isn't U from programs and that - # aren't ProgramID 476 - data$VQ_Plot[na.omit(data$ProgramID!=476)] <- - gsub("[^U]+", "", data$VQ_Plot[na.omit(data$ProgramID!=476)]) - # Changes blank character strings to NA - data$VQ_Plot[data$VQ_Plot==""] <- NA - # Prints the number and percentage of H, I, Q, U value qualifiers - cat(paste0("Number of Measurements: ", total, - ", Number Passed Filter: ", pass_filter, "\n", - "Program 476 H Codes: ", count_H, " (", round(perc_H, 6), "%)\n", - "I Codes: ", count_I, " (", round(perc_I, 6), "%)\n", - "Q Codes: ", count_Q, " (", round(perc_Q, 6), "%)\n", - "U Codes: ", count_U, " (", round(perc_U, 6), "%)")) - # If Parameter is Secchi_Depth - } else if (param_name=="Secchi_Depth") { - # Count the number of S ValueQualifier - count_S <- length(grep("S", data$ValueQualifier)) - # Get percentage of S ValueQualifier - perc_S <- 100*count_S/length(data$ValueQualifier) - # Remove anything from ValueQualifier that isn't S or U - data$VQ_Plot <- gsub("[^SU]+", "", data$VQ_Plot) - # Change all ValueQualifier that are US to be US, standardizes codes - data$VQ_Plot <- gsub("US", "SU", data$VQ_Plot) - # Sets any blank character ValueQualifier to be NA - data$VQ_Plot[data$VQ_Plot==""] <- NA - # Prints the number and percentage of I, Q, S, U - cat(paste0("Number of Measurements: ", total, - ", Number Passed Filter: ", pass_filter, "\n", - "I Codes: ", count_I, " (", round(perc_I, 6), "%)\n", - "Q Codes: ", count_Q, " (", round(perc_Q, 6), "%)\n", - "S Codes: ", count_S, " (", round(perc_S, 6), "%)\n", - "U Codes: ", count_U, " (", round(perc_U, 6), "%)")) - # For all other scenarios - } else{ - # Remove all ValueQualifier except U - data$VQ_Plot <- gsub("[^U]+", "", data$VQ_Plot) - # Sets any blank character ValueQualifier to be NA - data$VQ_Plot[data$VQ_Plot==""] <- NA - # Prints the number and percentage of I, Q, U - cat(paste0("Number of Measurements: ", total, - ", Number Passed Filter: ", pass_filter, "\n", - "I Codes: ", count_I, " (", round(perc_I, 6), "%)\n", - "Q Codes: ", count_Q, " (", round(perc_Q, 6), "%)\n", - "U Codes: ", count_U, " (", round(perc_U, 6), "%)")) - } - # Creates a data table that summarizes the number and percentage of - # ValueQualifier H, I, Q, S, and U for each managed area each year - data_summ <- data %>% - group_by(AreaID, ManagedAreaName, Year) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - N_Total=length(ResultValue), - N_AnalysisUse=length(ResultValue[Use_In_Analysis==TRUE]), - N_H=length(grep("H", ValueQualifier[ProgramID==476])), - perc_H=100*N_H/length(ValueQualifier), - N_I=length(grep("I", ValueQualifier)), - perc_I=100*N_I/length(ValueQualifier), - N_Q=length(grep("Q", ValueQualifier)), - perc_Q=100*N_Q/length(ValueQualifier), - N_S=length(grep("S", ValueQualifier)), - perc_S=100*N_S/length(ValueQualifier), - N_U=length(grep("U", ValueQualifier)), - perc_U=100*N_U/length(ValueQualifier)) - # Orders the data table rows based on managed area name - data_summ <- as.data.table(data_summ[order(data_summ$ManagedAreaName, - data_summ$Year), ]) - # Writes the ValueQualifier summary to a RDS file - print("Saving data_summ.rds") - saveRDS(data_summ, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_VQSummary.rds")) - - rm(data_summ) - - ############################### - ### MANAGED AREA STATISTICS ### - ############################### - - # Create summary statistics for each managed area based on Year and Month - # intervals. - MA_YM_Stats <- data[data$Use_In_Analysis==TRUE, ] %>% - group_by(AreaID, ManagedAreaName, Year, Month) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - N_Data=length(ResultValue), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName, Year, then Month - MA_YM_Stats <- as.data.table(MA_YM_Stats[order(MA_YM_Stats$ManagedAreaName, - MA_YM_Stats$Year, - MA_YM_Stats$Month), ]) - - # Get year from start for each managed area to be used in SKT analysis - MA_YM_Stats <- MA_YM_Stats %>% - group_by(AreaID, ManagedAreaName) %>% - mutate(YearFromStart=Year-min(Year)) - # Create decimal value of year and month values - MA_YM_Stats$YearMonthDec <- MA_YM_Stats$Year + ((MA_YM_Stats$Month-0.5) / 12) - - # Writes summary statistics to file - print("Saving MA_YM_Stats.rds") - saveRDS(MA_YM_Stats, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_MA_MMYY_Stats.rds")) - - # Create summary statistics for each managed area based on Year intervals. - MA_Y_Stats <- data[data$Use_In_Analysis==TRUE, ] %>% - group_by(AreaID, ManagedAreaName, Year) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - N_Data=length(ResultValue), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Year - MA_Y_Stats <- as.data.table(MA_Y_Stats[order(MA_Y_Stats$ManagedAreaName, - MA_Y_Stats$Year), ]) - # Writes summary statistics to file - - print("Saving MA_Y_Stats.rds") - saveRDS(MA_Y_Stats, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_MA_Yr_Stats.rds")) - rm(MA_Y_Stats) - - # Create summary statistics for each managed area based on Month intervals. - MA_M_Stats <- data[data$Use_In_Analysis==TRUE, ] %>% - group_by(AreaID, ManagedAreaName, Month) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - N_Data=length(ResultValue), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue), - Programs=paste(sort(unique(ProgramName), decreasing=FALSE), - collapse=', '), - ProgramIDs=paste(sort(unique(ProgramID), decreasing=FALSE), - collapse=', ')) - # Puts the data in order based on ManagedAreaName then Month - MA_M_Stats <- as.data.table(MA_M_Stats[order(MA_M_Stats$ManagedAreaName, - MA_M_Stats$Month), ]) - # Writes summary statistics to file - - print("Saving MA_M_Stats.rds") - saveRDS(MA_M_Stats, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_MA_Mo_Stats.rds")) - rm(MA_M_Stats) - - ################################# - ### MONITORING LOCATION STATS ### - ################################# - - # Gets summary statistics for monitoring locations, which are defined as unique - # combinations of ManagedAreaName, ProgramID, And ProgramLocationID - Mon_Stats <- data[data$Use_In_Analysis==TRUE, ] %>% - group_by(AreaID, ManagedAreaName, ProgramID, ProgramName, - ProgramLocationID) %>% - summarize(ParameterName=parameter, - RelativeDepth=depth, - ActivityType=activity, - EarliestSampleDate=min(SampleDate), - LastSampleDate=max(SampleDate), - N_Data=length(ResultValue), - Min=min(ResultValue), - Max=max(ResultValue), - Median=median(ResultValue), - Mean=mean(ResultValue), - StandardDeviation=sd(ResultValue)) - # Order data rows by ManagedAreaName, ProgramName, ProgramID, then - # ProgramLocationID - Mon_Stats <- as.data.table(Mon_Stats[order(Mon_Stats$ManagedAreaName, - Mon_Stats$ProgramName, - Mon_Stats$ProgramID, - Mon_Stats$ProgramLocationID), ]) - # Write summary statistics to file - print("Saving Mon_Stats.rds") - saveRDS(Mon_Stats, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_MonLoc_Stats.rds")) - rm(Mon_Stats) - - #################### - ### SKT ANALYSIS ### - #################### - - # List for column names - c_names <- c("AreaID", "ManagedAreaName", "Independent", "tau", "p", - "SennSlope", "SennIntercept", "ChiSquared", "pChiSquared", "Trend") - - skt_stats <- data.frame(matrix(ncol = length(c_names), nrow = n)) - - colnames(skt_stats) <- c_names - # Determines if there are any managed areas to analyze - if(n==0){ - print("There are no managed areas that qualify.") - } else{ - # Starts cycling through managed areas to determine seasonal Kendall Tau - for (i in 1:n) { - # Gets the number of rows of data for the managed area - data_SKT <- MA_YM_Stats[MA_YM_Stats$ManagedAreaName==MA_Include[i], ] - x <- nrow(data_SKT) - # Perform analysis if there is more than 1 row - if (x>0) { - # Store the managed area summary statistics to be used in - # trend analysis - SKT.med <- MA_Summ$Median[MA_Summ$ManagedAreaName==MA_Include[i]] - SKT.minYr <- MA_Summ$EarliestYear[MA_Summ$ManagedAreaName==MA_Include[i]] - SKT.maxYr <- MA_Summ$LatestYear[MA_Summ$ManagedAreaName==MA_Include[i]] - SKT.ind <- TRUE - SKT <- kendallSeasonalTrendTest(y=data_SKT$Mean, - season=data_SKT$Month, - year=data_SKT$YearFromStart, - independent.obs=SKT.ind) - if(is.na(SKT$estimate[1])==TRUE){ - SKT.ind <- FALSE - SKT <- kendallSeasonalTrendTest(y=data_SKT$Mean, - season=data_SKT$Month, - year=data_SKT$YearFromStart, - independent.obs=SKT.ind) - } - skt_stats$AreaID[i] <- - MA_Summ$AreaID[MA_Summ$ManagedAreaName==MA_Include[i]] - skt_stats$ManagedAreaName[i] <- - MA_Summ$ManagedAreaName[MA_Summ$ManagedAreaName==MA_Include[i]] - skt_stats$Independent[i] <- SKT.ind - skt_stats$tau[i] <- SKT$estimate[1] - skt_stats$p[i] <- SKT$p.value[2] - skt_stats$SennSlope[i] <- SKT$estimate[2] - skt_stats$SennIntercept[i] <- SKT$estimate[3] - skt_stats$ChiSquared[i] <- SKT$statistic[1] - skt_stats$pChiSquared[i] <- SKT$p.value[1] - # If the p value is less than 5% and the slope is greater than 10% of the - # median value, the trend is large (2). - if (skt_stats$p[i] < .05 & abs(skt_stats$SennSlope[i]) > - abs(SKT.med) / 10.) { - skt_stats$Trend[i] <- 2 - - # If the p value is less than 5% and the slope is less than 10% of the - # median value, there is a trend (1). - }else if (skt_stats$p[i] < .05 & abs(skt_stats$SennSlope[i]) < - abs(SKT.med) / 10.) { - skt_stats$Trend[i] <- 1 - - # Otherwise, there is no trend (0) - }else { - skt_stats$Trend[i] <- 0 - } - # Sets the sign of the trend based on Senn Slope direction - if (skt_stats$SennSlope[i] <= 0) { - skt_stats$Trend[i] <- -skt_stats$Trend[i] - } - } - } - - # Stores as data frame - skt_stats <- as.data.frame(skt_stats) - - } - # Clears unused variables - rm(SKT, data_SKT, x, SKT.med, SKT.minYr, SKT.maxYr, SKT.ind) - # Combines the skt_stats with MA_Summ - skt_stats <- merge.data.frame(MA_Summ, skt_stats, - by=c("AreaID","ManagedAreaName"), all=TRUE) - - skt_stats <- as.data.table(skt_stats[order(skt_stats$ManagedAreaName), ]) - - # Sets variables to proper format and rounds values if necessary - skt_stats$tau <- round(as.numeric(skt_stats$tau), digits=4) - skt_stats$p <- format(round(as.numeric(skt_stats$p), digits=4), - scientific=FALSE) - skt_stats$SennSlope <- as.numeric(skt_stats$SennSlope) - skt_stats$SennIntercept <- as.numeric(skt_stats$SennIntercept) - skt_stats$ChiSquared <- round(as.numeric(skt_stats$ChiSquared), digits=4) - skt_stats$pChiSquared <- round(as.numeric(skt_stats$pChiSquared), digits=4) - skt_stats$Trend <- as.integer(skt_stats$Trend) - - # Writes combined statistics to file - print("Saving SKT_stats.rds") - - saveRDS(skt_stats, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_skt_stats.rds")) - saveRDS(select(skt_stats, -c(EarliestSampleDate)), file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_", activity, "_", depth, "_KendallTau_Stats.rds")) - } - } - - # Removes data rows with no ResultValue (created by merging with MA_All) - data <- data[!is.na(data$ResultValue),] - - # saveRDS(KT.Plot, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_KT_Plot.rds")) - saveRDS(data, file = paste0(out_dir_tables,"/WC_Discrete_", param_abrev, "_data.rds")) -} - -disc_file_list_df <- bind_rows(disc_file_list) -fwrite(disc_file_list_df, "output/tables/disc/disc_file_list.txt", sep='|') - -toc() -End_time <- Sys.time() - -print(Start_time) -print(End_time) \ No newline at end of file diff --git a/MA Report Generation/output/Reports/HTML/BBSAP_Report.html b/MA Report Generation/output/Reports/HTML/BBSAP_Report.html new file mode 100644 index 00000000..d8d8931d --- /dev/null +++ b/MA Report Generation/output/Reports/HTML/BBSAP_Report.html @@ -0,0 +1,5855 @@ + + + + + + + + + + + + + +Big Bend Seagrasses Aquatic Preserve + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+
+
+
+
+ +
+ + + + + + + +
+
+

Threshold Filtering

+

Threshold filters, following the guidance of Florida Department of +Environmental Protection’s (FDEP) Division of Environmental +Assessment and Restoration (DEAR) are used to exclude specific +results values from the SEACAR Analysis. Based on the threshold filters, +Quality Assurance / Quality Control (QAQC) Flags are inserted +into the SEACAR_QAQCFlagCode and +SEACAR_QAQC_Description columns of the export data. The +Include column indicates whether the QAQC Flag will +also indicate that data are excluded from analysis. No data are excluded +from the data export, but the analysis scripts can use the +Include column to exclude data (1 to include, 0 to +exclude).

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Continuous Water Quality threshold values
Parameter NameUnitsLow ThresholdHigh ThresholdSensor Type
Dissolved Oxygenmg/L050YSI EXOs
Dissolved Oxygenmg/L050Analysis Only - 2022-04-04
Dissolved Oxygenmg/L0506600 Series
Salinityppt0706600 Series
Salinityppt070YSI EXOs
Salinityppt070Analysis Only - 2022-04-04
Water TemperatureDegrees C-545YSI EXOs
Water TemperatureDegrees C-545Analysis Only - 2022-04-04
Water TemperatureDegrees C-5456600 Series
pHpH214Analysis Only - 2022-04-04
pHpH2146600 Series
pHpH214YSI EXOs
Dissolved Oxygen Saturation%0500YSI EXOs
Dissolved Oxygen Saturation%05006600 Series
Dissolved Oxygen Saturation%0500Analysis Only - 2022-04-04
Specific ConductivitymS/cm01006600 Series
Specific ConductivitymS/cm0200YSI EXOs
TurbidityNTU04000YSI EXOs
TurbidityNTU010006600 Series
TurbidityNTU04000Analysis Only - 2022-04-04
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Discrete Water Quality threshold values
Parameter NameUnitsLow ThresholdHigh Threshold
Dissolved Oxygenmg/L0.00000122
Salinityppt070
Water TemperatureDegrees C340
pH213
Dissolved Oxygen Saturation%0.000001310
Specific ConductivitymS/cm0.005000001100
TurbidityNTU0-
Total Suspended Solids (TSS)mg/L0-
Chlorophyll a uncorrected for pheophytinug/L0-
Chlorophyll a corrected for pheophytinug/L0-
Secchi Depthm0.00000150
Light Extinction Coefficientm^10-
Colored dissolved organic matter, CDOMPCU0-
Fluorescent dissolved organic matter, FDOMQSE0-
Total Nitrogenmg/L0-
Total Kjeldahl Nitrogen TKNmg/L0-
NO2+3 Filteredmg/L0-
NH4 Filteredmg/L0-
Total Phosphorusmg/L0-
PO4 Filteredmg/L0-
Ammonia- Un-ionized (NH3)mg/L0-
Nitrate (N)mg/L0-
Nitrite (N)mg/L0-
Nitrogen, organicmg/L0-
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Quality Assurance Flags inserted based on threshold checks +listed in Table 1 & 2
SEACAR QAQC DescriptionIncludeSEACAR QAQCFlagCode
Exceeds Maximum threshold. Not verified in raw +dataNo2Q
Exceeds Maximum threshold. Verified in raw dataNo3Q
Below Minimum threshold. Not verified in raw dataNo4Q
Below Minimum threshold. Verified in raw dataNo5Q
Within threshold toleranceYes6Q
No defined thresholds for this parameterYes7Q
+
+
+

Value Qualifiers

+

Value qualifier codes included within the data are used to exclude +certain results from the analysis. The data are retained in the data +export files, but the analysis uses the Include column to +filter the results.

+

STORET and WIN value qualifier codes

+

Value qualifier codes from STORET and WIN data are +examined with the database and used to populate the Include +column in data exports.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifier codes excluded from analysis
Qualifier SourceValue QualifierIncludeMDLDescription
STORET-WINHNo0Value based on field kit determination; results may not +be accurate
STORET-WINJNo0Estimated value
STORET-WINVNo0Analyte was detected at or above method detection +limit
STORET-WINYNo0
+

Discrete Water Quality Value Qualifiers

+

The following value qualifiers are highlighted in the Discrete Water +Quality section of this report. An exception is made for Program +476 - Charlotte Harbor Estuaries Volunteer Water Quality +Monitoring Network and data flagged with Value Qualifier +H are included for this program only.

+

H - Value based on field kit determiniation; results +may not be accurate. This code shall be used if a field screening test +(e.g., field gas chromatograph data, immunoassay, or vendor-supplied +field kit) was used to generate the value and the field kit or method +has not been recognized by the Department as equivalent to laboratory +methods.

+

I - The reported value is greater than or equal to +the laboratory method detection limit but less than the laboratory +practical quantitation limit.

+

Q - Sample held beyond the accepted holding time. +This code shall be used if the value is derived from a sample that was +prepared or analyzed after the approved holding time restrictions for +sample preparation or analysis.

+

S - Secchi disk visible to bottom of waterbody. The +value reported is the depth of the waterbody at the location of the +Secchi disk measurement.

+

U - Indicates that the compound was analyzed for but +not detected. This symbol shall be used to indicate that the specified +component was not detected. The value associated with the qualifier +shall be the laboratory method detection limit. Unless requested by the +client, less than the method detection limit values shall not be +reported

+

Systemwide Monitoring Program (SWMP) value qualifier +codes

+

Value qualifier codes from the SWMP continuous program are +examined with the database and used to populate the Include +column in data exports. SWMP Qualifier Codes are indicated by +QualifierSource=SWMP.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
SWMP Value Qualifier codes
Qualifier SourceValue QualifierIncludeDescription
SWMP-1YesOptional parameter not collected
SWMP-2NoMissing data
SWMP-3NoData rejected due to QA/QC
SWMP-4NoOutside low sensor range
SWMP-5NoOutside high sensor range
SWMP0YesPassed initial QA/QC checks
SWMP1NoSuspect data
SWMP2YesReserved for future use
SWMP3Yes
SWMP4YesHistorical: Pre-auto QA/QC
SWMP5YesCorrected data
+
+
+
+

Water Column

+

The water column habitat extends from the surface of all water bodies +to the bottom sediments and encompasses the different features found in +the water at different depths (National Oceanographic Center, 2016). The +water column habitat must be viewed in relation to its +interconnectedness with other habitats. A healthy water column is an +integral component in ensuring a healthy marine and coastal ecosystem. +Having a flourishing marine and coastal ecosystem in Florida is +necessary to support a strong economy. The health of the water column is +dependent upon factors as diverse as land use (e.g., agriculture, +mining, forestry practices); human population growth; emissions, (e.g., +power plants, automobiles, wastewater); climate (e.g., rainfall, +temperature, winds and currents); and decadal trends (e.g., El Niño/La +Niña, Atlantic Multidecadal Oscillation, climate change).

+

The water column is composed of various physical, chemical and +biological features, and only a small number of them are adequately +monitored. Features of the water column that are monitored are used as +indicators of the water column health and help assess the status of +other habitats. These indicators include nutrient concentrations +(nitrogen and phosphorus); water quality (dissolved oxygen, temperature, +salinity and pH); water clarity (Secchi depth, turbidity, chlorophyll-a +and colored dissolved organic matter); and nekton (fish, +macroinvertebrates and megafauna).

+
+
+

Seasonal Kendall-Tau Analysis

+

Indicators must have a minimum of five to ten years, depending on the +habitat, of data within the geographic range of the analysis to be +included in the analysis. Ten years of data are required for discrete +parameters, and five years of data are required for continuous +parameters. If there are insufficient years of data, the number of years +of data available will be noted and labeled as “insufficient data to +conduct analysis”. Further, for the preferred Seasonal Kendall-Tau test, +there must be data from at least two months in common across at least +two consecutive years within the RCP managed area being analyzed. Values +that pass both of these tests will be included in the analysis and be +labeled as Use_In_Analysis = TRUE. Any that +fail either test will be excluded from the analyses and labeled as +Use_In_Analysis = FALSE.

+
+
+

Water Quality - Discrete

+

The following files were used in the discrete analysis:

+
    +

  • Combined_WQ_WC_NUT_Chlorophyll_a_corrected_for_pheophytin-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Chlorophyll_a_uncorrected_for_pheophytin-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Colored_dissolved_organic_matter_CDOM-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Dissolved_Oxygen-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Dissolved_Oxygen_Saturation-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_pH-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Salinity-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Secchi_Depth-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Total_Nitrogen-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Total_Phosphorus-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Total_Suspended_Solids_TSS-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Turbidity-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_Water_Temperature-2024-Feb-22.txt

    • +
+
+
+

Chlorophyll a, Corrected for Pheophytin - Discrete Water +Quality

+

Chlorophyll-a is monitored as a measure of +microalgae growing in the water. Algae are a natural part of coastal and +aquatic ecosystems but in excess can cause poor water quality and +clarity, and decreased levels of dissolved oxygen.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Chlorophyll a, +Corrected for Pheophytin
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Chlorophyll a, Corrected for +Pheophytin
ProgramIDN_DataYearMinYearMax
5002391819952023
51421220202023
54013120172022
47712920192022
1031020202021
+

Program names:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+540 - Shellfish Harvest Area Classification Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Chlorophyll a, Corrected for +Pheophytin
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
19999955.01010.1
20009322.14649.5
200110044.033.04242.0
200212143.386.66150.4
20035311.923.85298.1
20046469.46195.3
200570912.94564.3
20068144.97390.1
2007461328.31941.3
2008502754.01326.0
2009653452.32233.9
2010823745.13542.7
20111977839.62311.7
20121676035.93319.8
20131984120.72211.17638.4
20142384318.1177.18234.5
20152033115.3146.98340.9
20162534015.8135.110240.3
20172978528.610.34916.5
20183658824.1339.0
20192204219.13214.6
20202285825.4187.98336.4
202131710031.6288.810232.2
20223107825.2227.113142.3
20231253628.832.42419.2
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program

+
+
+

Chlorophyll a, Uncorrected for Pheophytin - Discrete Water +Quality

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Chlorophyll a, +Uncorrected for Pheophytin
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Chlorophyll a, Uncorrected for +Pheophytin
ProgramIDN_DataYearMinYearMax
5002491719902023
51449920012023
10326020002021
54013120172022
47712920192022
118820002006
115720002004
5008120212021
+

Program names:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+540 - Shellfish Harvest Area Classification Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+118 - National Aquatic Resource Surveys, National Coastal +Condition Assessment
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Chlorophyll a, Uncorrected for +Pheophytin
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
200715785.1
200813110.81612.2
20091212823.1119.1
20102114420.910.52712.8
20111824323.695.0
20121272922.8107.9
20131463725.31611.03725.3
20141503624.01610.75033.3
20151494127.51510.15134.2
20162505120.4135.26425.6
20173826517.010.3246.3
20184486314.1163.6
20192773311.9227.9
20202375121.5156.34820.2
20215356512.2295.410419.4
20223187724.2226.911536.2
20231252318.432.42116.8
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program

+
+
+

Colored Dissolved Organic Matter - Discrete Water Quality

+

Colored Dissolved Organic Matter (CDOM) +occurs naturally in every water body. It is made up of mainly plant +material, algae and bacteria. The composition is determined by its +source; plants, soil, algae, and wastewater are common sources.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Colored Dissolved +Organic Matter
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Colored Dissolved Organic +Matter
ProgramIDN_DataYearMinYearMax
5002133220142023
51482820012023
47715920172023
5409920172019
50083020212023
+

Program names:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Colored Dissolved Organic Matter
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
20177479.511.411.4
201810621.9
201960610.023.323.3
202045261.3143.181.8
202152381.5326.1122.3
2022503102.0112.2163.2
202350714.0510.024.0
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

477 - Suwannee River Water Management District Water +Resource Monitoring Program
+514 - Florida LAKEWATCH Program
+540 - Shellfish Harvest Area Classification Program
+5002 - Florida STORET / WIN

+
+
+

Dissolved Oxygen - Discrete Water Quality

+

Dissolved Oxygen (DO) is a key indicator of +water quality. Oxygen enters surface waters by air-sea gas exchange, by +wind action, or as a byproduct of aquatic plant photosynthesis. The +actual quantity of DO in aquatic environments is dependent on the above +processes as well as water temperature and salinity.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Dissolved +Oxygen
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Dissolved Oxygen
ProgramIDN_DataYearMinYearMax
50029335619892023
694280019962017
9595519852018
10315820032021
47715620192023
54012120172022
607819862015
1153819912004
50083020212023
118720002006
+

Program names:

+

5002 - Florida STORET / WIN
+69 - Fisheries-Independent Monitoring (FIM) Program
+95 - Harmful Algal Bloom Marine Observation Network
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program
+60 - Southeast Area Monitoring and Assessment Program (SEAMAP) +- Gulf of Mexico Fall & Summer Shrimp/Groundfish Survey
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region
+118 - National Aquatic Resource Surveys, National Coastal +Condition Assessment

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + +
Value Qualifiers for Dissolved Oxygen
YearN_TotalN_Qperc_Q
2014678710
+

Note: 1Q - Sample held +beyond the accepted holding time

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN

+
+
+

Dissolved Oxygen Saturation - Discrete Water Quality

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Dissolved Oxygen +Saturation
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Dissolved Oxygen +Saturation
ProgramIDN_DataYearMinYearMax
5002108619992023
47715620192023
50083020212023
95320162018
+

Program names:

+

5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region
+95 - Harmful Algal Bloom Marine Observation Network

+

There are no qualifying Value Qualifiers for Dissolved Oxygen +Saturation in Big Bend Seagrasses Aquatic Preserve

+
+
+

pH - Discrete Water Quality

+

The pH of water is the measure of how acidic or +basic the water body is on a scale of 0-14, with lower readings +indicating acidic and higher readings indicating basic, and a pH of 7 +being neutral. Florida’s natural waters fall between 6.5 and 8.5 on this +scale. A water body’s pH can change due to precipitation, geology, +vegetation, water pollution and air pollution.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for pH
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for pH
ProgramIDN_DataYearMinYearMax
50025155119892023
694272319962017
9559119642018
47716020122023
10315620032021
5408520172022
1153819912004
50083020212023
+

Program names:

+

5002 - Florida STORET / WIN
+69 - Fisheries-Independent Monitoring (FIM) Program
+95 - Harmful Algal Bloom Marine Observation Network
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+540 - Shellfish Harvest Area Classification Program
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region

+

There are no qualifying Value Qualifiers for pH in Big Bend +Seagrasses Aquatic Preserve

+
+
+

Salinity - Discrete Water Quality

+

Salinity is a measure of the amount of salt in the +water. In estuarine ecosystems, salinity is influenced by precipitation, +evaporation, surface-water inputs, and exchange with coastal waters.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Salinity
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Salinity
ProgramIDN_DataYearMinYearMax
50029726919902023
694294019962017
560137420032023
95106919642018
47713720142022
54013220172022
607819862015
1185120152021
1153819912004
103520032004
+

Program names:

+

5002 - Florida STORET / WIN
+69 - Fisheries-Independent Monitoring (FIM) Program
+560 - Big Bend Seagrasses & Nature Coast Aquatic Preserves +- Seagrass Monitoring
+95 - Harmful Algal Bloom Marine Observation Network
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program
+60 - Southeast Area Monitoring and Assessment Program (SEAMAP) +- Gulf of Mexico Fall & Summer Shrimp/Groundfish Survey
+118 - National Aquatic Resource Surveys, National Coastal +Condition Assessment
+115 - Environmental Monitoring Assessment Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)

+

There are no qualifying Value Qualifiers for Salinity in Big Bend +Seagrasses Aquatic Preserve

+
+
+

Secchi Depth - Discrete Water Quality

+

Secchi depth is a measure of the transparency or +clarity of the water by a device called a Secchi disk. A Secchi disk is +a black and white disk that is lowered into the water on a cord. The +Secchi depth is the depth at which the disk can no longer be seen. The +deeper the Secchi depth, the greater the water clarity.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Secchi Depth
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Secchi Depth
ProgramIDN_DataYearMinYearMax
694293019962017
514208119932023
5002199619992023
47715520192023
1034720202021
1152119912004
50081520212022
60919862014
+

Program names:

+

69 - Fisheries-Independent Monitoring (FIM) Program
+514 - Florida LAKEWATCH Program
+5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region
+60 - Southeast Area Monitoring and Assessment Program (SEAMAP) +- Gulf of Mexico Fall & Summer Shrimp/Groundfish Survey

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Secchi Depth
YearN_TotalN_Sperc_S
2013279450.2
20142797291.0
20152759341.2
20162790692.5
20172813421.5
20181501711.3
2019662131.8
20201786838.2
20212687528.0
202221010047.6
2023472961.7
+

Note: 1S - Secchi disk +visible to bottom of waterbody

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+477 - Suwannee River Water Management District Water Resource +Monitoring Program

+
+
+

Total Nitrogen - Discrete Water Quality

+

Nitrogen and Phosphorous are key +nutrients that provide nourishment essential for the growth and +maintenance of aquatic plants and animals; however, excess nutrients can +cause harmful algal blooms and other water quality concerns. Nutrients +enter water bodies several ways, including runoff from rain events and +atmospheric deposition from natural and industrial sources.

+

Total Nitrogen Calculation:

+

The logic for calculated Total Nitrogen was provided by Kevin +O’Donnell and colleagues at FDEP (with the help of Jay Silvanima, +Watershed Monitoring Section). The following logic is used, in this +order, based on the availability of specific nitrogen components.

+
    +
  1. TN = TKN + NO3O2;
    2. +
  2. TN = TKN + NO3 + NO2;
    3. +
  3. TN = ORGN + NH4 + NO3O2;
    4. +
  4. TN = ORGN + NH4 + NO2 + NO3;
    5. +
  5. TN = TKN + NO3;
    6. +
  6. TN = ORGN + NH4 + NO3;
    7. +
+

Additional Information:

+
    +
  • Rules for use of sample fraction: +
      +
    • FDEP report that if both “Total” and “Dissolved” are reported, only +“Total” is used. If the total is not reported, they do use dissolved as +a best available replacement.
      • +
    • An analysis of all SEACAR data shows that 90% of all possible TN +calculations can be done using nitrogen components with the same sample +fraction, rather than use nitrogen components with mixed total/dissolved +sample fractions. In other words, TN can be calculated when TKN and +NO3O2 are both total sample fraction, or when both are dissolved sample +fraction. This is important, because then the calculated TN value is not +based on components with mixed sample fractions.
      • +
    • +
  • Values inserted into data: +
      +
    • ParameterName = “Total Nitrogen”
      • +
    • SEACAR_QAQCFlagCode = “1Q”
      • +
    • SEACAR_QAQC_Description = “SEACAR Calculated”
      +Seasonal Kendall-Tau Trend Analysis
      +Discrete Water Quality
      +Map showing location of Discrete sampling sites for Total Nitrogen
      +Discrete Water Quality
      +The bubble size on the above plots reflects the amount of data available +at each sampling site
      • +
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Total Nitrogen
ProgramIDN_DataYearMinYearMax
5002538319902023
514216319932023
54013120172022
1034420002006
115520002004
5008120212021
477120172017
+

Program names:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+540 - Shellfish Harvest Area Classification Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region
+477 - Suwannee River Water Management District Water Resource +Monitoring Program

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Total Nitrogen
YearN_TotalN_Qperc_Q
2013283134.6
2014324288.6
2015283186.4
201631072.3
2019273103.7
20201492516.8
20212242410.7
202221031.4
+

Note: 1Q - Sample held +beyond the accepted holding time

+

Programs containing Value Qualified data:

+

514 - Florida LAKEWATCH Program
+5002 - Florida STORET / WIN

+
+
+

Total Phosphorus - Discrete Water Quality

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Total +Phosphorus
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Total Phosphorus
ProgramIDN_DataYearMinYearMax
5002344719922023
514216919932023
10316920002021
47715920172023
54013120172022
115520002004
5008120212021
+

Program names:

+

5002 - Florida STORET / WIN
+514 - Florida LAKEWATCH Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Total Phosphorus
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
199913810.7
200017121.221.2
200122273.1
200224841.6
2003187105.3
2005223135.810.4
2006232187.831.3
200717331.7
2010178116.210.6
20112984113.8
201225783.1
201428341.4
201524252.131.2
2016289103.5
2017400133.2
2018453214.610.2
2019290134.5103.5
2020222135.93013.5
2021396133.3205.010.2
2022266186.831.110.4
202312853.9
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

514 - Florida LAKEWATCH Program
+5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program

+
+
+

Total Suspended Solids - Discrete Water Quality

+

Total Suspended Solids (TSS) are solid +particles suspended in water that exceed 2 microns in size and can be +trapped by a filter.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Total Suspended +Solids
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Total Suspended Solids
ProgramIDN_DataYearMinYearMax
5002281619902023
4772020212023
1031220202021
+

Program names:

+

5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Total Suspended Solids
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
199844920.4
19998822.33337.5
200014910.76342.3
200114642.77752.7
2002841113.16577.4
2003731216.46082.2
2004631015.911.65384.1
2005791620.26076.0
20061012221.86766.3
20076046.75490.0
200863914.35485.7
2009742128.456.85371.6
2010753445.34053.3
20111979648.72914.7
2012836375.91821.7
2013866879.11618.6
20141035856.34240.8
2015925054.44245.6
201614711981.010.72517.0
20171057369.52725.7
2018533871.711.91528.3
2019271970.4622.2
2020502448.02040.0
2021913639.611.14044.0
20221415236.98761.7
2023361952.81541.7
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program

+
+
+

Turbidity - Discrete Water Quality

+

Turbidity results from suspended solids in the +water, including silts, clays, tannins, industrial wastes, sewage and +plankton, which are all factors that contribute to how clouded or murky +a water column is. Turbidity is caused by soil erosion, excess +nutrients, pollutants, and physical forces such as winds, currents and +bottom feeders.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Turbidity
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Turbidity
ProgramIDN_DataYearMinYearMax
50024238919902023
47731420172023
10311620052021
5403520192022
+

Program names:

+

5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+540 - Shellfish Harvest Area Classification Program

+

Value Qualifiers

+
    +
  • N_Total is total amount of data for a given year
    • +
  • N_ is the total amount of values flagged with the +respective value qualifier in a given year
    • +
  • perc_ is the percent of data flagged with the respective +value qualifier as a proportion of N_Total
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Value Qualifiers for Turbidity
YearN_TotalN_Iperc_IN_Qperc_QN_Uperc_U
1999170410.1
2000196010.0
2001205410.0
2002203020.120.1
2004219940.2
2005193120.1
2006231220.1
2007248120.110.0
2008269810.0
2010202550.220.1
201273210.1
20139511.011.0
2014165106.142.4
2015148106.842.710.7
20161169141.240.3
2017150370.520.1
201914032.121.410.7
2020202167.9136.4
202132592.8134.0
20222656123.041.5186.8
20231142824.610.9
+

Note: 1I - Reported +value is greater than or equal to lab method detection limit, but less +than quantitation limit 2Q - Sample held +beyond the accepted holding time 3U - +Compound was analyzed for but not detected

+

Programs containing Value Qualified data:

+

5002 - Florida STORET / WIN
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program

+
+
+

Water Temperature - Discrete Water Quality

+

Temperature determines the capacity of water to hold +oxygen. Cooler water can hold more dissolved oxygen because water +molecules are more tightly packed, making it harder for oxygen to +escape. Additionally, as water temperature increases, fish and other +aquatic organisms become more active and consume oxygen at a faster +rate.

+

Seasonal Kendall-Tau Trend Analysis
+Discrete Water Quality
+Map showing location of Discrete sampling sites for Water +Temperature
+Discrete Water Quality
+The bubble size on the above plots reflects the amount of data available +at each sampling site

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Programs contributing data for Water Temperature
ProgramIDN_DataYearMinYearMax
50029976219892023
694296219962017
95116519642018
10315820032021
47715620192023
54013320172022
607819862015
1153819912004
50083020212023
+

Program names:

+

5002 - Florida STORET / WIN
+69 - Fisheries-Independent Monitoring (FIM) Program
+95 - Harmful Algal Bloom Marine Observation Network
+103 - EPA STOrage and RETrieval Data Warehouse (STORET)
+477 - Suwannee River Water Management District Water Resource +Monitoring Program
+540 - Shellfish Harvest Area Classification Program
+60 - Southeast Area Monitoring and Assessment Program (SEAMAP) +- Gulf of Mexico Fall & Summer Shrimp/Groundfish Survey
+115 - Environmental Monitoring Assessment Program
+5008 - Project COAST (Coastal Assessment Team) - Springs Coast +Ecosystem Region

+

There are no qualifying Value Qualifiers for Water Temperature in Big +Bend Seagrasses Aquatic Preserve

+
+
+
+
+

Water Quality - Continuous

+

The following files were used in the continuous analysis:

+
    +

  • Combined_WQ_WC_NUT_cont_Dissolved_Oxygen_NW-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_cont_Dissolved_Oxygen_Saturation_NW-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_cont_pH_NW-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_cont_Salinity_NW-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_cont_Turbidity_NW-2024-Feb-22.txt

    • +

  • Combined_WQ_WC_NUT_cont_Water_Temperature_NW-2024-Feb-22.txt

    • +
+

Continuous Water Quality
+Map showing Continuous Water Quality Monitoring sampling locations +within the boundaries of Big Bend Seagrasses Aquatic Preserve. Sites +marked as Use In Analysis are featured in this report.

+
+
+

Dissolved Oxygen - Continuous Water Quality

+
+

02313700

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02323566

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02326526

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - Dissolved +Oxygen
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
02313700111352019 - 20236.5-0.096.65-0.020.7787
02323566129892015 - 20231.1-0.130.89-0.080.0448
02326526131282016 - 20239.3-0.069.380.050.6979
231370039722022 - 20235.8----
232356635022022 - 20231.2----
232652639222022 - 20239.7----
BBSDB184327102007 - 20167.3-0.057.46-0.010.6066
BBSSK134287102004 - 20157.10.286.60.090.0023
BBSST11141152019 - 20236.9-0.146.72-0.020.3964
BBSSW18232782009 - 20166.20601.0000
+
+
+
+
+

Dissolved Oxygen Saturation - Continuous Water Quality

+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - Dissolved +Oxygen Saturation
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
BBSDB183530102007 - 201697.6-0.30100.88-0.810.0003
BBSSK134196102004 - 201591.80.1293.370.360.2612
BBSST11446552019 - 202393.30.1391.370.640.3964
BBSSW18215882009 - 201675.8-0.0579.14-0.250.6835
+
+
+
+
+

pH - Continuous Water Quality

+
+

02313700

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02323566

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02326526

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - pH
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
02313700104752019 - 20237.60.047.620.030.2234
02323566123892015 - 20237.2-0.147.1900.1310
02326526113982016 - 20238.20.228.010.050.0233
231370035422022 - 20237.5----
232356635722022 - 20237.1----
232652638622022 - 20238.2----
BBSDB250183102007 - 20168.1-0.288.17-0.020.0004
BBSSK168278102004 - 20158.1-0.378.28-0.040.0000
BBSST12109252019 - 20238.00.167.950.020.3533
BBSSW22473382009 - 20167.6-0.297.8-0.060.0017
+
+
+
+
+

Salinity - Continuous Water Quality

+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - +Salinity
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
29165208306410012312000 - 200019.0----
BBSDB265544102007 - 201630.6-0.5333.78-0.750.0000
BBSSK178356102004 - 201529.6-0.2230.77-0.210.0197
BBSST12198452019 - 202328.60.2126.790.50.1594
BBSSW22169682009 - 20167.5-0.2310.39-0.650.0160
+
+
+
+
+

Turbidity - Continuous Water Quality

+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - +Turbidity
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
BBSDB224613102007 - 201610.491.471.220.0000
BBSSK165043102004 - 201550.116.350.300.1867
BBSST12524652019 - 20234-0.156.58-0.570.3149
BBSSW20269982009 - 20166-0.3512.41-0.990.0001
+
+
+
+
+

Water Temperature - Continuous Water Quality

+
+

02313700

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02323566

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

02326526

+

National Water Information System (7)
+Continuous Water Quality

+
+
+

BBSDB

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSK

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSST

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

BBSSW

+

Big Bend Seagrasses Aquatic Preserves Continuous Water Quality +Monitoring (471)
+Continuous Water Quality

+
+
+

All Stations Combined

+
+Continuous Water Quality +
Continuous Water Quality
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Seasonal Kendall-Tau Results for All Stations - Water +Temperature
StationN_DataN_YearsPeriod of RecordMediantauSennInterceptSennSlopep
02313700103052019 - 202325.00-0.0424.750.030.9195
02323566133292015 - 202322.700.4722.510.040.0000
0232359247822022 - 202321.70----
02326526126182016 - 202322.00-0.0223.140.040.5177
0232655047522022 - 202320.80----
231370033822022 - 202327.40----
232356636422022 - 202322.80----
232652633522022 - 202324.00----
2916520830641009212000 - 200018.35----
BBSDB265988102007 - 201623.200.0822.340.040.2922
BBSSK179213102004 - 201521.70-0.3325.19-0.370.0002
BBSST12848952019 - 202323.600.1624.340.150.3149
BBSSW22799682009 - 201623.700.0223.090.010.9025
+
+
+
+
+
+

Submerged Aquatic Vegetation

+

The data file used is: +All_SAV_Parameters-2024-Feb-23.txt

+

Submerged aquatic vegetation (SAV) refers +to plants and plant-like macroalgae species that live entirely +underwater. The two primary categories of SAV inhabiting +Florida estuaries are benthic macroalgae and +seagrasses. They often grow together in dense beds or meadows +that carpet the seafloor. Macroalgae include multicellular +species of green, red and brown algae that often live attached to the +substrate by a holdfast. They tend to grow quickly and can tolerate +relatively high nutrient levels, making them a threat to seagrasses and +other benthic habitats in areas with poor water quality. In contrast, +seagrasses are grass-like, vascular, flowering plants that are +attached to the seafloor by extensive root systems. Seagrasses +occur throughout the coastal areas of Florida, including protected bays +and lagoons as well as deeper offshore waters on the continental shelf. +Seagrasses have taken advantage of the broad, shallow shelf and +clear water to produce two of the most extensive seagrass beds anywhere +in continental North America.

+
+

Parameters

+

Percent Cover measures the fraction of an area of +seafloor that is covered by SAV, usually estimated by evaluating +multiple small areas of seafloor. Percent cover is often estimated for +total SAV, individual types of vegetation (seagrass, attached algae, +drift algae) and individual species.

+

Frequency of Occurrence was calculated as the number +of times a taxon was observed in a year divided by the number of +sampling events, multiplied by 100. Analysis is conducted at the quadrat +level and is inclusive of all quadrats (i.e., quadrats evaluated using +Braun-Blanquet, modified Braun-Blanquet, and percent cover.”

+
+
+

Species

+

Turtle grass (Thalassia testudinum) is the +largest of the Florida seagrasses, with longer, thicker blades and +deeper root structures than any of the other seagrasses. It is +considered a climax seagrass species.

+

Shoal grass (Halodule wrightii) is an early +colonizer of vegetated areas and usually grows in water too shallow for +other species except widgeon grass. It can often tolerate +larger salinity ranges than other seagrass species. Shoal grass +is characterized by thin, flat blades, that are narrower than turtle +grass blades.

+

Manatee grass (Syringodium filiforme) is +easily recognizable because its leaves are thin and cylindrical instead +of the flat, ribbon-like form shared by many other seagrass species. The +leaves can grow up to half a meter in length. Manatee grass is +usually found in mixed seagrass beds or small, dense monospecific +patches.

+

Widgeon grass (Ruppia maritima) grows in +both fresh and salt water and is widely distributed throughout Florida’s +estuaries in less saline areas, particularly in inlets along the east +coast. This species resembles shoal grass in certain +environments but can be identified by the pointed tips of its +leaves.

+

Three species of Halophila spp. are found in Florida - +Star grass (Halophila engelmannii), +Paddle grass (Halophila decipiens), and +Johnson’s seagrass (Halophila johnsonii). +These are smaller, more fragile seagrasses than other Florida species +and are considered ephemeral. They grow along a single long rhizome, +with short blades. These species are not well-studied, although surveys +are underway to define their ecological roles.

+
+

Notes

+

Star grass, Paddle grass, and Johnson’s +seagrass will be grouped together and listed as Halophila +spp. in the following managed areas. This is because several +surveys did not specify to the species level:

+
    +

  • Banana River Aquatic Preserve

    • +

  • Indian River-Malabar to Vero Beach Aquatic Preserve

    • +

  • Indian River-Vero Beach to Ft. Pierce Aquatic Preserve

    • +

  • Jensen Beach to Jupiter Inlet Aquatic Preserve

    • +

  • Loxahatchee River-Lake Worth Creek Aquatic Preserve

    • +

  • Mosquito Lagoon Aquatic Preserve

    • +

  • Biscayne Bay Aquatic Preserve

    • +

  • Florida Keys National Marine Sanctuary

    • +
+
+

SAV - Temporal Scope
+Maps showing the temporal scope of SAV sampling sites within the +boundaries of Big Bend Seagrasses Aquatic Preserve by Program +name.

+

Sampling locations by Program:

+

SAV - Sampling Map
+Map showing SAV sampling sites within the boundaries of Big Bend +Seagrasses Aquatic Preserve. The point size reflects the number of +samples at a given sampling site.

+ + + + + + + + + + + + + + + + + + + + +
Northern Big Bend Seagrass Monitoring - Program +559
N_DataYearMinYearMaxCollection MethodSample Locations
53720122018Modified Braun Blanquet195
+ + + + + + + + + + + + + + + + + + + + + + + + + + + +
Big Bend Seagrasses & Nature Coast Aquatic Preserves - +Seagrass Monitoring - Program 560
N_DataYearMinYearMaxCollection MethodSample Locations
2188720002023Modified Braun Blanquet125
263720222023Percent Cover99
+SAV
+Median percent cover by species in Big Bend Seagrasses Aquatic +Preserve. Linear mixed-effects models are applied to each species +to produce species trends. The trendlines are then isolated and +reproduced below for ease of viewing. The LME results are available in +table form beneath the supplemental trendplot below.
+SAV
+ +
+SAV +
SAV
+
+

SAV
+Generalized additive models for each species in Big Bend Seagrasses +Aquatic Preserve. Species must have at least 10 years of data to be +evaluated.

+

Drift algae, Total seagrass, Attached +algae, and Total SAV are excluded from the analyses.

+
+
+
+ + + +
+
+ +
+ + + + + + + + + + + + + + + + diff --git a/MA Report Generation/output/Reports/PDF/ABAP_Report.pdf b/MA Report Generation/output/Reports/PDF/ABAP_Report.pdf new file mode 100644 index 00000000..dad705f2 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/ABAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/AHAP_Report.pdf b/MA Report Generation/output/Reports/PDF/AHAP_Report.pdf new file mode 100644 index 00000000..a1bb7157 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/AHAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/ANERR_Report.pdf b/MA Report Generation/output/Reports/PDF/ANERR_Report.pdf new file mode 100644 index 00000000..5d8208eb Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/ANERR_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/BBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/BBAP_Report.pdf new file mode 100644 index 00000000..40b76244 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/BBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/BBCFMCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/BBCFMCAP_Report.pdf new file mode 100644 index 00000000..dcf7205c Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/BBCFMCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/BBSAP_Report.pdf b/MA Report Generation/output/Reports/PDF/BBSAP_Report.pdf new file mode 100644 index 00000000..c756bf54 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/BBSAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/BCBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/BCBAP_Report.pdf new file mode 100644 index 00000000..b69c4cff Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/BCBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/BRAP_Report.pdf b/MA Report Generation/output/Reports/PDF/BRAP_Report.pdf new file mode 100644 index 00000000..dd54ec74 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/BRAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/CBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/CBAP_Report.pdf new file mode 100644 index 00000000..84006d8f Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/CBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/CHAP_Report.pdf b/MA Report Generation/output/Reports/PDF/CHAP_Report.pdf new file mode 100644 index 00000000..8e63f0b5 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/CHAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/CKRBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/CKRBAP_Report.pdf new file mode 100644 index 00000000..21b1e9d7 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/CKRBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/CRCP_Report.pdf b/MA Report Generation/output/Reports/PDF/CRCP_Report.pdf new file mode 100644 index 00000000..2c96c638 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/CRCP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/CRTTIAP_Report.pdf b/MA Report Generation/output/Reports/PDF/CRTTIAP_Report.pdf new file mode 100644 index 00000000..185a6e9b Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/CRTTIAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/EBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/EBAP_Report.pdf new file mode 100644 index 00000000..34d60eca Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/EBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/FCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/FCAP_Report.pdf new file mode 100644 index 00000000..5730c468 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/FCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/FKNMS_Report.pdf b/MA Report Generation/output/Reports/PDF/FKNMS_Report.pdf new file mode 100644 index 00000000..51905cc6 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/FKNMS_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/FPAP_Report.pdf b/MA Report Generation/output/Reports/PDF/FPAP_Report.pdf new file mode 100644 index 00000000..15a55051 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/FPAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/GRMAP_Report.pdf b/MA Report Generation/output/Reports/PDF/GRMAP_Report.pdf new file mode 100644 index 00000000..fa8f34cf Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/GRMAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/GSCHAP_Report.pdf b/MA Report Generation/output/Reports/PDF/GSCHAP_Report.pdf new file mode 100644 index 00000000..681e3960 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/GSCHAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/GTMNERR_Report.pdf b/MA Report Generation/output/Reports/PDF/GTMNERR_Report.pdf new file mode 100644 index 00000000..f78837b1 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/GTMNERR_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/IRMVBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/IRMVBAP_Report.pdf new file mode 100644 index 00000000..7c404577 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/IRMVBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/IRVBFPAP_Report.pdf b/MA Report Generation/output/Reports/PDF/IRVBFPAP_Report.pdf new file mode 100644 index 00000000..7a7137f0 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/IRVBFPAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/JBJIAP_Report.pdf b/MA Report Generation/output/Reports/PDF/JBJIAP_Report.pdf new file mode 100644 index 00000000..6c755059 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/JBJIAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/LBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/LBAP_Report.pdf new file mode 100644 index 00000000..54cc2653 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/LBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/LKAP_Report.pdf b/MA Report Generation/output/Reports/PDF/LKAP_Report.pdf new file mode 100644 index 00000000..c434761b Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/LKAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/LRLWCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/LRLWCAP_Report.pdf new file mode 100644 index 00000000..40cd6e20 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/LRLWCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/MLAP_Report.pdf b/MA Report Generation/output/Reports/PDF/MLAP_Report.pdf new file mode 100644 index 00000000..0ab98302 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/MLAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/MPAP_Report.pdf b/MA Report Generation/output/Reports/PDF/MPAP_Report.pdf new file mode 100644 index 00000000..ced6bd2e Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/MPAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/NCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/NCAP_Report.pdf new file mode 100644 index 00000000..e406844c Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/NCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/NFSLRAP_Report.pdf b/MA Report Generation/output/Reports/PDF/NFSLRAP_Report.pdf new file mode 100644 index 00000000..7d650781 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/NFSLRAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/NRSJRAP_Report.pdf b/MA Report Generation/output/Reports/PDF/NRSJRAP_Report.pdf new file mode 100644 index 00000000..f83b2802 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/NRSJRAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/PCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/PCAP_Report.pdf new file mode 100644 index 00000000..e8aa6725 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/PCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/PCRAP_Report.pdf b/MA Report Generation/output/Reports/PDF/PCRAP_Report.pdf new file mode 100644 index 00000000..44dff06a Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/PCRAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/PISAP_Report.pdf b/MA Report Generation/output/Reports/PDF/PISAP_Report.pdf new file mode 100644 index 00000000..f9df0b15 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/PISAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/RBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/RBAP_Report.pdf new file mode 100644 index 00000000..99934436 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/RBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/RBNERR_Report.pdf b/MA Report Generation/output/Reports/PDF/RBNERR_Report.pdf new file mode 100644 index 00000000..6b98508f Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/RBNERR_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/RBSPAP_Report.pdf b/MA Report Generation/output/Reports/PDF/RBSPAP_Report.pdf new file mode 100644 index 00000000..0a28c351 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/RBSPAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/SBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/SBAP_Report.pdf new file mode 100644 index 00000000..09485827 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/SBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/SJBAP_Report.pdf b/MA Report Generation/output/Reports/PDF/SJBAP_Report.pdf new file mode 100644 index 00000000..72aa43ae Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/SJBAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/SMMAP_Report.pdf b/MA Report Generation/output/Reports/PDF/SMMAP_Report.pdf new file mode 100644 index 00000000..e21365a0 Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/SMMAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/TCAP_Report.pdf b/MA Report Generation/output/Reports/PDF/TCAP_Report.pdf new file mode 100644 index 00000000..a239047a Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/TCAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/TMAP_Report.pdf b/MA Report Generation/output/Reports/PDF/TMAP_Report.pdf new file mode 100644 index 00000000..44c9949b Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/TMAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/PDF/YRMAP_Report.pdf b/MA Report Generation/output/Reports/PDF/YRMAP_Report.pdf new file mode 100644 index 00000000..a4eece6a Binary files /dev/null and b/MA Report Generation/output/Reports/PDF/YRMAP_Report.pdf differ diff --git a/MA Report Generation/output/Reports/BBSAP/BBSAP_Report.pdf b/MA Report Generation/output/Reports/archive/BBSAP/BBSAP_Report.pdf similarity index 100% rename from MA Report Generation/output/Reports/BBSAP/BBSAP_Report.pdf rename to MA Report Generation/output/Reports/archive/BBSAP/BBSAP_Report.pdf diff --git a/MA Report Generation/output/Reports/EBAP/EBAP_Report.pdf b/MA Report Generation/output/Reports/archive/EBAP/EBAP_Report.pdf similarity index 100% rename from MA Report Generation/output/Reports/EBAP/EBAP_Report.pdf rename to MA Report Generation/output/Reports/archive/EBAP/EBAP_Report.pdf diff --git a/MA Report Generation/output/Reports/EBAP/EBAP_Report_Nov30.pdf b/MA Report Generation/output/Reports/archive/EBAP/EBAP_Report_Nov30.pdf similarity index 100% rename from MA Report Generation/output/Reports/EBAP/EBAP_Report_Nov30.pdf rename to MA Report Generation/output/Reports/archive/EBAP/EBAP_Report_Nov30.pdf diff --git a/MA Report Generation/output/Reports/GTMNERR/GTMNERR_Report.pdf b/MA Report Generation/output/Reports/archive/GTMNERR/GTMNERR_Report.pdf similarity index 100% rename from MA Report Generation/output/Reports/GTMNERR/GTMNERR_Report.pdf rename to MA Report Generation/output/Reports/archive/GTMNERR/GTMNERR_Report.pdf diff --git a/MA Report Generation/output/Reports/PISAP/PISAP_Report_Nov30.pdf b/MA Report Generation/output/Reports/archive/PISAP/PISAP_Report_Nov30.pdf similarity index 100% rename from MA Report Generation/output/Reports/PISAP/PISAP_Report_Nov30.pdf rename to MA Report Generation/output/Reports/archive/PISAP/PISAP_Report_Nov30.pdf diff --git a/MA Report Generation/output/Reports/index.html b/MA Report Generation/output/Reports/index.html new file mode 100644 index 00000000..ec409998 --- /dev/null +++ b/MA Report Generation/output/Reports/index.html @@ -0,0 +1,650 @@ + + + + + + + + + + + + + + + +Managed Area Reports - Directory + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

Managed Area Reports

+

Managed Area reports are available in both PDF and HTML format. The +GitHub Repository is located here

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Managed.AreaHTMLPDF
Alligator Harbor Aquatic PreserveAHAP_Report.pdf
Apalachicola Bay Aquatic PreserveABAP_Report.pdf
Apalachicola National Estuarine Research ReserveANERR_Report.pdf
Banana River Aquatic PreserveBRAP_Report.pdf
Big Bend Seagrasses Aquatic PreserveBBSAP_Report.htmlBBSAP_Report.pdf
Biscayne Bay Aquatic PreserveBBAP_Report.pdf
Biscayne Bay-Cape Florida to Monroe County Line Aquatic +PreserveBBCFMCAP_Report.pdf
Boca Ciega Bay Aquatic PreserveBCBAP_Report.pdf
Cape Haze Aquatic PreserveCHAP_Report.pdf
Cape Romano-Ten Thousand Islands Aquatic PreserveCRTTIAP_Report.pdf
Cockroach Bay Aquatic PreserveCKRBAP_Report.pdf
Southeast Florida Coral Reef Ecosystem Conservation +AreaCRCP_Report.pdf
Coupon Bight Aquatic PreserveCBAP_Report.pdf
Estero Bay Aquatic PreserveEBAP_Report.pdf
Florida Keys National Marine SanctuaryFKNMS_Report.pdf
Fort Clinch State Park Aquatic PreserveFCAP_Report.pdf
Fort Pickens State Park Aquatic PreserveFPAP_Report.pdf
Gasparilla Sound-Charlotte Harbor Aquatic PreserveGSCHAP_Report.pdf
Guana River Marsh Aquatic PreserveGRMAP_Report.pdf
Guana Tolomato Matanzas National Estuarine Research +ReserveGTMNERR_Report.pdf
Indian River-Malabar to Vero Beach Aquatic +PreserveIRMVBAP_Report.pdf
Indian River-Vero Beach to Ft. Pierce Aquatic +PreserveIRVBFPAP_Report.pdf
Jensen Beach to Jupiter Inlet Aquatic PreserveJBJIAP_Report.pdf
Lemon Bay Aquatic PreserveLBAP_Report.pdf
Lignumvitae Key Aquatic PreserveLKAP_Report.pdf
Loxahatchee River-Lake Worth Creek Aquatic +PreserveLRLWCAP_Report.pdf
Matlacha Pass Aquatic PreserveMPAP_Report.pdf
Mosquito Lagoon Aquatic PreserveMLAP_Report.pdf
Nassau River-St. Johns River Marshes Aquatic +PreserveNRSJRAP_Report.pdf
North Fork St. Lucie Aquatic PreserveNFSLRAP_Report.pdf
Pellicer Creek Aquatic PreservePCRAP_Report.pdf
Pine Island Sound Aquatic PreservePISAP_Report.pdf
Pinellas County Aquatic PreservePCAP_Report.pdf
Rocky Bayou State Park Aquatic PreserveRBSPAP_Report.pdf
Rookery Bay Aquatic PreserveRBAP_Report.pdf
Rookery Bay National Estuarine Research ReserveRBNERR_Report.pdf
St. Andrews State Park Aquatic PreserveSBAP_Report.pdf
St. Joseph Bay Aquatic PreserveSJBAP_Report.pdf
St. Martins Marsh Aquatic PreserveSMMAP_Report.pdf
Terra Ceia Aquatic PreserveTCAP_Report.pdf
Tomoka Marsh Aquatic PreserveTMAP_Report.pdf
Yellow River Marsh Aquatic PreserveYRMAP_Report.pdf
Nature Coast Aquatic PreserveNCAP_Report.pdf
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ABAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ABAP_map_bypr.jpg new file mode 100644 index 00000000..5dd0e498 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ABAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_AHAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_AHAP_map_bypr.jpg new file mode 100644 index 00000000..e651396a Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_AHAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ANERR_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ANERR_map_bypr.jpg new file mode 100644 index 00000000..c95eb481 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_ANERR_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBAP_map_bypr.jpg new file mode 100644 index 00000000..4a64b6c8 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBSAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBSAP_map_bypr.jpg new file mode 100644 index 00000000..e4c2632b Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BBSAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BCBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BCBAP_map_bypr.jpg new file mode 100644 index 00000000..47696d8c Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BCBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BRAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BRAP_map_bypr.jpg new file mode 100644 index 00000000..9b4bc194 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_BRAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CHAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CHAP_map_bypr.jpg new file mode 100644 index 00000000..55e65057 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CHAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CKRBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CKRBAP_map_bypr.jpg new file mode 100644 index 00000000..1891acac Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_CKRBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_EBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_EBAP_map_bypr.jpg new file mode 100644 index 00000000..86a917ac Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_EBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FKNMS_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FKNMS_map_bypr.jpg new file mode 100644 index 00000000..dc3287ec Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FKNMS_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FPAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FPAP_map_bypr.jpg new file mode 100644 index 00000000..f0a909c4 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_FPAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_GSCHAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_GSCHAP_map_bypr.jpg new file mode 100644 index 00000000..702344f5 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_GSCHAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRMVBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRMVBAP_map_bypr.jpg new file mode 100644 index 00000000..b468a6d8 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRMVBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRVBFPAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRVBFPAP_map_bypr.jpg new file mode 100644 index 00000000..b936b735 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_IRVBFPAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_JBJIAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_JBJIAP_map_bypr.jpg new file mode 100644 index 00000000..a2fe58cf Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_JBJIAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LBAP_map_bypr.jpg new file mode 100644 index 00000000..188f85fe Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LRLWCAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LRLWCAP_map_bypr.jpg new file mode 100644 index 00000000..e5576ccb Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_LRLWCAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MLAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MLAP_map_bypr.jpg new file mode 100644 index 00000000..9de1c607 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MLAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MPAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MPAP_map_bypr.jpg new file mode 100644 index 00000000..8b1af38e Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_MPAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_NCAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_NCAP_map_bypr.jpg new file mode 100644 index 00000000..63aa6fe4 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_NCAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PCAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PCAP_map_bypr.jpg new file mode 100644 index 00000000..40e4362f Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PCAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PISAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PISAP_map_bypr.jpg new file mode 100644 index 00000000..e03b8d57 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_PISAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBAP_map_bypr.jpg new file mode 100644 index 00000000..f8aecf13 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBNERR_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBNERR_map_bypr.jpg new file mode 100644 index 00000000..d93328b5 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_RBNERR_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SBAP_map_bypr.jpg new file mode 100644 index 00000000..f6d7e8b8 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SJBAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SJBAP_map_bypr.jpg new file mode 100644 index 00000000..28666e79 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SJBAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SMMAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SMMAP_map_bypr.jpg new file mode 100644 index 00000000..2b6e0885 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_SMMAP_map_bypr.jpg differ diff --git a/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_TCAP_map_bypr.jpg b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_TCAP_map_bypr.jpg new file mode 100644 index 00000000..684f9298 Binary files /dev/null and b/MA Report Generation/output/SAV-Temporal-Scope-Plots/SAV_TCAP_map_bypr.jpg differ diff --git a/MA Report Generation/scripts/Coral.R b/MA Report Generation/scripts/Coral.R index 650f38bd..a41b0670 100644 --- a/MA Report Generation/scripts/Coral.R +++ b/MA Report Generation/scripts/Coral.R @@ -554,8 +554,8 @@ plot_coral_pc <- function(ma, data = data_pc, lme_plot = lme_plot_pc, MA_Ov_Stat geom_point(aes(x=Year, y=ResultValue), position=plot_jitter, shape=21, size=2, color="#333333", fill="#cccccc", alpha=1) + - # geom_line(data=lme_plot_data, aes(x=x, y=y), - # color="#000099", size=2, alpha=0.8) + + geom_line(data=lme_plot_data, aes(x=x, y=y), + color="#000099", size=2, alpha=0.8) + labs(title="Coral Percent Cover", subtitle=ma, x="Year", y="Percent cover (%)") + @@ -668,7 +668,7 @@ plot_coral_sr <- function(ma, MA_Y_Stats = MA_Y_Stats_sr, MA_Ov_Stats = MA_Ov_St # size=0.75, alpha=1) + geom_point(aes(x=Year, y=Mean), fill=color_palette[1], shape=21, size=2, color="#333333", alpha=1) + - labs(title=title_param, + labs(title="Grazers and Reef-Dependent Species Richness", subtitle=ma, x="Year", y="Richness (# of species)") + scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), diff --git a/MA Report Generation/scripts/SAV-Functions.R b/MA Report Generation/scripts/SAV-Functions.R index ebc58ca7..fddae6c9 100644 --- a/MA Report Generation/scripts/SAV-Functions.R +++ b/MA Report Generation/scripts/SAV-Functions.R @@ -95,20 +95,25 @@ sav_stats_table[Species=="Unidentified Halophila", Species := "Halophila, unk."] # SAV LMEResults Table Function # For use in report generation sav_trend_table <- function(ma){ - table <- sav_stats_table[ManagedAreaName == ma, c("Species","StatisticalTrend","years","LME_Intercept","LME_Slope","p")] + table <- sav_stats_table[ManagedAreaName == ma, c("Species","StatisticalTrend","years","LME_Intercept","LME_Slope","p")] %>% + mutate(CommonName = modify_species_labels(Species, usenames="common")) %>% + mutate(CommonName = ifelse(CommonName==Species, NA, CommonName)) %>% + select(Species,CommonName,StatisticalTrend,years,LME_Intercept,LME_Slope,p) caption <- paste0("Percent Cover Trend Analysis for ", ma) sav_kable <- table %>% - kable(format="simple",caption=caption, - col.names = c("*Species*","*Trend Significance* (0.05)","*Period of Record*","*LME_Intercept*","*LME_Slope*","*p*")) %>% - kable_styling() + kable(format="latex",caption=caption, booktabs = T, linesep = "", + col.names = c("Species","CommonName","Trend Significance (0.05)","Period of Record","LME-Intercept","LME-Slope","p")) %>% + row_spec(0, italic=TRUE) %>% + kable_styling(latex_options=c("scale_down","HOLD_position"), + position = "center") print(sav_kable) cat("\n") } -source(here::here("scripts/load_shape_files.R")) +# source(here::here("scripts/load_shape_files.R")) ############################## ### SAV PLOTTING FUNCTIONS ### @@ -186,9 +191,9 @@ for(pl in multiplots){ plot_sav_multiplot <- function(ma, ma_abrev){ if(ma_abrev %in% multiplot_list){ - plot_file <- lapply(ma_abrev, find_exact_matches, filenames = multiplots) + plot_file <- unlist(lapply(ma_abrev, find_exact_matches, filenames = multiplots)) + if(length(plot_file)>1){plot_file <- str_subset(plot_file, "_BBpct_")} plot <- readRDS(here::here(paste0("output/Figures/BB/", plot_file))) - caption <- paste0("Median percent cover by species in *", ma, "*. Linear mixed-effects models are applied to each species to produce species trends. The trendlines are then isolated and reproduced below for ease of viewing. The LME results are available in table form beneath the supplemental trendplot below.") cat(" \n") print(plot) @@ -318,16 +323,23 @@ sav_maps <- function(ma, ma_abrev){ sav_programs$ProgramID <- as.numeric(sav_programs$ProgramID) # grab sample coordinates from those programs - coord_df <- locs_pts_rcp %>% filter(ProgramID %in% sav_programs$ProgramID) + pt_coord_df <- locs_pts_rcp %>% filter(ProgramID %in% sav_programs$ProgramID) + ln_coord_df <- locs_lns_rcp %>% filter(ProgramID %in% sav_programs$ProgramID) # frame to plot coordinates, allows for bubble size display of n_samples + # grouping by LocationID yields better results, PLID doesn't always match (BBAP) sav_df <- SAV4 %>% filter(ManagedAreaName == ma, ProgramID %in% sav_programs$ProgramID) %>% - group_by(ProgramLocationID) %>% - summarise(n_data = n()) %>% - rename(ProgramLoc = ProgramLocationID) + group_by(LocationID) %>% + summarise(n_data = n()) + + # sav_df <- SAV4 %>% filter(ManagedAreaName == ma, ProgramID %in% sav_programs$ProgramID) %>% + # group_by(ProgramLocationID) %>% + # summarise(n_data = n()) %>% + # rename(ProgramLoc = ProgramLocationID) + + pt_ln_df <- bind_rows(pt_coord_df, ln_coord_df) - # merge frames together prior to plotting - sav_df <- merge(sav_df, coord_df) + sav_df <- merge(sav_df, pt_ln_df) sav_df <- sav_df[order(sav_df$n_data, decreasing=TRUE), ] # locate shape file for a given MA @@ -336,20 +348,57 @@ sav_maps <- function(ma, ma_abrev){ # get coordinates to set zoom level shape_coordinates <- get_shape_coordinates(ma_shape) + # color palette set up to match coloring on SAV_Scope_plots + color_values <- subset(prcols, names(prcols) %in% unique(sav_df$ProgramName)) + # rename list names as ProgramID instead of ProgramName (display ID in map legend) + # names(color_values) <- sapply( + # names(color_values), + # function(x){sav_df %>% filter(ProgramName==x) %>% distinct(ProgramID)}) + # setting color palette - pal <- colorFactor("plasma", sav_df$ProgramID) + pal <- colorFactor(palette = color_values, levels = names(color_values)) - # leaflet map + # create empty map template with shape file + # previous shape col - #4E809C map <- leaflet(sav_df, options = leafletOptions(zoomControl = FALSE)) %>% addProviderTiles(providers$CartoDB.PositronNoLabels) %>% - addPolygons(data=ma_shape, color="#4e809c", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.2) %>% - addCircleMarkers(lat=~Latitude_D, lng=~Longitude_, color=~pal(ProgramID), weight=0.5, radius=sqrt(sav_df$n_data), fillOpacity=0.3) %>% - addLegend(pal=pal, values=~ProgramID, labFormat=labelFormat(prefix="Program "), title="") %>% + addPolygons(data=ma_shape, color="black", weight = 1, smoothFactor = 0.5, opacity = 0.8, fillOpacity = 0.1) %>% + addLegend(pal=pal, values=~ProgramName, labFormat=labelFormat(prefix=""), title="") %>% fitBounds(lng1=shape_coordinates$xmin, lat1=shape_coordinates$ymin, lng2=shape_coordinates$xmax, lat2=shape_coordinates$ymax) + # set sav_df as SF geo-object + sav_df <- st_as_sf(sav_df) + + # subsetting for lines vs points (coordinate vs transect) + pts <- sav_df %>% filter(!is.na(Longitude_)) + lns <- sav_df %>% filter(!is.na(RawLineStr)) + + # add transects and points where available + if(nrow(pts)>0){ + # set pt-size weighting (some MAs have large amounts of samples) + pt_weight_setting <- ifelse(mean(pts$n_data)>40, 3, 1) + map <- map %>% + addCircleMarkers(data = pts, + lat=~Latitude_D, lng=~Longitude_, + color=~pal(pts$ProgramName), weight=0.5, + radius=sqrt(pts$n_data)/pt_weight_setting, + fillOpacity=0.6) + } + + if(nrow(lns)>0){ + # set ln-size weighting + ln_weight_setting <- ifelse(sqrt(mean(lns$n_data))>100, 10, + ifelse(sqrt(mean(lns$n_data))>20, 2, 1)) + map <- map %>% + addPolylines(data = lns, + weight = sqrt(lns$n_data)/ln_weight_setting, + color = ~pal(lns$ProgramName),smoothFactor = 0.5, + stroke = TRUE, opacity = 0.6) + } + # map output filepath map_out <- paste0(map_output, ma_abrev, "_sav.png") @@ -360,14 +409,15 @@ sav_maps <- function(ma, ma_abrev){ p1 <- ggdraw() + draw_image(map_out, scale = 1) # captions / label - caption = paste0("Map showing SAV sampling sites within the boundaries of *", ma, "*. The point size reflects the number of samples at a given sampling site. \n") + caption = paste0("Map showing SAV sampling sites within the boundaries of *", + ma, "*. The point size reflects the number of samples at a given sampling site. \n") print(p1) cat(" \n") cat(caption) + cat(" \n") # SAV program data tables - # cat(paste0("Programs Containing SAV data: ")) cat(" \n") for (p_id in sav_programs$ProgramID){ @@ -376,12 +426,13 @@ sav_maps <- function(ma, ma_abrev){ caption <- paste0(p_name, " - *Program ", p_id,"*") - ma_sav <- SAV4 %>% filter(ManagedAreaName == ma, ProgramID==p_id) %>% + ma_sav <- SAV4 %>% filter(ManagedAreaName==ma, ProgramID==p_id) %>% + group_by(method) %>% summarise(N_Data = n(), YearMin = min(Year), YearMax = max(Year), - "Collection Method" = unique(method), "Sample Locations" = length(unique(ProgramLocationID))) %>% + select(N_Data, YearMin, YearMax, method, "Sample Locations") %>% kable(format="simple", caption=caption, col.names = c("*N_Data*","*YearMin*","*YearMax*","*Collection Method*","*Sample Locations*")) %>% kable_styling() diff --git a/MA Report Generation/scripts/SAV.R b/MA Report Generation/scripts/SAV.R index d59293dc..efb50a08 100644 --- a/MA Report Generation/scripts/SAV.R +++ b/MA Report Generation/scripts/SAV.R @@ -26,6 +26,8 @@ library(ggpubr) library(glue) library(kableExtra) +data_directory <- list() + SAV <- fread(sav_file_in, sep = "|", header = TRUE, stringsAsFactors = FALSE, na.strings=c("NULL","","NA")) SAV <- SAV[!is.na(ResultValue), ] @@ -35,7 +37,6 @@ SAV$BB <- NA SAV$mBB <- NA SAV$PC <- NA SAV$PO <- NA -SAV$SC <- NA SAV$PA <- NA # Fill created columns with values based on parameter names @@ -51,18 +52,9 @@ SAV$PC[SAV$ParameterName=="Percent Cover"] <- SAV$PO[SAV$ParameterName=="Percent Occurrence"] <- SAV$ResultValue[SAV$ParameterName=="Percent Occurrence"] -SAV$SC[SAV$ParameterName=="Shoot Count"] <- - SAV$ResultValue[SAV$ParameterName=="Shoot Count"] - SAV$PA[SAV$ParameterName=="Presence/Absence"] <- SAV$ResultValue[SAV$ParameterName=="Presence/Absence"] -#Rename "Total_SAV" to "Total SAV" -SAV$CommonIdentifier[SAV$CommonIdentifier=="Total_SAV"] <- "Total SAV" - -# Create a list of n years available for each managed area -SAV_sum <- SAV %>% group_by(ManagedAreaName) %>% summarize(n_yr = length(unique(Year)), yrs = list(sort(unique(Year)))) - # Filtering and subsetting SAV2 <- subset(SAV, !is.na(SAV$BB) | !is.na(SAV$mBB) | !is.na(SAV$PC) | !is.na(SAV$PO)) SAV2 <- SAV2 %>% filter(BB >= 0 & BB <= 5 | is.na(BB)) @@ -108,32 +100,31 @@ SAV2[!is.na(PO), PA := ifelse(PO == 0, 0, 1)] SAV2[, relyear := Year - min(Year)] -SAV3 <- SAV2 %>% filter(SpeciesGroup1 == "Seagrass" | SpeciesGroup1 == "Macroalgae") - -#Temporary fix to programs 570 and 571 - Group 1 should be "Total seagrass" instead of "Total SAV" -SAV3[ProgramID %in% c(570, 571) & CommonIdentifier == "Total SAV", CommonIdentifier := "Total seagrass"] +SAV3 <- SAV2[SpeciesGroup1 %in% c("Seagrass", "Macroalgae", "Total SAV"), ] #Temporary fix to cases where analysisunit is NA but CommonIdentifier is "Drift Algae" (and Drift_Attached is also NA); ~6,000 records SAV3[CommonIdentifier == "Drift algae", Drift_Attached := "Drift"] -species_reject <- c("All", "NA", - "Vallisneria americana", "Najas guadalupensis", +species_reject <- c("NA","Vallisneria americana", "Najas guadalupensis", "Hydrilla verticillata", "Potamogeton pusillus", "Zannichellia palustris") + SAV3[, `:=` (analysisunit_halid = ifelse(CommonIdentifier %in% species_reject, NA, ifelse(str_detect(CommonIdentifier, "Halophila") & is.na(SpeciesName), "Unidentified Halophila", - ifelse(SpeciesGroup1 == "Seagrass", CommonIdentifier, Drift_Attached))), + ifelse(SpeciesGroup1 %in% c("Seagrass","Total SAV"), CommonIdentifier, Drift_Attached))), analysisunit = ifelse(CommonIdentifier %in% species_reject, NA, ifelse(str_detect(CommonIdentifier, "Halophila"), "Halophila spp.", - ifelse(SpeciesGroup1 == "Seagrass", CommonIdentifier, Drift_Attached))))] -SAV3[!is.na(Drift_Attached), `:=` (analysisunit_halid = paste0(analysisunit_halid, " algae"), - analysisunit = paste0(analysisunit, " algae"))] + ifelse(SpeciesGroup1 %in% c("Seagrass","Total SAV"), CommonIdentifier, Drift_Attached))))] + +SAV3[str_detect(analysisunit, "Drift|Attached"), `:=` (analysisunit = paste0(analysisunit, " algae"))] +SAV3[str_detect(analysisunit_halid, "Drift|Attached"), `:=` (analysisunit_halid = paste0(analysisunit_halid, " algae"))] SAV4 <- subset(SAV3, !is.na(SAV3$analysisunit)) +saveRDS(SAV4, "output/data/SAV/SAV4.rds") sav_managed_areas <- unique(SAV4$ManagedAreaName) -rm(SAV, SAV2, SAV3, SAV_sum) +rm(SAV, SAV2, SAV3) MA_All <- fread("data/ManagedArea.csv", sep = ",", header = TRUE, stringsAsFactors = FALSE, na.strings = "") @@ -141,177 +132,29 @@ MA_All <- fread("data/ManagedArea.csv", sep = ",", header = TRUE, stringsAsFacto ### SAV Plotting Functions #### ############################### -# declaring previous addfits_blacktrendlines function to create multi-plots -addfits_blacktrendlines <- function(models, plot_i, param){ - aucol <- as.name(names(plot_i$data)[1]) - ifelse(length(models) == 1, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 2, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 3, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 4, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 5, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 6, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 7, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 8, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[8]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[8]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 9, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[8]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[8]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[9]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[9]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 10, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[8]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[8]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[9]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[9]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[10]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[10]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - ifelse(length(models) == 11, - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[8]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[8]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[9]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[9]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[10]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[10]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[11]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[11]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE)), - - return(plot_i + geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[1]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[1]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[2]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[2]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[3]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[3]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[4]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[4]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[5]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[5]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[6]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[6]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[7]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[7]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[8]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[8]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[9]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[9]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[10]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[10]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[11]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[11]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + - geom_line(data = SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(aucol) == eval(parse(text = paste0("unique(", models[[12]], "$data$", aucol, ")"))), ], - aes(x = relyear, y = predict(eval(models[[12]]), level = 0)), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE))))))))))))) +# modified version of previous addfits_blacktrendlines function to create multi-plots +addfits_multiplots <- function(models, plot_i, param, aucol){ + for(n in 1:length(models)){ + model_name <- names(models[n]) + model <- models[[model_name]] + + sp <- unique(model$data[[aucol]]) + + species_data <- SAV4[ManagedAreaName == i & !is.na(eval(p)) & eval(as.name(aucol)) == sp, ] + species_data$predictions <- predict(model, level = 0) + + plot_i <- plot_i + + geom_line(data = species_data, + aes(x = relyear, y = predictions), color="#000099", size=0.75, alpha=0.7, inherit.aes = FALSE) + } + + # order_match <- ifelse(usenames=="common", "order(match(spp_common))", "order(match(spp))") + + plot_i <- plot_i + + facet_wrap(~factor(modify_species_labels(eval(aucol), usenames)), + ncol = 3, strip.position = "top") + + return(plot_i) } # declaring addfits function which plots Percent Cover models on a single plot @@ -324,13 +167,13 @@ addfits <- function(models, plot_i, param) { for (i in seq_along(models)) { # finding model name, calling previously created model variable - model_name <- models[[i]] - model <- get(model_name) + model_name <- names(models[i]) + model <- models[[i]] # selecting for Total SAV and Total Seagrass to apply aesthetic conditions later is_ToSa <- grepl("ToSa", model_name) is_ToSe <- grepl("ToSe", model_name) - exclude <- c("DrAl") + exclude <- c("DrAl","AtAl") # declaring species & managed area of each model species <- unique(model$data[[aucol]]) @@ -353,9 +196,6 @@ addfits <- function(models, plot_i, param) { !is.na({{p}}), {{ aucol }} == species) - # plot_dat <- plotdat %>% - # filter({{ aucol }} == species) - # create predicted values variable for each model predicted_values <- predict(model, level = 0, newdata = species_data) @@ -403,7 +243,7 @@ addfits <- function(models, plot_i, param) { species_list <- species_list[order(match(species_list, names(spcols)))] # determining if scientific or common names - species_labels <- modify_species_labels(species_list) + species_labels <- modify_species_labels(species_list, usenames) plot_i <- plot_i + scale_color_manual(values = subset(spcols, names(spcols) %in% species_list), breaks = species_list, @@ -413,18 +253,21 @@ addfits <- function(models, plot_i, param) { } # function to modify species labels prior to plotting (sci vs common names) -modify_species_labels <- function(species_list) { - if(usenames == "common") { +# also replaces "Unidentified Halophila" with "Halophila, unk." +modify_species_labels <- function(species_list, usenames) { + + if(usenames == "scientific") { lab <- species_list } else { lab <- sapply(species_list, function(name) { - match_idx <- match(name, spp_common) + match_idx <- match(name, spp) if (!is.na(match_idx)) { - return(spp[match_idx]) + return(spp_common[match_idx]) } return(name) }) } + lab <- str_replace_all(lab, "Unidentified Halophila", "Halophila, unk.") return(lab) } @@ -482,57 +325,19 @@ spp <- c("Halophila spp.","Unidentified Halophila","Halophila johnsonii","Syring spp_common <- c("Halophila spp.", "Unidentified Halophila", "Johnson's seagrass", "Manatee grass", "Paddle grass", "Shoal grass", "Star grass", "Turtle grass", "Widgeon grass", "Attached algae", "Total SAV", "Total seagrass") -usenames <- "common" #alternative is "scientific" - -spcols <- setNames(spcollist, spp_common) - -SAV4[, `:=` (analysisunit_halid = fcase(analysisunit_halid == "Thalassia testudinum", "Turtle grass", - analysisunit_halid == "Syringodium filiforme", "Manatee grass", - analysisunit_halid == "Halodule wrightii", "Shoal grass", - analysisunit_halid == "Ruppia maritima", "Widgeon grass", - analysisunit_halid == "Halophila decipiens", "Paddle grass", - analysisunit_halid == "Halophila engelmannii", "Star grass", - analysisunit_halid == "Halophila johnsonii", "Johnson's seagrass", - analysisunit_halid == "Unidentified Halophila", "Unidentified Halophila", - analysisunit_halid == "Halophila spp.", "Halophila spp.", - analysisunit_halid == "Total seagrass", "Total seagrass", - analysisunit_halid == "Attached algae", "Attached algae", - analysisunit_halid == "Drift algae", "Drift algae", - analysisunit_halid == "Total SAV", "Total SAV"), - analysisunit = fcase(analysisunit == "Thalassia testudinum", "Turtle grass", - analysisunit == "Syringodium filiforme", "Manatee grass", - analysisunit == "Halodule wrightii", "Shoal grass", - analysisunit == "Ruppia maritima", "Widgeon grass", - analysisunit == "Halophila decipiens", "Paddle grass", - analysisunit == "Halophila engelmannii", "Star grass", - analysisunit == "Halophila johnsonii", "Johnson's seagrass", - analysisunit == "Unidentified Halophila", "Unidentified Halophila", - analysisunit == "Halophila spp.", "Halophila spp.", - analysisunit == "Total seagrass", "Total seagrass", - analysisunit == "Attached algae", "Attached algae", - analysisunit == "Drift algae", "Drift algae", - analysisunit == "Total SAV", "Total SAV"))] +usenames <- "scientific" #alternative is "common" -props[, analysisunit := fcase(analysisunit == "Thalassia testudinum", "Turtle grass", - analysisunit == "Syringodium filiforme", "Manatee grass", - analysisunit == "Halodule wrightii", "Shoal grass", - analysisunit == "Ruppia maritima", "Widgeon grass", - analysisunit == "Halophila decipiens", "Paddle grass", - analysisunit == "Halophila engelmannii", "Star grass", - analysisunit == "Halophila johnsonii", "Johnson's seagrass", - analysisunit == "Unidentified Halophila", "Unidentified Halophila", - analysisunit == "Halophila spp.", "Halophila spp.", - analysisunit == "Attached algae", "Attached algae")] +spcols <- setNames(spcollist, spp) props <- props[, analysisunit := factor(analysisunit, levels = c("Unidentified Halophila", "Halophila spp.", - "Johnson's seagrass", - "Manatee grass", - "Paddle grass", - "Shoal grass", - "Star grass", - "Turtle grass", - "Widgeon grass", + "Halophila johnsonii", + "Syringodium filiforme", + "Halophila decipiens", + "Halodule wrightii", + "Halophila engelmannii", + "Thalassia testudinum", + "Ruppia maritima", "Attached algae"))] # prcollist <- hcl.colors(n = length(unique(SAV4$ProgramID)), palette = "viridis") @@ -661,29 +466,28 @@ for(p in parameters$column){ setnames(nyears2, "analysisunit_halid", "analysisunit") nyears <- distinct(rbind(nyears, nyears2)) ma_include <- unique(subset(nyears, nyears$nyr >= 5)$ManagedAreaName) + # ma_include <- c("Banana River Aquatic Preserve", "Biscayne Bay Aquatic Preserve") #For each managed area, make sure there are multiple levels of BB scores per species; remove ones that don't from further consideration. + for(i in ma_include){ + # for(i in ma_include[ma_include %in% ma_halspp]){ ma_abrev <- MA_All %>% filter(ManagedAreaName==i) %>% pull(Abbreviation) cat(paste0("\nStarting MA: ", i, "\n")) if(i %in% ma_halspp){ - species <- subset(nyears, nyears$ManagedAreaName == i & nyears$nyr >= 5 & analysisunit %in% c("Attached algae", "Drift algae", "Halophila spp.", "Manatee grass", - "Shoal grass", "Total seagrass", "Total SAV", "Turtle grass", - "Widgeon grass", "Syringodium filiforme", "Halodule wrightii", "Thalassia testudinum", + species <- subset(nyears, nyears$ManagedAreaName == i & nyears$nyr >= 5 & analysisunit %in% c("Attached algae", "Drift algae", "Halophila spp.", "Syringodium filiforme", + "Halodule wrightii", "Total seagrass", "Total SAV", "Thalassia testudinum", "Ruppia maritima"))$analysisunit } else{ species <- subset(nyears, nyears$ManagedAreaName == i & nyears$nyr >= 5 & analysisunit %in% c("Attached algae", "Drift algae", "Unidentified Halophila", - "Johnson's seagrass", "Manatee grass", "Paddle grass", - "Shoal grass", "Star grass", "Total seagrass", "Total SAV", - "Turtle grass", "Widgeon grass", "Syringodium filiforme", - "Halodule wrightii", "Thalassia testudinum","Ruppia maritima"))$analysisunit + "Halophila johnsonii", "Syringodium filiforme", "Halophila decipiens", + "Halodule wrightii", "Halophila engelmannii", "Total seagrass", "Total SAV", + "Thalassia testudinum", "Ruppia maritima"))$analysisunit } - models <- c() - #Create data.tables to hold model results for managed area i---------------------------------------------------- lmemodresults <- data.table(managed_area = character(), species = character(), @@ -759,37 +563,41 @@ for(p in parameters$column){ #Individual model objects are needed for plotting all species together ##This allows get(model) functionality within addfits function - eval(call("<-", as.name(paste0(ma_abrev, - "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))), - model_j)) + # eval(call("<-", as.name(paste0(ma_abrev, + # "_", + # gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))), + # model_j)) + + short_model_name <- gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE) #Save the model object as .rds saveRDS(model_j, here::here(paste0("output/models/SAV_", parameters[column == p, type], "_", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), + short_model_name, ".rds"))) print(paste0(" Model object saved: ", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))) + short_model_name)) #record lme model results------------------------------------------------------ - if(class(try(eval(as.name(paste0(ma_abrev, "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))), silent = TRUE)) != "try-error"){ - models <- append(models, as.name(paste0(ma_abrev, "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))) - modj_i <- setDT(broom.mixed::tidy(eval(as.name(paste0(ma_abrev, "_", gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE)))))) + if(class(try(eval(model_j), silent = TRUE)) != "try-error"){ + # append only the successful models to data_directory object + data_directory[[ma_abrev]][[p]][[short_model_name]] <- model_j + + modj_i <- setDT(broom.mixed::tidy(eval(model_j))) modj_i[, `:=` (managed_area = i, species = j, filename = paste0("SAV_", parameters[column == p, type], "_", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"))] + short_model_name, ".rds"))] lmemodresults <- rbind(lmemodresults, modj_i) } else{ failedmod <- data.table(model = paste0("SAV_", parameters[column == p, type], "_", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"), + short_model_name, ".rds"), error = model_j[1]) failedmods <- rbind(failedmods, failedmod) @@ -798,7 +606,7 @@ for(p in parameters$column){ species = j, filename = paste0("SAV_", parameters[column == p, type], "_", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE), ".rds"), + short_model_name, ".rds"), effect = NA, group = NA, term = NA, @@ -825,24 +633,8 @@ for(p in parameters$column){ setnames(plotdat, "eval(p)", "data") aucol <- names(plotdat[,1]) - #split modeled vs unmodeled data - modeledsp <- c() - for(u in seq_along(models)){ - name_u <- fcase(str_detect(paste0(models[[u]]), "_ShGr"), "Shoal grass", - str_detect(paste0(models[[u]]), "_TuGr"), "Turtle grass", - str_detect(paste0(models[[u]]), "_MaGr"), "Manatee grass", - str_detect(paste0(models[[u]]), "_WiGr"), "Widgeon grass", - str_detect(paste0(models[[u]]), "_PaGr"), "Paddle grass", - str_detect(paste0(models[[u]]), "_StGr"), "Star grass", - str_detect(paste0(models[[u]]), "_JoSe"), "Johnson's seagrass", - str_detect(paste0(models[[u]]), "_UnHa"), "Unidentified Halophila", - str_detect(paste0(models[[u]]), "_HaSp"), "Halophila spp.", - str_detect(paste0(models[[u]]), "_ToSe"), "Total seagrass", - str_detect(paste0(models[[u]]), "_AtAl"), "Attached algae", - str_detect(paste0(models[[u]]), "_DrAl"), "Drift algae", - str_detect(paste0(models[[u]]), "_To"), "Total SAV") - modeledsp <- append(modeledsp, name_u) - } + # declaring available models + models <- data_directory[[ma_abrev]][[as.character(p)]] miny <- c() for(v in seq_along(models)){ @@ -860,8 +652,6 @@ for(p in parameters$column){ to = max(plotdat$Year), by = 3) - plotdat[get(aucol) == "Unidentified Halophila", (aucol) := "Halophila, unk."] - #create base plot of seagrass percent cover data over time for managed area i plot_i <- ggplot(data = droplevels(plotdat), aes(x = relyear, y = data)) + @@ -902,51 +692,9 @@ for(p in parameters$column){ # trendlines multi-plot (addfits_blacktrendlines function) aucol <- as.name(names(plot_i_2$data)[1]) - plot_i_2 <- addfits_blacktrendlines(models, plot_i_2, p) + - {if(usenames == "common"){ - facet_wrap(~factor(eval(aucol), levels = c("Total SAV", - "Total seagrass", - "Halophila, unk.", - "Halophila spp.", - "Johnson's seagrass", - "Manatee grass", - "Paddle grass", - "Shoal grass", - "Star grass", - "Turtle grass", - "Widgeon grass", - "Attached algae", - "Drift algae")), - ncol = 3, strip.position = "top") - } else{ - facet_wrap(~factor(eval(aucol), levels = c("Total SAV", - "Total seagrass", - "Halodule wrightii", - "Halophila decipiens", - "Halophila engelmannii", - "Halophila johnsonii", - "Halophila, unk.", - "Halophila spp.", - "Ruppia maritima", - "Syringodium filiforme", - "Thalassia testudinum", - "Attached algae", - "Drift algae")), - labeller = c("Total SAV", - "Total seagrass", - "Halodule wrightii", - "Halophila decipiens", - "Halophila engelmannii", - "Halophila johnsonii", - "Halophila spp.", - "Halophila spp.", - "Ruppia maritima", - "Syringodium filiforme", - "Thalassia testudinum", - "Attached algae", - "Drift algae"), - ncol = 3, strip.position = "top") - }} + # modify_species_labels changes scientific into common if needed + # also replaces "Unidentified Halophila" with "Halophila, unk." + plot_i_2 <- addfits_multiplots(models, plot_i_2, p, aucol) } #Save the single plot object as .rds @@ -983,7 +731,7 @@ for(p in parameters$column){ sp_list <- sp_list[order(match(sp_list, names(spcols)))] # add color scale, determining if scientific or common names - sp_labels <- modify_species_labels(sp_list) + sp_labels <- modify_species_labels(sp_list, usenames) barplot_sp <- ggplot(data = bpdat, aes(x = relyear, y = sp_pct, fill = analysisunit)) + geom_col(color = "grey20") + @@ -1004,7 +752,7 @@ for(p in parameters$column){ sp_list <- sp_list[order(match(sp_list, names(spcols)))] # add color scale, determining if scientific or common names - sp_labels <- modify_species_labels(sp_list) + sp_labels <- modify_species_labels(sp_list, usenames) barplot_sp <- ggplot(data = bpdat, aes(x = relyear, y = sp_pct, fill = analysisunit)) + geom_col(color = "grey20") + @@ -1026,7 +774,7 @@ for(p in parameters$column){ print(paste0(" Plot objects and results tables saved: ", ma_abrev, "_", - gsub('\\b(\\p{Lu}\\p{Ll})|.','\\1', str_to_title(j), perl = TRUE))) + short_model_name)) } } diff --git a/MA Report Generation/scripts/SAV_scope_plots.R b/MA Report Generation/scripts/SAV_scope_plots.R index 83b2da9b..eecf1091 100644 --- a/MA Report Generation/scripts/SAV_scope_plots.R +++ b/MA Report Generation/scripts/SAV_scope_plots.R @@ -124,6 +124,7 @@ MA_All <- fread("data/ManagedArea.csv", sep = ",", header = TRUE, stringsAsFacto #Create map(s) for the managed area------------------------------------------- for (i in unique(SAV4$ManagedAreaName)){ +# for (i in c("Terra Ceia Aquatic Preserve")){ ma_abrev <- MA_All %>% filter(ManagedAreaName==i) %>% pull(Abbreviation) @@ -275,7 +276,7 @@ for (i in unique(SAV4$ManagedAreaName)){ base <- ggplot() + geom_sf(data = rotate_sf(fl_i, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), fill = "beige", color = "navajowhite3", lwd = 0.5, inherit.aes = FALSE) + - geom_sf(data = rotate_sf(rcp_i, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), color = "grey50", fill = "powderblue", alpha = 0.35, lwd = 0.5, inherit.aes = FALSE) + + geom_sf(data = rotate_sf(rcp_i, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), color = "grey50", fill = "grey70", alpha = 0.15, lwd = 0.5, inherit.aes = FALSE) + geom_sf(data = rotate_sf(sbar, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), color = "grey50", linewidth = 1.25, inherit.aes = FALSE) + geom_sf(data = rotate_sf(narrow, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), color = "grey50", linewidth = 1, inherit.aes = FALSE) + geom_sf_text(data = rotate_sf(sbarlab, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), label = ifelse(wkm < 20, "3 km", ifelse(wkm < 50, "5 km", "10 km")), hjust = 0.5, angle = 4, color = "grey50", size = 3.5, inherit.aes = FALSE) + @@ -283,7 +284,7 @@ for (i in unique(SAV4$ManagedAreaName)){ scale_color_manual(values = subset(prcols, names(prcols) %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct), ProgramName])), aesthetics = c("color", "fill")) + labs(title = paste0(i), - subtitle = "Sample Locations - SAV Percent Cover", + subtitle = "SAV Percent Cover - Sample Locations", fill = "Program name", color = "Program name") + theme(panel.grid.major = element_line(colour = NA), panel.grid.minor = element_line(colour = NA), @@ -325,40 +326,41 @@ for (i in unique(SAV4$ManagedAreaName)){ base <- base + geom_sf(data = rotate_sf(subset(locs_pts_rcp_i, locs_pts_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == startyear, LocationID])), ma = i, coast = corners[LONG_NAME == i, Coast[1]]), - aes(fill = droplevels(as.factor(ProgramName))), shape = 21, color = "black", size=pt_size, alpha=0.5) + aes(fill = droplevels(as.factor(ProgramName))), shape = 21, color = "black", size=pt_size, alpha=0.8) } if(length(subset(locs_lns_rcp_i, locs_lns_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == startyear, LocationID]))$LocationID) > 0){ base <- base + geom_sf(data = rotate_sf(subset(locs_lns_rcp_i, locs_lns_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == startyear, LocationID])), ma = i, coast = corners[LONG_NAME == i, Coast[1]]), - aes(color = droplevels(as.factor(ProgramName))), shape = 21, size=pt_size, alpha=0.5) + aes(color = droplevels(as.factor(ProgramName))), size=0.1, alpha=0.8, linewidth=3, lineend = "round") } years <- sort(unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year != startyear, Year])) total_years <- length(years) - rows_per_column <- ceiling(total_years / 2) + num_col <- ifelse(total_years<=12, 2, ifelse(total_years<=24, 3, 4)) + rows_per_column <- ceiling(total_years / num_col) for(index in seq_along(years)){ y <- years[index] base <- base + geom_sf(data = rotate_sf(rcp_i, x_add = xadd + maxxdist, y_add = yadd + maxydist, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), - color = "grey50", fill = "powderblue", alpha = 0.65, lwd = 0.5, inherit.aes = FALSE) + + color = "grey50", fill = "grey70", alpha = 0.15, lwd = 0.5, inherit.aes = FALSE) + annotate("text", x = xlab + xadd + maxxdist, y = xmax_y + yadd + maxydist, label = y, hjust = "left") if(length(subset(locs_pts_rcp_i, locs_pts_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == y, LocationID]))$LocationID) > 0){ base <- base + geom_sf(data = rotate_sf(subset(locs_pts_rcp_i, locs_pts_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == y, LocationID])), x_add = xadd + maxxdist, y_add = yadd + maxydist, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), - aes(fill = droplevels(as.factor(ProgramName))), shape = 21, color = "black", size=pt_size, alpha=0.5) + aes(fill = droplevels(as.factor(ProgramName))), shape = 21, color = "black", size=pt_size, alpha=0.8) } if(length(subset(locs_lns_rcp_i, locs_lns_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == startyear, LocationID]))$LocationID) > 0){ base <- base + geom_sf(data = rotate_sf(subset(locs_lns_rcp_i, locs_lns_rcp_i$LocationID %in% unique(SAV4[ManagedAreaName == i & !is.na(BB_pct) & Year == startyear, LocationID])), x_add = xadd + maxxdist, y_add = yadd + maxydist, ma = i, coast = corners[LONG_NAME == i, Coast[1]]), - aes(color = droplevels(as.factor(ProgramName))), shape = 21, size=pt_size, alpha=0.5) + aes(color = droplevels(as.factor(ProgramName))), size=0.1, alpha=0.8, linewidth=3, lineend = "round") } yadd <- yadd + maxydist @@ -385,21 +387,13 @@ for (i in unique(SAV4$ManagedAreaName)){ "_map_bypr.jpg")), plot = base, dpi = 300, - limitsize = FALSE) - + limitsize = FALSE, + width = 15, + height = 18) rm(base) print(paste0(i, " - SAV Scope plot object created")) } # plotbuild <- ggplot_build(base) # hwratio <- (plotbuild$layout$panel_scales_y[[1]]$range$range[2] - plotbuild$layout$panel_scales_y[[1]]$range$range[1]) / (plotbuild$layout$panel_scales_x[[1]]$range$range[2] - plotbuild$layout$panel_scales_x[[1]]$range$range[1]) -# pwidth <- 6 - - - -# ggsave(filename = here::here(paste0("output/Figures/BB/img/SAV_", -# ma_abrev, -# "_map_bypr.jpg")), -# plot = base, -# dpi = 300, -# limitsize = FALSE) \ No newline at end of file +# pwidth <- 6 \ No newline at end of file diff --git a/MA Report Generation/scripts/WQ_Continuous.R b/MA Report Generation/scripts/WQ_Continuous.R index 96833ce4..60aa303d 100644 --- a/MA Report Generation/scripts/WQ_Continuous.R +++ b/MA Report Generation/scripts/WQ_Continuous.R @@ -71,33 +71,24 @@ station_count_table <- function(cont_data){ for (prog in programs_by_ma){ n_years <- coordinates_df %>% filter(ManagedAreaName==ma, ProgramID==prog) %>% - group_by(ProgramLocationID) %>% - distinct(ProgramLocationID, years_of_data, Use_In_Analysis, ProgramName) %>% + group_by(ProgramLocationID, years_of_data, Use_In_Analysis, ProgramName) %>% + summarise(params = list(Parameter)) %>% arrange(ProgramLocationID) - # n_years$Use_In_Analysis <- cell_spec(n_years$Use_In_Analysis, background = ifelse(n_years$Use_In_Analysis==TRUE, "green", "orange")) - p_name <- unique(n_years$ProgramName) caption <- paste0(p_name," (",prog,")") station_kable <- n_years %>% select(-ProgramName) %>% - kable(format="simple",caption=caption, - col.names = c("*ProgramLocationID*","*Years of Data*","*Use in Analysis*")) %>% - kable_styling() + kable(format="latex",caption=caption, booktabs = T, linesep = "", + col.names = c("ProgramLocationID","Years of Data","Use in Analysis","Parameters")) %>% + row_spec(0, italic=TRUE) %>% + kable_styling(latex_options=c("scale_down","HOLD_position"), + position = "center") print(station_kable) cat("\n") } - ## n stations total, n stations included (Use_In_Analysis) - # n_stations <- nrow(stations) - # n_stations_inc <- nrow(stations[stations$Use_In_Analysis==TRUE, ]) - - ## print text statement - # cat(paste0("There are ", n_stations, " stations in ", ma, ". \n\n")) - # cat(paste0(n_stations_inc, " out of ", n_stations, " are included in this report.")) - # cat(" \n\n") - ############ ### maps ### ############ @@ -132,32 +123,38 @@ station_count_table <- function(cont_data){ df_coord <- adjust_label_position(df_coord, buffer_distance = 6000) + df_coord <- merge(df_coord, stations) + iconSet <- awesomeIconList( `Use In Analysis` = makeAwesomeIcon( icon = "glyphicon glyphicon-stats", library = "glyphicon", iconColor = "black", markerColor = "green" ) ) - for (i in 1:nrow(df_coord)){ - lati <- df_coord$lat[i] - long <- df_coord$lon[i] - sta_name <- df_coord$ProgramLocationID[i] + for (sta_name in unique(df_coord$ProgramLocationID)){ + + lati <- df_coord %>% filter(ProgramLocationID==sta_name) %>% distinct(lat) %>% pull(lat) + long <- df_coord %>% filter(ProgramLocationID==sta_name) %>% distinct(lon) %>% pull(lon) + + used <- df_coord %>% filter(ProgramLocationID==sta_name) %>% + distinct(Use_In_Analysis) %>% pull(Use_In_Analysis) + label_dir <- df_coord$labelDirection[i] offset_val <- ifelse(label_dir=="right", 10, -10) icons <- awesomeIcons( - icon = ifelse( + icon = ifelse(length(used)>1, "glyphicon-stats", ifelse( stations %>% filter(ProgramLocationID==sta_name) %>% pull(Use_In_Analysis) == TRUE, "glyphicon-stats", "glyphicon-none" - ), + )), iconColor = 'black', library = 'glyphicon', - markerColor = ifelse( + markerColor = ifelse(length(used)>1, "green", ifelse( stations %>% filter(ProgramLocationID==sta_name) %>% pull(Use_In_Analysis) == TRUE, "green", "orange" - ) + )) ) map <- map %>% @@ -170,12 +167,11 @@ station_count_table <- function(cont_data){ offset = c(offset_val, 0) )) - # set zoom level if only 1 station available - if(nrow(df_coord) == 1) { + # set zoom level if only 2 or less stations available + if(length(unique(df_coord$ProgramLocationID)) <= 2) { map <- map %>% setView(lng = long, lat = lati, zoom = 12) } - } # add legend for MAs with more than 1 station @@ -184,6 +180,16 @@ station_count_table <- function(cont_data){ addLegendAwesomeIcon(iconSet = iconSet, position = 'topright') } + + # Add miniMap (inset to show context within MA) + # Add scale-bar (metric & imperial) + map <- map %>% + addMiniMap(centerFixed = c(mean(df_coord$lat),mean(df_coord$lon)), + zoomLevelOffset = -5, + position = 'topright', + tiles = providers$CartoDB.PositronNoLabels) %>% + addScaleBar(position = "bottomright", + options = scaleBarOptions(metric=TRUE)) map_out <- paste0(map_output, ma_abrev, ".png") @@ -253,9 +259,9 @@ plot_cont <- function(p, y_labels, parameter, cont_data){ for (i in 1:length(MonIDs)) { id <- MonIDs[i] - if (i > 1){ - cat("\\newpage") - } + # if (i > 1){ + # cat("\\newpage") + # } # Plot trendplots @@ -347,7 +353,7 @@ plot_cont <- function(p, y_labels, parameter, cont_data){ plot_cont_combined <- function(param, y_labels, parameter, cont_data){ data <- cont_data %>% filter(ManagedAreaName == ma) - Mon_YM_Stats <- as.data.frame(load_cont_data_table(param, region, "Mon_YM_Stats")) + Mon_YM_Stats <- as.data.table(load_cont_data_table(param, region, "Mon_YM_Stats")) skt_stats <- as.data.frame(load_cont_data_table(param, region, "skt_stats")) skt_stats <- skt_stats %>% filter(ManagedAreaName==ma) @@ -355,108 +361,213 @@ plot_cont_combined <- function(param, y_labels, parameter, cont_data){ # Checking for missing values Mon_YM_Stats <- Mon_YM_Stats %>% filter(ManagedAreaName == ma & ParameterName == parameter) - ### SKT STATS ### - # Gets x and y values for starting point for trendline - KT.Plot <- skt_stats %>% - group_by(MonitoringID) %>% - summarize(x=decimal_date(EarliestSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Gets x and y values for ending point for trendline - KT.Plot2 <- skt_stats %>% - group_by(MonitoringID) %>% - summarize(x=decimal_date(LastSampleDate), - y=(x-EarliestYear)*SennSlope+SennIntercept) - # Combines the starting and endpoints for plotting the trendline - KT.Plot <- bind_rows(KT.Plot, KT.Plot2) - rm(KT.Plot2) - KT.Plot <- as.data.table(KT.Plot[order(KT.Plot$MonitoringID), ]) - KT.Plot <- KT.Plot[!is.na(KT.Plot$y),] - - # all plots together - plot_data <- Mon_YM_Stats[Mon_YM_Stats$ManagedAreaName==ma,] - - #Determine max and min time (Year) for plot x-axis - t_min <- min(plot_data$Year) - t_max <- max(plot_data$YearMonthDec) - t_max_brk <- as.integer(round(t_max, 0)) - t <- t_max-t_min - min_RV <- min(plot_data$Mean) - # Creates break intervals for plots based on number of years of data - if(t>=30){ - # Set breaks to every 10 years if more than 30 years of data - brk <- -10 - }else if(t<30 & t>=10){ - # Set breaks to every 4 years if between 30 and 10 years of data - brk <- -4 - }else if(t<10 & t>=4){ - # Set breaks to every 2 years if between 10 and 4 years of data - brk <- -2 - }else if(t<4 & t>=2){ - # Set breaks to every year if between 4 and 2 years of data - brk <- -1 - }else if(t<2){ - # Set breaks to every year if less than 2 years of data - brk <- -1 - # Sets t_max to be 1 year greater and t_min to be 1 year lower - # Forces graph to have at least 3 tick marks - t_max <- t_max+1 - t_min <- t_min-1 - } - - setDT(plot_data) - KT.Plot$ProgramLocationID <- "" - for (m in unique(KT.Plot$MonitoringID)){ - PLID <- unique(plot_data[MonitoringID == m, ]$ProgramLocationID) - KT.Plot[MonitoringID == m, ProgramLocationID := PLID] - } - - # number of stations for shape-palette - n <- length(unique(KT.Plot$MonitoringID)) - - p1 <- ggplot(data=plot_data, aes(x=YearMonthDec, y=Mean, group=factor(ProgramLocationID))) + - geom_point(aes(shape=ProgramLocationID), color="#cccccc" ,fill="#444444", size=3,alpha=0.9, show.legend = TRUE) + - labs(title=paste0(ma, "\nAll Stations"), - subtitle=paste0(parameter, " - Continuous"), - x="Year", y=y_labels) + - scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), - breaks=seq(t_max_brk, t_min, brk)) + - plot_theme + - geom_line(data=KT.Plot, aes(x=x, y=y, linetype=ProgramLocationID), color="#000099", linewidth=1.2, alpha=0.7) + - labs(shape = "Station ID", linetype = "Station ID") + - scale_shape_manual(values=1:n) - - ResultTable <- skt_stats %>% - mutate("Period of Record" = paste0(EarliestYear, " - ", LatestYear)) %>% - select(ProgramLocationID, N_Data, N_Years, "Period of Record", Median, tau, - SennIntercept, SennSlope, p) %>% - rename("Station" = ProgramLocationID) %>% - mutate_if(is.numeric, ~round(., 2)) - - # Remove text-based "NA" values in p column - if (nrow(ResultTable[ResultTable$p==" NA", ]) > 0){ - ResultTable[ResultTable$p==" NA", ]$p <- "-" + if(length(unique(Mon_YM_Stats$ProgramLocationID))>1){ + + ### SKT STATS ### + # Gets x and y values for starting point for trendline + KT.Plot <- skt_stats %>% + group_by(MonitoringID, ProgramID, ProgramLocationID) %>% + summarize(x=decimal_date(EarliestSampleDate), + y=(x-EarliestYear)*SennSlope+SennIntercept) + # Gets x and y values for ending point for trendline + KT.Plot2 <- skt_stats %>% + group_by(MonitoringID, ProgramID, ProgramLocationID) %>% + summarize(x=decimal_date(LastSampleDate), + y=(x-EarliestYear)*SennSlope+SennIntercept) + # Combines the starting and endpoints for plotting the trendline + KT.Plot <- bind_rows(KT.Plot, KT.Plot2) + rm(KT.Plot2) + KT.Plot <- as.data.table(KT.Plot[order(KT.Plot$MonitoringID), ]) + KT.Plot <- KT.Plot[!is.na(KT.Plot$y),] + + # Account for managed areas with large number of continuous sites + # Too many to plot together, plot combined by Program + if(length(unique(Mon_YM_Stats$ProgramLocationID))>10){ + + cat("### All Stations Combined by Program") + cat(" \n") + + for(pid in unique(Mon_YM_Stats$ProgramID)){ + + # all plots together + plot_data <- Mon_YM_Stats[Mon_YM_Stats$ManagedAreaName==ma & ProgramID==pid,] + p_name <- unique(plot_data$ProgramName) + + #Determine max and min time (Year) for plot x-axis + t_min <- min(plot_data$Year) + t_max <- max(plot_data$YearMonthDec) + t_max_brk <- as.integer(round(t_max, 0)) + t <- t_max-t_min + min_RV <- min(plot_data$Mean) + + # Creates break intervals for plots based on number of years of data + if(t>=30){ + # Set breaks to every 10 years if more than 30 years of data + brk <- -10 + }else if(t<30 & t>=10){ + # Set breaks to every 4 years if between 30 and 10 years of data + brk <- -4 + }else if(t<10 & t>=4){ + # Set breaks to every 2 years if between 10 and 4 years of data + brk <- -2 + }else if(t<4 & t>=2){ + # Set breaks to every year if between 4 and 2 years of data + brk <- -1 + }else if(t<2){ + # Set breaks to every year if less than 2 years of data + brk <- -1 + # Sets t_max to be 1 year greater and t_min to be 1 year lower + # Forces graph to have at least 3 tick marks + t_max <- t_max+1 + t_min <- t_min-1 + } + + setDT(plot_data) + # number of stations for shape-palette + n <- length(unique(KT.Plot[ProgramID==pid, ]$MonitoringID)) + + p1 <- ggplot(data=plot_data, aes(x=YearMonthDec, y=Mean, group=factor(ProgramLocationID))) + + geom_point(aes(shape=ProgramLocationID), color="#cccccc" ,fill="#444444", size=3,alpha=0.9, show.legend = TRUE) + + labs(title=paste0(ma,"\n",p_name, + "\nProgramID: ", pid), + subtitle=paste0(parameter, " - Continuous"), + x="Year", y=y_labels) + + scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), + breaks=seq(t_max_brk, t_min, brk)) + + plot_theme + + geom_line(data=KT.Plot[ProgramID==pid, ], aes(x=x, y=y, linetype=ProgramLocationID, color=ProgramLocationID), linewidth=1.2, alpha=0.7) + + labs(shape = "Station ID", linetype = "Station ID", color = "Station ID") + + scale_shape_manual(values=1:n) + + scale_linetype_manual(values=1:n) + + scale_color_manual(values=1:n) + + ResultTable <- skt_stats %>% + filter(ProgramID==pid) %>% + mutate("Period of Record" = paste0(EarliestYear, " - ", LatestYear)) %>% + select(ProgramLocationID, N_Data, N_Years, "Period of Record", Median, tau, + SennIntercept, SennSlope, p) %>% + rename("Station" = ProgramLocationID) %>% + mutate_if(is.numeric, ~round(., 2)) + + # Remove text-based "NA" values in p column + if (nrow(ResultTable[ResultTable$p==" NA", ]) > 0){ + ResultTable[ResultTable$p==" NA", ]$p <- "-" + } + ResultTable[is.na(ResultTable)] <- "-" + + t1 <- ggtexttable(ResultTable, rows=NULL, + theme=ttheme(base_size=10)) %>% + tab_add_footnote(text="p < 0.00005 appear as 0 due to rounding.\n + SennIntercept is intercept value at beginning of + record for monitoring location", + size=10, face="italic") + + # title <- glue("#### {p_name}: ({pid})") + # cat(" \n") + # cat(title) + cat(" \n") + cat(" \n") + cat(" \n") + print(p1) + cat(" \n") + + result_table <- kable(ResultTable, format="simple", + caption=paste0("Seasonal Kendall-Tau Results for All Stations - ", parameter), + row.names = FALSE, digits = 5) %>% + kable_styling(font_size=8) + + print(result_table) + cat("\n \n \n") + } + } else { + # all plots together + plot_data <- Mon_YM_Stats[Mon_YM_Stats$ManagedAreaName==ma,] + + #Determine max and min time (Year) for plot x-axis + t_min <- min(plot_data$Year) + t_max <- max(plot_data$YearMonthDec) + t_max_brk <- as.integer(round(t_max, 0)) + t <- t_max-t_min + min_RV <- min(plot_data$Mean) + # Creates break intervals for plots based on number of years of data + if(t>=30){ + # Set breaks to every 10 years if more than 30 years of data + brk <- -10 + }else if(t<30 & t>=10){ + # Set breaks to every 4 years if between 30 and 10 years of data + brk <- -4 + }else if(t<10 & t>=4){ + # Set breaks to every 2 years if between 10 and 4 years of data + brk <- -2 + }else if(t<4 & t>=2){ + # Set breaks to every year if between 4 and 2 years of data + brk <- -1 + }else if(t<2){ + # Set breaks to every year if less than 2 years of data + brk <- -1 + # Sets t_max to be 1 year greater and t_min to be 1 year lower + # Forces graph to have at least 3 tick marks + t_max <- t_max+1 + t_min <- t_min-1 + } + + setDT(plot_data) + KT.Plot$ProgramLocationID <- "" + for (m in unique(KT.Plot$MonitoringID)){ + PLID <- unique(plot_data[MonitoringID == m, ]$ProgramLocationID) + KT.Plot[MonitoringID == m, ProgramLocationID := PLID] + } + + # number of stations for shape-palette + n <- length(unique(KT.Plot$MonitoringID)) + + p1 <- ggplot(data=plot_data, aes(x=YearMonthDec, y=Mean, group=factor(ProgramLocationID))) + + geom_point(aes(shape=ProgramLocationID), color="#cccccc" ,fill="#444444", size=3,alpha=0.9, show.legend = TRUE) + + labs(title=paste0(ma, "\nAll Stations"), + subtitle=paste0(parameter, " - Continuous"), + x="Year", y=y_labels) + + scale_x_continuous(limits=c(t_min-0.25, t_max+0.25), + breaks=seq(t_max_brk, t_min, brk)) + + plot_theme + + geom_line(data=KT.Plot, aes(x=x, y=y, linetype=ProgramLocationID), color="#000099", linewidth=1.2, alpha=0.7) + + labs(shape = "Station ID", linetype = "Station ID") + + scale_shape_manual(values=1:n) + + ResultTable <- skt_stats %>% + mutate("Period of Record" = paste0(EarliestYear, " - ", LatestYear)) %>% + select(ProgramLocationID, N_Data, N_Years, "Period of Record", Median, tau, + SennIntercept, SennSlope, p) %>% + rename("Station" = ProgramLocationID) %>% + mutate_if(is.numeric, ~round(., 2)) + + # Remove text-based "NA" values in p column + if (nrow(ResultTable[ResultTable$p==" NA", ]) > 0){ + ResultTable[ResultTable$p==" NA", ]$p <- "-" + } + ResultTable[is.na(ResultTable)] <- "-" + + t1 <- ggtexttable(ResultTable, rows=NULL, + theme=ttheme(base_size=10)) %>% + tab_add_footnote(text="p < 0.00005 appear as 0 due to rounding.\n + SennIntercept is intercept value at beginning of + record for monitoring location", + size=10, face="italic") + + title <- glue("### All Stations Combined") + cat(" \n") + cat(title) + cat(" \n") + print(p1) + cat(" \n") + + result_table <- kable(ResultTable, format="simple", + caption=paste0("Seasonal Kendall-Tau Results for All Stations - ", parameter), + row.names = FALSE, digits = 5) %>% + kable_styling(font_size=8) + + print(result_table) + cat("\n \n \n") + } } - ResultTable[is.na(ResultTable)] <- "-" - - t1 <- ggtexttable(ResultTable, rows=NULL, - theme=ttheme(base_size=10)) %>% - tab_add_footnote(text="p < 0.00005 appear as 0 due to rounding.\n - SennIntercept is intercept value at beginning of - record for monitoring location", - size=10, face="italic") - - title <- glue("### All Stations Combined") - cat(" \n") - cat(title) - cat(" \n") - print(p1) - cat(" \n") - - result_table <- kable(ResultTable, format="simple", - caption=paste0("Seasonal Kendall-Tau Results for All Stations - ", parameter), - row.names = FALSE, digits = 5) %>% - kable_styling(font_size=8) - print(result_table) - cat("\n \n \n") } \ No newline at end of file diff --git a/MA Report Generation/scripts/WQ_Discrete.R b/MA Report Generation/scripts/WQ_Discrete.R index d0328fee..daee405b 100644 --- a/MA Report Generation/scripts/WQ_Discrete.R +++ b/MA Report Generation/scripts/WQ_Discrete.R @@ -214,12 +214,13 @@ plot_discrete_maps <- function(ma, data, param_label){ shape_coordinates <- get_shape_coordinates(ma_shape) # setting color palette + # pal <- colorFactor(seacar_palette, discrete_df$ProgramID) pal <- colorFactor("plasma", discrete_df$ProgramID) # leaflet map map <- leaflet(discrete_df, options = leafletOptions(zoomControl = FALSE)) %>% addProviderTiles(providers$CartoDB.PositronNoLabels) %>% - addPolygons(data=ma_shape, color="#4e809c", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.2) %>% + addPolygons(data=ma_shape, color="black", weight = 1, smoothFactor = 0.5, opacity = 0.8, fillOpacity = 0.1) %>% addCircleMarkers(lat=~Latitude_D, lng=~Longitude_, color=~pal(ProgramID), weight=0.5, radius=sqrt(discrete_df$n_data), fillOpacity=0.3) %>% addLegend(pal=pal, values=~ProgramID, labFormat=labelFormat(prefix="Program "), title="") %>% fitBounds(lng1=shape_coordinates$xmin, @@ -245,12 +246,6 @@ plot_discrete_maps <- function(ma, data, param_label){ print(p1) cat(" \n") cat("The bubble size on the above plots reflects the amount of data available at each sampling site") - - # print(plot_grid(p1, - # labels = caption, - # label_size = 8, - # label_y = 0.06)) - cat(" \n") } @@ -337,16 +332,9 @@ plot_trendlines <- function(p, a, d, activity_label, depth_label, y_labels, para record for monitoring location", size=10, face="italic") - # result_table <- kable(ResultTable, format="simple", - # caption="Seasonal Kendall-Tau Analysis Results", - # row.names = FALSE) %>% - # kable_styling(font_size=9) - # Arrange and display plot and statistic table print(ggarrange(p1, t1, ncol=1, heights=c(0.85, 0.15))) - # print(p1) cat(" \n") - # print(result_table) ##################### ### Discrete Maps ### diff --git a/MA Report Generation/scripts/load_shape_files.R b/MA Report Generation/scripts/load_shape_files.R index d1ec1609..4d022693 100644 --- a/MA Report Generation/scripts/load_shape_files.R +++ b/MA Report Generation/scripts/load_shape_files.R @@ -5,8 +5,9 @@ shape_files <- list.files(seacar_shape_location, full=TRUE) shape_locate <- function(location){return(paste0(seacar_shape_location, location))} -AP_shp <- st_read(shape_locate("APs/Florida_Aquatic_Preserves.shp")) -NERR_shp <- st_read(shape_locate("NERRs/Florida_National_Estuarine_Resarch_Reserves__NERR__Boundaries.shp")) +# below are now defunct, use updated "rcp" shapefile +# AP_shp <- st_read(shape_locate("APs/Florida_Aquatic_Preserves.shp")) +# NERR_shp <- st_read(shape_locate("NERRs/Florida_National_Estuarine_Resarch_Reserves__NERR__Boundaries.shp")) GeoDBdate <- "12dec2023" locs_pts <- st_read(shape_locate(paste0("SampleLocations", GeoDBdate, "/seacar_dbo_vw_SampleLocation_Point.shp"))) @@ -15,19 +16,32 @@ rcp <- st_read(shape_locate("orcp_all_sites/ORCP_Managed_Areas.shp")) counties <- st_read(shape_locate("FLCounties/Counties_-_Detailed_Shoreline.shp")) corners <- fread(shape_locate("MApolygons_corners.csv")) +corners[, `:=` (xmax = xmax + (xmax-xmin)*0.25, ymax = ymax + (ymax-ymin)*0.1)] + +locs_pts <- st_make_valid(locs_pts) +locs_lns <- st_make_valid(locs_lns) +rcp <- st_make_valid(rcp) +counties <- st_make_valid(counties) + +locs_pts <- st_transform(locs_pts, crs = 4326) +locs_lns <- st_transform(locs_lns, crs = 4326) +rcp <- st_transform(rcp, crs = 4326) +counties <- st_transform(counties, crs = 4326) + +locs_pts_rcp <- locs_pts[rcp, , op = st_intersects] +locs_lns_rcp <- locs_lns[rcp, , op = st_intersects] + +pnames <- distinct(SAV4[, .(ProgramID, ProgramName)]) +locs_pts_rcp <- merge(locs_pts_rcp, pnames, by = "ProgramID", all.x = TRUE) +locs_lns_rcp <- merge(locs_lns_rcp, pnames, by = "ProgramID", all.x = TRUE) + ############### ## FUNCTIONS ## ############### # Allows location of shapefile for each MA -find_shape <- function(ma){ - if (grepl("National Estuarine", ma, fixed = TRUE)){ - shape_file <- NERR_shp %>% filter(SITE_NAME==ma) - } else if (grepl("Aquatic Preserve", ma, fixed = TRUE)) { - shape_file <- AP_shp %>% filter(LONG_NAME==ma) - } - return(shape_file) -} +# Updated RCP shapefiles (including NCAP) +find_shape <- function(ma){return(rcp %>% filter(LONG_NAME==ma))} # Gets coordinate min and max from shapefile # This allows for accurately setting view on the map diff --git a/README.md b/README.md new file mode 100644 index 00000000..aa072718 --- /dev/null +++ b/README.md @@ -0,0 +1,55 @@ +# SEACAR Trend Analyses + +The *SEACAR Trend Analyses* repository contains the analysis scripts used to generate habitat-specific reports. Updated forms of these scripts can be found in the *MA Report Generation/scripts/* sub-folder where they are used to generate **Managed Area Reports** for each Managed Area which include analyses for each habitat (except Oyster - in development). + +## Managed Area Reports overview + +The **Managed Area Reports** can be found in the [MA Report Generation/output/Reports/](MA%20Report%20Generation/output/Reports/) sub-folder. + +Managed Area Reports contain the following information and visualizations if the habitats are included for a given Managed Area: +* Introduction + + Threshold filtering + + Value Qualifiers overview +* Discrete Water Quality / Water Clarity (by parameter) + + Seasonal Kendall-Tau trend analysis ("*discrete trendplots*") + + Map of discrete sample locations ("*discrete maps*") + + Programs contributing data ("*program tables*"): + - ProgramID + - N_Data + - Year Min & Max + + Overview of value qualifiers by year ("*VQ tables*") + - Year + - N_Total (total data for that parameter in that year) + - N_* (count of data entries with a given VQ in that year) + - Perc_* (percent of data entries flagged with a given VQ compared to total for that year) +* Continuous Water Quality / Water Clarity (by parameter) + + Station overview table ("*continuous station table*") + - ProgramLocationID + - Years of Data + - Use in Analysis (*True* or *False*) + - Parameters measured + + Map of continuous sites with visual indicators showing if they are used in analysis ("*continuous maps*") + + Seasonal Kendall-Tau trend analyses: + - For each station/ProgramLocationID ("*continuous trendplots*") + - All stations combined for each parameter ("*combined continuous trendplots*") + - For MAs with lots of continuous stations, the combined trendplots will be combined by ProgramID +* Submerged Aquatic Vegetation (SAV) + + [Spatio-temporal sample locations plot](MA%20Report%20Generation/output/SAV-Temporal-Scope-Plots) ("*SAV temporal scope plot*") + + Map of SAV sample locations ("*SAV maps*") + + Program Summary tables / program-level overview + - N_Data, Year Min and Max, Collection method, Number of sample locations + - Individual tables provided for each program + + Median Percent Cover species trend plots (Linear Mixed Effects) + - Plots for all available species with LME trendlines laid upon scatterplots of median percent cover ("*SAV multiplots*") + - Combined species trendlines with their significance indicated, simplified form of above plot ("*SAV trendplots*") + - LME Trend Results table provides statistical information behind *SAV multiplots* and *SAV trendplots* + + Frequency of Occurrence plots ("*SAV barplots*") + + GAM species plots - Median % Cover ("*SAV GAM plots*") +* Nekton + + Species richness plots (LME trend analysis) +* Coral + + Species richness plots (LME trend analysis) + + Percent cover plots (LME trend analysis) +* Coastal Wetlands + + Species richness plots (LME trend analysis) +* Oyster (currently unavailable, in development)