在 Shiny 中通过串扰将 Plotly 与 DT 一起使用
Posted
技术标签:
【中文标题】在 Shiny 中通过串扰将 Plotly 与 DT 一起使用【英文标题】：Using Plotly with DT via crosstalk in Shiny 【发布时间】：2018-08-29 02:45:26 【问题描述】：我正在编写一个应用程序来将一个 csv 文件读入闪亮并将一个散点图与一个 DT 表链接。我几乎遵循 DT 数据表 (https://plot.ly/r/datatable/) 上的 Plotly 网站上的示例，除了保存的 csv 数据保存为反应输入，并且我为散点图的 x 和 y 变量选择输入。 单击操作按钮后，我可以生成绘图和 DT 表，还可以更新 DT 以仅显示刷散点图的选定行。我的问题是，当我在 DT 中选择行时，散点图中相应的各个点不会被选中（应该是红色）。我似乎是我使用反应函数（）作为 x 和 y 变量的输入，而不是 plotly 中的公式，但我似乎无法克服这个问题。
控制台上出现一条警告消息，但我似乎不知道如何解决此问题：
origRenderFunc() 中的警告：
忽略显式提供的小部件 ID“154870637775”；闪亮不使用它们
设置off 事件（即'plotly_deselect'）以匹配on 事件（即'plotly_selected'）。您可以通过highlight() 函数更改此默认值。
感谢您对此问题的任何意见。
我已经简化了我闪亮的应用程序，只包含相关的代码块：
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】：您需要一个 sharedData 对象，以便 Plotly 和 DT 可以共享更新的选择。希望我下面的玩具示例可以帮助说明。不幸的是，我还没有找到一种方法可以使导入的文件产生串扰（我自己的question 参考）。
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", ,
options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
, server = FALSE)
# Run the application
shinyApp(ui = ui, server = server)
【讨论】：
感谢 RDavey。它与我的问题相似，但不完全是我想要的。我已经拥有一个 SharedData 对象。我的同事发现 pp 对象需要被子集化，它通过更改为以下内容来工作：` # selected data pp 现在我有一个问题，当我刷选择数据点时，数据表会相应更新，但在新更新的数据表中选择一行不会引用图中正确的数据点，而是引用原始未过滤数据。 我不确定如何解决这个问题，但也许使用 DataTableProxy("table") 来引用更改可能会有所帮助。另外，如果您不介意更新数据表，那么您可以使用我的答案here，它依赖于 input$table_cell_edit 事件。以上是关于在 Shiny 中通过串扰将 Plotly 与 DT 一起使用的主要内容，如果未能解决你的问题，请参考以下文章
通过R中的串扰使用选择框在R plotly图中选择默认值，使用静态html不闪亮