如何在闪亮的某些单元格中创建带有空格的矩阵状复选框组？

Question

我正在尝试以元素周期表的形式显示一组复选框。这是因为我想做一个使用选定元素来处理东西的程序。像这样的：

这是我目前的代码：

tabPanel("Elements",

fluidRow(column(1, "Tabla Periodica")),

fluidRow(
    column(width = 1,
              checkboxGroupInput("g1", "", choices=c("H" = 1, "Li" = 2, "Na" = 3, "K" = 3, "Rb" = 3, "Cs" = 3, "Fr" = 3))
    ),   
    column(width = 1,   
              tags$div(HTML("<div style=\"width:10px;height:25px;\"></div>")),
              checkboxGroupInput("g2", "", choices=c("Be" = 2, "Mg" = 2, "Ca" = 2, "Sr" = 2, "Ba" = 2, "Ra" = 2))
    ),

  column(width = 3, offset = 0, 
         tags$div(HTML("<div style=\"width:10px;height:75px;\"></div>")),
            splitLayout(
             checkboxGroupInput("g3", "", choices=c("Sc" = 2, "Y" = 2, "La" = 2, "Ac" = 2)),
             checkboxGroupInput("g4", "", choices=c("Ti" = 2, "Zr" = 2, "Hf" = 2, "Rf" = 2)),
             checkboxGroupInput("g5", "", choices=c("V" = 2, "Nb" = 2, "Ta" = 2, "Db" = 2)),
             checkboxGroupInput("g6", "", choices=c("Cr" = 2, "Mo" = 2, "W" = 2, "Sg" = 2)),
             checkboxGroupInput("g7", "", choices=c("Mn" = 2, "Tc" = 2, "Re" = 2, "Bh" = 2)),
             checkboxGroupInput("g8", "", choices=c("Fe" = 2, "Ru" = 2, "Os" = 2, "Hs" = 2)),
             checkboxGroupInput("g9", "", choices=c("Co" = 2, "Rh" = 2, "Ir" = 2, "Mt" = 2)),
             checkboxGroupInput("g10", "", choices=c("Ni" = 2, "Pd" = 2, "Pt" = 2, "Ds" = 2)),
             checkboxGroupInput("g11", "", choices=c("Cu" = 2, "Ag" = 2, "Au" = 2, "Rg" = 2)),
             checkboxGroupInput("g12", "", choices=c("Zn" = 2, "Cd" = 2, "Hg" = 2, "Cn" = 2))
            )
        ),

        column(2,
         tags$div(HTML("<div style=\"width:10px;height:25px;\"></div>")),
         splitLayout(

         checkboxGroupInput("g13", "", choices=c("B" = 2, "Al" = 2, "Ga" = 2, "In" = 2, "Ti" = 2, "Nh" = 2)),
         checkboxGroupInput("g14", "", choices=c("C" = 2, "Si" = 2, "Ge" = 2, "Sn" = 2, "Pb" = 2, "Fl" = 2)),
         checkboxGroupInput("g15", "", choices=c("N" = 2, "P" = 2, "As" = 2, "Sb" = 2, "Bi" = 2, "Mc" = 2)),
         checkboxGroupInput("g16", "", choices=c("O" = 2, "S" = 2, "Se" = 2, "Te" = 2, "Po" = 2, "Lv" = 2)),
         checkboxGroupInput("g17", "", choices=c("F" = 2, "Cl" = 2, "Br" = 2, "I" = 2, "At" = 2, "Ts" = 2))

         ),
        column(1,checkboxGroupInput("g18", "", choices=c("He" = 2, "Ne" = 2, "Ar" = 2, "Kr" = 2, "Xe" = 2, "Rn" = 2, "Og" = 2))
         )
      )
    )
)

但结果是这样的：

Answer 1

这是我的做法。主元素周期表有 7 行 18 列。基于此，可以假设元素周期表由 7x18 = 126 个单元组成，其中每个单元要么包含一个元素，要么是空白的。我为每个单元格分配 5%（屏幕宽度）的宽度，对于 18 列将覆盖屏幕宽度的 90%。

每个checkBox 都是独立的（不使用checkBoxGroupInput），output$show_element_selections 显示了如何确定用户选择的元素。由于元素符号在定义上是唯一的，因此它们可以直接作为按钮 ID。

您需要将shinyApp() 之外的所有内容都放在global.R 中，假设您在ui.R 中有UI，在server.R 中有服务器。

这是代码 -

library(shiny)

spaceFun <- function(width = "5%") {
  s <- paste0("display: inline-block;vertical-align:top; width: ", width, ";")
  tags$div(style = s, HTML("<br>"))
}

checkBoxFun <- function(btn_id = NULL, lab = NULL, width = "5%") {
  s <- paste0("display: inline-block;vertical-align:top; width: ", width, ";")
  tags$div(style = s, checkboxInput(btn_id, label = lab, value = F))
}

# define ui for each of perodic table cell
# cb stands for checkbox and sp stands for space
ui_type_by_cell <- c("cb", rep("sp", 16), "cb", # periodic table row 1
             "cb", "cb", rep("sp", 10), rep("cb", 6), # periodic table row 2
             "cb", "cb", rep("sp", 10), rep("cb", 6), # periodic table row 3
             rep("cb", 18), # periodic table row 4
             rep("cb", 18), # periodic table row 5
             rep("cb", 18), # periodic table row 6
             rep("cb", 18) # periodic table row 7
            )
elements <- c("H", "He", "Li", "Be", "B", "C", "N", "O", "F", "Ne", "Na", 
              "Mg", "Al", "Si", "P", "S", "Cl", "Ar", "K", "Ca", "Sc", "Ti", 
              "V", "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn", "Ga", "Ge", "As", 
              "Se", "Br", "Kr", "Rb", "Sr", "Y", "Zr", "Nb", "Mo", "Tc", "Ru", 
              "Rh", "Pd", "Ag", "Cd", "In", "Sn", "Sb", "Te", "I", "Xe", "Cs", 
              "Ba", "La", "Hf", "Ta", "W", "Re", "Os", "Ir", "Pt", "Au", "Hg", 
              "Tl", "Pb", "Bi", "Po", "At", "Rn", "Fr", "Ra", "Ac", "Rf", "Db", 
              "Sg", "Bh", "Hs", "Mt", "Ds", "Rg", "Cn", "Nh", "Fl", "Mc", "Lv", 
              "Ts", "Og")
btn_labels <- rep("", length(ui_type_by_cell))
btn_labels[ui_type_by_cell == "cb"] <- elements

shinyApp(
  ui = fluidPage(
    fluidRow(style = "width: 1350px; margin: auto;",
      lapply(seq_along(ui_type_by_cell), function(a) {
        if(ui_type_by_cell[a] == "sp") {
          spaceFun()
        } else {
          checkBoxFun(btn_id = btn_labels[a], lab = btn_labels[a])
        }
      })      
    ),
    verbatimTextOutput("show_selected_elements")
  ),
  server = function(input, output, session) {
    output$show_selected_elements <- renderPrint({
      btn_status <- unlist(sapply(btn_labels[ui_type_by_cell == "cb"], function(x) input[[x]]))
      names(which(btn_status))
    })
  }
)

Answer 2

您好，我已经更改了最后一个拆分布局代码。

总代码为：

if (interactive()) {
     library(shiny)

  shinyApp(
   ui = fluidPage(
     tabPanel("Elements",

              fluidRow(column(1, "Tabla Periodica")),

              fluidRow(
                width=12,
                column(width = 1,
                       checkboxGroupInput("g1", "", choices=c("H" = 1, "Li" = 2, "Na" = 3, "K" = 3, "Rb" = 3, "Cs" = 3, "Fr" = 3))
                ),   
                column(width = 1,   
                       tags$div(HTML("<div style=\"width:10px;height:25px;\"></div>")),
                       checkboxGroupInput("g2", "", choices=c("Be" = 2, "Mg" = 2, "Ca" = 2, "Sr" = 2, "Ba" = 2, "Ra" = 2))
                ),

                column(width = 3, offset = 0, 
                       tags$div(HTML("<div style=\"width:10px;height:75px;\"></div>")),
                       splitLayout(
                         checkboxGroupInput("g3", "", choices=c("Sc" = 2, "Y" = 2, "La" = 2, "Ac" = 2)),
                         checkboxGroupInput("g4", "", choices=c("Ti" = 2, "Zr" = 2, "Hf" = 2, "Rf" = 2)),
                         checkboxGroupInput("g5", "", choices=c("V" = 2, "Nb" = 2, "Ta" = 2, "Db" = 2)),
                         checkboxGroupInput("g6", "", choices=c("Cr" = 2, "Mo" = 2, "W" = 2, "Sg" = 2)),
                         checkboxGroupInput("g7", "", choices=c("Mn" = 2, "Tc" = 2, "Re" = 2, "Bh" = 2)),
                         checkboxGroupInput("g8", "", choices=c("Fe" = 2, "Ru" = 2, "Os" = 2, "Hs" = 2)),
                         checkboxGroupInput("g9", "", choices=c("Co" = 2, "Rh" = 2, "Ir" = 2, "Mt" = 2)),
                         checkboxGroupInput("g10", "", choices=c("Ni" = 2, "Pd" = 2, "Pt" = 2, "Ds" = 2)),
                         checkboxGroupInput("g11", "", choices=c("Cu" = 2, "Ag" = 2, "Au" = 2, "Rg" = 2)),
                         checkboxGroupInput("g12", "", choices=c("Zn" = 2, "Cd" = 2, "Hg" = 2, "Cn" = 2))
                       )
                ),

                column(2,
                       tags$div(HTML("<div style=\"width:10px;height:25px;\"></div>")),
                       splitLayout(

                         checkboxGroupInput("g13", "", choices=c("B" = 2, "Al" = 2, "Ga" = 2, "In" = 2, "Ti" = 2, "Nh" = 2)),
                         checkboxGroupInput("g14", "", choices=c("C" = 2, "Si" = 2, "Ge" = 2, "Sn" = 2, "Pb" = 2, "Fl" = 2)),
                         checkboxGroupInput("g15", "", choices=c("N" = 2, "P" = 2, "As" = 2, "Sb" = 2, "Bi" = 2, "Mc" = 2)),
                         checkboxGroupInput("g16", "", choices=c("O" = 2, "S" = 2, "Se" = 2, "Te" = 2, "Po" = 2, "Lv" = 2)),
                         checkboxGroupInput("g17", "", choices=c("F" = 2, "Cl" = 2, "Br" = 2, "I" = 2, "At" = 2, "Ts" = 2))

                       )
                       ),
                       column(1,checkboxGroupInput("g18", "", choices=c("He" = 2, "Ne" = 2, "Ar" = 2, "Kr" = 2, "Xe" = 2, "Rn" = 2, "Og" = 2))
                       )

              )
     )
         ),
       server = function(input, output) {

      }
     )
   }

输出是：

供您将来参考：使用this