Related
I'm putting together a shiny app to play around with some athlete GPS data. Essentially, I'm looking to structure my script so that each time the user selects an area of interest on the plotly plot and the "Add" actionButton is clicked, the table below will add the calculated Start_time, Time_at_peak, Max_velocity, Time_to_peak, and Distance_to_peak values.
The issue can be seen in the GIF below: - Once the area of interest is selected and the "Add" button clicked, the first values seem correct. However, when the user selects a second area of interest to add to the table, it overwrites the initial entry and will keep overwriting each time a new selection is made. This is seemingly because because the code is inside the observeEvent(event_data("plotly_selected"), which, confusingly, it needs to be in order to calculate the variables of interest.
I'm currently a little stumped and can't seem to find any relevant information. As such, any guidance would be greatly appreciated!
Here is a we transfer link to some test data that can be uploaded to the app: https://wetransfer.com/downloads/5a7c5da5a7647bdbe133eb3fdac79c6b20211119052848/afe3e5
library(shiny)
library(readr)
library(DT)
library(dplyr)
library(plotly)
library(lubridate)
library(tidyr)
library(purrr)
library(htmlwidgets)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
x_df <- data.frame(Start_time = character(1), Time_at_peak = character(1), Max_velocity = integer(1),
Time_to_peak = integer(1), Distance_to_peak = integer(1))
x_df$Start_time <- as.character("0:00:00.0")
x_df$Time_at_peak <- as.character("0:00:00.0")
x_df$Max_velocity <- as.integer(0)
x_df$Time_to_peak <- as.integer(0)
x_df$Distance_to_peak <- as.integer(0)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("Event to Table"),
mainPanel(
fileInput(
inputId = "filedata",
label = "Upload data file (.csv)",
accept = c(".csv")),
plotlyOutput('myPlot'),br(),br(),br(),br(),
DTOutput("testing"), br(), br(),
fluidRow(
valueBoxOutput("starttime", width = 2),
valueBoxOutput("endtime", width = 2),
valueBoxOutput("maxvelocity", width = 2),
valueBoxOutput("timediff", width = 3),
valueBoxOutput("distance", width = 3)
),
useShinyjs(),
fluidRow(
div(style = "text-align:center", actionButton("Add", "Add Data to Table"),
downloadButton("export", "Export Table as .CSV"))), br(),
DTOutput(outputId = "table")))
),
server = (function(input, output, session) {
data<-reactive({
req(input$filedata)
read.csv(input$filedata$datapath, header = TRUE)%>%
rename(Velocity = 'Speed..m.s.',
Player = 'Player.Display.Name',
Latitude = 'Lat',
Longtitude = 'Lon',
AccelImpulse = 'Instantaneous.Acceleration.Impulse',
HeartRate = 'Heart.Rate..bpm.')
})
observe({
thedata<-data()
updateSelectInput(session, 'y', choices = names(data))
})
output$myPlot = renderPlotly({
plot_ly(data = data(), x = ~Time, y = ~Velocity, height = 450,
marker =list(color = 'rgb(132,179,202)', size = 0.1),
line = list(color = 'rgb(132,179,202)', size = 0.1, width = 0.9),
type = 'scatter', mode = 'markers+lines') %>%
layout(dragmode = "select",
showlegend = F,
title = list(text = 'Velocity Trace', font = list(size = 20)),
xaxis = list(title = list(text = "", standoff = 0), nticks = 10),
yaxis = list(title = list(text = "Velocity (m/s)"), nticks = 5, gridcolor = "#46505a"),
font = list(color = 'black'),
margin = list(t = 70))
})
observeEvent(event_data("plotly_selected"), {
event.data <- event_data("plotly_selected")
if (max(event.data$y) < 1.5) {
maxvel <- (max(event.data$y))
maxpos <- match(maxvel, event.data$y)
}
else {
filter1 <- filter (event.data, event.data$y > 1.5)
maxvel <- (max(filter1$y))
maxpos <- match(maxvel, event.data$y)
}
zero_val <- function(x) x == 0
zero_index <- event.data$y[1:maxpos] %>% detect_index(zero_val, .dir = "backward")
if (zero_index==0) {starttime <- event.data$x[1]}
else {starttime <- event.data$x[zero_index]}
endvel <- which.max(event.data$y)
endtime <- event.data$x[endvel]
timediff <- paste(today(), endtime) %>% as_datetime() - paste(today(), starttime) %>% as_datetime()
sprint <- as_tibble(event.data$y[zero_index:endvel])
ms <- as_tibble(rep(0.1, count(sprint)))
time_vel <- cbind(ms, sprint)
distance <- sum(time_vel[1]*time_vel[2])
sprintselect <- as_tibble(cbind(Start_time = starttime,
Time_at_peak = endtime,
Max_velocity = round(maxvel, 2),
Time_to_peak = round(timediff, 1),
Distance_to_peak = round(distance, 1)))
values <- reactiveValues()
values$df <- x_df
addData <- observe({
if(input$Add > 0) {
newLine <- isolate(data.frame(Start_time = sprintselect$Start_time, Time_at_peak = sprintselect$Time_at_peak,
Max_velocity = sprintselect$Max_velocity,
Time_to_peak = sprintselect$Time_to_peak,
Distance_to_peak = sprintselect$Distance_to_peak,
stringsAsFactors= FALSE))
values$df <- isolate(rbind(values$df, newLine))}
})
output$testing <- renderDataTable({values$df})
})
})
))
I've managed to figure it out and thought I'd post an answer rather than delete the question - just in case someone out there is looking to do a similar thing and they are unsure how to do it.
Firstly, I removed the pre-populated table x_df from the beginning - it was no longer required.
Although I thought the code needed to sit inside the observeEvent(event_data("plotly_selected") to function correctly, it did not - thankfully, because that was at the root of the issue. Instead, I used observeEvent(input$Add, { (which is the correct code to use as opposed to if(input$Add > 0)) to anchor the event to the click of the Add button.
The values <- reactiveValues() was placed outside the observeEvent() and an IF statement was used to either add the data to the values$df data frame on it's own if it was the first selection, or bind it to the existing saved data.
Here's the new code and a GIF demonstrating.
library(shiny)
library(readr)
library(DT)
library(dplyr)
library(plotly)
library(lubridate)
library(tidyr)
library(purrr)
library(htmlwidgets)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("Event to Table"),
mainPanel(
fileInput(
inputId = "filedata",
label = "Upload data file (.csv)",
accept = c(".csv")),
plotlyOutput('myPlot'),br(),br(),br(),br(),
DTOutput("testing"), br(), br(),
fluidRow(
valueBoxOutput("starttime", width = 2),
valueBoxOutput("endtime", width = 2),
valueBoxOutput("maxvelocity", width = 2),
valueBoxOutput("timediff", width = 3),
valueBoxOutput("distance", width = 3)
),
useShinyjs(),
fluidRow(
div(style = "text-align:center", actionButton("Add", "Add Data to Table"),
downloadButton("export", "Export Table as .CSV"))), br(),
DTOutput(outputId = "table")))
),
server = (function(input, output, session) {
values <- reactiveValues(df_data = NULL)
data<-reactive({
req(input$filedata)
read.csv(input$filedata$datapath, header = TRUE)%>%
rename(Velocity = 'Speed..m.s.',
Player = 'Player.Display.Name',
Latitude = 'Lat',
Longtitude = 'Lon',
AccelImpulse = 'Instantaneous.Acceleration.Impulse',
HeartRate = 'Heart.Rate..bpm.')
})
observe({
thedata<-data()
updateSelectInput(session, 'y', choices = names(data))
})
output$myPlot = renderPlotly({
plot_ly(data = data(), x = ~Time, y = ~Velocity, height = 450,
marker =list(color = 'rgb(132,179,202)', size = 0.1),
line = list(color = 'rgb(132,179,202)', size = 0.1, width = 0.9),
type = 'scatter', mode = 'markers+lines') %>%
layout(dragmode = "select",
showlegend = F,
title = list(text = 'Velocity Trace', font = list(size = 20)),
xaxis = list(title = list(text = "", standoff = 0), nticks = 10),
yaxis = list(title = list(text = "Velocity (m/s)"), nticks = 5, gridcolor = "#46505a"),
font = list(color = 'black'),
margin = list(t = 70))
})
observeEvent(input$Add, {
event.data <- event_data("plotly_selected")
if (max(event.data$y) < 1.5) {
maxvel <- (max(event.data$y))
maxpos <- match(maxvel, event.data$y)
}
else {
filter1 <- filter (event.data, event.data$y > 1.5)
maxvel <- (max(filter1$y))
maxpos <- match(maxvel, event.data$y)
}
zero_val <- function(x) x == 0
zero_index <- event.data$y[1:maxpos] %>% detect_index(zero_val, .dir = "backward")
if (zero_index==0) {starttime <- event.data$x[1]}
else {starttime <- event.data$x[zero_index]}
endvel <- which.max(event.data$y)
endtime <- event.data$x[endvel]
timediff <- paste(today(), endtime) %>% as_datetime() - paste(today(), starttime) %>% as_datetime()
sprint <- as_tibble(event.data$y[zero_index:endvel])
ms <- as_tibble(rep(0.1, count(sprint)))
time_vel <- cbind(ms, sprint)
distance <- sum(time_vel[1]*time_vel[2])
sprintselect <- as_tibble(cbind(Start_time = starttime,
Time_at_peak = endtime,
Max_velocity = round(maxvel, 2),
Time_to_peak = round(timediff, 1),
Distance_to_peak = round(distance, 1)))
newLine <- isolate(data.frame(Start_time = sprintselect$Start_time, Time_at_peak = sprintselect$Time_at_peak,
Max_velocity = sprintselect$Max_velocity,
Time_to_peak = sprintselect$Time_to_peak,
Distance_to_peak = sprintselect$Distance_to_peak,
stringsAsFactors= FALSE))
if (is.null(values$df)){
values$df <- newLine}
else {
values$df <- isolate(rbind(values$df, newLine))}
output$testing <- renderDataTable({values$df})
})
})
))
I created an application in Shiny where I would like to choose multiple items from the drop-down menu. Unfortunately, I don't know how to make items on the list reduce after a given menu selection. By which all lines merge into a whole. what should I add in the code so that each model is a separate line. Below I put a picture with charts.
My code:
library(shiny)
library(plotly)
library(readxl)
library(shinyWidgets)
library(shinydashboard)
library(shinyjs)
library(DT)
df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Model = paste0('Ferrari ', rep(LETTERS[1:10], each = 12)),
Value = sample(c(0:300),120, replace = T),
Car = rep('Ferrari', 10,each = 12), Year = rep(2019:2020, each = 60),Country = rep(c("USA","DE"), each = 12, times = 5), stringsAsFactors = F)
df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Model = paste0('Porsche ', rep(LETTERS[1:10], each = 12)),
Value = sample(c(0:300),120, replace = T),
Car = rep('Porsche', 10,each = 12), Year = rep(2019:2020, each = 60), Country = rep(c("USA","DE"), each = 12, times = 5),stringsAsFactors = F)
data <-rbind(df1, df2)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel( width = 3,
uiOutput("category1"),
uiOutput("category2"),
uiOutput("category3"),
uiOutput("category4")),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotlyOutput("plot", height = 550,width = 1000))
)
)
)
)
server <- function(input, output,session) {
output$category1 <- renderUI({
selectInput('cat1', 'Choose year:', multiple = T, selected = NULL, choices = sort(as.numeric(unique(data$Year))))
})
df_subset <- eventReactive(input$cat1,{
if(input$cat1=="All") {df_subset <- data}
else{df_subset <- data[data$Year == input$cat1,]}
})
df_subset1 <- reactive({
if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Country %in% input$cat2,]}
})
output$category2 <- renderUI({
selectInput('cat2', 'Choose country:', choices = sort(as.character(unique(df_subset()$Country))), multiple = T, selected = NULL)
})
df_subset2 <- reactive({
if(is.null(input$cat3)){df_subset1()} else {df_subset1()[df_subset1()$Car %in% input$cat3,]}
})
output$category3 <- renderUI({
selectInput('cat3', 'Choose car:', choices = sort(as.character(unique(df_subset1()$Car))), multiple = F, selected = NULL)
})
df_subset3 <- reactive({
if(is.null(input$cat4)){df_subset2()} else {df_subset2()[df_subset2()$Model %in% input$cat4,]}
})
output$category4 <- renderUI({
pickerInput('cat4', 'Choose model:', choices = sort(as.character(unique(df_subset2()$Model))), multiple = TRUE, selected = NULL)
})
output$plot <- renderPlotly({
xform <- list(categoryorder = "array",
categoryarray = df_subset3()$Month,
title = " ",
nticks=12)
plot_ly(data=df_subset3(), x=~Month, y = ~Value, type = 'scatter', mode = 'lines', name = 'Value') %>%
layout(title = " ",xaxis = xform) %>%
layout(legend = list(orientation = 'h', xanchor = "center", y=1.1, x=0.5))
})
}
shinyApp(ui, server)
To display each model as a separate line on the plot, you can assign the Model column of your dataset to the color parameter of plot_ly this way:
plot_ly( data = df_subset3(), x = ~Month, y = ~Value, color = ~Model, ...)
I'm trying to code a shiny app for plotting xy data. Each xy point is associated with several factors:
set.seed(1)
data.df <- data.frame(x = rnorm(1000), y = rnorm(1000),
sex = sample(c("F", "M"), 1000, replace = T),
age = sample(c("Y", "O"), 1000, replace = T),
group = sample(c("A", "B", "C", "D"), 1000, replace = T),
stringsAsFactors = F)
design.df <- data.frame(factor.name = c(c(rep("sex",2), rep("age",2), rep("group",4))),
factor.levels = c("F", "M","Y", "O","A", "B", "C", "D"), stringsAsFactors = F)
I would like to enable the user to subset the xy data (data.df) based on a selection of multiple rows from design.df using DT::renderDT within renderUI in the server, where the default selection is all rows of design.df. This works fine using this code:
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(DT))
server <- function(input, output)
{
output$design.idx <- renderUI({
output$design.df <- DT::renderDT(design.df, server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
DT::dataTableOutput("design.df")
})
xy.plot <- reactive({
if(!is.null(input$design.df_rows_selected)){
selected.design.df <- design.df[input$design.df_rows_selected,,drop = FALSE]
selected.idx <- lapply(unique(selected.design.df$factor.name), function(f) which(data.df[,f] %in% dplyr::filter(selected.design.df, factor.name == f)$factor.levels)) %>%
unlist() %>% unique()
plot.df <- data.df[selected.idx,,drop=F]
xy.plot <- suppressWarnings(plotly::plot_ly(marker = list(size = 3), type = 'scatter', mode = "markers", x = plot.df$x, y = plot.df$y, showlegend = FALSE) %>%
plotly::layout(xaxis = list(zeroline = FALSE, showticklabels = FALSE, showgrid = FALSE), yaxis = list(zeroline = FALSE, showticklabels = FALSE, showgrid = FALSE)))
} else{
xy.plot <- NULL
}
return(xy.plot)
})
output$outPlot <- plotly::renderPlotly({
xy.plot()
})
}
ui <- fluidPage(
titlePanel("Results Explorer"),
sidebarLayout(
sidebarPanel(
uiOutput("design.idx")
),
mainPanel(
plotly::plotlyOutput("outPlot")
)
)
)
shinyApp(ui = ui, server = server)
But I would also like to have a title or caption for the rendered datatable, so I tried replacing:
output$design.df <- DT::renderDT(design.df, server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
with:
output$design.df <- DT::renderDT(datatable(design.df, caption = "Subset Selection"), server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
in which case the selected = rownames(design.df)[1:nrow(design.df)] argument seems to be ignored and the default selection is no rows.
Changing selected = rownames(design.df)[1:nrow(design.df)] to selected = 1:nrow(design.df) makes no difference.
Any idea how to get both a title or caption to the rendered table together with have all rows as a pre-selection default?
You have to put selection in the datatable object:
output$design.df <- DT::renderDT(
datatable(design.df,
caption = "Subset Selection",
selection = list(mode = "multiple",
selected = rownames(design.df)[1:nrow(design.df)])
),
server = TRUE)
I'm trying to create a shinyapp using mapdeck that maps a variable based on some attributes. Basically, I select a city and then select an activity and a time threshold to produce the desirable map. Reproducible code below (make sure to use a mapbox API):
library(shiny)
library(dplyr)
library(mapdeck)
library(sf)
ui <- shinyUI(fluidPage(
selectInput(inputId = "city",
label = h1("Pick city:"),
choices = c("Belo Horizonte" = "bho",
"Fortaleza" = "for"),
selected = "bho"),
selectInput(inputId = "activity",
label = h1("Pick activity:"),
choices = c("TT", "ST"),
selected = "TT"),
sliderInput(inputId = "time",
label = h1("Pick time threshold:"),
min = 30, max = 120,
step = 30, value = 30,
animate = TRUE),
mapdeckOutput("map")
)
)
# SERVER --------------------------------------------------------------------------------------
# Define a server for the Shiny app
server <- shinyServer(function(input, output) {
data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")
centroids <- data.frame(sigla_muni = c("for", "bho"),
lon = c(-38.52770, -43.95988),
lat = c( -3.785656, -19.902739))
# register mapbox api key
mapdeck::set_token("YOUR_API")
# reactive for the city
city_filtered <- reactive({
data %>% filter(sigla_muni == input$city)
})
# reactive for the activity
activity_filtered <- reactive({
city_filtered() %>% dplyr::filter(activity == input$activity)
})
# Reactive for time threshold
time_filtered <- reactive({
activity_filtered() %>% dplyr::filter(time_threshold == input$time)
})
# initialize baseMap
output$map <- renderMapdeck({
mapdeck(location = c(-43.95988, -19.902739), zoom = 0)
})
#
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
}
)
shinyApp(ui = ui, server = server)
I want to use the cool map transitions provided by mapdeck, so I create a basemap with zero zoom and then use the mapdeck_view function inside my shiny::observer so I can have the nice transition whenever I open the map or select a different city. I set the views based on cities centroids.
The problem is that the view (and the transition) also updates whenever I change the zoom inside the same city and then select different attributes (different activities or a different time threshold). I wish there was a way to keep the map in the same zoom while I change attributes within the same city, having transition only when I change cities.
I tried to play with shiny::isolate inside my observer but didn't succeed (nothing happened in this case):
observe({
isolate({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess_cum",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
Appreciate any help. Thanks!
I think you need the city input and the time & activity inputs in different observers. This appears to achieve your desired behaviour.
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
observeEvent({c(input$time, input$activity, input$city)},{
print(" -- changing -- ")
sf <- time_filtered()
print( unique( sf$sigla_muni ) )
print( unique( sf$time_threshold ) )
print( unique( sf$activity ) )
mapdeck_update(map_id = "map") %>%
add_polygon(
data = sf,
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
I'm trying to print an interactive pie chart. On a click on the plot another trace should be added. I'm using event_data for this. When the trace is added, on the next click anywhere on the page the trace shall be removed. I didn't find a solution for that. I don't know how to overwrite the onclick-event after another click.
The next Problem would be to remove the before added trace. I think i could use plotlyProxy for that like in Removing traces by name using plotlyProxy (or accessing output schema in reactive context)
Afterwards you can see my code
library(shiny)
library(data.table)
library(plotly)
ui <- basicPage(
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata = data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata = data.table(testdata)
testdata_agg = testdata[, sum(Umsatz.Orga), by=Dachorga]
output$myplot <- renderPlotly({
p <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
d <- event_data("plotly_click")
if (!is.null(d)) {
p = add_pie(p, data = testdata[Dachorga == "Bla"], labels = ~Orga, values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}
p
})
}
shinyApp(ui = ui, server = server)
Sorry for my bad english and thanks in advance
One can use a small javascript code to detect one click on the document, and send the result to the shiny server with Shiny.setInputValue. Then one can control the plot with the help of a reactive value.
library(shiny)
library(data.table)
library(plotly)
js <- "
$(document).ready(function(){
$(document).on('click', function(){
Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
})
})"
ui <- basicPage(
tags$head(tags$script(HTML(js))),
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata <- data.table(testdata)
testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]
plot <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
click <- reactiveVal(FALSE)
observe({
event <- !is.null(event_data("plotly_click"))
click(event)
})
observeEvent(input$click_on_doc, {
click(FALSE)
})
output$myplot <- renderPlotly({
if (click()) {
p <- add_pie(plot, data = testdata[Dachorga == "Bla"], labels = ~Orga,
values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}else{
p <- plot
}
p
})
}
shinyApp(ui = ui, server = server)
I have not understood your "next problem". Perhaps open a new question and try to clarify.