问题
I am writing an app to read a csv file into shiny and link a plotly scatter plot with a DT table. I pretty much followed the example from the Plotly website on DT datatable (https://plot.ly/r/datatable/) with the exception that the saved data from the csv is saved as a reactive input and that I have selectinput for the x and y variables for the scatterplot. I can generate the plot and DT table after clicking on the action button and I can also update the DT to only show selected rows from brushing the scatterplot. My problem is that when I select rows in the DT, then the corresponding individual points in the scatterplot does not become selected (should be in red color). I seems to be that I used reactive functions() as input for the x and y variables instead of formulas in plotly but I cannot seem to overcome this problem.
A warning message appear on the console but I cant seem to figure out how to fix this:
Warning in origRenderFunc() :
Ignoring explicitly provided widget ID "154870637775"; Shiny doesn't use them
Setting the off event (i.e., 'plotly_deselect') to match the on event (i.e., 'plotly_selected'). You can change this default via the highlight() function.
Would be thankful for any input on this issue.
I have simplified my shiny app to include only the relevant code chunks:
library(shiny)
library(dplyr)
library(shinythemes)
library(DT)
library(plotly)
library(crosstalk)
ui <- fluidPage(
theme = shinytheme('spacelab'),
titlePanel("Plot"),
tabsetPanel(
# Upload Files Panel
tabPanel("Upload File",
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
tags$br(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"'),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
mainPanel(
tableOutput('contents')
)
)
),
# Plot and DT Panel
tabPanel("Plots",
titlePanel("Plot and Datatable"),
sidebarLayout(
sidebarPanel(
selectInput('xvar', 'X variable', ""),
selectInput("yvar", "Y variable", ""),
actionButton('go', 'Update')
),
mainPanel(
plotlyOutput("Plot1"),
DT::dataTableOutput("Table1")
)
)
)
)
)
# Server function ---------------------------------------------------------
server <- function(input, output, session) {
## For uploading Files Panel ##
MD_data <- reactive({
req(input$file1) ## ?req # require that the input is available
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
return(df)
})
# add a table of the file
output$contents <- renderTable({
if(is.null(MD_data())){return()}
if(input$disp == "head") {
return(head(MD_data()))
}
else {
return(MD_data())
}
})
#### Plot Panel ####
observeEvent(input$go, {
m <- MD_data ()
updateSelectInput(session, inputId = 'xvar', label = 'Specify the x variable for plot',
choices = names(m), selected = NULL)
updateSelectInput(session, inputId = 'yvar', label = 'Specify the y variable for plot',
choices = names(m), selected = NULL)
plot_x1 <- reactive({
m[,input$xvar]})
plot_y1 <- reactive({
m[,input$yvar]})
########
d <- SharedData$new(m)
# highlight selected rows in the scatterplot
output$Plot1 <- renderPlotly({
s <- input$Table1_rows_selected
if (!length(s)) {
p <- d %>%
plot_ly(x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers", color = I('black'), name = 'Unfiltered') %>%
layout(showlegend = T) %>%
highlight("plotly_selected", color = I('red'), selected = attrs_selected(name = 'Filtered'), deselected = attrs_selected(name ="Unfiltered)"))
} else if (length(s)) {
pp <- m %>%
plot_ly() %>%
add_trace(x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers", color = I('black'), name = 'Unfiltered') %>%
layout(showlegend = T)
# selected data
pp <- add_trace(pp, data = m[s, , drop = F], x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers",
color = I('red'), name = 'Filtered')
}
})
# highlight selected rows in the table
output$Table1 <- DT::renderDataTable({
T_out1 <- m[d$selection(),]
dt <- DT::datatable(m)
if (NROW(T_out1) == 0) {
dt
} else {
T_out1
}
})
})
}
shinyApp(ui, server)
回答1:
You need a sharedData object so that both Plotly and DT can share updated selections. Hopefully my toy example below can help illustrate. Unfortunately, I have not found a way of making crosstalk work with imported files (my own question refers).
library(shiny)
library(crosstalk)
library(plotly)
library(ggplot2)
# Shared data available for use by the crosstalk package
shared_df <- SharedData$new(iris)
ui <- fluidPage(
# Application title
titlePanel("Crosstalk test"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
filter_select("iris-select", "Select Species:",
shared_df,
~Species),
filter_slider("iris-slider", "Select width:",
shared_df,
~Sepal.Width, step=0.1, width=250)
),
# Show a plot of the generated data
mainPanel(
plotlyOutput("distPlot"),
DTOutput("table")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlotly({
ggplotly(ggplot(shared_df) +
geom_point(aes(x = Sepal.Width, y = Sepal.Length, colour = Species))
)
})
output$table <- renderDT({
datatable(shared_df, extensions="Scroller", style="bootstrap", class="compact", width="100%",
options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
}, server = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
来源：https://stackoverflow.com/questions/49381631/using-plotly-with-dt-via-crosstalk-in-shiny