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

这是我到目前为止的代码：

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))
         )
      )
    )
)

但它导致这样的事情：

解决方法:

这是我的方式.主周期表有7行18列.基于此,可以假设周期表由7×18 = 126个单元组成,其中每个单元包含元素或者是空白的.我为每个单元格分配了5％(屏幕宽度)宽度,18列将覆盖90％的屏幕宽度.

每个checkBox都是独立的(不使用checkBoxGroupInput),输出$show_element_selections显示如何确定用户选择的元素.由于元素符号按定义是唯一的,因此它们可以直接作为按钮ID服务.

你需要将shinApp()中的所有内容放在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))
    })
  }
)