这是this post的扩展：
我想在DT::renderDataTable中放入renderUI，然后在output中使用renderUI中的reactive。
这就是我在做什么：
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shiny))
#data.frames to be used in the server
set.seed(1)
coordinate.df <- data.frame(coordinate_id = paste0("c", 1:1000),x = rnorm(1000), y = rnorm(1000), stringsAsFactors = F)
feature.df <- data.frame(coordinate_id = rep(paste0("c", 1:1000), 10), feature_id = rep(paste0("f", 1:10), 1000), value = rnorm(10*1000), stringsAsFactors = F)
feature.rank.df <- feature.df %>% dplyr::select(feature_id) %>% unique() %>% dplyr::mutate(rank=sample(1:10,10,replace = F)) %>% dplyr::arrange(rank)
feature.color.vec <- c("lightgray","darkred")
server <- function(input, output)
{
output$feature.idx <- renderUI({
output$feature.table <- DT::renderDataTable(feature.rank.df, server = FALSE, selection = "single")
DT::dataTableOutput("feature.table")
})
feature.plot <- reactive({
if(!is.null(input$feature.idx)){
feature.id <- feature.rank.df$feature_id[input$feature.idx]
plot.title <- feature.id
plot.df <- suppressWarnings(feature.df %>%
dplyr::filter(feature_id == feature.id) %>%
dplyr::left_join(coordinate.df,by = c("coordinate_id"="coordinate_id")))
feature.plot <- suppressWarnings(plotly::plot_ly(marker=list(size=3),type='scatter',mode="markers",color=plot.df$value,x=plot.df$x,y=plot.df$y,showlegend=F,colors=colorRamp(feature.color.vec)) %>%
plotly::layout(title=plot.title,xaxis=list(zeroline=F,showticklabels=F,showgrid=F),yaxis=list(zeroline=F,showticklabels=F,showgrid=F)) %>%
plotly::colorbar(limits=c(min(plot.df$value,na.rm=T),max(plot.df$value,na.rm=T)),len=0.4,title="Value"))
}
feature.plot
})
output$outPlot <- plotly::renderPlotly({
feature.plot()
})
}
ui <- fluidPage(
titlePanel("Results Explorer"),
sidebarLayout(
sidebarPanel(
uiOutput("feature.idx")
),
mainPanel(
plotly::plotlyOutput("outPlot")
)
)
)
shinyApp(ui = ui, server = server)
它确实加载了feature.rank.df data.frame，但随后将此错误消息打印到主面板：
Error: no applicable method for 'plotly_build' applied to an object of class "c('reactiveExpr', 'reactive')"
在侧面板的表中，在选择行时没有任何内容。
您知道解决方案是什么吗？
答案 0 :(得分：1)
您可以通过以下代码替换服务器功能来解决此问题。
input$feature.table_rows_selected引用所选功能renderPlotly函数中保留反应性feature.plot代码server <- function(input, output)
{
output$feature.idx <- renderUI({
output$feature.table <-
DT::renderDataTable(feature.rank.df,
server = FALSE,
selection = "single")
DT::dataTableOutput("feature.table")
})
output$outPlot <- plotly::renderPlotly({
if (!is.null(input$feature.table_rows_selected)) {
feature.id <-
feature.rank.df$feature_id[input$feature.table_rows_selected]
plot.title <- feature.id
plot.df <- suppressWarnings(
feature.df %>%
dplyr::filter(feature_id == feature.id) %>%
dplyr::left_join(
coordinate.df,
by = c("coordinate_id" = "coordinate_id")
)
)
feature.plot <-
suppressWarnings(
plotly::plot_ly(
marker = list(size = 3),
type = 'scatter',
mode = "markers",
color = plot.df$value,
x = plot.df$x,
y = plot.df$y,
showlegend = F,
colors = colorRamp(feature.color.vec)
) %>%
plotly::layout(
title = plot.title,
xaxis = list(
zeroline = F,
showticklabels = F,
showgrid = F
),
yaxis = list(
zeroline = F,
showticklabels = F,
showgrid = F
)
) %>%
plotly::colorbar(
limits = c(
min(plot.df$value, na.rm = T),
max(plot.df$value, na.rm = T)
),
len = 0.4,
title = "Value"
)
)
feature.plot
}
})
}
编辑：
或者，您可以将feature.plot保持为被动状态，如下所示：
server <- function(input, output)
{
output$feature.idx <- renderUI({
output$feature.table <- DT::renderDataTable(feature.rank.df, server = FALSE, selection = "single")
DT::dataTableOutput("feature.table")
})
feature.plot <- reactive({
if (!is.null(input$feature.table_rows_selected)) {
feature.id <-
feature.rank.df$feature_id[input$feature.table_rows_selected]
plot.df <- suppressWarnings(
feature.df %>%
dplyr::filter(feature_id == feature.id) %>%
dplyr::left_join(coordinate.df, by = c("coordinate_id" =
"coordinate_id"))
)
feature.plot <-
suppressWarnings(
plotly::plot_ly(
marker = list(size = 3),
type = 'scatter',
mode = "markers",
color = plot.df$value,
x = plot.df$x,
y = plot.df$y,
showlegend = F,
colors = colorRamp(feature.color.vec)
) %>%
plotly::layout(
title = plot.df$feature_id[1],
xaxis = list(
zeroline = F,
showticklabels = F,
showgrid = F
),
yaxis = list(
zeroline = F,
showticklabels = F,
showgrid = F
)
) %>%
plotly::colorbar(
limits = c(
min(plot.df$value, na.rm = T),
max(plot.df$value, na.rm = T)
),
len = 0.4,
title = "Value"
)
)
}
return(feature.plot)
})
output$outPlot <- plotly::renderPlotly({
req(feature.plot(), input$feature.table_rows_selected)
feature.plot()
})
}