有没有办法在闪亮的情况下修复 tableOutPut 或 dataTableOutput 的高度？

Question

下面粘贴的app有问题； 当您将鼠标悬停在某些数据点上时，表格输出的大小会垂直增加，向下推绘图并取消选择这些点。

library(tidyverse)
library(shiny)

#example text with short and long entries
example_text <- c("short",
                  "This text is fairly long and it changes the size of the table: maybe there is a scrolling option?",
                  "also short",
                  "Here we have another example of long text ruining everything; I would maybe accept it expanding downwards or sideways",
                  "not long",
                  "I'm at a loss for what to do so I'm asking stackoverflow, a website that has helped millions of stuck people")

example_data <- tibble(x = (1:6) ^2, y = sqrt(1:6), hover_text = example_text)

ui <- fluidPage(
    fluidRow(
        column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
        column(2,tableOutput("dynamic_table"))
    ),
    fluidRow(
        plotOutput("plot_out",hover = "plot_hover"),
    )
    
    
)

server <- function(input, output,session) {
    output$plot_out <- renderPlot(ggplot(example_data,aes(x = x, y = y)) + geom_point(size = 5) + labs()) 
    
    table_out <- reactive(nearPoints(df = example_data,
                                     coordinfo = input$plot_hover,
                                     maxpoints = 1,
                                     threshold = 100))
    
    output$dynamic_table <- renderTable(table_out())
}

shinyApp(ui = ui, server = server)

我在这里通过给列宽度 2 强制表格垂直调整大小来强制这种行为，但在我的实际用例中，表格本身很宽，并且即使列宽为 12 也会垂直调整大小。

所以我正在寻找一些东西来永久设置数据表的垂直大小，而不管显示什么文本。 它可能是来自使用滚动条而不是调整大小的不同包的表格输出。 它可能是不动态改变大小的fluidRow的替代方案。 一个hacky的替代方法是添加一个具有更高元素的列，这样它通常会比表格高，但我没有尝试过/不知道它是否有效。

Answer 1

最简单的解决方案是添加固定你的fluidRow的高度， fluidRow有足够的空间来呈现表格你可以通过向你的流体行添加一个style参数并提供足够的空间来做到这一点

fluidRow(id="tablerow",style="height:400px;",
        column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
        column(2,tableOutput("dynamic_table"))
    )

另一个解决方案是在tableOutput css 中添加一个溢出并固定你的fluidRow的高度，如果你希望保持你的流体行的高度狭窄，在这个例子中我使用 200px

示例代码：

library(tidyverse)
library(shiny)

#example text with short and long entries
example_text <- c("short",
                  "This text is fairly long and it changes the size of the table: maybe there is a scrolling option?",
                  "also short",
                  "Here we have another example of long text ruining everything; I would maybe accept it expanding downwards or sideways",
                  "not long",
                  "I'm at a loss for what to do so I'm asking stackoverflow, a website that has helped millions of stuck people")

example_data <- tibble(x = (1:6) ^2, y = sqrt(1:6), hover_text = example_text)

ui <- fluidPage(
    tags$head(
        # Note the wrapping of the string in HTML()
        tags$style(HTML("
                        
                        
                        #dynamic_table{
                        
                        overflow-y:auto;
                        height:200px;
                        }
                        
                        "))
    ),
    
    
    fluidRow(id="tablerow",style="height:200px;",
        column(10,h1( "hover over the points and the changing size of the table moves the plot and deselects points")),
        column(2,tableOutput("dynamic_table"))
    ),
    fluidRow(
        plotOutput("plot_out",hover = "plot_hover"),
    )
    
    
)

server <- function(input, output,session) {
    output$plot_out <- renderPlot(ggplot(example_data,aes(x = x, y = y)) + geom_point(size = 5) + labs()) 
    
    table_out <- reactive(nearPoints(df = example_data,
                                     coordinfo = input$plot_hover,
                                     maxpoints = 1,
                                     threshold = 100))
    
    output$dynamic_table <- renderTable(table_out())
}

shinyApp(ui = ui, server = server)