用户输入等表格的闪亮 UI 美学改进

Posted 2023-03-24

【中文标题】用户输入等表格的闪亮 UI 美学改进

【英文标题】：Shiny UI aesthetic improvements for table like user inputs

【发布时间】：2021-10-20 17:15:32

【问题描述】：

我正在创建一个闪亮的应用程序，我希望用户在其中选择看起来像表格的输入。我的代码有效，但是它看起来不是很漂亮，因为滑块与它们的相关信息不对齐。几个问题：

有什么方法可以让滑块与相关文本正确对齐？ 滑动条上的所有输入都是相同的，我可以只在用户当前悬停的那个上显示标签吗？或者可能只是顶部或底部滑块？ 如何强制使“表格”在窗口最小化时不会自行调整大小/换行？

屏幕截图显示了“表格”的不良外观，其中滑动条未正确对齐，以及屏幕最小化时的“包裹”外观。

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  # App title ----
  titlePanel("Overall Title"),
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(
      h4(strong("Set lake N concentrations (ppb)")),
      fluidRow(
        column(3,
               h5(strong("Lake")),
               h5("Okareka"),
               h5("Tikitapu")
        ),
        column(3,
               h5(strong("Existing N")),
               h5("190.98"),
               h5("173.88")
        ),

        column(4,
               h5(strong("Improvement/Degradation")),
               sliderTextInput(
                 inputId = "DegImp_1",
                 label = "",
                 grid = TRUE,
                 force_edges = TRUE,
                 choices = c("-20%", "-10%", "No change", "10%", "20%"),
                 selected = "No change"
               ),

               sliderTextInput(
                 inputId = "DegImp_8",
                 label = "",
                 grid = TRUE,
                 force_edges = TRUE,
                 choices = c("-20%", "-10%", "No change", "10%", "20%"),
                 selected = "No change"
               )
        ),
        column(2,
               h5(strong("Value")),
               textOutput("DegImp_1value"),
               textOutput("DegImp_8value")
        )
      )
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      # Output: Data file ----
      tableOutput("contents")
    )
  )
)

# server ----
server <- function(input, output) 
  
  DI_1value <- reactive ( switch(input$DegImp_1, "-20%" = 190.98*0.8, "-10%" = 190.98*0.9, "No change" = 190.98, "10%" = 190.98*1.1, "20%" = 190.98*1.2))
  DI_8value <- reactive ( switch(input$DegImp_8, "-20%" = 173.88*0.8, "-10%" = 173.88*0.9, "No change" = 173.88, "10%" = 173.88*1.1, "20%" = 173.88*1.2))
  
  output$DegImp_1value <- renderPrint( round(DI_1value(),2) )
  output$DegImp_8value <- renderPrint( round(DI_8value(),2) )
  


# Create Shiny app ----
shinyApp(ui, server)

【参考方案1】：

您可以使用splitLayout 逐行进行。结果还不错：

library(shiny)
library(shinyWidgets)

shinyApp(ui = fluidPage(

  splitLayout(
    h5(strong("Lake")),
    h5(strong("Existing N")),
    h5(strong("Improvement"))
  ),
  
  splitLayout(
    h5("Okareka"),
    h5(190.18),
    sliderTextInput(
      inputId = "DegImp_1",
      label = "",
      grid = TRUE,
      force_edges = TRUE,
      choices = c("-20%", "-10%", "No change", "10%", "20%"),
      selected = "No change"
    )
  ),
  
  splitLayout(
    h5("Tikitapu"),
    h5(173.88),
    sliderTextInput(
      inputId = "DegImp_8",
      label = "",
      grid = TRUE,
      force_edges = TRUE,
      choices = c("-20%", "-10%", "No change", "10%", "20%"),
      selected = "No change"
    )
  )
    
), 

server = function(input, output, session) 
  
)

这是一个更紧凑的版本：

fluidPage(

  div(
    style = "width: 500px;",
    
    splitLayout(
      h5(strong("Lake")),
      h5(strong("Existing N")),
      h5(strong("Improvement")),
      cellWidths = c("20%", "20%", "60%")
    ),
    
    splitLayout(
      h5("Okareka"),
      h5(190.18),
      sliderTextInput(
        inputId = "DegImp_1",
        label = "",
        grid = TRUE,
        force_edges = TRUE,
        choices = c("-20%", "-10%", "No change", "10%", "20%"),
        selected = "No change",
        width = "200px"
      ),
      cellWidths = c("20%", "20%", "60%")
    ),
    
    splitLayout(
      h5("Tikitapu"),
      h5(173.88),
      sliderTextInput(
        inputId = "DegImp_8",
        label = "",
        grid = TRUE,
        force_edges = TRUE,
        choices = c("-20%", "-10%", "No change", "10%", "20%"),
        selected = "No change",
        width = "200px"
      ),
      cellWidths = c("20%", "20%", "60%")
    )
  
  )
    
)

您可以通过将滑块包含在具有负上边距的 div 中来上移滑块：

splitLayout(
  h5("Okareka"),
  h5(190.18),
  div(
    style = "margin-top: -15px;",
    sliderTextInput(
      inputId = "DegImp_1",
      label = "",
      grid = TRUE,
      force_edges = TRUE,
      choices = c("-20%", "-10%", "No change", "10%", "20%"),
      selected = "No change",
      width = "200px"
    )
  ),
  cellWidths = c("20%", "20%", "60%")
),

splitLayout(
  h5("Tikitapu"),
  h5(173.88),
  div(
    style = "margin-top: -15px;",
    sliderTextInput(
      inputId = "DegImp_8",
      label = "",
      grid = TRUE,
      force_edges = TRUE,
      choices = c("-20%", "-10%", "No change", "10%", "20%"),
      selected = "No change",
      width = "200px"
    )
  ),
  cellWidths = c("20%", "20%", "60%")
)

或者，更好的是，设置label = NULL，而不是label = ""：

splitLayout(
  h5("Okareka"),
  h5(190.18),
  sliderTextInput(
    inputId = "DegImp_1",
    label = NULL,
    grid = TRUE,
    force_edges = TRUE,
    choices = c("-20%", "-10%", "No change", "10%", "20%"),
    selected = "No change",
    width = "200px"
  ),
  cellWidths = c("20%", "20%", "60%")
),

splitLayout(
  h5("Tikitapu"),
  h5(173.88),
  sliderTextInput(
    inputId = "DegImp_8",
    label = NULL,
    grid = TRUE,
    force_edges = TRUE,
    choices = c("-20%", "-10%", "No change", "10%", "20%"),
    selected = "No change",
    width = "200px"
  ),
  cellWidths = c("20%", "20%", "60%")
)