Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Figures.r condensed code and tada view color palette to return a non null value #511

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
hillarymarler merged 5 commits into from
Aug 26, 2024
Merged

Figures.r condensed code and tada view color palette to return a non null value #511

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
60d754a
Condensed GroupedScatterplot code
wokenny13 Aug 16, 2024
4a27019
Merge branch 'develop' into Figures.R-condensed-code-and-tada-view-co…
wokenny13 Aug 16, 2024
51bcfeb
switched order of storing return value in code
wokenny13 Aug 22, 2024
2dd08c4
Changed Graphics margin
wokenny13 Aug 26, 2024
cfa974b
Update Utilities.R
wokenny13 Aug 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
189 changes: 35 additions & 154 deletions R/Figures.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1175,9 +1175,9 @@ TADA_TwoCharacteristicScatterplot <- function(.data, id_cols = "TADA.ComparableD
#' data(Data_Nutrients_UT)
#' # UT Nutrients results grouped by county
#' # transform non-detect data
#' df <- TADA_SimpleCensoredMethods(Data_Nutrients_UT)
#' df2 <- TADA_SimpleCensoredMethods(Data_Nutrients_UT)
#' # create scatterplots for selected counties
#' UT_Nutrients_by_CountyCode <- TADA_GroupedScatterplot(df, group_col = "CountyCode", groups = c("057", "011", "003", "037"))
#' UT_Nutrients_by_CountyCode <- TADA_GroupedScatterplot(df2, group_col = "CountyCode", groups = c("057", "011", "003", "037"))
#' # view the 3rd and 4th plots
#' UT_Nutrients_by_CountyCode[[3]]
#' UT_Nutrients_by_CountyCode[[4]]
Expand Down Expand Up @@ -1261,13 +1261,11 @@ TADA_GroupedScatterplot <- function(.data, group_col = "MonitoringLocationName",
n.groups.plotted == 4 ~ "four"
)


# if only group is identified, stop and print message to use TADA_Scatterplot
if (n.groups.plotted == "one") {
stop("TADA_GroupedScatterplot: requires at least two 'groups'. Use TADA_Scatterplot to plot results without grouping.")
}


# print message describing groups that will be plotted
print(paste0("TADA_GroupedScatterplot: No 'groups' selected for ", group_col, ". There are ",
n.groups.total, " ", group_col, "s in the TADA data frame. The top ", n.groups.plotted,
Expand Down Expand Up @@ -1310,8 +1308,10 @@ TADA_GroupedScatterplot <- function(.data, group_col = "MonitoringLocationName",
plot.data <- dplyr::arrange(plot.data, ActivityStartDate)

# returns the param groups for plotting. Up to 4 params are defined.
param.data <- list()
for (i in 1:length(unique(groups))) {
assign(paste0("param", as.character(i)), subset(plot.data, plot.data[, group_col] %in% groups[i]))
param.data[[i]] <- subset(plot.data, plot.data[, group_col] %in% groups[i])
#assign(paste0("param", as.character(i)), subset(plot.data, plot.data[, group_col] %in% groups[i]))
}

# create empty list to store scatterplots
Expand Down Expand Up @@ -1341,19 +1341,10 @@ TADA_GroupedScatterplot <- function(.data, group_col = "MonitoringLocationName",
# create TADA color palette
tada.pal <- TADA_ColorPalette(col_pair = TRUE)

assign("paramA", subset(param1, param1[, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i]))
assign("paramB", subset(param2, param2[, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i]))
if (length(groups) >= 3) {
assign("paramC", subset(param3, param3[, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i]))
}
if (length(groups) >= 4) {
assign("paramD", subset(param4, param4[, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i]))
}

plot.data.y <- subset(plot.data, plot.data[, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i])
plot.data.y$name <- gsub("_NA", "", plot.data.y[, "TADA.ComparableDataIdentifier"])
plot.data.y$name <- gsub("_", " ", plot.data.y$name)

scatterplot <-
plotly::plot_ly(type = "scatter", mode = "markers") %>%
plotly::layout(
Expand Down Expand Up @@ -1383,164 +1374,54 @@ TADA_GroupedScatterplot <- function(.data, group_col = "MonitoringLocationName",
)
) %>%
# config options https://plotly.com/r/configuration-options/
plotly::config(displaylogo = FALSE) %>% # , displayModeBar = TRUE) # TRUE makes bar always visible
plotly::add_trace(
data = paramA,
x = ~ as.Date(ActivityStartDate),
y = ~ TADA.ResultMeasureValue,
name = groups[1],
marker = list(
size = 10,
color = tada.pal[1, 1],
line = list(color = tada.pal[1, 2], width = 2)
),
hoverinfo = "text",
hovertext = paste(
"Result:", paste0(paramA$TADA.ResultMeasureValue, " ", paramA$TADA.ResultMeasure.MeasureUnitCode), "<br>",
"Activity Start Date:", paramA$ActivityStartDate, "<br>",
"Activity Start Date Time:", paramA$ActivityStartDateTime, "<br>",
"Monitoring Location Name:", paramA$MonitoringLocationName, "<br>",
"Media:", paramA$TADA.ActivityMediaName, "<br>",
"Media Subdivision:", paramA$ActivityMediaSubdivisionName, "<br>",
"Result Depth:", paste0(
paramA$TADA.ResultDepthHeightMeasure.MeasureValue, " ",
paramA$TADA.ResultDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Relative Depth Name:", paramA$ActivityRelativeDepthName, "<br>",
"Activity Depth:", paste0(
paramA$TADA.ActivityDepthHeightMeasure.MeasureValue, " ",
paramA$TADA.ActivityDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Top Depth:", paste0(
paramA$TADA.ActivityTopDepthHeightMeasure.MeasureValue, " ",
paramA$TADA.ActivityTopDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Bottom Depth:", paste0(
paramA$TADA.ActivityBottomDepthHeightMeasure.MeasureValue, " ",
paramA$TADA.ActivityBottomDepthHeightMeasure.MeasureUnitCode
), "<br>"
)
)
if (length(groups) >= 2) {
scatterplot <- scatterplot %>%
plotly::add_trace(
data = paramB,
x = ~ as.Date(ActivityStartDate),
y = ~TADA.ResultMeasureValue,
name = groups[2],
marker = list(
size = 10,
color = tada.pal[2, 1],
line = list(color = tada.pal[2, 2], width = 2)
),
hoverinfo = "text",
hovertext = paste(
"Result:", paste0(paramB$TADA.ResultMeasureValue, " ", paramB$TADA.ResultMeasure.MeasureUnitCode), "<br>",
"Activity Start Date:", paramB$ActivityStartDate, "<br>",
"Activity Start Date Time:", paramB$ActivityStartDateTime, "<br>",
"Monitoring Location Name:", paramB$MonitoringLocationName, "<br>",
"Media:", paramB$TADA.ActivityMediaName, "<br>",
"Media Subdivision:", paramB$ActivityMediaSubdivisionName, "<br>",
"Result Depth:", paste0(
paramB$TADA.ResultDepthHeightMeasure.MeasureValue, " ",
paramB$TADA.ResultDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Relative Depth Name:", paramB$ActivityRelativeDepthName, "<br>",
"Activity Depth:", paste0(
paramB$TADA.ActivityDepthHeightMeasure.MeasureValue, " ",
paramB$TADA.ActivityDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Top Depth:", paste0(
paramB$TADA.ActivityTopDepthHeightMeasure.MeasureValue, " ",
paramB$TADA.ActivityTopDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Bottom Depth:", paste0(
paramB$TADA.ActivityBottomDepthHeightMeasure.MeasureValue, " ",
paramB$TADA.ActivityBottomDepthHeightMeasure.MeasureUnitCode
), "<br>"
)
)
}
if (length(groups) >= 3) {
scatterplot <- scatterplot %>%
plotly::add_trace(
data = paramC,
x = ~ as.Date(ActivityStartDate),
y = ~TADA.ResultMeasureValue,
name = groups[3],
marker = list(
size = 10,
color = tada.pal[3, 1],
line = list(color = tada.pal[3, 2], width = 2)
),
hoverinfo = "text",
hovertext = paste(
"Result:", paste0(paramC$TADA.ResultMeasureValue, " ", paramC$TADA.ResultMeasure.MeasureUnitCode), "<br>",
"Activity Start Date:", paramC$ActivityStartDate, "<br>",
"Activity Start Date Time:", paramC$ActivityStartDateTime, "<br>",
"Monitoring Location Name:", paramC$MonitoringLocationName, "<br>",
"Media:", paramC$TADA.ActivityMediaName, "<br>",
"Media Subdivision:", paramC$ActivityMediaSubdivisionName, "<br>",
"Result Depth:", paste0(
paramC$TADA.ResultDepthHeightMeasure.MeasureValue, " ",
paramC$TADA.ResultDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Relative Depth Name:", paramC$ActivityRelativeDepthName, "<br>",
"Activity Depth:", paste0(
paramC$TADA.ActivityDepthHeightMeasure.MeasureValue, " ",
paramC$TADA.ActivityDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Top Depth:", paste0(
paramC$TADA.ActivityTopDepthHeightMeasure.MeasureValue, " ",
paramC$TADA.ActivityTopDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Bottom Depth:", paste0(
paramC$TADA.ActivityBottomDepthHeightMeasure.MeasureValue, " ",
paramC$TADA.ActivityBottomDepthHeightMeasure.MeasureUnitCode
), "<br>"
)
)
}
if (length(groups) >= 4) {
plotly::config(displaylogo = FALSE) # , displayModeBar = TRUE) # TRUE makes bar always visible

param <- list()
for (j in 1:length(groups)) {
if ( length(groups) >= j){
param[[j]] <- subset(param.data[[j]], param.data[[j]][, "TADA.ComparableDataIdentifier"] %in% unique(plot.data$TADA.ComparableDataIdentifier)[i])

scatterplot <- scatterplot %>%
plotly::add_trace(
data = paramD,
data = param[[j]],
x = ~ as.Date(ActivityStartDate),
y = ~TADA.ResultMeasureValue,
name = groups[4],
name = groups[j],
marker = list(
size = 10,
color = tada.pal[4, 1],
line = list(color = tada.pal[4, 2], width = 2)
color = tada.pal[j, 1],
line = list(color = tada.pal[j, 2], width = 2)
),
hoverinfo = "text",
hovertext = paste(
"Result:", paste0(paramD$TADA.ResultMeasureValue, " ", paramD$TADA.ResultMeasure.MeasureUnitCode), "<br>",
"Activity Start Date:", paramD$ActivityStartDate, "<br>",
"Activity Start Date Time:", paramD$ActivityStartDateTime, "<br>",
"Monitoring Location Name:", paramD$MonitoringLocationName, "<br>",
"Media:", paramD$TADA.ActivityMediaName, "<br>",
"Media Subdivision:", paramD$ActivityMediaSubdivisionName, "<br>",
"Result:", paste0(param[[j]]$TADA.ResultMeasureValue, " ", param[[j]]$TADA.ResultMeasure.MeasureUnitCode), "<br>",
"Activity Start Date:", param[[j]]$ActivityStartDate, "<br>",
"Activity Start Date Time:", param[[j]]$ActivityStartDateTime, "<br>",
"Monitoring Location Name:", param[[j]]$MonitoringLocationName, "<br>",
"Media:", param[[j]]$TADA.ActivityMediaName, "<br>",
"Media Subdivision:", param[[j]]$ActivityMediaSubdivisionName, "<br>",
"Result Depth:", paste0(
paramD$TADA.ResultDepthHeightMeasure.MeasureValue, " ",
paramD$TADA.ResultDepthHeightMeasure.MeasureUnitCode
param[[j]]$TADA.ResultDepthHeightMeasure.MeasureValue, " ",
param[[j]]$TADA.ResultDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Relative Depth Name:", paramD$ActivityRelativeDepthName, "<br>",
"Activity Relative Depth Name:", param[[j]]$ActivityRelativeDepthName, "<br>",
"Activity Depth:", paste0(
paramD$TADA.ActivityDepthHeightMeasure.MeasureValue, " ",
paramD$TADA.ActivityDepthHeightMeasure.MeasureUnitCode
param[[j]]$TADA.ActivityDepthHeightMeasure.MeasureValue, " ",
param[[j]]$TADA.ActivityDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Top Depth:", paste0(
paramD$TADA.ActivityTopDepthHeightMeasure.MeasureValue, " ",
paramD$TADA.ActivityTopDepthHeightMeasure.MeasureUnitCode
param[[j]]$TADA.ActivityTopDepthHeightMeasure.MeasureValue, " ",
param[[j]]$TADA.ActivityTopDepthHeightMeasure.MeasureUnitCode
), "<br>",
"Activity Bottom Depth:", paste0(
paramD$TADA.ActivityBottomDepthHeightMeasure.MeasureValue, " ",
paramD$TADA.ActivityBottomDepthHeightMeasure.MeasureUnitCode
param[[j]]$TADA.ActivityBottomDepthHeightMeasure.MeasureValue, " ",
param[[j]]$TADA.ActivityBottomDepthHeightMeasure.MeasureUnitCode
), "<br>"
)
)
}
}
}

# create plots and store as list
all_scatterplots[[i]] <- scatterplot

Expand Down
12 changes: 7 additions & 5 deletions R/Utilities.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1532,7 +1532,7 @@ TADA_ColorPalette <- function(col_pair = FALSE) {
# Each row defines the pairing of colors to be used if col_pair is TRUE
if(col_pair == TRUE){
col1 <- c(pal[5], pal[3], pal[7], pal[14])
col2 <- c(pal[10], pal[12], pal[11], pal[1])
col2 <- c(pal[10], pal[12], pal[11], pal[2])
col_combo <- data.frame(col1, col2)
pal <- col_combo
}
Expand Down Expand Up @@ -1572,7 +1572,7 @@ TADA_ViewColorPalette <- function(col_pair = FALSE) {
label_colors[1] <- "white"

# create color swatch graphic
graphics::par(mar = c(5, 0, 5, 0))
graphics::par(mar = c(1, 0, 1, 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
Expand All @@ -1585,7 +1585,8 @@ TADA_ViewColorPalette <- function(col_pair = FALSE) {

if(col_pair == TRUE){
swatch <- list()
graphics::par(mfrow = c(2, nrow(col_combo)/2)) # Create a 2 x nrow/2 plotting matrix
# Create a 2 x nrow/2 plotting matrix, can handle additional color pairings, in one view, if more are added in the future.
graphics::par(mfrow = c(2, nrow(col_combo)/2))
# create list of label colors for pairs
label_colors <- rep("black", 2)

Expand All @@ -1602,9 +1603,10 @@ TADA_ViewColorPalette <- function(col_pair = FALSE) {
swatch[[i]] <- one_swatch
}
}

graphics::par(mfrow=c(1,1))

swatch <- grDevices::recordPlot()

return(swatch)
}

Expand Down
4 changes: 2 additions & 2 deletions man/TADA_GroupedScatterplot.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.