我想编写一个 shiny app
用于绘制 xy
数据。每个 xy
点与几个因素有关。
set.seed(1)
data.df <- data.frame(x = rnorm(1000), y = rnorm(1000),
sex = sample(c("F", "M"), 1000, replace = T),
age = sample(c("Y", "O"), 1000, replace = T),
group = sample(c("A", "B", "C", "D"), 1000, replace = T),
stringsAsFactors = F)
design.df <- data.frame(factor.name = c(c(rep("sex",2), rep("age",2), rep("group",4))),
factor.levels = c("F", "M","Y", "O","A", "B", "C", "D"), stringsAsFactors = F)
我想让用户能够对这些数据进行子集。xy
数据 (data.df
),根据从 design.df
使用 DT::renderDT
内 renderUI
在 server
的所有行,其中默认选择的是 design.df
. 使用这段代码可以正常工作。
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(DT))
server <- function(input, output)
{
output$design.idx <- renderUI({
output$design.df <- DT::renderDT(design.df, server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
DT::dataTableOutput("design.df")
})
xy.plot <- reactive({
if(!is.null(input$design.df_rows_selected)){
selected.design.df <- design.df[input$design.df_rows_selected,,drop = FALSE]
selected.idx <- lapply(unique(selected.design.df$factor.name), function(f) which(data.df[,f] %in% dplyr::filter(selected.design.df, factor.name == f)$factor.levels)) %>%
unlist() %>% unique()
plot.df <- data.df[selected.idx,,drop=F]
xy.plot <- suppressWarnings(plotly::plot_ly(marker = list(size = 3), type = 'scatter', mode = "markers", x = plot.df$x, y = plot.df$y, showlegend = FALSE) %>%
plotly::layout(xaxis = list(zeroline = FALSE, showticklabels = FALSE, showgrid = FALSE), yaxis = list(zeroline = FALSE, showticklabels = FALSE, showgrid = FALSE)))
} else{
xy.plot <- NULL
}
return(xy.plot)
})
output$outPlot <- plotly::renderPlotly({
xy.plot()
})
}
ui <- fluidPage(
titlePanel("Results Explorer"),
sidebarLayout(
sidebarPanel(
uiOutput("design.idx")
),
mainPanel(
plotly::plotlyOutput("outPlot")
)
)
)
shinyApp(ui = ui, server = server)
但我还想为渲染后的画面加上标题或说明。datatable
所以我试着换成:
output$design.df <- DT::renderDT(design.df, server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
替换成:
output$design.df <- DT::renderDT(datatable(design.df, caption = "Subset Selection"), server = TRUE, selection = list(mode = "multiple", selected = rownames(design.df)[1:nrow(design.df)]))
这样的话 selected = rownames(design.df)[1:nrow(design.df)]
参数似乎被忽略了,默认选择是没有行。selected = rownames(design.df)[1:nrow(design.df)]
到 selected = 1:nrow(design.df)
毫无区别。
有什么办法可以让渲染后的表格同时有标题或标题,并将所有行作为默认的预选?
你必须把选择在 datatable
对象。
output$design.df <- DT::renderDT(
datatable(design.df,
caption = "Subset Selection",
selection = list(mode = "multiple",
selected = rownames(design.df)[1:nrow(design.df)])
),
server = TRUE)