我正在编写一个应用程序，将csv文件读入闪亮状态，并使用DT表链接绘图散点图。我几乎关注了来自Plotly网站上DT datatable（https://plot.ly/r/datatable/）的示例，但是来自csv的保存数据被保存为被动输入，并且我为散点图的x和y变量选择了输入。 我可以在单击操作按钮后生成绘图和DT表，我还可以更新DT以仅显示从刷涂散点图中选择的行。我的问题是，当我在DT中选择行时，散点图中相应的各个点不会被选中（应该是红色）。我似乎是因为我使用反应函数（）作为x和y变量的输入而不是图形中的公式，但我似乎无法克服这个问题。
控制台上出现警告消息，但我似乎无法弄清楚如何解决这个问题：
origRenderFunc（）中的警告：
忽略明确提供的小部件ID＆＃34; 154870637775＆＃34 ;; Shiny并没有使用它们
设置off事件（即＆＃39; plotly_deselect＆＃39;）以匹配on事件（即＆＃39; plotly_selected＆＃39;）。您可以通过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)
答案 0 :(得分：0)
您需要一个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", width="100%",
options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
}, server = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)