Hello I have created a shiny app which creates a scatter plot between selected variables. Then when I click on a data point the name of the point is printed in the plot. The problem is that when I update the plot with other variables the printed are not erased. I used the example below which works fine.
library(shiny)
library(plotly)
library(htmlwidgets)
js <- HTML(
"Shiny.addCustomMessageHandler('resetValue', function(variableName){
Shiny.onInputChange(variableName, null);
}
);"
)
ui <- fluidPage(
# 5b. js to reset the plotly click event
tags$head(tags$script(js)),
fluidRow(column(width = 3,
selectInput("column_x", "X Variable", colnames(mtcars)),
selectInput("column_y", "Y Variable", colnames(mtcars))),
column(width = 9,
plotlyOutput("plot")
)
)
)
server <- function(input, output, session) {
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observeEvent({event_data("plotly_click", source = "select")}, {
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# check if from correct curve
if(!is.null(click_data) && click_data[["curveNumber"]] == 2) {
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
}
})
output$plot <- renderPlotly({
mtcars$model <- row.names(mtcars)
g <- ggplot(mtcars, aes_string(x = input$column_x,
y = input$column_y,
key = "model",
group = 1)) +
geom_smooth(aes(group = 1)) +
geom_point() +
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 1.5)
ggplotly(g, source = "select", tooltip = c("key"))
})
# 5a. reset plotly click event and vals$click_all upon changing plot inputs
observeEvent(c(
input$column_x,
input$column_y
), {
session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
})
}
shinyApp(ui, server)
But when Im trying to implement this into my actual application which uses uiOutput(), for lx1 and lx2 as my actual dataset comes from an uploaded csv file nothing happens. My assumption is that this happens because of the uiOutput() as I do not think that theif statement that I use may cause the problem.
library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(htmlwidgets)
js <- HTML(
"Shiny.addCustomMessageHandler('resetValue', function(variableName){
Shiny.onInputChange(variableName, null);
}
);"
)
fluidPage(
tags$head(tags$script(js)),
# App title ----
titlePanel(div("CROSS CORRELATION",style = "color:blue")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(width = 3
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table",
shiny::dataTableOutput("contents")),
tabPanel("Correlation Plot",
tags$style(type="text/css", "
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 5px 0px 5px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: #000000;
background-color: #CCFF66;
z-index: 105;
}
"),conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div("Loading...",id="loadmessage")
),
fluidRow(
column(3, uiOutput("lx1")),
column(3,uiOutput("lx2"))),
hr(),
fluidRow(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
column(3,uiOutput("td")),
column(3,uiOutput("an"))
),
fluidRow(
plotlyOutput("sc"))
)
)
)))
#server.r
function(input, output,session) {
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(mtcars)
)
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(mtcars)
)
})
output$td<-renderUI({
radioButtons("td", label = h4("Trendline"),
choices = list("Add Trendline" = "lm", "Remove Trendline" = ""),
selected = "")
})
output$an<-renderUI({
radioButtons("an", label = h4("Correlation Coefficient"),
choices = list("Add Cor.Coef" = cor(subset(mtcars, select=c(input$lx1)),subset(mtcars, select=c(input$lx2))), "Remove Cor.Coef" = ""),
selected = "")
})
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observeEvent({event_data("plotly_click", source = "select")}, {
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# check if from correct curve
if(!is.null(click_data) && click_data[["curveNumber"]] == 2) {
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
}
})
output$sc<-renderPlotly({
mtcars$model <- row.names(mtcars)
if(input$td=="lm"){
p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "model",group = 1))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
scale_x_continuous(breaks = seq(0, 35, 5)) +
scale_y_continuous(breaks = seq(0, 35, 5)) +
# Change how the text looks for each element
theme(title = element_text(family = "Calibri",
size = 10,
face = "bold"),
axis.title = element_text(family = "Calibri Light",
size = 16,
face = "bold",
color = "darkgrey"),
axis.text = element_text(family = "Calibri",
size = 11))+
theme_bw()+
annotate("text", x = 5, y = 5, label = as.character(input$an))+
geom_smooth(aes(group = 1))+
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_y = -1,5)
}
else{
mtcars$model <- row.names(mtcars)
p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "model",group = 1))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
scale_x_continuous(breaks = seq(0, 35, 5)) +
scale_y_continuous(breaks = seq(0, 35, 5)) +
# Change how the text looks for each element
theme(title = element_text(family = "Calibri",
size = 10,
face = "bold"),
axis.title = element_text(family = "Calibri Light",
size = 16,
face = "bold",
color = "darkgrey"),
axis.text = element_text(family = "Calibri",
size = 11))+
theme_bw()+
annotate("text", x = 5, y = 5, label = as.character(input$an))+
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_y = -1,5)
}
ggplotly(p1,source = "select", tooltip = c("key")) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
# 5a. reset plotly click event and vals$click_all upon changing plot inputs
observeEvent(c(
input$lx1,
input$lx2
), {
session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
})
}