diff --git a/.gitignore b/.gitignore index fa9cec069..1c23d0016 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ # RStudio files TADA.Rproj .Rproj.user +test_function.R # History files .Rhistory diff --git a/NAMESPACE b/NAMESPACE index b9f64af94..0540f000a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,12 +8,14 @@ export(TADA_AutoFilter) export(TADA_BigDataRetrieval) export(TADA_Boxplot) export(TADA_CalculateTotalNP) +export(TADA_ColorPalette) export(TADA_ConvertDepthUnits) export(TADA_ConvertResultUnits) export(TADA_ConvertSpecialChars) export(TADA_CreateComparableID) export(TADA_CreateUnitRef) export(TADA_DataRetrieval) +export(TADA_DepthProfilePlot) export(TADA_FieldCounts) export(TADA_FieldValuesPie) export(TADA_FieldValuesTable) @@ -27,6 +29,7 @@ export(TADA_FlagAboveThreshold) export(TADA_FlagBelowThreshold) export(TADA_FlagContinuousData) export(TADA_FlagCoordinates) +export(TADA_FlagDepthCategory) export(TADA_FlagFraction) export(TADA_FlagMeasureQualifierCode) export(TADA_FlagMethod) @@ -48,6 +51,7 @@ export(TADA_GetWQXCharValRef) export(TADA_HarmonizeSynonyms) export(TADA_Histogram) export(TADA_IDCensoredData) +export(TADA_IDDepthProfiles) export(TADA_InsertBreaks) export(TADA_JoinWQPProfiles) export(TADA_MakeSpatial) @@ -66,6 +70,7 @@ export(TADA_SummarizeColumn) export(TADA_TwoCharacteristicScatterplot) export(TADA_UniqueCharUnitSpeciation) export(TADA_ViewATTAINS) +export(TADA_ViewColorPalette) export(TADA_addPoints) export(TADA_addPolys) importFrom(magrittr,"%>%") diff --git a/R/DepthProfile.R b/R/DepthProfile.R new file mode 100644 index 000000000..2faa86a46 --- /dev/null +++ b/R/DepthProfile.R @@ -0,0 +1,1438 @@ +#' TADA_FlagDepthCategory +#' +#' This function creates a new column, TADA.DepthCategory.Flag with values: "No +#' depth info", "Surface", "Bottom", and +#' "Middle" when multiple depths are available. +#' Categories are: less than 2m (or user specified value) depth = "Surface", from +#' bottom up to 2m (or user specified value) from bottom = "Bottom", and all depths +#' in between the Surface and Bottom are assigned to the "Middle" category. +#' +#' When more than one result is available for a MonitoringLocationIdentifier, +#' ActivityStartDate, OrganizationIdentifier, and TADA.CharacteristicName, the +#' user can choose a single result value (average, max, or min value) to use for that +#' day and location. If results vary with depth, the user may also define whether +#' the daily aggregation occurs over each depth category (surface, middle, or bottom) +#' or for the entire depth profile. +#' +#' @param .data TADA dataframe which must include the columns +#' TADA.ActivityDepthHeightMeasure.MeasureValue, TADA.ResultDepthHeightMeasure.MeasureValue, +#' TADA.ActivityBottomDepthHeightMeasure.MeasureValue, and ActivityRelativeDepthName. +#' +#' @param dailyagg Character argument; with options "none", "avg", "min", or +#' "max". The default is dailyagg = "none". When dailyagg = "none", all results +#' will be retained. When dailyagg == "avg", the mean value in each group of +#' results (as determined by the depth category) will be identified or calculated for each +#' MonitoringLocation, ActivityDate, Organization ID, and TADA.CharacteristicName combination. +#' When dailyagg == "min" or when dailyagg == "max", the min or max +#' value in each group of results (as determined by the depth category) will +#' be identified or calculated for each MonitoringLocation, ActivityDate, and TADA.CharacteristicName +#' combination. An additional column, TADA.DepthProfileAggregation.Flag will be added +#' to describe aggregation. +#' +#' @param bycategory character argument with options "no", "all", "surface", "middle", +#' "bottom". The default is bycategory = "no" which means that any aggregate values +#' are based on the entire water column at a Monitoring Location. When bycategory +#' = "all", any aggregate values are determined for each depth category for each +#' Monitoring Location. When bycategory = "surface", "middle", or "bottom", the data +#' frame is filtered only to include results in the selected category and aggregate +#' values are determined ONLY for results with TADA.DepthCategory.Flags +#' "Surface", "Bottom", or "Middle" +#' results respectively. +#' +#' @param bottomvalue numeric argument. The user enters how many meters from the +#' bottom should be included in the "Bottom" category. Default is +#' bottomvalue = 2. If bottomvalue = "null", "Bottom" and "Middle" results cannot +#' be identified, however TADA.ConsolidatedDepth and TADA.ConsolidatedDepth.Bottom +#' will still be determined. +#' +#' @param surfacevalue numeric argument. The user enters how many meters from the +#' surface should be included in the "Surface" category. Default is surfacevalue = 2. +#' If surfacealue = "null", "Surface" and "Middle" results cannot +#' be identified, however TADA.ConsolidatedDepth and TADA.ConsolidatedDepth.Bottom +#' will still be determined. +#' +#' @param aggregatedonly Boolean argument with options "TRUE" or "FALSE". The +#' default is aggregatedonly = "FALSE" which means that all results are returned. +#' When aggregatedonly = "TRUE", only aggregate values are returned. +#' +#' @param clean Boolean argument with options "TRUE" or "FALSE". The +#' default is clean = "FALSE" which means that all results are returned. +#' When clean = "TRUE", only aggregate results which can be assigned to a depth +#' category are included in the returned dataframe. +#' +#' @param .data TADA dataframe +#' +#' @return The same input TADA dataframe with additional columns TADA.DepthCategory.Flag, +#' TADA.DepthProfileAggregation.Flag, TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Bottom, +#' and TADA.ConsolidatedDepth.Unit. The consolidated depth fields are created by reviewing +#' multiple WQC columns where users may input depth information. If a daily_agg = "avg", +#' "min", or "max", aggregated values will be identified in the TADA.ResultAggregation.Flag +#' column. In the case of daily_agg = "avg", additional rows to display averages will be +#' added to the data frame. They can be identified by the prefix ("TADA-") of +#' their result identifiers. +#' +#' @export +#' +#' @examples +#' # Load dataset +#' data(Data_6Tribes_5y) +#' +#' # assign TADA.DepthCategory.Flag with no aggregation +#' Data_6Tribs_5y_DepthCat <- TADA_FlagDepthCategory(Data_6Tribes_5y) +#' +#' # assign TADA.DepthCategory.Flag and determine average values by depth category and returning only aggregate values +#' Data_6Tribs_5y_Mean <- TADA_FlagDepthCategory(Data_6Tribes_5y, bycategory = "all", dailyagg = "avg", aggregatedonly = FALSE) +#' +TADA_FlagDepthCategory <- function(.data, bycategory = "no", bottomvalue = 2, surfacevalue = 2, dailyagg = "none", aggregatedonly = FALSE, clean = FALSE) { + depthcat.list <- c("Surface", "Bottom", "Middle") + + ard.ref <- utils::read.csv(system.file("extdata", "WQXActivityRelativeDepthRef.csv", package = "TADA")) %>% + dplyr::rename( + ARD_Category = TADA.DepthCategory.Flag, + ActivityRelativeDepthName = Name + ) %>% + dplyr::select(ARD_Category, ActivityRelativeDepthName) + + depth.count <- .data %>% + dplyr::filter(!is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) | + !is.na(TADA.ResultDepthHeightMeasure.MeasureValue)) %>% + nrow() + + length.units <- c("M", "FT", "IN") + + depth.params <- c( + "DEPTH, SECCHI DISK DEPTH", + "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)", + "DEPTH, SECCHI DISK DEPTH REAPPEARS", + "DEPTH, DATA-LOGGER (NON-PORTED)", + "DEPTH, DATA-LOGGER (PORTED)", + "RBP STREAM DEPTH - RIFFLE", + "RBP STREAM DEPTH - RUN", + "THALWEG DEPTH" + ) + + if (bycategory == "no") { + cattype <- "for the entire depth profile" + } + + if (bycategory == "all") { + cattype <- "for each depth category" + } + + if (bycategory == "bottom") { + cattype <- "for Bottom" + } + + if (bycategory == "middle") { + cattype <- "for Middle" + } + + if (bycategory == "surface") { + cattype <- "for Surface" + } + + + if (depth.count > 0) { + print(paste("TADA_FlagDepthCategory: checking data set for depth values. ", depth.count, " results have depth values available.", sep = "")) + + print("TADA_FlagDepthCategory: assigning depth categories.") + + .data <- .data %>% + # set equal to TADA.ResultDepthHeighMeasure.MeasureValue if available, otherwise use TADA.ActivityDepthHeightMeasure.MeasureValue + dplyr::mutate( + TADA.ConsolidatedDepth = ifelse(!is.na(TADA.ResultDepthHeightMeasure.MeasureValue), TADA.ResultDepthHeightMeasure.MeasureValue, + TADA.ActivityDepthHeightMeasure.MeasureValue + ), + TADA.ConsolidatedDepth.Unit = ifelse(!is.na(TADA.ResultDepthHeightMeasure.MeasureUnitCode), + TADA.ResultDepthHeightMeasure.MeasureUnitCode, TADA.ActivityDepthHeightMeasure.MeasureUnitCode + ), + TADA.ConsolidatedDepth = ifelse(TADA.CharacteristicName %in% depth.params, + TADA.ResultMeasureValue, TADA.ConsolidatedDepth + ), + TADA.ConsolidatedDepth.Unit = ifelse(TADA.CharacteristicName %in% depth.params, + TADA.ResultMeasure.MeasureUnitCode, TADA.ConsolidatedDepth.Unit + ), + TADA.ConsolidatedDepth.Unit = tolower(TADA.ConsolidatedDepth.Unit) + ) %>% + # use group_by to identify profile data + dplyr::group_by(ActivityStartDate, MonitoringLocationIdentifier, OrganizationIdentifier) %>% + # determine the number of Depths per group + dplyr::mutate( + DepthsPerGroup = length(unique(TADA.ConsolidatedDepth)), + # determine bottom value using TADA.ActivityBottomDepthHeightMeasure.MeasureValue or the max depth record for profile data + TADA.ConsolidatedDepth.Bottom = ifelse(DepthsPerGroup > 1 & is.na(TADA.ActivityBottomDepthHeightMeasure.MeasureValue), max(TADA.ConsolidatedDepth, na.rm = TRUE), TADA.ActivityBottomDepthHeightMeasure.MeasureValue) + ) %>% + dplyr::ungroup() %>% + # assign depth categories by using depth information + dplyr::mutate(TADA.DepthCategory.Flag = dplyr::case_when( + TADA.ConsolidatedDepth <= surfacevalue ~ "Surface", + TADA.ConsolidatedDepth <= TADA.ConsolidatedDepth.Bottom & TADA.ConsolidatedDepth >= TADA.ConsolidatedDepth.Bottom - bottomvalue ~ "Bottom", + TADA.ConsolidatedDepth < surfacevalue & TADA.ConsolidatedDepth < TADA.ConsolidatedDepth.Bottom - bottomvalue ~ "Middle" + )) %>% + # assign depth categories that could not be assigned using depth + dplyr::left_join(ard.ref, by = "ActivityRelativeDepthName") %>% + dplyr::mutate( + TADA.DepthCategory.Flag = ifelse(is.na(TADA.DepthCategory.Flag), ARD_Category, TADA.DepthCategory.Flag), + TADA.DepthCategory.Flag = ifelse(is.na(TADA.ActivityDepthHeightMeasure.MeasureValue) & is.na(TADA.ConsolidatedDepth.Bottom) & is.na(TADA.ResultDepthHeightMeasure.MeasureValue) & is.na(TADA.DepthCategory.Flag), "No depth info", TADA.DepthCategory.Flag), + TADA.DepthCategory.Flag = ifelse(is.na(TADA.DepthCategory.Flag), "Not enough depth info to determine category", TADA.DepthCategory.Flag) + ) %>% + dplyr::select(-ARD_Category, -DepthsPerGroup) + + if (depth.count == 0) { + print(paste("TADA_FlagDepthCategory: checking data set for depth values. No results have depth values available, TADA_FlagDepthCategory cannot be used on this data set.", sep = "")) + + return(.data) + } + } + + if (clean == TRUE) { + .data <- .data %>% + dplyr::filter(TADA.DepthCategory.Flag %in% depthcat.list) + } + + if (clean == FALSE) { + .data <- .data + } + + if (bycategory == "all") { + print("TADA_FlagDepthCategory: Grouping results by MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, ActivityStartDate, and TADA.DepthCategory.Flag for aggregation by TADA.DepthCategory.Flag.") + + group.list <- c( + "MonitoringLocationIdentifier", "OrganizationIdentifier", + "TADA.CharacteristicName", "ActivityStartDate", + "TADA.DepthCategory.Flag" + ) + + .data <- .data + } + + if (bycategory == "no") { + print("TADA_FlagDepthCategory: Grouping results by MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for entire water column.") + + group.list <- c( + "MonitoringLocationIdentifier", "OrganizationIdentifier", + "TADA.CharacteristicName", "ActivityStartDate" + ) + + .data <- .data + } + + if (bycategory == "surface") { + print("TADA_FlagDepthCategory: Grouping results by MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for surface samples only.") + + group.list <- c( + "MonitoringLocationIdentifier", "OrganizationIdentifier", + "TADA.CharacteristicName", "ActivityStartDate" + ) + + .data <- .data %>% + dplyr::filter(TADA.DepthCategory.Flag == "Surface") + } + + if (bycategory == "middle") { + print("TADA_FlagDepthCategory: Grouping results by MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for middle samples only.") + + group.list <- c( + "MonitoringLocationIdentifier", "OrganizationIdentifier", + "TADA.CharacteristicName", "ActivityStartDate" + ) + + .data <- .data %>% + dplyr::filter(TADA.DepthCategory.Flag == "Middle") + } + + if (bycategory == "bottom") { + print("TADA_FlagDepthCategory: Grouping results by MonitoringLocationIdentifier, OrganizationIdentifier, CharacteristicName, and ActivityStartDate for aggregation for bottom samples only.") + + group.list <- c( + "MonitoringLocationIdentifier", "OrganizationIdentifier", + "TADA.CharacteristicName", "ActivityStartDate" + ) + + .data <- .data %>% + dplyr::filter(TADA.DepthCategory.Flag == "Bottom") + } + + if (dailyagg == "none") { + print("TADA_FlagDepthCategory: No aggregation performed.") + + # add TADA.ResultValue.Aggregation.Flag, remove unecessary columns, and order columns + orig.data <- .data %>% + dplyr::group_by_at(group.list) %>% + dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) %>% + dplyr::mutate(TADA.DepthProfileAggregation.Flag = ifelse(DepthsByGroup > 1, "No aggregation perfomed", "No aggregation needed")) %>% + dplyr::select(-DepthsByGroup) %>% + dplyr::ungroup() %>% + TADA_OrderCols() + + if (aggregatedonly == TRUE) { + stop("Function not executed because clean cannot be TRUE while daily_agg is 'no'") + } + + if (aggregatedonly == FALSE) { + return(orig.data) + } + } + if ((dailyagg == "avg")) { + print("TADA_FlagDepthCategory: Calculating mean aggregate value with randomly selected metadata.") + + # add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set + orig.data <- .data %>% + dplyr::group_by_at(group.list) %>% + dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) %>% + dplyr::mutate( + TADA.DepthProfileAggregation.Flag = ifelse(DepthsByGroup > 1, paste("Used in averaging results ", cattype, " but not selected as aggregate value"), "No aggregation needed"), + TADA.DepthProfileAggregation.Flag = ifelse(!TADA.DepthCategory.Flag %in% depthcat.list, "No aggregation needed", TADA.DepthProfileAggregation.Flag) + ) + + # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, calculate mean result value per group, and assign random metadata from group. + agg.data <- orig.data %>% + dplyr::filter( + DepthsByGroup > 1, + TADA.DepthCategory.Flag %in% depthcat.list + ) %>% + dplyr::mutate(TADA.ResultMeasureValue1 = mean(TADA.ResultMeasureValue, na.rm = TRUE)) %>% + dplyr::slice_sample(n = 1) %>% + dplyr::mutate(TADA.DepthProfileAggregation.Flag = paste0("Calculated mean aggregate value ", cattype, ", with randomly selected metadata from a row in the aggregate group")) %>% + dplyr::select(-TADA.ResultMeasureValue, -DepthsByGroup) %>% + dplyr::rename(TADA.ResultMeasureValue = TADA.ResultMeasureValue1) %>% + dplyr::mutate(ResultIdentifier = paste0("TADA-", ResultIdentifier)) %>% + dplyr::ungroup() + + if (aggregatedonly == TRUE) { + rm(orig.data) + + return(agg.data) + } + + if (aggregatedonly == FALSE) { + # combine original and aggregate data + comb.data <- plyr::rbind.fill(orig.data, agg.data) %>% + dplyr::ungroup() %>% + dplyr::select(-DepthsByGroup) %>% + TADA_OrderCols() + + rm(agg.data, orig.data) + + return(comb.data) + } + } + if ((dailyagg == "min")) { + print("TADA_FlagDepthCategory: Selecting minimum aggregate value.") + + # add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set + orig.data <- .data %>% + dplyr::group_by_at(group.list) %>% + dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) %>% + dplyr::mutate( + TADA.DepthProfileAggregation.Flag = ifelse(DepthsByGroup > 1, paste("Used in minimum aggregation ", cattype, "but not selected"), "No aggregation needed"), + TADA.DepthProfileAggregation.Flag = ifelse(!TADA.DepthCategory.Flag %in% depthcat.list, "No aggregation needed", TADA.DepthProfileAggregation.Flag) + ) + + # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, and select minimum result value per group. + agg.data <- orig.data %>% + dplyr::filter( + DepthsByGroup > 1, + TADA.DepthCategory.Flag %in% depthcat.list + ) %>% + dplyr::slice_min(order_by = TADA.ResultMeasureValue, n = 1, with_ties = FALSE) %>% + dplyr::mutate(TADA.DepthProfileAggregation.Flag = paste0("Selected as min aggregate value ", cattype)) %>% + dplyr::select(-DepthsByGroup) %>% + dplyr::ungroup() + + if (aggregatedonly == TRUE) { + rm(orig.data) + + return(agg.data) + } + + if (aggregatedonly == FALSE) { + # create list of result identifiers for selected aggregate data + agg.list <- agg.data %>% + dplyr::ungroup() %>% + dplyr::select(ResultIdentifier) %>% + unique() %>% + dplyr::pull() + + # combine original and aggregate data + comb.data <- orig.data %>% + dplyr::filter(!ResultIdentifier %in% agg.list) %>% + plyr::rbind.fill(agg.data) %>% + dplyr::ungroup() %>% + dplyr::select(-DepthsByGroup) %>% + TADA_OrderCols() + + rm(agg.data, orig.data, agg.list) + + return(comb.data) + } + } + + if ((dailyagg == "max")) { + print("TADA_FlagDepthCategory: Selecting maximum aggregate value.") + + # add TADA.ResultValue.Aggregation.Flag and remove unnecessary columns in original data set + orig.data <- .data %>% + dplyr::group_by_at(group.list) %>% + dplyr::mutate(DepthsByGroup = length(unique(TADA.ConsolidatedDepth))) %>% + dplyr::mutate(TADA.DepthProfileAggregation.Flag = ifelse(DepthsByGroup > 1, paste("Used in maximum aggregation ", cattype, "but not selected"), "No aggregation needed")) + + # add TADA.ResultValue.Aggregation.Flag, remove necessary columns, and select maximum result value per group. + agg.data <- orig.data %>% + dplyr::filter( + DepthsByGroup > 1, + TADA.DepthCategory.Flag %in% depthcat.list + ) %>% + dplyr::slice_max(order_by = TADA.ResultMeasureValue, n = 1, with_ties = FALSE) %>% + dplyr::mutate(TADA.DepthProfileAggregation.Flag = paste0("Selected as max aggregate value ", cattype)) %>% + dplyr::mutate(ResultIdentifier = paste0("TADA-", ResultIdentifier)) %>% + dplyr::select(-DepthsByGroup) %>% + dplyr::ungroup() + + if (aggregatedonly == TRUE) { + rm(orig.data) + + return(agg.data) + } + + if (aggregatedonly == FALSE) { + # create list of result identifiers for selected aggregate data + agg.list <- agg.data %>% + dplyr::ungroup() %>% + dplyr::select(ResultIdentifier) %>% + unique() %>% + dplyr::pull() + + # combine original and aggregate data + comb.data <- orig.data %>% + dplyr::filter(!ResultIdentifier %in% agg.list) %>% + plyr::rbind.fill(agg.data) %>% + dplyr::ungroup() %>% + dplyr::select(-DepthsByGroup) %>% + TADA_OrderCols() + + rm(agg.data, orig.data, agg.list) + + return(comb.data) + } + } +} + + +#' TADA_IDDepthProfiles +#' +#' This function identifies depth profiles within a data frame to assist the user in +#' selecting params for TADA_DepthProfilePlot. A TADA compatible data set is required. +#' If TADA_FlagDepthCategory has not yet been run, it will be run as part of this +#' function. The output data frame is grouped by MonitoringLocationIdentifier, +#' OrganizationIdentifier, and ActivityStartDate. +#' +#' A new column, TADA.CharacteristicsForDepthProfile, is created which lists the +#' characteristics available for depth profile analysis. Using the, nresults param, +#' users can specify whether characteristic names should be followed by the number +#' of results available for the characteristic in parentheses. +#' +#' @param .data TADA dataframe which must include the columns ActivityStartDate, +#' TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom, +#' TADA.ResultMeasureValue, TADA.ResultMeasureValue.UnitCode, +#' OrganizationIdentifier, MonitoringLocationName, MonitoringLocationIdentifier, +#' and TADA.ComparableDataIdentifier. +#' +#' @param nresults Boolean argument with options "TRUE" or "FALSE". The +#' default is nresults = TRUE, which means that the number of results for each +#' characteristic are added within the TADA.CharacteristicsForDepthProfile column. +#' When nresults = FALSE. +#' +#' @param nvalue numeric argument to specify the number of results required to identify +#' a depth profile. The default is 2, which means that a depth profile will be identified +#' if 2 or more results at different depths exists for the same ActivityStartDate, +#' MonitoringLocationIdentifier, OrganizationIdentifier, and TADA.ComparableDataIdentifier. +#' A few characteristics are excluded from this requirement because they are expected to +#' have only a single result in depth units (ex: secchi disk depth). +#' +#' @param aggregates Boolean argument with options "TRUE" or "FALSE". The default is +#' aggregates = FALSE, which means that any aggregate values created (means) in +#' TADA_FlagDepthCategory are excluded from identifying depth profile data. Aggregate +#' values that were selected from the existing data set (max and min) remain. +#' Only columns created/add by TADA_FlagDepthCategory are removed when aggregates = +#' FALSE. When aggregates = TRUE, all aggregate values are included when identifying +#' depth profile data. +#' +#' @return A dataframe with the columns MonitoringLocationIdentifier, +#' MonitoringLocationName, OrganizationIdentifier, ActivityStartDate, +#' TADA.CharacteristicsForDepthProfile. Based on the user input for the nresults +#' param, TADA.CharacteristicsForDepthProfile may or may not contain the number +#' of results for each characteristic. +#' +#' @export +#' +#' @examples +#' # Load dataset +#' data(Data_6Tribes_5y) +#' +#' # find depth profile data without showing number of results +#' Data_6Tribes_5y_DepthProfileID_Nresults <- TADA_IDDepthProfiles(Data_6Tribes_5y, nresults = FALSE) +#' +#' # find depth profile data showing number of results +#' Data_6Tribes_5y_DepthProfileID <- TADA_IDDepthProfiles(Data_6Tribes_5y) +#' +TADA_IDDepthProfiles <- function(.data, nresults = TRUE, nvalue = 2, aggregates = FALSE) { + # check for columns created in TADA_FlagDepthCategory and run the function if they are missing + # add check that depth category flag function has been run, run it if it has not + flag.func.cols <- c( + "TADA.ConsolidatedDepth", "TADA.ConsolidatedDepth.Unit", + "TADA.ConsolidatedDepth.Bottom, TADA.DepthCategory.Flag", + "TADA.DepthProfileAggregation.Flag" + ) + + if (all(flag.func.cols %in% colnames(.data)) == TRUE) { + print("TADA_IDDepthProfiles: Necessary columns from TADA_DepthCategoryFlag function are included in the data frame.") + + .data <- .data + } + + if (any(flag.func.cols %in% colnames(.data)) == FALSE) { + print("TADA_IDDepthProfiles: Necessary columns are being added to the data frame using TADA_DepthCatgegory.Flag function.") + + .data <- TADA_FlagDepthCategory(.data) + } + + depth.params <- c("DEPTH, SECCHI DISK DEPTH") + + if (aggregates == FALSE) { + if ("TADA.DepthProfileAggregation.Flag" %in% names(.data) == TRUE) { + .data <- .data %>% + dplyr::filter(TADA.DepthProfileAggregation.Flag != c("Calculated mean aggregate value, with randomly selected metadata from a row in the aggregate group")) + + if ("TADA.DepthProfileAggregation.Flag" %in% names(.data) == FALSE) { + .data <- .data + } + } + + + if (aggregates == TRUE) { + .data <- .data + } + } + + + if (nresults == TRUE) { + .data <- .data %>% + dplyr::select( + MonitoringLocationIdentifier, MonitoringLocationName, MonitoringLocationTypeName, + OrganizationIdentifier, ActivityStartDate, TADA.CharacteristicName, TADA.ComparableDataIdentifier, + TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom + ) %>% + dplyr::group_by( + MonitoringLocationIdentifier, OrganizationIdentifier, ActivityStartDate, + TADA.ComparableDataIdentifier + ) %>% + dplyr::mutate( + TADA.NResults = length(unique(TADA.ConsolidatedDepth)), + TADA.CharacteristicsForDepthProfile = paste( + TADA.ComparableDataIdentifier, " (", TADA.NResults, ")", + sep = "" + ) + ) %>% + dplyr::filter(TADA.NResults >= nvalue | TADA.CharacteristicName %in% depth.params) %>% + dplyr::ungroup() %>% + dplyr::group_by(MonitoringLocationIdentifier, OrganizationIdentifier, ActivityStartDate) %>% + # check that for results with only a single depth unit (ex: secchi disk depth) that other results are available in group + dplyr::mutate(MeanResults = mean(TADA.NResults)) %>% + dplyr::filter(MeanResults > 1) %>% + dplyr::mutate( + TADA.CharacteristicsForDepthProfile = paste( + unique(TADA.CharacteristicsForDepthProfile), ";", + collapse = "" + ), + TADA.CharacteristicsForDepthProfile = stringr::str_replace_all(paste(sort(unique(unlist(strsplit(TADA.CharacteristicsForDepthProfile, ";", )))), collapse = ";"), " ;", "; ") + ) %>% + dplyr::select( + MonitoringLocationIdentifier, MonitoringLocationName, MonitoringLocationTypeName, OrganizationIdentifier, ActivityStartDate, + TADA.CharacteristicsForDepthProfile + ) %>% + unique() + + return(.data) + } + + if (nresults == FALSE) { + .data <- .data %>% + dplyr::select( + MonitoringLocationIdentifier, MonitoringLocationName, MonitoringLocationTypeName, + OrganizationIdentifier, ActivityStartDate, TADA.CharacteristicName, TADA.ComparableDataIdentifier, + TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom + ) %>% + dplyr::group_by( + MonitoringLocationIdentifier, OrganizationIdentifier, ActivityStartDate, + TADA.ComparableDataIdentifier + ) %>% + dplyr::mutate(TADA.NResults = length(unique(TADA.ConsolidatedDepth))) %>% + dplyr::filter(TADA.NResults >= nvalue | TADA.CharacteristicName %in% depth.params) %>% + dplyr::ungroup() %>% + dplyr::group_by(MonitoringLocationIdentifier, OrganizationIdentifier, ActivityStartDate) %>% + # check that for results with only a single depth unit (ex: secchi disk depth) that other results are available in group + dplyr::mutate(MeanResults = mean(TADA.NResults)) %>% + dplyr::filter(MeanResults > 1) %>% + dplyr::mutate( + TADA.CharacteristicsForDepthProfile = paste( + unique(TADA.ComparableDataIdentifier), ";", + collapse = "" + ), + TADA.CharacteristicsForDepthProfile = stringr::str_replace_all(paste(sort(unique(unlist(strsplit(TADA.CharacteristicsForDepthProfile, ";", )))), collapse = ";"), " ;", "; ") + ) %>% + dplyr::select( + MonitoringLocationIdentifier, MonitoringLocationName, MonitoringLocationTypeName, OrganizationIdentifier, ActivityStartDate, + TADA.CharacteristicsForDepthProfile + ) %>% + unique() + + return(.data) + } +} + +#' Create A Three-Characteristic Depth Profile +#' +#' @param .data TADA data frame containing the data downloaded from the WQP, +#' where each row represents a unique data record. TADA_FlagDepthCategory +#' has been run as data frame must include the columns TADA.DepthCategory.Flag, +#' TADA.ResultDepthHeightMeasure.MeasureUnitCode, TADA.ActivityDepthHeightMeasure.MeasureUnitCode, +#' and TADA.ActivityDepthHeightMeasure.MeasureValue. Units for all depth fields +#' must be the same. This can be accomplished using TADA_AutoClean() or +#' TADA_ConvertDepthUnits. +#' +#' @param groups A vector of two identifiers from the TADA.ComparableDataIdentifier column. +#' For example, the groups could be 'DISSOLVED OXYGEN (DO)_NA_NA_UG/L' and 'PH_NA_NA_NA'. +#' These groups will be specific to your dataset. The TADA_IDDepthProfiles can be +#' used to identify available groups. +#' +#' @param location A single MonitoringLocationIdentifier to plot the depth profile. +#' A MonitoringLocationIdentifier must be entered or an error will be returned and +#' no depth profile will be created. +#' +#' @param activity_date The date the depth profile results were collected. +#' +#' @param depthcat Boolean argument indicating whether delineation between depth +#' categories should be shown on the depth profile figure. depthcat = TRUE is the +#' default and displays solid black lines to delineate between surface, middle, and +#' bottom samples and labels each section of the plot. +#' +#' @param bottomvalue numeric argument. The user enters how many meters from the +#' bottom should be included in the "Bottom" category. Default is +#' bottomvalue = 2. +#' +#' @param surfacevalue numeric argument. The user enters how many meters from the +#' surface should be included in the "Surface" category. Default is surfacevalue = 2. +#' +#' @param unit Character argument. The enters either "m" or "ft" to specify which +#' depth units should be used for the plot. Default is "m". +#' +#' @return A depth profile plot displaying up to three parameters for a single +#' MonitoringLocationIdentifier. Displaying depth categories is optional with the +#' depthcat argument. +#' +#' @export +#' +#' @examples +#' # Load example dataset: +#' data(Data_6Tribes_5y_Harmonized) +#' # Create a depth profile figure with three parameters for a single monitoring location and date +#' TADA_DepthProfilePlot(Data_6Tribes_5y_Harmonized, +#' groups = c("TEMPERATURE_NA_NA_DEG C", "PH_NA_NA_NA", "DEPTH, SECCHI DISK DEPTH_NA_NA_M"), +#' location = "REDLAKE_WQX-ANKE", +#' activity_date = "2018-10-04" +#' ) +#' +#' # Load example dataset: +#' data(Data_6Tribes_5y_Harmonized) +#' # Create a depth profile figure with two parameters for a single monitoring location and date without displaying depth categories +#' TADA_DepthProfilePlot(Data_6Tribes_5y_Harmonized, +#' groups = c("CONDUCTIVITY_NA_NA_US/CM", "DISSOLVED OXYGEN (DO)_NA_NA_MG/L"), +#' location = "REDLAKE_WQX-JOHN", +#' activity_date = "2018-07-31", +#' depthcat = FALSE +#' ) +TADA_DepthProfilePlot <- function(.data, + groups = NULL, + location = NULL, + activity_date = NULL, + depthcat = TRUE, + surfacevalue = 2, + bottomvalue = 2, + unit = "m") { + # check to see if TADA.ComparableDataIdentifier column is present + if ("TADA.ComparableDataIdentifier" %in% colnames(.data)) { + .data <- .data + + if (!"TADA.ComparableDataIdentifier" %in% colnames(.data)) { + print("TADA.ComparableDataIdentifier column not present in data set. Run TADA_CreateComparableID to create TADA.ComparableDataIdentifier.") + + stop() + } + } + + + # check .data is data.frame + TADA_CheckType(.data, "data.frame", "Input object") + + # add check that depth category flag function has been run, run it if it has not + flag.func.cols <- c( + "TADA.ConsolidatedDepth", "TADA.ConsolidatedDepth.Unit", + "TADA.ConsolidatedDepth.Bottom, TADA.DepthCategory.Flag" + ) + + if (all(flag.func.cols %in% colnames(.data)) == TRUE) { + print("TADA_DepthProfilePlot: Necessary columns from TADA_DepthCategoryFlag function are included in the data frame") + + .data <- .data + } + + if (any(flag.func.cols %in% colnames(.data)) == FALSE) { + print("TADA_DepthProfilePlot: Running TADA_DepthCategoryFlag function to add required columns to data frame") + + + if (bottomvalue == "null" & surfacevalue == "null") { + .data <- TADA_FlagDepthCategory(.data, surfacevalue = 2, bottomvalue = 2) %>% + dplyr::mutate(TADA.DepthCategory.Flag = NA) + } + + + if (surfacevalue == "null" & is.numeric(bottomvalue)) { + .data <- TADA_FlagDepthCategory(.data, surfacevalue = 2, bottomvalue = bottomvalue) %>% + dplyr::mutate(TADA.DepthCatgeory.Flag = ifelse(TADA.DepthCategory.Flag %in% c("Surface", "Middle"), + NA, TADA.DepthCategory.Flag + )) + } + + if (bottomvalue == "null" & is.numeric(surfacevalue)) { + .data <- TADA_FlagDepthCategory(.data, surfacevalue = surfacevalue, bottomvalue = 2) %>% + dplyr::mutate(TADA.DepthCatgeory.Flag = ifelse(TADA.DepthCategory.Flag %in% c("Bottom", "Middle"), + NA, TADA.DepthCategory.Flag + )) + } + + if (is.numeric(bottomvalue) & is.numeric(surfacevalue)) { + .data <- TADA_FlagDepthCategory(.data, surfacevalue = surfacevalue, bottomvalue = bottomvalue) + } + } + + # add convert depth unit (this still needs to be added), for now print warning and stop function if units don't match + .data <- .data %>% dplyr::filter(!is.na(TADA.ConsolidatedDepth)) + + if (.data$TADA.ConsolidatedDepth.Unit[1] == unit) { + print("TADA_DepthProfilePlot: Depth unit in data set matches depth unit specified by user for plot. No conversion necessary.") + + .data <- .data + + if (.data$TADA.ConsolidatedDepth.Unit[1] != unit) { + stop("TADA_DepthProfilePlot: Depth unit in data set does not match depth unit specified by user for plot. Convert units in data or specify correct unit in TADA_DepthProfilePlot function.") + } + } + + # create ID Depth Profiles data.frame to check against params + + param.check <- TADA_IDDepthProfiles(.data) + + + if (is.null(location)) { + print("TADA_DepthProfilePlot: No MonitoringLocationIdentifier selected, a depth profile cannot be generated.") + + stop() + + if (!location %in% param.check$MonitoringLocationIdentifier) { + print("TADA_DepthProfilePlot: MonitoringLocationIdentifier selected is not in data set.") + + stop() + } + + if (location %in% param.check$MonitoringLocationIdentifier) { + print("TADA_DepthProfilePlot: MonitoringLocationIdentifier selected.") + } + } + + if (is.null(activity_date)) { + print("TADA_DepthProfilePlot: No ActivityStartDate selected, a depth profile cannot be generated.") + + stop() + + if (!activity_date %in% param.check$ActivityStartDate) { + print("TADA_DepthProfilePlot: ActivityStartDate selected is not in data set.") + } + + stop() + + if (activity_date %in% param.check$ActivityStartDate) { + print("TADA_DepthProfilePlot: ActivityStartDate selected.") + } + } + + if (is.null(groups)) { + print("TADA_DepthProfilePlot: No groups selected, a depth profile cannot be generated.") + + stop() + + if (!is.null(groups)) { + groups.length <- length(groups) + + if (groups.length > 0) { + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[1]) == FALSE) { + print("TADA_DepthProfilePlot: First of groups for depth profile plot does not exist in data set.") + } + + stop() + + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[1]) == TRUE) { + print("TADA:DepthProfilePlot: First of groups for depth profile exists in data set.") + } + } + + if (groups.length > 1) { + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[2]) == FALSE) { + print("TADA_DepthProfilePlot: Second of groups for depth profile plot does not exist in data set.") + } + + stop() + + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[2]) == TRUE) { + print("TADA:DepthProfilePlot: Second of groups for depth profile exists in data set.") + } + } + + if (groups.length > 2) { + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[3]) == FALSE) { + print("TADA_DepthProfilePlot: Third of groups for depth profile plot does not exist in data set.") + } + + stop() + + if (stringr::str_detect(param.check$TADA.CharacteristicsForDepthProfile, groups[3]) == TRUE) { + print("TADA:DepthProfilePlot: Third of groups for depth profile exists in data set.") + } + } + } + + + if (!activity_date %in% param.check$ActivityStartDate) { + print("TADA_DepthProfilePlot: ActivityStartDate selected is not in data set.") + } + + stop() + + if (activity_date %in% param.check$ActivityStartDate) { + print("TADA_DepthProfilePlot: ActivityStartDate selected.") + } + + param.check <- param.check %>% + dplyr::filter(ActivityStartDate == activity_date) + } + + # remove param.check + rm(param.check) + + # list required columns + reqcols <- c( + "TADA.ResultDepthHeightMeasure.MeasureValue", + "TADA.ResultDepthHeightMeasure.MeasureUnitCode", + "TADA.ActivityDepthHeightMeasure.MeasureUnitCode", + "TADA.ActivityDepthHeightMeasure.MeasureValue", + "TADA.DepthCategory.Flag", + "TADA.ResultMeasureValue", + "TADA.ResultMeasure.MeasureUnitCode", + "MonitoringLocationIdentifier", + "MonitoringLocationName", + "ActivityStartDate", + "ActivityStartDateTime", + "TADA.ConsolidatedDepth", + "TADA.ConsolidatedDepth.Unit", + "TADA.ConsolidatedDepth.Bottom" + ) + + # check .data has required columns + TADA_CheckColumns(.data, reqcols) + + print("TADA_DepthProfilePlot: Identifying available depth profile data.") + + # identify depth profile data + depth.params <- c( + "DEPTH, SECCHI DISK DEPTH", + "DEPTH, SECCHI DISK DEPTH (CHOICE LIST)", + "DEPTH, SECCHI DISK DEPTH REAPPEARS", + "DEPTH, DATA-LOGGER (NON-PORTED)", + "DEPTH, DATA-LOGGER (PORTED)", + "RBP STREAM DEPTH - RIFFLE", + "RBP STREAM DEPTH - RUN", + "THALWEG DEPTH" + ) + + depthprofile.avail <- .data %>% + dplyr::filter( + !is.na(TADA.ConsolidatedDepth), + MonitoringLocationIdentifier %in% location, + ActivityStartDate %in% activity_date, + TADA.ActivityMediaName == "WATER" + ) %>% + dplyr::group_by( + TADA.ComparableDataIdentifier, + ActivityStartDate, TADA.ConsolidatedDepth + ) %>% + dplyr::slice_sample(n = 1) %>% + dplyr::ungroup() %>% + dplyr::group_by( + MonitoringLocationIdentifier, TADA.ComparableDataIdentifier, + ActivityStartDate + ) %>% + dplyr::mutate(N = length(TADA.ResultMeasureValue)) %>% + dplyr::filter(N > 2 | TADA.CharacteristicName %in% depth.params) %>% + dplyr::ungroup() %>% + dplyr::select(-N) + + depth.params.groups <- depthprofile.avail %>% + dplyr::filter( + TADA.ComparableDataIdentifier %in% groups, + TADA.CharacteristicName %in% depth.params + ) %>% + dplyr::select(TADA.ComparableDataIdentifier) %>% + unique() %>% + dplyr::pull() + + # identify depth unit being used in graph + fig.depth.unit <- depthprofile.avail %>% + dplyr::select(TADA.ConsolidatedDepth.Unit) %>% + dplyr::filter(!is.na(TADA.ConsolidatedDepth.Unit)) %>% + unique() %>% + dplyr::pull() + + # if any depth parameter (ex: secchi) data + + if (length(intersect(groups, depth.params.groups)) == 0) { + depth.params.string <- toString(depth.params, sep = "; ") %>% + stringi::stri_replace_last(" or ", fixed = "; ") + + profile.data <- depthprofile.avail + + + rm(depth.params.string, depthprofile.avail) + } + + if (length(intersect(groups, depth.params.groups)) > 0) { + # add depth param (ex: secchi) results + depth.params.string <- toString(depth.params, sep = "; ") %>% + stringi::stri_replace_last(" or ", fixed = "; ") + + depth.units <- c("m", "ft", "in", "m", "m", "ft", "ft", "in", "in", "m", "ft", "in") + + depth.params.avail <- .data %>% + dplyr::filter( + MonitoringLocationIdentifier %in% location, + TADA.CharacteristicName %in% depth.params, + ActivityStartDate %in% activity_date, + TADA.ActivityMediaName == "WATER" + ) %>% + dplyr::group_by(TADA.CharacteristicName, ActivityStartDate, MonitoringLocationIdentifier) %>% + dplyr::slice_sample(n = 1) %>% + dplyr::ungroup() + + if (unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) == fig.depth.unit) { + print(paste("TADA_DepthProfilePlot: Any results for", depth.params.string, "match the depth unit selected for the figure.")) + + depth.params.avail <- depth.params.avail + + + if (unique(depth.params.avail$TADA.ConsolidatedDepth.Unit) != fig.depth.unit) { + print(paste( + "TADA_DepthProfilePlot: Converting depth units for any results for", + depth.params.string, "results to match depth units selected for the figure." + )) + + depth.units <- c("m", "ft", "in", "m", "m", "ft", "ft", "in", "in", "m", "ft", "in") + + result.units <- c("m", "ft", "in", "ft", "in", "m", "in", "m", "ft", "cm", "cm", "cm") + + convert.factor <- c("1", "1", "1", "0.3048", "0.0254", "3.281", "0.083", "39.3701", "12", "0.01", "0.032808", "0.39") + + secchi.conversion <- data.frame(result.units, depth.units, convert.factor) %>% + dplyr::rename( + TADA.ConsolidatedDepth.Unit = result.units, + YAxis.DepthUnit = depth.units, + SecchiConversion = convert.factor + ) + + depth.params.avail <- depth.params.avail %>% + dplyr::mutate(YAxis.DepthUnit = fig.depth.unit) %>% + dplyr::left_join(secchi.conversion) %>% + dplyr::mutate( + TADA.ConsolidatedDepth.Unit = fig.depth.unit, + TADA.ConsolidatedDepth = TADA.ResultMeasureValue * as.numeric(SecchiConversion) + ) %>% + dplyr::select(-YAxis.DepthUnit, -SecchiConversion) + + rm(secchi.conversion, depth.params.string, depth.units, result.units, convert.factor) + } + } + + profile.data <- depthprofile.avail %>% + dplyr::full_join(depth.params.avail) + + rm(depth.params.avail, depthprofile.avail) + } + + + # this subset must include all fields included in plot hover below + plot.data <- profile.data %>% + dplyr::filter(dplyr::if_any(TADA.ComparableDataIdentifier, ~ .x %in% groups)) %>% + dplyr::select(dplyr::all_of(reqcols), "TADA.ComparableDataIdentifier", "ActivityStartDateTime", "MonitoringLocationName", "TADA.ActivityMediaName", "ActivityMediaSubdivisionName", "ActivityRelativeDepthName", "TADA.CharacteristicName", "TADA.MethodSpeciationName", "TADA.ResultSampleFractionText") %>% + dplyr::mutate(TADA.ResultMeasure.MeasureUnitCode = ifelse(is.na(TADA.ResultMeasure.MeasureUnitCode), + "NA", TADA.ResultMeasure.MeasureUnitCode + )) + + rm(profile.data) + + # break into subsets for each parameter + param1 <- plot.data %>% + dplyr::filter(dplyr::if_any(TADA.ComparableDataIdentifier, ~ .x %in% groups[1])) + + param2 <- plot.data %>% + dplyr::filter(dplyr::if_any(TADA.ComparableDataIdentifier, ~ .x %in% groups[2])) + + param3 <- plot.data %>% + dplyr::filter(dplyr::if_any(TADA.ComparableDataIdentifier, ~ .x %in% groups[3])) + + # create title for figure, conditional on number of groups/characteristics selected + + # title for three characteristics + if (length(groups) == 3) { + title <- TADA_InsertBreaks( + paste0( + param1$TADA.CharacteristicName[1], + ", ", + param2$TADA.CharacteristicName[1], + " and ", + param3$TADA.CharacteristicName[1], + " for ", + # figure out addition of weird \n in name + plot.data$MonitoringLocationName[1], + " on ", + format(as.Date(plot.data$ActivityStartDate[1]), "%B %d, %Y") + ), + len = 45 + ) + } + + # title for two characteristics + if (length(groups) == 2) { + title <- TADA_InsertBreaks( + paste0( + param1$TADA.CharacteristicName[1], + " and ", + param2$TADA.CharacteristicName[1], + " for ", + # figure out addition of weird \n in name + plot.data$MonitoringLocationName[1], + " on ", + format(as.Date(plot.data$ActivityStartDate[1]), "%B %d, %Y") + ), + len = 45 + ) + } + + # title for one characteristic + if (length(groups) == 1) { + title <- TADA_InsertBreaks( + paste0( + param1$TADA.CharacteristicName[1], + " for ", + # figure out addition of weird \n in name + plot.data$MonitoringLocationName[1], + " on ", + format(as.Date(plot.data$ActivityStartDate[1]), "%B %d, %Y") + ), + len = 45 + ) + } + + # figure margin + mrg <- list( + l = 50, r = 50, + b = 100, t = 75, + pad = 0 + ) + + # determine x + y max and range for plotting + xmax <- max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE) + 0.5 * max(plot.data$TADA.ResultMeasureValue, na.rm = TRUE) + xrange <- c(0, xmax) + + ymax <- max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE) + 0.1 * max(plot.data$TADA.ConsolidatedDepth, na.rm = TRUE) + yrange <- c(0, ymax) + + # set palette + tada.pal <- TADA_ColorPalette() + + # create base of scatter plot + scatterplot <- plotly::plot_ly(type = "scatter", mode = "lines+markers") %>% + plotly::layout( + xaxis = list( + # title = title.x, + titlefont = list(size = 16, family = "Arial"), + tickfont = list(size = 16, family = "Arial"), + hoverformat = ",.4r", linecolor = "black", rangemode = "tozero", + showgrid = FALSE, tickcolor = "black" + ), + yaxis = list( + title = paste0("Depth", " (", param1$TADA.ConsolidatedDepth.Unit[1], ")"), + titlefont = list(size = 16, family = "Arial"), + tickfont = list(size = 16, family = "Arial"), + hoverformat = ",.4r", linecolor = "black", rangemode = "tozero", + showgrid = FALSE, tickcolor = "black", + autorange = "reversed" + ), + hoverlabel = list(bgcolor = "white"), + title = title, + plot_bgcolor = "#e5ecf6", + margin = mrg, + legend = list( + orientation = "h", + x = 0.5, + y = -0.2, + xanchor = "center", + yanchor = "top" + ) + ) + + + # first parameter has a depth profile + if (length(groups) >= 1 & !param1$TADA.CharacteristicName[1] %in% depth.params) { + # config options https://plotly.com/r/configuration-options/ + scatterplot <- scatterplot %>% + plotly::config(displaylogo = FALSE) %>% # , displayModeBar = TRUE) # TRUE makes bar always visible + plotly::add_trace( + data = param1, + x = ~TADA.ResultMeasureValue, + y = ~TADA.ConsolidatedDepth, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param1$TADA.ResultSampleFractionText[1], " ", + param1$TADA.CharacteristicName[1], " ", + param1$TADA.MethodSpeciationName[1], " ", + "(", param1$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + marker = list( + size = 10, + color = tada.pal[10] + ), + line = list(color = tada.pal[5], width = 2), + hoverinfo = "text", + hovertext = paste( + "Result:", paste0(param1$TADA.ResultMeasureValue, " ", param1$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param1$ActivityStartDate, "
", + "Activity Start Date Time:", param1$ActivityStartDateTime, "
", + "Depth:", paste0( + param1$TADA.ConsolidatedDepth, " ", + param1$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param1$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param1$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # first parameter has a single value where units are depth + if (length(groups) >= 1 & param1$TADA.CharacteristicName[1] %in% depth.params) { + scatterplot <- scatterplot %>% + plotly::add_lines( + y = param1$TADA.ResultMeasureValue[1], + x = xrange, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param1$TADA.ResultSampleFractionText[1], " ", + param1$TADA.CharacteristicName[1], " ", + param1$TADA.MethodSpeciationName[1], " ", + "(", param1$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + showlegend = TRUE, + line = list(color = tada.pal[10], dash = "dash"), + hoverinfo = "text", + hovertext = paste( + "Result:", paste0(param1$TADA.ResultMeasureValue, " ", param3$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param1$ActivityStartDate, "
", + "Activity Start Date Time:", param1$ActivityStartDateTime, "
", + "Depth:", paste0( + param1$TADA.ConsolidatedDepth, " ", + param1$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param1$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param1$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # second parameter has a depth profile + if (length(groups) >= 2 & !param2$TADA.CharacteristicName[1] %in% depth.params) { + scatterplot <- scatterplot %>% + plotly::add_trace( + data = param2, + x = ~TADA.ResultMeasureValue, + y = ~TADA.ConsolidatedDepth, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param2$TADA.ResultSampleFractionText[1], " ", + param2$TADA.CharacteristicName[1], " ", + param2$TADA.MethodSpeciationName[1], " ", + "(", param2$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + marker = list( + size = 10, + color = tada.pal[12] + ), + line = list(color = tada.pal[3], width = 2), + hoverinfo = "text", + hovertext = paste( + "Result:", paste0(param2$TADA.ResultMeasureValue, " ", param2$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param2$ActivityStartDate, "
", + "Activity Start Date Time:", param2$ActivityStartDateTime, "
", + "Depth:", paste0( + param2$TADA.ConsolidatedDepth, " ", + param2$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param2$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param2$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # second parameter has a single value where units are depth + if (length(groups) >= 2 & param2$TADA.CharacteristicName[1] %in% depth.params) { + scatterplot <- scatterplot %>% + plotly::add_lines( + y = param2$TADA.ResultMeasureValue[1], + x = xrange, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param2$TADA.ResultSampleFractionText[1], " ", + param2$TADA.CharacteristicName[1], " ", + param2$TADA.MethodSpeciationName[1], " ", + "(", param2$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + # inherit = FALSE, + showlegend = TRUE, + line = list(color = tada.pal[12], dash = "dash"), + hoverinfo = "text", + hovertext = ~ paste( + "Result:", paste0(param2$TADA.ResultMeasureValue, " ", param2$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param2$ActivityStartDate, "
", + "Activity Start Date Time:", param2$ActivityStartDateTime, "
", + "Depth:", paste0( + param2$TADA.ConsolidatedDepth, " ", + param2$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param2$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param2$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # third parameter has a depth profile + if (length(groups) >= 3 & !param3$TADA.CharacteristicName[1] %in% depth.params) { + scatterplot <- scatterplot %>% + plotly::add_trace( + data = param3, + x = ~TADA.ResultMeasureValue, + y = ~TADA.ConsolidatedDepth, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param3$TADA.ResultSampleFractionText[1], " ", + param3$TADA.CharacteristicName[1], " ", + param3$TADA.MethodSpeciationName[1], " ", + "(", param3$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + marker = list( + size = 10, + color = tada.pal[11] + ), + line = list(color = tada.pal[9], width = 2), + hoverinfo = "text", + hovertext = paste( + "Result:", paste0(param3$TADA.ResultMeasureValue, " ", param2$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param3$ActivityStartDate, "
", + "Activity Start Date Time:", param3$ActivityStartDateTime, "
", + "Depth:", paste0( + param3$TADA.ConsolidatedDepth, " ", + param3$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param3$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param3$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # third parameter has a single value where units are depth + if (length(groups) >= 3 & param3$TADA.CharacteristicName[1] %in% depth.params) { + scatterplot <- scatterplot %>% + plotly::add_lines( + y = param3$TADA.ResultMeasureValue[1], + x = xrange, + name = stringr::str_remove_all(stringr::str_remove_all( + stringr::str_remove_all(paste0( + param3$TADA.ResultSampleFractionText[1], " ", + param3$TADA.CharacteristicName[1], " ", + param3$TADA.MethodSpeciationName[1], " ", + "(", param3$TADA.ResultMeasure.MeasureUnitCode[1], ")" + ), stringr::fixed(" (NA)")), + stringr::fixed("NA ") + ), stringr::fixed(" NA")), + # inherit = FALSE, + showlegend = TRUE, + line = list(color = tada.pal[11], dash = "dash"), + hoverinfo = "text", + hovertext = paste( + "Result:", paste0(param3$TADA.ResultMeasureValue, " ", param3$TADA.ResultMeasure.MeasureUnitCode), "
", + "Activity Start Date:", param3$ActivityStartDate, "
", + "Activity Start Date Time:", param3$ActivityStartDateTime, "
", + "Depth:", paste0( + param3$TADA.ConsolidatedDepth, " ", + param3$TADA.ConsolidatedDepth.Unit + ), "
", + "Activity Relative Depth Name:", param3$ActivityRelativeDepthName, "
", + "TADA.DepthCategory.Flag:", paste0( + param3$TADA.DepthCategory.Flag + ), "
" + ) + ) + } + + # add horizontal lines for depth profile category + if (depthcat == TRUE) { + if (depthcat == TRUE & is.null(surfacevalue) & is.null(bottomvalue)) { + stop("TADA_DepthProfilePlot: No depth categories can be determined when both surfacevalue and bottomvalue are null. Supply one or both of these values and run the function again.") + } + + # create list to store depth annotation text + depth_annotations <- list() + + # adjust margins of plot + scatterplot <- scatterplot %>% + plotly::layout(margin = list( + l = 50, r = 100, + b = 100, t = 75, + pad = 0 + )) + + if (is.numeric(surfacevalue)) { + print("TADA_DepthProfilePlot: Adding surface delination to figure.") + + # add surface line + scatterplot <- scatterplot %>% + plotly::add_lines( + y = surfacevalue, + x = xrange, + inherit = FALSE, + showlegend = FALSE, + line = list(color = tada.pal[1]), + hoverinfo = "text", + hovertext = paste(surfacevalue, fig.depth.unit, sep = " ") + ) + + surface_text <- + list( + x = 1, + y = surfacevalue / 2, + xref = "paper", + yref = "y", + text = "Surface", + showarrow = F, + align = "right", + xanchor = "left", + yanchor = "center" + ) + + depth_annotations <- c(depth_annotations, surface_text) + } + + if (is.numeric(bottomvalue)) { + # find bottom depth + bot.depth <- plot.data %>% + dplyr::select(TADA.ConsolidatedDepth.Bottom) %>% + unique() %>% + dplyr::slice_max(TADA.ConsolidatedDepth.Bottom) %>% + dplyr::pull() + + + print("TADA_DepthProfilePlot: Adding bottom delination to figure.") + + scatterplot <- scatterplot %>% + plotly::add_lines( + y = bot.depth - bottomvalue, + x = xrange, + inherit = FALSE, + showlegend = FALSE, + line = list(color = tada.pal[1]), + hoverinfo = "text", + hovertext = paste(round((bot.depth - bottomvalue), digits = 1), fig.depth.unit, sep = " ") + ) + + + bottom_text <- + list( + x = 1, + y = (ymax + (bot.depth - bottomvalue)) / 2, + xref = "paper", + yref = "y", + text = "Bottom", + showarrow = F, + align = "right", + xanchor = "left", + yanchor = "center" + ) + + depth_annotations <- c(depth_annotations, bottom_text) + } + + if (is.numeric(surfacevalue) & is.numeric(bottomvalue)) { + middle_text <- + list( + x = 1, + y = (surfacevalue + (bot.depth - bottomvalue)) / 2, + xref = "paper", + yref = "y", + text = "Middle", + showarrow = F, + align = "right", + xanchor = "left", + yanchor = "center" + ) + + depth_annotations <- c(depth_annotations, middle_text) + } + + scatterplot <- scatterplot %>% + plotly::layout(annotations = depth_annotations) + + return(scatterplot) + } + + # return plot with no depth profile category + if (depthcat == FALSE) { + scatterplot <- scatterplot + + return(scatterplot) + } +} \ No newline at end of file diff --git a/R/Figures.R b/R/Figures.R index 046904010..6d1bf3df3 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -72,6 +72,10 @@ TADA_Boxplot <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) { "TADA.ResultMeasure.MeasureUnitCode" )) + # load TADA color palette + + tada.pal <- TADA_ColorPalette() + start <- dim(.data)[1] .data <- subset(.data, !is.na(.data$TADA.ResultMeasureValue)) @@ -131,15 +135,15 @@ TADA_Boxplot <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) { box_lower_row <- which(values == min(values[values >= lower_thresh])) box_lower <- values[[box_lower_row[[1]]]] } - # construct plotly boxplot + base_boxplot <- plotly::plot_ly( - y = list(values), type = "box", + y = list(values), type = "box", fillcolor = tada.pal[5], q1 = quant_25, median = box_median, q3 = quant_75, lowerfence = box_lower, hoverinfo = "y", upperfence = box_upper, boxpoints = "outliers", - marker = list(color = "#00bde3"), - stroke = I("#005ea2") + marker = list(color = tada.pal[5]), + stroke = I(tada.pal[10]) ) # figure margin @@ -165,6 +169,7 @@ TADA_Boxplot <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) { ) %>% plotly::config(displayModeBar = FALSE) + # create boxplot for all groupid's boxplots[[i]] <- base_boxplot @@ -244,6 +249,8 @@ TADA_Histogram <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) "TADA.ResultMeasure.MeasureUnitCode" )) + tada.pal <- TADA_ColorPalette() + start <- dim(.data)[1] .data <- subset(.data, !is.na(.data$TADA.ResultMeasureValue)) @@ -299,8 +306,8 @@ TADA_Histogram <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) plotly::add_histogram( x = plot.data$TADA.ResultMeasureValue, xbins = list(start = min(plot.data$TADA.ResultMeasureValue)), - marker = list(color = "#00bde3"), - stroke = I("#005ea2"), + marker = list(color = tada.pal[5]), + stroke = I(tada.pal[10]), bingroup = 1, name = "All Data" ) @@ -309,8 +316,8 @@ TADA_Histogram <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) plotly::add_histogram( x = no_outliers$TADA.ResultMeasureValue, xbins = list(start = min(plot.data$TADA.ResultMeasureValue)), - marker = list(color = "#00bde3"), - stroke = I("#005ea2"), + marker = list(color = tada.pal[5]), + stroke = I(tada.pal[10]), bingroup = 1, name = paste0("Outliers Removed", "\nUpper Threshold: ", box_upper, "\nLower Threshold: ", box_lower), visible = "legendonly" @@ -390,148 +397,167 @@ TADA_Histogram <- function(.data, id_cols = c("TADA.ComparableDataIdentifier")) #' TADA_OverviewMap <- function(.data) { suppressMessages(suppressWarnings({ - quiet({ - # taken from this stackoverflow: https://stackoverflow.com/questions/58505589/circles-in-legend-for-leaflet-map-with-addcirclemarkers-in-r-without-shiny - addLegendCustom <- function(map, colors, labels, sizes, opacity = 0.5) { - colorAdditions <- paste0(colors, "; border-radius: 50%; width:", sizes, "px; height:", sizes, "px") - labelAdditions <- paste0("
", labels, "
") + quiet({ + # taken from this stackoverflow: https://stackoverflow.com/questions/58505589/circles-in-legend-for-leaflet-map-with-addcirclemarkers-in-r-without-shiny + addLegendCustom <- function(map, colors, labels, sizes, opacity = 0.5) { + colorAdditions <- paste0(colors, "; border-radius: 50%; width:", sizes, "px; height:", sizes, "px") + labelAdditions <- paste0("
", labels, "
") - return(leaflet::addLegend(map, colors = colorAdditions, labels = labelAdditions, opacity = opacity, title = "Measurements")) - } + return(leaflet::addLegend(map, colors = colorAdditions, labels = labelAdditions, opacity = opacity, title = "Measurements")) + } - sumdat <- .data %>% - dplyr::group_by(MonitoringLocationIdentifier, MonitoringLocationName, TADA.LatitudeMeasure, TADA.LongitudeMeasure) %>% - dplyr::summarise("Sample_Count" = length(unique(ResultIdentifier)), "Visit_Count" = length(unique(ActivityStartDate)), "Parameter_Count" = length(unique(TADA.CharacteristicName)), "Organization_Count" = length(unique(OrganizationIdentifier))) - - param_counts <- sort(unique(sumdat$Parameter_Count)) - param_length <- length(param_counts) - param_diff <- diff(param_counts) - - pt_sizes <- round(stats::quantile(sumdat$Sample_Count, probs = c(0.1, 0.25, 0.5, 0.75)), 0) - pt_labels <- c( - paste0("<=", pt_sizes[1]), - paste0(">", pt_sizes[1]), - paste0(">", pt_sizes[2]), - paste0(">", pt_sizes[3]), - paste0(">", pt_sizes[4]) - ) + sumdat <- .data %>% + dplyr::group_by(MonitoringLocationIdentifier, MonitoringLocationName, TADA.LatitudeMeasure, TADA.LongitudeMeasure) %>% + dplyr::summarise("Sample_Count" = length(unique(ResultIdentifier)), "Visit_Count" = length(unique(ActivityStartDate)), "Parameter_Count" = length(unique(TADA.CharacteristicName)), "Organization_Count" = length(unique(OrganizationIdentifier))) + + param_counts <- sort(unique(sumdat$Parameter_Count)) + param_length <- length(param_counts) + param_diff <- diff(param_counts) + + pt_sizes <- round(stats::quantile(sumdat$Sample_Count, probs = c(0.1, 0.25, 0.5, 0.75)), 0) + pt_labels <- c( + paste0("<=", pt_sizes[1]), + paste0(">", pt_sizes[1]), + paste0(">", pt_sizes[2]), + paste0(">", pt_sizes[3]), + paste0(">", pt_sizes[4]) + ) - sumdat$radius <- 5 - sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[1], 10, sumdat$radius) - sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[2], 15, sumdat$radius) - sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[3], 20, sumdat$radius) - sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[4], 30, sumdat$radius) + sumdat$radius <- 5 + sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[1], 10, sumdat$radius) + sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[2], 15, sumdat$radius) + sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[3], 20, sumdat$radius) + sumdat$radius <- ifelse(sumdat$Sample_Count > pt_sizes[4], 30, sumdat$radius) - site_size <- data.frame(Sample_n = pt_labels, Point_size = c(5, 10, 15, 20, 30)) + site_size <- data.frame(Sample_n = pt_labels, Point_size = c(5, 10, 15, 20, 30)) - site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) + site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) - # set color palette - # set color palette for small number of characteristics (even intervals, no bins) - if (length(unique(param_diff)) == 1 & param_length < 10) { - pal <- leaflet::colorFactor( - palette = "Blues", - levels = param_counts - ) - } else if (length(unique(param_counts)) == 1) { - pal <- "orange" - } else { # set breaks to occur only at integers for data sets requiring bins pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) - pal <- leaflet::colorBin( - palette = "Blues", - bins = pretty.breaks - ) - } + bins_n <- length(pretty.breaks) + + # create TADA color palette + tada.pal <- TADA_ColorPalette() - # create custom fill color function so that data sets with one value for parameter count are displayed correctly - customFillColor <- function(category, pal) { - if (length(param_diff > 0)) { - return(pal(category)) + start.rgb.val <- col2rgb(tada.pal[5]) / 255 + + new.rgb.start <- start.rgb.val * (1 - 0.7) + 1 * 0.7 + + start.color <- rgb(new.rgb.start[1], new.rgb.start[2], new.rgb.start[3]) + + end.rgb.val <- col2rgb(tada.pal[10]) / 255 + + new.rgb.end <- end.rgb.val * (1 - 0.4) + + end.color <- rgb(new.rgb.end[1], new.rgb.end[2], new.rgb.end[3]) + + tada.blues <- grDevices::colorRampPalette(c(start.color, end.color))(bins_n) + + # set color palette + # set color palette for small number of characteristics (even intervals, no bins) + if (length(unique(param_diff)) == 1 & param_length < 10) { + pal <- leaflet::colorFactor( + palette = tada.blues, + levels = param_counts + ) + } else if (length(unique(param_counts)) == 1) { + pal <- "orange" } else { - return("#2171b5") + pal <- leaflet::colorBin( + palette = tada.blues, + bins = pretty.breaks + ) } - } + # create custom fill color function so that data sets with one value for parameter count are displayed correctly + customFillColor <- function(category, pal) { + if (length(param_diff > 0)) { + return(pal(category)) + } else { + return(tada.pal[5]) + } + } - # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset - # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). - # Colors and icons are as discussed previously (orange/tan colors and open triangle icons for points) but can be changed to match HMW if desired. - bbox <- sf::st_bbox( - c( - xmin = min(sumdat$TADA.LongitudeMeasure), - ymin = min(sumdat$TADA.LatitudeMeasure), - xmax = max(sumdat$TADA.LongitudeMeasure), - ymax = max(sumdat$TADA.LatitudeMeasure) - ), - crs = sf::st_crs(sumdat) - ) - vbbox <- bbox %>% - as.vector() - - map <- leaflet::leaflet() %>% - leaflet::addProviderTiles("Esri.WorldTopoMap", group = "World topo", options = leaflet::providerTileOptions(updateWhenZooming = FALSE, updateWhenIdle = TRUE)) %>% - leaflet::clearShapes() %>% # get rid of whatever was there before if loading a second dataset - leaflet::fitBounds(lng1 = vbbox[1], lat1 = vbbox[2], lng2 = vbbox[3], lat2 = vbbox[4]) %>% # fit to bounds of data in tadat$raw - leaflet.extras::addResetMapButton() %>% # button to reset to initial zoom and lat/long - leaflet::addMapPane("featurelayers", zIndex = 300) %>% - leaflet::addCircleMarkers( - data = sumdat, - lng = ~TADA.LongitudeMeasure, - lat = ~TADA.LatitudeMeasure, - # sets color of monitoring site circles - color = "red", - fillColor = customFillColor(sumdat$Parameter_Count, pal), - fillOpacity = 0.7, - stroke = TRUE, - weight = 1.5, - radius = sumdat$radius, - popup = paste0( - "Site ID: ", sumdat$MonitoringLocationIdentifier, - "
Site Name: ", sumdat$MonitoringLocationName, - "
Measurement Count: ", sumdat$Sample_Count, - "
Visit Count: ", sumdat$Visit_Count, - "
Characteristic Count: ", sumdat$Parameter_Count - ) - ) %>% - addLegendCustom( - colors = "black", - labels = site_legend$Sample_n, sizes = site_legend$Point_size * 2 - ) - # create conditional map legend - # create legend for single parameter count value data sets - if (length(param_diff) == 0) { - map <- map %>% leaflet::addLegend("bottomright", - color = "#2171b5", labels = param_counts, - title = "Characteristics", - opacity = 0.5 - ) - } - # create legend for data sets with multiple factors/bins for parameter count - if (length(param_diff) > 0) { - map <- map %>% leaflet::addLegend("bottomright", - pal = pal, values = sumdat$Parameter_Count, - title = "Characteristics", - opacity = 0.5 + # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset + # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). + # Colors and icons are as discussed previously (orange/tan colors and open triangle icons for points) but can be changed to match HMW if desired. + bbox <- sf::st_bbox( + c( + xmin = min(sumdat$TADA.LongitudeMeasure), + ymin = min(sumdat$TADA.LatitudeMeasure), + xmax = max(sumdat$TADA.LongitudeMeasure), + ymax = max(sumdat$TADA.LatitudeMeasure) + ), + crs = sf::st_crs(sumdat) ) - } + vbbox <- bbox %>% + as.vector() + + map <- leaflet::leaflet() %>% + leaflet::addProviderTiles("Esri.WorldTopoMap", group = "World topo", options = leaflet::providerTileOptions(updateWhenZooming = FALSE, updateWhenIdle = TRUE)) %>% + leaflet::clearShapes() %>% # get rid of whatever was there before if loading a second dataset + leaflet::fitBounds(lng1 = vbbox[1], lat1 = vbbox[2], lng2 = vbbox[3], lat2 = vbbox[4]) %>% # fit to bounds of data in tadat$raw + leaflet.extras::addResetMapButton() %>% # button to reset to initial zoom and lat/long + leaflet::addMapPane("featurelayers", zIndex = 300) %>% + leaflet::addCircleMarkers( + data = sumdat, + lng = ~TADA.LongitudeMeasure, + lat = ~TADA.LatitudeMeasure, + # sets color of monitoring site circles + color = as.character(tada.pal[10]), + fillColor = customFillColor(sumdat$Parameter_Count, pal), + fillOpacity = 0.7, + stroke = TRUE, + weight = 1.5, + radius = sumdat$radius, + popup = paste0( + "Site ID: ", sumdat$MonitoringLocationIdentifier, + "
Site Name: ", sumdat$MonitoringLocationName, + "
Measurement Count: ", sumdat$Sample_Count, + "
Visit Count: ", sumdat$Visit_Count, + "
Characteristic Count: ", sumdat$Parameter_Count + ) + ) %>% + addLegendCustom( + colors = "black", + labels = site_legend$Sample_n, sizes = site_legend$Point_size * 2 + ) - # TADA_addPolys and TADA_addPoints are in Utilities.R - map <- TADA_addPolys(map, "extdata/AKAllotments.shp", "Tribes", "Alaska Allotments", bbox) - map <- TADA_addPolys(map, "extdata/AmericanIndian.shp", "Tribes", "American Indian", bbox) - map <- TADA_addPolys(map, "extdata/OffReservation.shp", "Tribes", "Off Reservation", bbox) - map <- TADA_addPolys(map, "extdata/OKTribe.shp", "Tribes", "Oklahoma Tribe", bbox) - map <- TADA_addPoints(map, "extdata/AKVillages.shp", "Tribes", "Alaska Native Villages", bbox) - map <- TADA_addPoints(map, "extdata/VATribe.shp", "Tribes", "Virginia Tribe", bbox) - map <- leaflet::addLayersControl(map, - overlayGroups = c("Tribes"), - options = leaflet::layersControlOptions(collapsed = FALSE) - ) + # create conditional map legend + # create legend for single parameter count value data sets + if (length(param_diff) == 0) { + map <- map %>% leaflet::addLegend("bottomright", + color = tada.pal[5], labels = param_counts, + title = "Characteristics", + opacity = 0.5 + ) + } + # create legend for data sets with multiple factors/bins for parameter count + if (length(param_diff) > 0) { + map <- map %>% leaflet::addLegend("bottomright", + pal = pal, values = sumdat$Parameter_Count, + title = "Characteristics", + opacity = 0.5 + ) + } + + # TADA_addPolys and TADA_addPoints are in Utilities.R + map <- TADA_addPolys(map, "extdata/AKAllotments.shp", "Tribes", "Alaska Allotments", bbox) + map <- TADA_addPolys(map, "extdata/AmericanIndian.shp", "Tribes", "American Indian", bbox) + map <- TADA_addPolys(map, "extdata/OffReservation.shp", "Tribes", "Off Reservation", bbox) + map <- TADA_addPolys(map, "extdata/OKTribe.shp", "Tribes", "Oklahoma Tribe", bbox) + map <- TADA_addPoints(map, "extdata/AKVillages.shp", "Tribes", "Alaska Native Villages", bbox) + map <- TADA_addPoints(map, "extdata/VATribe.shp", "Tribes", "Virginia Tribe", bbox) + map <- leaflet::addLayersControl(map, + overlayGroups = c("Tribes"), + options = leaflet::layersControlOptions(collapsed = FALSE) + ) - return(map) - }) + return(map) + }) })) } @@ -563,15 +589,36 @@ TADA_FieldValuesPie <- function(.data, field = "null", characteristicName = "nul dplyr::rowwise() %>% dplyr::mutate(Legend = TADA::TADA_InsertBreaks(Legend)) + # create TADA color palette + tada.pal <- TADA_ColorPalette() + + # define number of colors required for pie chart colorCount <- length(unique(dat$Legend)) - # define color palette - getPalette <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(8, "Set2")) + if (colorCount < 15) { + tada.pal <- c( + tada.pal[3], tada.pal[5], tada.pal[6], + tada.pal[8], tada.pal[9], tada.pal[10], + tada.pal[14], tada.pal[12], tada.pal[15], + tada.pal[4], tada.pal[7], tada.pal[13], + tada.pal[2], tada.pal[11] + ) + + + tada.pal <- tada.pal[2:(1 + colorCount)] + } + + if (colorCount > 14) { + getPalette <- grDevices::colorRampPalette(tada.pal)(1 + colorCount) + + tada.pal <- getPalette[2:(1 + colorCount)] + } + # create pie chart pie <- ggplot2::ggplot(dat, ggplot2::aes(x = "", y = Count, fill = Legend)) + - ggplot2::scale_fill_manual(values = getPalette(colorCount), name = field) + + ggplot2::scale_fill_manual(values = tada.pal, name = field) + ggplot2::geom_bar(stat = "identity", width = 1) + ggplot2::coord_polar("y", start = 0) + ggplot2::theme_void() @@ -669,6 +716,9 @@ TADA_Scatterplot <- function(.data, id_cols = c("TADA.ComparableDataIdentifier") unit <- unique(plot.data$TADA.ResultMeasure.MeasureUnitCode) y_label <- "Activity Start Date" + # create TADA color palette + tada.pal <- TADA_ColorPalette() + # construct plotly scatterplot one_scatterplot <- plotly::plot_ly( data = plot.data, @@ -679,8 +729,8 @@ TADA_Scatterplot <- function(.data, id_cols = c("TADA.ComparableDataIdentifier") # consider adding color or shapes to make it easier to see sites and/or possible realtive result values # color = ~MonitoringLocationName, # colors = RColorBrewer::brewer.pal(3, "Set2"), - marker = list(color = "#00bde3"), # marker color - stroke = I("#005ea2"), # marker border color + marker = list(color = tada.pal[5]), # marker color + stroke = I(tada.pal[10]), # marker border color name = "All Data", hoverinfo = "text", hovertext = paste( @@ -856,6 +906,9 @@ TADA_TwoCharacteristicScatterplot <- function(.data, id_cols = "TADA.ComparableD pad = 0 ) + # create TADA color palette + tada.pal <- TADA_ColorPalette() + scatterplot <- plotly::plot_ly(type = "scatter", mode = "markers") %>% plotly::layout( xaxis = list( @@ -905,8 +958,8 @@ TADA_TwoCharacteristicScatterplot <- function(.data, id_cols = "TADA.ComparableD ), marker = list( size = 10, - color = "#E34234", - line = list(color = "#005ea2", width = 2) + color = tada.pal[5], + line = list(color = tada.pal[10], width = 2) ), hoverinfo = "text", hovertext = paste( @@ -945,8 +998,8 @@ TADA_TwoCharacteristicScatterplot <- function(.data, id_cols = "TADA.ComparableD param2$TADA.MethodSpeciationName ), marker = list( - size = 10, color = "#00bde3", - line = list(color = "#005ea2", width = 2) + size = 10, color = tada.pal[3], + line = list(color = tada.pal[12], width = 2) ), yaxis = "y2", hoverinfo = "text", @@ -978,4 +1031,4 @@ TADA_TwoCharacteristicScatterplot <- function(.data, id_cols = "TADA.ComparableD ) return(scatterplot) -} +} \ No newline at end of file diff --git a/R/GeospatialFunctions.R b/R/GeospatialFunctions.R index 885df0ffb..fc1a2b7b0 100644 --- a/R/GeospatialFunctions.R +++ b/R/GeospatialFunctions.R @@ -534,11 +534,13 @@ TADA_ViewATTAINS <- function(.data) { # if data was spatial, remove for downstream leaflet dev: try(ATTAINS_table <- ATTAINS_table %>% sf::st_drop_geometry(), silent = TRUE) + + tada.pal <- TADA_ColorPalette() colors <- data.frame( overallstatus = c("Not Supporting", "Fully Supporting", "Not Assessed"), - col = c("#DC851E", "#059FA4", "#A1A522"), - dark_col = c("#813B00", "#005258", "#4F5900"), + col = c(tada.pal[3], tada.pal[4], tada.pal[7]), + dark_col = c(tada.pal[12], tada.pal[6], tada.pal[11]), priority = c(1, 2, 3) ) @@ -605,7 +607,7 @@ TADA_ViewATTAINS <- function(.data) { leaflet.extras::addResetMapButton() %>% leaflet::addLegend( position = "bottomright", - colors = c("#DC851E", "#059FA4", "#A1A522", "black", NA), + colors = c(tada.pal[3], tada.pal[4], tada.pal[7], "black", NA), labels = c( "ATTAINS: Not Supporting", "ATTAINS: Supporting", "ATTAINS: Not Assessed", "Water Quality Observation(s)", "NHDPlus HR catchments containing water quality observations + ATTAINS feature are represented as clear polygons with black outlines." diff --git a/R/RequiredCols.R b/R/RequiredCols.R index ede33a67f..7ff22746b 100644 --- a/R/RequiredCols.R +++ b/R/RequiredCols.R @@ -76,6 +76,11 @@ require.cols <- c( "TADA.CensoredMethod", # Result Depth + "TADA.ConsolidatedDepth", + "TADA.ConsolidatedDepth.Bottom", + "TADA.ConsolidatedDepth.Unit", + "TADA.DepthCategory.Flag", + "TADA.DepthProfileAggregation.Flag", "ResultDepthHeightMeasure.MeasureValue", "TADA.ResultDepthHeightMeasure.MeasureValue", "TADA.ResultDepthHeightMeasure.MeasureValueDataTypes.Flag", diff --git a/R/ResultFlagsIndependent.R b/R/ResultFlagsIndependent.R index 83c24a14b..d3fb6f411 100644 --- a/R/ResultFlagsIndependent.R +++ b/R/ResultFlagsIndependent.R @@ -1403,4 +1403,4 @@ TADA_FindPotentialDuplicatesSingleOrg <- function(.data) { .data <- TADA_OrderCols(.data) return(.data) -} +} \ No newline at end of file diff --git a/R/Utilities.R b/R/Utilities.R index bec9848ec..6a8352b22 100644 --- a/R/Utilities.R +++ b/R/Utilities.R @@ -72,7 +72,17 @@ utils::globalVariables(c( "ResultMeasure.MeasureUnitCode", "TADA.DetectionQuantitationLimitMeasure.MeasureUnitCode", "DetectionQuantitationLimitMeasure.MeasureUnitCode", "NCode", "ATTAINS.assessmentunitidentifier", "ATTAINS_AU", "TOTALAREA_MI", "TOTALAREA_KM", - "ATTAINS_AUs" + "ATTAINS_AUs", "ARD_Category", "ActivityRelativeDepthName", "DepthsByGroup", + "DepthsPerGroup","MeanResults", "MonitoringLocationTypeName", "N", "SecchiConversion", + "TADA.ActivityBottomDepthHeightMeasure.MeasureValue", + "TADA.ActivityDepthHeightMeasure.MeasureUnitCode", "TADA.ActivityDepthHeightMeasure.MeasureValue", + "TADA.CharacteristicsForDepthProfile TADA.ConsolidatedDepth", + "TADA.ConsolidatedDepth.Bottom TADA.ConsolidatedDepth.Unit", "TADA.DepthCategory.Flag", + "TADA.DepthProfileAggregation.Flag", "TADA.NResults", + "TADA.ResultDepthHeightMeasure.MeasureUnitCode", "TADA.ResultDepthHeightMeasure.MeasureValue", + "YAxis.DepthUnit", "TADA.CharacteristicsForDepthProfile", "TADA.ConsolidatedDepth", + "TADA.ConsolidatedDepth.Bottom", "TADA.ConsolidatedDepth.Unit", "col2rgb", + "palette.colors", "rect", "rgb", "text" )) # global variables for tribal feature layers used in TADA_OverviewMap in Utilities.R @@ -1386,3 +1396,67 @@ TADA_UniqueCharUnitSpeciation <- function(.data) { dplyr::select(-NCode) } + +#' Create Color Palette For Use in Graphs and Maps +#' +#' Creates a consistent color palette for use in TADA visualizations. Currently, +#' the palette is utilizing the "Okabe-Ito" palette from base R via the palette.colors +#' function. The palette includes 9 colors by default. However, additional colors +#' can be added to the palette as needed as more complex visualization functions +#' are added to the TADA package. +#' +#' @return A color palette based on the "Okabe-Ito" palette, extended to 15 colors, +#' with modifications for use in mapping and graphing functions +#' +#' @export +#' +#' @examples +#' TestColorPalette <- TADA_ColorPalette() +#' + TADA_ColorPalette <- function() { + + pal <- c("#000000", "#835A00", "#DC851E", "#059FA4", "#56B4E9", + "#005258", "#A1A522", "#F0E442", "#66A281", "#1E6F98", + "#4F5900", "#813B00", "#CD758F", "#B686A1", "#999999") + + return(pal) + } + + + #' View TADA Color Palette + #' + #' View a swatch of the colors in the TADA Color palette labeled by color and + #' index number. TADA developers can reference this function when deciding which + #' colors to use in TADA visualizations. TADA users can also reference this + #' palette function to create their own visually consistent figures. + #' + #' @return A color swatch figure based on the TADA color palette. + #' + #' @export + #' + #' @examples + #' TestViewPalette <- TADA_ViewColorPalette() + #' + TADA_ViewColorPalette <- function() { + + # call TADA color palette + pal <- TADA_ColorPalette() + + # determine length of color palette + n <- length(pal) + + # create list of label colors, first one needs to be white to show up clearly + label_colors <- rep("black", n) + label_colors[1] <- "white" + + # create color swatch graphic + graphics::par(mar = c(5,0,5,0)) + swatch <- graphics::plot(1, type = "n", xlab = "", ylab = "", xlim = c(0.5,n + 0.5), ylim = c(0,1), main = "TADA Palette", axes = FALSE) + rect(1:n - 0.5, 0, n + 0.5, 1, col = pal, border = NA) + text(x = 1:n, y = 0.5, labels = 1:n, pos = 3, col = label_colors) + text(x = 1:n, y = 0.5 - 0.2, labels = pal, pos = 1, col = label_colors, cex = 0.7, srt = 90) + +return(swatch) + } + + diff --git a/inst/WORDLIST b/inst/WORDLIST index 963879800..312383133 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,6 +1,7 @@ ANDs ActivityBottomDepthHeightMeasure ActivityCommentText +ActivityDate ActivityDepthHeightMeasure ActivityGroup ActivityMediaName @@ -36,9 +37,11 @@ CharacteristicGroup CharacteristicName CharacteristicNameAssumptions CharacteristicNameUserSupplied +CharacteristicsForDepthProfile CharactersticName Chilton ComparableDataIdentifier +ConsolidatedDepth ConstructionDateText ContinuousData ConversionCoefficient @@ -52,6 +55,9 @@ DataQuality DataRetreival DataRetrieval DataTypes +DepthCategory +DepthProfileAggregation +DepthProfilePlot DetectionQuantitationLimiMeasure DetectionQuantitationLimitMeasure DetectionQuantitationLimitType @@ -88,11 +94,13 @@ GetSynonymRef Github HUC HUCS +HUCs HarmonizeSynonyms HorizontalCoordinateReferenceSystemDatumName HydrologicCondition HydrologicEvent IDCensoredData +IDDepthProfiles InvalidCoordinates InvalidFraction InvalidResultUnit @@ -116,6 +124,7 @@ MeasureUnit MeasureUnitCode MeasureValue MeasureValueDataTypes +MeetsStandard MethodDescriptionText MethodIdentifier MethodIdentifierContext @@ -124,6 +133,7 @@ MethodQualifierCodes MethodQualifierTypeName MethodSpeciation MethodSpeciationName +MonitoringLocation MonitoringLocationIdentifier MonitoringLocationIdentifier's MonitoringLocationName @@ -147,6 +157,7 @@ NutrientSummationEquation NutrientSummationGroup OA ORs +Okabe OrganizationFormalName OrganizationIdentifier OutsideUSA @@ -165,6 +176,7 @@ QAQC QAQC'd QAQCCharacteristicValidation QC'ing +QCing README REDLAKE RMarkdown @@ -178,6 +190,7 @@ Rancherias ReplicateSampleID Repo ResultAboveUpperThreshold +ResultAggregation ResultAnalyticalMethod ResultCommentText ResultDepthHeightMeasure @@ -221,7 +234,6 @@ SpeciationUnitConversion StateCode SubstituteDeprecatedChars SummarizeColumn -TADA's TADADataRetrieval TADAGeospatialRefLayers TADAModule @@ -238,11 +250,13 @@ USGS's Uncomment UncommonAnalyticalMethodID UniqueHarmonizationRef +UnitCode UpdateTribalLayers UseForAnalysis VCS ViewATTAINS WGS +WQC WQP WQX WQX's @@ -259,6 +273,8 @@ WQXTargetUnit WQXUnitConversionFactor WQXcharValRef WQXunitRef +Waterbody +WaterbodyReport WellDepthMeasure WellHoleDepthMeasure Wikimedia @@ -266,6 +282,7 @@ YYYY addPoints addPolys agg +aggregatedonly analytes applyautoclean arcgis @@ -277,7 +294,9 @@ assmnt autoclean autocleaned bbox +bottomvalue bplan +bycategory catchmentareasqkm catchmentistribal catchmentresolution @@ -292,9 +311,11 @@ countycode cristinamullin crs csv +dailyagg dataProfile dataRetrieval datetimes +depthcat devtools dimCheck dlist @@ -307,7 +328,7 @@ endDate endDateHi english epa -eval +estimatiom extdata fabec fetchATTAINS @@ -345,6 +366,7 @@ nhdplusid nondetections nonstandardized np +nresults num od organizationid @@ -354,6 +376,8 @@ orgtype ousideUSA outsideUSA overallstatus +param +params pch pchIcons pcodes @@ -367,6 +391,7 @@ repo reportingcycle reproducibility sampleMedia +secchi shp siteType siteid @@ -379,6 +404,7 @@ startDateLo statecode sthda submissionid +surfacevalue sysdata tada tas diff --git a/man/TADA_ColorPalette.Rd b/man/TADA_ColorPalette.Rd new file mode 100644 index 000000000..dc5d347e8 --- /dev/null +++ b/man/TADA_ColorPalette.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{TADA_ColorPalette} +\alias{TADA_ColorPalette} +\title{Create Color Palette For Use in Graphs and Maps} +\usage{ +TADA_ColorPalette() +} +\value{ +A color palette based on the "Okabe-Ito" palette, extended to 15 colors, +with modifications for use in mapping and graphing functions +} +\description{ +Creates a consistent color palette for use in TADA visualizations. Currently, +the palette is utilizing the "Okabe-Ito" palette from base R via the palette.colors +function. The palette includes 9 colors by default. However, additional colors +can be added to the palette as needed as more complex visualization functions +are added to the TADA package. +} +\examples{ +TestColorPalette <- TADA_ColorPalette() + +} diff --git a/man/TADA_DepthProfilePlot.Rd b/man/TADA_DepthProfilePlot.Rd new file mode 100644 index 000000000..f3e3cbd51 --- /dev/null +++ b/man/TADA_DepthProfilePlot.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DepthProfile.R +\name{TADA_DepthProfilePlot} +\alias{TADA_DepthProfilePlot} +\title{Create A Three-Characteristic Depth Profile} +\usage{ +TADA_DepthProfilePlot( + .data, + groups = NULL, + location = NULL, + activity_date = NULL, + depthcat = TRUE, + surfacevalue = 2, + bottomvalue = 2, + unit = "m" +) +} +\arguments{ +\item{.data}{TADA data frame containing the data downloaded from the WQP, +where each row represents a unique data record. TADA_FlagDepthCategory +has been run as data frame must include the columns TADA.DepthCategory.Flag, +TADA.ResultDepthHeightMeasure.MeasureUnitCode, TADA.ActivityDepthHeightMeasure.MeasureUnitCode, +and TADA.ActivityDepthHeightMeasure.MeasureValue. Units for all depth fields +must be the same. This can be accomplished using TADA_AutoClean() or +TADA_ConvertDepthUnits.} + +\item{groups}{A vector of two identifiers from the TADA.ComparableDataIdentifier column. +For example, the groups could be 'DISSOLVED OXYGEN (DO)_NA_NA_UG/L' and 'PH_NA_NA_NA'. +These groups will be specific to your dataset. The TADA_IDDepthProfiles can be +used to identify available groups.} + +\item{location}{A single MonitoringLocationIdentifier to plot the depth profile. +A MonitoringLocationIdentifier must be entered or an error will be returned and +no depth profile will be created.} + +\item{activity_date}{The date the depth profile results were collected.} + +\item{depthcat}{Boolean argument indicating whether delineation between depth +categories should be shown on the depth profile figure. depthcat = TRUE is the +default and displays solid black lines to delineate between surface, middle, and +bottom samples and labels each section of the plot.} + +\item{surfacevalue}{numeric argument. The user enters how many meters from the +surface should be included in the "Surface" category. Default is surfacevalue = 2.} + +\item{bottomvalue}{numeric argument. The user enters how many meters from the +bottom should be included in the "Bottom" category. Default is +bottomvalue = 2.} + +\item{unit}{Character argument. The enters either "m" or "ft" to specify which +depth units should be used for the plot. Default is "m".} +} +\value{ +A depth profile plot displaying up to three parameters for a single +MonitoringLocationIdentifier. Displaying depth categories is optional with the +depthcat argument. +} +\description{ +Create A Three-Characteristic Depth Profile +} +\examples{ +# Load example dataset: +data(Data_6Tribes_5y_Harmonized) +# Create a depth profile figure with three parameters for a single monitoring location and date +TADA_DepthProfilePlot(Data_6Tribes_5y_Harmonized, + groups = c("TEMPERATURE_NA_NA_DEG C", "PH_NA_NA_NA", "DEPTH, SECCHI DISK DEPTH_NA_NA_M"), + location = "REDLAKE_WQX-ANKE", + activity_date = "2018-10-04" +) + +# Load example dataset: +data(Data_6Tribes_5y_Harmonized) +# Create a depth profile figure with two parameters for a single monitoring location and date without displaying depth categories +TADA_DepthProfilePlot(Data_6Tribes_5y_Harmonized, + groups = c("CONDUCTIVITY_NA_NA_US/CM", "DISSOLVED OXYGEN (DO)_NA_NA_MG/L"), + location = "REDLAKE_WQX-JOHN", + activity_date = "2018-07-31", + depthcat = FALSE +) +} diff --git a/man/TADA_FlagDepthCategory.Rd b/man/TADA_FlagDepthCategory.Rd new file mode 100644 index 000000000..bb6a85943 --- /dev/null +++ b/man/TADA_FlagDepthCategory.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DepthProfile.R +\name{TADA_FlagDepthCategory} +\alias{TADA_FlagDepthCategory} +\title{TADA_FlagDepthCategory} +\usage{ +TADA_FlagDepthCategory( + .data, + bycategory = "no", + bottomvalue = 2, + surfacevalue = 2, + dailyagg = "none", + aggregatedonly = FALSE, + clean = FALSE +) +} +\arguments{ +\item{.data}{TADA dataframe} + +\item{bycategory}{character argument with options "no", "all", "surface", "middle", +"bottom". The default is bycategory = "no" which means that any aggregate values +are based on the entire water column at a Monitoring Location. When bycategory += "all", any aggregate values are determined for each depth category for each +Monitoring Location. When bycategory = "surface", "middle", or "bottom", the data +frame is filtered only to include results in the selected category and aggregate +values are determined ONLY for results with TADA.DepthCategory.Flags +"Surface", "Bottom", or "Middle" +results respectively.} + +\item{bottomvalue}{numeric argument. The user enters how many meters from the +bottom should be included in the "Bottom" category. Default is +bottomvalue = 2. If bottomvalue = "null", "Bottom" and "Middle" results cannot +be identified, however TADA.ConsolidatedDepth and TADA.ConsolidatedDepth.Bottom +will still be determined.} + +\item{surfacevalue}{numeric argument. The user enters how many meters from the +surface should be included in the "Surface" category. Default is surfacevalue = 2. +If surfacealue = "null", "Surface" and "Middle" results cannot +be identified, however TADA.ConsolidatedDepth and TADA.ConsolidatedDepth.Bottom +will still be determined.} + +\item{dailyagg}{Character argument; with options "none", "avg", "min", or +"max". The default is dailyagg = "none". When dailyagg = "none", all results +will be retained. When dailyagg == "avg", the mean value in each group of +results (as determined by the depth category) will be identified or calculated for each +MonitoringLocation, ActivityDate, Organization ID, and TADA.CharacteristicName combination. +When dailyagg == "min" or when dailyagg == "max", the min or max +value in each group of results (as determined by the depth category) will +be identified or calculated for each MonitoringLocation, ActivityDate, and TADA.CharacteristicName +combination. An additional column, TADA.DepthProfileAggregation.Flag will be added +to describe aggregation.} + +\item{aggregatedonly}{Boolean argument with options "TRUE" or "FALSE". The +default is aggregatedonly = "FALSE" which means that all results are returned. +When aggregatedonly = "TRUE", only aggregate values are returned.} + +\item{clean}{Boolean argument with options "TRUE" or "FALSE". The +default is clean = "FALSE" which means that all results are returned. +When clean = "TRUE", only aggregate results which can be assigned to a depth +category are included in the returned dataframe.} +} +\value{ +The same input TADA dataframe with additional columns TADA.DepthCategory.Flag, +TADA.DepthProfileAggregation.Flag, TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Bottom, +and TADA.ConsolidatedDepth.Unit. The consolidated depth fields are created by reviewing +multiple WQC columns where users may input depth information. If a daily_agg = "avg", +"min", or "max", aggregated values will be identified in the TADA.ResultAggregation.Flag +column. In the case of daily_agg = "avg", additional rows to display averages will be +added to the data frame. They can be identified by the prefix ("TADA-") of +their result identifiers. +} +\description{ +This function creates a new column, TADA.DepthCategory.Flag with values: "No +depth info", "Surface", "Bottom", and +"Middle" when multiple depths are available. +Categories are: less than 2m (or user specified value) depth = "Surface", from +bottom up to 2m (or user specified value) from bottom = "Bottom", and all depths +in between the Surface and Bottom are assigned to the "Middle" category. +} +\details{ +When more than one result is available for a MonitoringLocationIdentifier, +ActivityStartDate, OrganizationIdentifier, and TADA.CharacteristicName, the +user can choose a single result value (average, max, or min value) to use for that +day and location. If results vary with depth, the user may also define whether +the daily aggregation occurs over each depth category (surface, middle, or bottom) +or for the entire depth profile. +} +\examples{ +# Load dataset +data(Data_6Tribes_5y) + +# assign TADA.DepthCategory.Flag with no aggregation +Data_6Tribs_5y_DepthCat <- TADA_FlagDepthCategory(Data_6Tribes_5y) + +# assign TADA.DepthCategory.Flag and determine average values by depth category and returning only aggregate values +Data_6Tribs_5y_Mean <- TADA_FlagDepthCategory(Data_6Tribes_5y, bycategory = "all", dailyagg = "avg", aggregatedonly = FALSE) + +} diff --git a/man/TADA_IDDepthProfiles.Rd b/man/TADA_IDDepthProfiles.Rd new file mode 100644 index 000000000..c47666b90 --- /dev/null +++ b/man/TADA_IDDepthProfiles.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DepthProfile.R +\name{TADA_IDDepthProfiles} +\alias{TADA_IDDepthProfiles} +\title{TADA_IDDepthProfiles} +\usage{ +TADA_IDDepthProfiles(.data, nresults = TRUE, nvalue = 2, aggregates = FALSE) +} +\arguments{ +\item{.data}{TADA dataframe which must include the columns ActivityStartDate, +TADA.ConsolidatedDepth, TADA.ConsolidatedDepth.Unit, TADA.ConsolidatedDepth.Bottom, +TADA.ResultMeasureValue, TADA.ResultMeasureValue.UnitCode, +OrganizationIdentifier, MonitoringLocationName, MonitoringLocationIdentifier, +and TADA.ComparableDataIdentifier.} + +\item{nresults}{Boolean argument with options "TRUE" or "FALSE". The +default is nresults = TRUE, which means that the number of results for each +characteristic are added within the TADA.CharacteristicsForDepthProfile column. +When nresults = FALSE.} + +\item{nvalue}{numeric argument to specify the number of results required to identify +a depth profile. The default is 2, which means that a depth profile will be identified +if 2 or more results at different depths exists for the same ActivityStartDate, +MonitoringLocationIdentifier, OrganizationIdentifier, and TADA.ComparableDataIdentifier. +A few characteristics are excluded from this requirement because they are expected to +have only a single result in depth units (ex: secchi disk depth).} + +\item{aggregates}{Boolean argument with options "TRUE" or "FALSE". The default is +aggregates = FALSE, which means that any aggregate values created (means) in +TADA_FlagDepthCategory are excluded from identifying depth profile data. Aggregate +values that were selected from the existing data set (max and min) remain. +Only columns created/add by TADA_FlagDepthCategory are removed when aggregates = +FALSE. When aggregates = TRUE, all aggregate values are included when identifying +depth profile data.} +} +\value{ +A dataframe with the columns MonitoringLocationIdentifier, +MonitoringLocationName, OrganizationIdentifier, ActivityStartDate, +TADA.CharacteristicsForDepthProfile. Based on the user input for the nresults +param, TADA.CharacteristicsForDepthProfile may or may not contain the number +of results for each characteristic. +} +\description{ +This function identifies depth profiles within a data frame to assist the user in +selecting params for TADA_DepthProfilePlot. A TADA compatible data set is required. +If TADA_FlagDepthCategory has not yet been run, it will be run as part of this +function. The output data frame is grouped by MonitoringLocationIdentifier, +OrganizationIdentifier, and ActivityStartDate. +} +\details{ +A new column, TADA.CharacteristicsForDepthProfile, is created which lists the +characteristics available for depth profile analysis. Using the, nresults param, +users can specify whether characteristic names should be followed by the number +of results available for the characteristic in parentheses. +} +\examples{ +# Load dataset +data(Data_6Tribes_5y) + +# find depth profile data without showing number of results +Data_6Tribes_5y_DepthProfileID_Nresults <- TADA_IDDepthProfiles(Data_6Tribes_5y, nresults = FALSE) + +# find depth profile data showing number of results +Data_6Tribes_5y_DepthProfileID <- TADA_IDDepthProfiles(Data_6Tribes_5y) + +} diff --git a/man/TADA_ViewColorPalette.Rd b/man/TADA_ViewColorPalette.Rd new file mode 100644 index 000000000..1fc141279 --- /dev/null +++ b/man/TADA_ViewColorPalette.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Utilities.R +\name{TADA_ViewColorPalette} +\alias{TADA_ViewColorPalette} +\title{View TADA Color Palette} +\usage{ +TADA_ViewColorPalette() +} +\value{ +A color swatch figure based on the TADA color palette. +} +\description{ +View a swatch of the colors in the TADA Color palette labeled by color and +index number. TADA developers can reference this function when deciding which +colors to use in TADA visualizations. TADA users can also reference this +palette function to create their own visually consistent figures. +} +\examples{ +TestViewPalette <- TADA_ViewColorPalette() + +} diff --git a/vignettes/TADAAssessmentUnitUseCase.Rmd b/vignettes/TADAAssessmentUnitUseCase.Rmd index 63979c103..b4a753647 100644 --- a/vignettes/TADAAssessmentUnitUseCase.Rmd +++ b/vignettes/TADAAssessmentUnitUseCase.Rmd @@ -83,11 +83,21 @@ library(lubridate) library(knitr) library(DT) + # Record start time start.time <- Sys.time() ``` +```{r for-development-only, echo = F, results = 'hide', eval = F} +# IF YOU ARE NOT DEVELOPING TADA, SKIP THIS CODE CHUNK +# when developing the package, update this chunk to the current repository branch, so it runs with all of the new features prior to a PR to develop +remotes::install_github("USEPA/TADA", + ref = "colorpalette_set_up", + dependencies = TRUE +) +``` + ## Data Retrieval - Water Chemistry The water chemistry data we will use are downloaded from the Water diff --git a/vignettes/TADAModule1.Rmd b/vignettes/TADAModule1.Rmd index 33e90cab9..f6a61bde0 100644 --- a/vignettes/TADAModule1.Rmd +++ b/vignettes/TADAModule1.Rmd @@ -74,7 +74,6 @@ remotes::install_github("USEPA/TADA", ref = "develop", dependencies = TRUE ) - # remotes::install_github("USGS-R/dataRetrieval", dependencies=TRUE) ``` @@ -85,6 +84,15 @@ your R session. library(TADA) ``` +```{r for-development-only, echo = F, results = 'hide', eval = F} +# IF YOU ARE NOT DEVELOPING TADA, SKIP THIS CODE CHUNK +# when developing the package, update this chunk to the current repository branch, so it runs with all of the new features prior to a PR to develop +remotes::install_github("USEPA/TADA", + ref = "colorpalette_set_up", + dependencies = TRUE +) +``` + ## TADA_DataRetrieval WQP data is retrieved and processed for compatibility with TADA. This diff --git a/vignettes/TADAModule1_AdvancedTraining.Rmd b/vignettes/TADAModule1_AdvancedTraining.Rmd index 1c5b09b51..8044dfe36 100644 --- a/vignettes/TADAModule1_AdvancedTraining.Rmd +++ b/vignettes/TADAModule1_AdvancedTraining.Rmd @@ -97,16 +97,18 @@ the console to update dependency packages that have more recent versions available. If you see this prompt, it is recommended to update all of them (enter 1 into the console). -```{r, eval = F, results = 'hide'} -remotes::install_github("USEPA/TADA", ref = "develop") -library(TADA) +```{r install_TADA, eval = F, results = 'hide'} +remotes::install_github("USEPA/TADA", + ref = "develop", + dependencies = TRUE +) ``` ```{r for-development-only, echo = F, results = 'hide', eval = F} # IF YOU ARE NOT DEVELOPING TADA, SKIP THIS CODE CHUNK # when developing the package, update this chunk to the current repository branch, so it runs with all of the new features prior to a PR to develop remotes::install_github("USEPA/TADA", - ref = "cm-4.29.24", + ref = "colorpalette_set_up", dependencies = TRUE ) ``` diff --git a/vignettes/TADAModule1_BeginnerTraining.Rmd b/vignettes/TADAModule1_BeginnerTraining.Rmd index 46b4e5ef7..9fa1c57b2 100644 --- a/vignettes/TADAModule1_BeginnerTraining.Rmd +++ b/vignettes/TADAModule1_BeginnerTraining.Rmd @@ -94,7 +94,7 @@ remotes::install_github("USEPA/TADA", # IF YOU ARE NOT DEVELOPING TADA, SKIP THIS CODE CHUNK # when developing the package, update this chunk to the current repository branch, so it runs with all of the new features prior to a PR to develop remotes::install_github("USEPA/TADA", - ref = "447-vignetts-cannot-build-if-they-include-tada_overviewmap-because-they-cannot-find-shp-files", + ref = "colorpalette_set_up", dependencies = TRUE ) ``` diff --git a/vignettes/TADAModule2.Rmd b/vignettes/TADAModule2.Rmd index cca4dbd48..ce9518763 100644 --- a/vignettes/TADAModule2.Rmd +++ b/vignettes/TADAModule2.Rmd @@ -82,7 +82,7 @@ remotes::install_github("USEPA/TADA", # IF YOU ARE NOT DEVELOPING TADA, SKIP THIS CODE CHUNK # when developing the package, update this chunk to the current repository branch, so it runs with all of the new features prior to a PR to develop remotes::install_github("USEPA/TADA", - ref = "cm-4.29.24", + ref = "colorpalette_set_up", dependencies = TRUE ) ``` diff --git a/vignettes/WQXValidationService.Rmd b/vignettes/WQXValidationService.Rmd index b8241c6ff..05576a627 100644 --- a/vignettes/WQXValidationService.Rmd +++ b/vignettes/WQXValidationService.Rmd @@ -133,10 +133,11 @@ TADA leverages many of the WQX domain tables. ([CSV)](https://cdx.epa.gov/wqx/download/DomainValues/QAQCCharacteristicValidation.CSV) - Both WQX and TADA leverage the table above to flag invalid and - uncommon results. This reference table is used in the following TADA functions: + uncommon results. This reference table is used in the following + TADA functions: - [TADA_FlagAboveThreshold()](https://usepa.github.io/TADA/reference/TADA_FlagAboveThreshold.html) - + - [TADA_FlagBelowThreshold()](https://usepa.github.io/TADA/reference/TADA_FlagBelowThreshold.html) - [TADA_FlagResultUnit()](https://usepa.github.io/TADA/reference/TADA_FlagResultUnit.html)