Can you guys please help. I am using plotly click event to add annotations to my plot. it is working perfectly fine for the plot_spc_chart function but not for other plot_test_spc_chart function. Annotation not being plotted on the point where i click but someplace else.
plot_spc_chart <- function(data, chart_title = "", chart_title_size = 14, caption = "", caption_size = 8, annotations = NULL) {
# Ensure that 'x' is a Date object if not already
if (!inherits(data$x, "Date")) {
data$x <- parse_date_time(data$x, orders = c("my", "ym", "ymd", "mdy", "dmy", "ydm",
"ymd_HMS", "ymd_HM", "ymd_H",
"mdy_HMS", "mdy_HM", "mdy_H",
"dmy_HMS", "dmy_HM", "dmy_H",
"ydm_HMS", "ydm_HM", "ydm_H"))
# Force convert to Date if necessary
if (!inherits(data$x, "Date")) {
data$x <- as.Date(data$x)
}
}
# Define color palette for the chart
colors <- list(
y = rgb(74, 121, 134, maxColorValue = 255),
cl = rgb(216, 159, 62, maxColorValue = 255),
lcl_ucl = rgb(190, 190, 190, maxColorValue = 255),
title = rgb(27, 87, 104, 104, maxColorValue = 255),
annotation = rgb(0, 0, 0, maxColorValue = 255),
annotation_line = rgb(169, 169, 169, maxColorValue = 255) # Gray for annotation lines
)
# Prepare data by phase if phase column exists
data_list <- split(data, data$phase)
# Create the initial plot with ggplot2
p <- ggplot(data, aes(x = x)) +
scale_x_date(name = "Date") + # Use scale_x_date for date handling
theme_minimal() +
theme(
plot.title = element_text(color = colors$title, size = chart_title_size, hjust = 0.5),
plot.background = element_blank(),
panel.grid = element_blank(),
panel.background = element_blank(),
axis.title = element_blank(),
axis.text.x = element_text(angle = 0, vjust = 0.5, color = "darkgray"), # Set angle to 0 for horizontal text
axis.text.y = element_text(color = "darkgray"),
axis.ticks = element_line(color = "darkgray"),
axis.line = element_line(color = "darkgray"),
plot.caption = element_text(size = caption_size, color = "darkgray", hjust = 1),
plot.caption.position = "plot"
)
# Add phase-based layers
for (df in data_list) {
p <- p +
geom_line(data = df, aes(y = cl, group = 1), color = colors$cl, size = 1.25) +
geom_line(data = df, aes(y = lcl, group = 1), color = colors$lcl_ucl, size = 1.25, alpha = 0.5) +
geom_line(data = df, aes(y = ucl, group = 1), color = colors$lcl_ucl, size = 1.25, alpha = 0.5)
}
# Add y line and points last so they're on top
p <- p +
geom_line(aes(y = y, group = 1), color = colors$y, size = 1.25) +
geom_point(aes(y = y), color = colors$y, fill = "white", shape = 21, size = 3)
# Conditionally add chart title if provided
if (chart_title != "") {
p <- p + labs(title = chart_title)
}
# Conditionally add caption if provided
if (caption != "") {
p <- p + labs(caption = caption)
}
# Conditionally add annotations if provided
if (!is.null(annotations) && nrow(annotations) > 0) {
# Add columns to annotations for plotting
annotations$x <- data$x[annotations$serial_number]
annotations$y <- data$y[annotations$serial_number]
# Adjust x positions based on position_x
annotations$label_x <- annotations$x + annotations$position_x
# Adjust starting point of annotation line based on position_y
point_radius <- 3 * 0.085 # Adjusted for size of the data point
text_offset <- 0.5 # Adjust the gap between the label and the line
p <- p +
geom_segment(data = annotations, aes(
x = x,
y = ifelse(position_y > 0, y + point_radius, y - point_radius),
xend = label_x,
yend = y + position_y
), color = colors$annotation_line, size = 0.5) +
geom_text(data = annotations, aes(
x = label_x,
y = y + position_y + ifelse(position_y > 0, text_offset, -text_offset),
label = label
), color = colors$annotation, size = annotations$text_size, hjust = 0.5, vjust = ifelse(annotations$position_y > 0, -0.3, 1.3))
}
return(p)
}
plot_test_spc_chart <- function(data, chart_title = "", chart_title_size = 14, caption = "", caption_size = 8, annotations = NULL) {
# Ensure 'x' is a Date object
if (!inherits(data$x, "Date")) {
data$x <- parse_date_time(data$x, orders = c("my", "ymd", "mdy", "dmy", "ydm",
"ymd_HMS", "ymd_HM", "ymd_H",
"mdy_HMS", "mdy_HM", "mdy_H",
"dmy_HMS", "dmy_HM", "dmy_H",
"ydm_HMS", "ydm_HM", "ydm_H"))
if (!inherits(data$x, "Date")) {
data$x <- as.Date(data$x)
}
}
# Define color palette
colors <- list(
y = rgb(74, 121, 134, maxColorValue = 255),
cl = rgb(216, 159, 62, maxColorValue = 255),
lcl_ucl = rgb(190, 190, 190, maxColorValue = 255),
title = rgb(27, 87, 104, maxColorValue = 255),
annotation = rgb(78, 78, 78, maxColorValue = 255),
annotation_line = rgb(169, 169, 169, maxColorValue = 255),
special = rgb(157, 15, 78, maxColorValue = 255),
shift_pattern = rgb(190, 114, 157, maxColorValue = 255),
fifteen_more = rgb(58, 166, 216, maxColorValue = 255),
trend_stability = rgb(153, 215, 216, maxColorValue = 255),
normal = rgb(255, 255, 255, maxColorValue = 255),
two_of_three = rgb(109, 164, 47, maxColorValue = 255),
runs_signal = rgb(0, 255, 0, maxColorValue = 255) # Green for runs.signal
)
# Split data by phase
data_list <- split(data, data$phase)
# Function to apply highlighting rules within each phase
apply_highlighting <- function(df) {
# Default condition names and colors
fill_conditions <- rep("Normal", nrow(df))
fill_colors <- rep(colors$normal, nrow(df))
# Sigma Signal
fill_conditions[df$sigma.signal] <- "Sigma Signal"
fill_colors[df$sigma.signal] <- colors$special
# Shift patterns
rle_shift <- rle(df$shift)
pos <- 1
for (i in seq_along(rle_shift$lengths)) {
if (!is.na(rle_shift$values[i]) && rle_shift$lengths[i] >= 8) {
indices <- pos:(pos + rle_shift$lengths[i] - 1)
fill_conditions[indices] <- "Shift"
fill_colors[indices] <- colors$shift_pattern
}
pos <- pos + rle_shift$lengths[i]
}
# Fifteen or more points in a run
if ("fifteen_more" %in% names(df) && any(df$fifteen_more, na.rm = TRUE)) {
rle_fifteen <- rle(df$fifteen_more)
pos <- 1
for (i in seq_along(rle_fifteen$lengths)) {
if (rle_fifteen$values[i] && rle_fifteen$lengths[i] >= 15) {
indices <- pos:(pos + rle_fifteen$lengths[i] - 1)
fill_conditions[indices] <- "15+"
fill_colors[indices] <- colors$fifteen_more
}
pos <- pos + rle_fifteen$lengths[i]
}
}
# Trend analysis
differences <- c(diff(df$y), NA)
trends <- ifelse(differences < 0, TRUE, ifelse(differences > 0, FALSE, NA))
rle_trend <- rle(trends)
pos <- 1
for (i in seq_along(rle_trend$lengths)) {
if (rle_trend$lengths[i] >= 5) {
indices <- pos:(pos + rle_trend$lengths[i] - 1)
if (length(differences) >= max(indices) + 1) {
indices <- c(indices, max(indices) + 1)
}
fill_conditions[indices] <- "Trend"
fill_colors[indices] <- colors$trend_stability
}
pos <- pos + rle_trend$lengths[i]
}
# Two out of three rule
for (i in 3:nrow(df)) {
if (sum(df$two_more[(i - 2):i], na.rm = TRUE) >= 2) {
if (all(fill_conditions[(i - 2):i] == "Normal")) {
fill_conditions[(i - 2):i] <- "Two Out of Three"
fill_colors[(i - 2):i] <- colors$two_of_three
}
}
}
df$fill_conditions <- fill_conditions
df$fill_colors <- fill_colors
# Add border color for runs.signal
df$border_color <- ifelse(df$runs.signal, "Runs Signal", "Normal")
return(df)
}
# Apply highlighting to each phase
data_list <- lapply(data_list, apply_highlighting)
# Combine data back
highlighted_data <- do.call(rbind, data_list)
# Print debugging information
print("Data after highlighting:")
print(head(highlighted_data))
# Create the plot
p <- ggplot(highlighted_data, aes(x = x, y = y)) +
lapply(data_list, function(df) {
list(
geom_line(data = df, aes(y = cl, group = phase), color = colors$cl, size = 1.25),
geom_line(data = df, aes(y = lcl, group = phase), color = colors$lcl_ucl, size = 1.25, alpha = 0.5),
geom_line(data = df, aes(y = ucl, group = phase), color = colors$lcl_ucl, size = 1.25, alpha = 0.5)
)
}) +
geom_line(aes(group = 1), color = colors$y, size = 1.25) +
geom_point(aes(fill = fill_conditions, color = border_color), shape = 21, size = 3) +
scale_fill_manual(values = c(
"Normal" = colors$normal,
"Sigma Signal" = colors$special,
"Shift" = colors$shift_pattern,
"15+" = colors$fifteen_more,
"Trend" = colors$trend_stability,
"Two Out of Three" = colors$two_of_three
), name = NULL) +
scale_color_manual(values = c("Runs Signal" = colors$runs_signal), guide = "none") + # Remove legend title
scale_x_date(name = "Date") + # Use scale_x_date for date handling
theme_minimal(base_family = "Arial") +
theme(
plot.title = element_text(color = colors$title, size = chart_title_size, hjust = 0.5, family = "Arial"),
plot.background = element_blank(),
panel.grid = element_blank(),
panel.background = element_blank(),
legend.position = "bottom",
legend.direction = "horizontal",
legend.title = element_blank(),
legend.text = element_text(size = 8),
legend.margin = margin(t = 10), # Add margin for better spacing
axis.title = element_blank(),
axis.text.x = element_text(angle = 0, vjust = 0.5, color = "darkgray"), # Set angle to 0 for horizontal text
axis.text.y = element_text(color = "darkgray"),
axis.ticks = element_line(color = "darkgray"),
axis.line = element_line(color = "darkgray"),
plot.caption = element_text(size = caption_size, color = "darkgray", hjust = 1, family = "Arial"),
plot.caption.position = "plot",
plot.margin = margin(t = 20, r = 20, b = 60, l = 20) # Increase bottom margin to accommodate caption
)
# Print debugging information
print("Plot before adding annotations:")
print(p)
# Conditionally add chart title if provided
if (chart_title != "") {
p <- p + labs(title = chart_title)
}
# Conditionally add caption if provided
if (caption != "") {
p <- p + labs(caption = caption)
}
# Conditionally add annotations if provided
if (!is.null(annotations) && nrow(annotations) > 0) {
# Add columns to annotations for plotting
annotations$x <- data$x[annotations$serial_number]
annotations$y <- data$y[annotations$serial_number]
# Adjust x positions based on position_x
annotations$label_x <- annotations$x + annotations$position_x
# Adjust starting point of annotation line based on position_y
point_radius <- 3 * 0.085 # Adjusted for size of the data point
text_offset <- 0.2 # Adjust the gap between the label and the line
p <- p +
geom_segment(data = annotations, aes(
x = x,
y = ifelse(position_y > 0, y + point_radius, y - point_radius),
xend = label_x,
yend = y + position_y
), color = colors$annotation_line, size = 0.5) +
geom_text(data = annotations, aes(
x = label_x,
y = y + position_y + ifelse(position_y > 0, text_offset, -text_offset),
label = label
), color = colors$annotation, size = annotations$text_size, hjust = 0.5, vjust = ifelse(annotations$position_y > 0, -0.3, 1.3))
}
return(p)
}