После этого поста моя цель здесь - расширить shiny app, чтобы он предлагал выбрать либо из DT (через DT::renderDataTable, DT::dataTableOutput и renderUI), либо из списка (через renderUI и selectInput)
Итак, вот что у меня есть:
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")
plot.types <- c("list","table")
server <- function(input, output)
{
#select a feature from the table
output$feature.idx <- renderUI({
if(input$plotType == "table"){
output$feature.table <- DT::renderDataTable(feature.rank.df, server = FALSE, selection = "single")
DT::dataTableOutput("feature.table")
}
})
#select a feature from the list
output$feature.id <- renderUI({
if(input$plotType == "list"){
selectInput("feature.id", "Select Feature", choices = feature.rank.df$feature_id)
}
})
#plot the feature selected from the 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
}
})
#plot the feature selected from the list
output$outPlot <- plotly::renderPlotly({
if(!is.null(input$feature.id)){
feature.id <- input$feature.id
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
}
})
}
ui <- fluidPage(
titlePanel("Results Explorer"),
sidebarLayout(
sidebarPanel(
selectInput("plotType", "Plot Type", choices = plot.types),
uiOutput("feature.idx"),
uiOutput("feature.id")
),
mainPanel(
plotly::plotlyOutput("outPlot")
)
)
)
shinyApp(ui = ui, server = server)
В результате при выборе table на боковой панели отображать таблицу, ничего не происходит при выборе строки. С другой стороны, опция list работает нормально.
Есть идеи, как решить эту проблему?