Dear all,
I'm programming an shiny app on which user add or remove plots pushing actions buttons
On these dynamically added plot I want allow user to add and edit an annotation when he clicks on the graph
My problem when I click on the plot (a plotly graph) it displays an annotation (I cannot yet edit it..) on the clicked graph but also on the others graphs ...
For adding annotation texte zone I would like to do in my shiny app something like
https://codepen.io/plotly/pen/Kzjamd
(next step I will need to edit it)
Here below is a commented reprex of what I'm trying to do
I hope someone could solved my problem. I have been stuck for two weeks on this ...
Kind regards
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(ggplot2)
library(plotly)
library(dplyr)
library(shinycssloaders) # for spinner while data / plot loads
library(tidyr)
#data definition
X <- c(1,2,3,4,5,6,7,8,9,10)
Y<-c(100,200,250,267,234,88,78,90,15,32)
Z<-c(-10,2,25,27,23,8,8,90,-15,3)
data <- data.frame(X,Y,Z)
#UI part
ui <- fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(# Add button UI to add graph dynamically
actionButton("add_graphe", label = '+'),
# Add button UI to deletecgraph dynamically
actionButton("supp_graphe", label = '-'),
# Hold the graph from InsertUI created in the server part
div(id = 'placeholder')
)
)
)
#Server part
server <- function(input, output) {
# Create a reactive value which contain the number of graphs actually plotted
nbre <- reactiveVal(0)
# Create a reactive which will contains informations about the clicked plot
states<-reactiveValues(source=c(), value =c(), changed=c())
# Create a reactive function which concatenate the number of graph with a string. Used further to give an incremental id to the new plot or other widget (ex.selectizeinput)
Id <- reactive({
function(id){
paste0(id, nbre())
}
})
# Triggered when we push the "Add_graph" button
observeEvent(input$add_graphe, {
#increase nbre() value
nbre(nbre()+1)
#Insert an UI element
insertUI(
selector = '#placeholder',
#The block representing the UI element (several elements inside, PlotlyOUput, seletizeInput x2)
ui = div(id = Id()('ui'), style = "display:inline-block;width:49%", #Insertion en ligne des elements
plotlyOutput(Id()('graph')),
selectizeInput(Id()('select_X'), 'Axe X', names(data)),
selectizeInput(Id()('select_Y'), 'Axe Y', names(data),multiple=T, options = list('plugins' = list('remove_button'),'create' = TRUE,'persist' = FALSE))
)
)
# Let's collect information id about the created graph
states$source <- c(states$source,Id()('graph'))
states$value <- c(states$value,nbre())
states$changed = rep(FALSE,length(states$source))
})
# Triggered when we push the "supp_graph" button
observeEvent(input$supp_graphe, {
if(nbre()>=1)
{
#Remove the ui corresponding to plot id to delete
removeUI(
selector = paste0('#',Id()('ui')) #
)
#Decrease nbre() value
nbre(nbre()-1)
}
})
# Triggered when nbre() change (so when we increase or decrease nbre() following an action on add or supp button)
observeEvent(nbre(), {
id <- Id()('graph')
selectionX <- Id()('select_X')
selectionY <- Id()('select_Y')
x_clicked = 0
y_clicked = 0
output[[id]] <- renderPlotly({
#Check that both selectize input are not null
if(is.null(input[[selectionX]]) || is.null(input[[selectionY]])){return()}
#if not null get the selected values
x_var <- input[[selectionX]]
y_var <- input[[selectionY]]
# Perform adaptation to the dataframe to allow multiplot
data_to_plot <- select(data, y_var)
data_to_plot <- gather(data_to_plot,variable,value)
data_to_plot <-data.frame(data[names(data)==x_var],data_to_plot)
# The for loop is dedicated to identify which plot has been clicked comparing even_data() information to the graphs ids
# It also allows to know which x and y point has been clicked in order to position the future annotation on this clicked point
for(src in states$source)
{
if( !is.null(event_data("plotly_click", source = src) ) )
{
x_clicked = event_data("plotly_click", source = src)$x
y_clicked = event_data("plotly_click", source = src)$y
value <- event_data("plotly_click", source = src)[[2]]
if(states$value[states$source==src]!=value )
{
states$value[states$source==src] <- value
states$changed[states$source==src] <- TRUE
}
}
}
if(sum(states$changed)>0)
{
print(paste(states$source[states$changed==T], 'has changed'))
states$changed <- rep(FALSE,length(states$source))
}
# Perform ggplot function
p<-ggplot(data_to_plot, aes(x=get(names(data_to_plot[1])), y = value, colour = variable)) + geom_line() + theme_linedraw()
#Add plotly functionalities
q<- ggplotly(p, source = id, dynamicTicks = TRUE) %>%
config(
editable = F,
scrollZoom = T,
displaylogo = F
)%>%
#Add a new annotation near the clicked point
add_annotations(x= x_clicked, y = y_clicked, text = "enter",clicktoshow = FALSE)%>%
event_register('plotly_click')
})
}, ignoreInit = FALSE)
}
shinyApp(ui = ui, server = server)