组合renderUI，dataTableOutput，renderDataTable和反应式 [英] Combining renderUI, dataTableOutput, renderDataTable, and reactive
本文介绍了组合renderUI，dataTableOutput，renderDataTable和反应式的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
这是这篇文章的扩展:
我想将DT::renderDataTable放在renderUI内，然后将renderUI的output用于reactive.
I would like to have the DT::renderDataTable inside the renderUI and then have the output of the renderUI used in the 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，但随后将以下错误消息打印到主面板:
It does load the feature.rank.df data.frame but it then prints this error message to the main panel:
Error: no applicable method for 'plotly_build' applied to an object of class "c('reactiveExpr', 'reactive')"
在侧面板的表中，在选择行时没有任何内容.
And nothing gets plotted upon row selection in the table in the side panel.
您知道解决方案是什么吗?
Any idea what the solution is?
推荐答案
您可以通过以下代码替换服务器功能来解决此问题.
You can fix this by replacing your server function by the code below.
- 参考
input$feature.table_rows_selected所选择的功能
- 保留
renderPlotly函数中的反应性功能.plot代码
- refer to the selected feature by
input$feature.table_rows_selected - keep the reactive feature.plot code in the
renderPlotlyfunction
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保持为被动状态，如下所示:
Alternatively, you can keep the feature.plot as a reactive, like this:
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()
})
}
这篇关于组合renderUI，dataTableOutput，renderDataTable和反应式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
