Как создать матричную группу флажков с пробелами в некоторых ячейках в блестящем цвете?

Привет, я изменил последний код splitlayout.

Общий код:

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

      }
     )
   }

Результат:

Для ваших будущих ссылок: используйте это

Вот мой способ сделать это. Основная таблица Менделеева состоит из 7 строк и 18 столбцов. Исходя из этого, можно предположить, что периодическая таблица состоит из 7x18 = 126 ячеек, где каждая ячейка либо содержит элемент, либо пуста. Я назначаю ширину 5% (ширины экрана) каждой ячейке, которая для 18 столбцов будет покрывать 90% ширины экрана.

Каждый checkBox является независимым (без использования checkBoxGroupInput), а output$show_element_selections показывает, как вы можете определить элементы, выбранные пользователем. Поскольку символы элементов по определению уникальны, они могут напрямую использоваться как идентификаторы кнопок.

Вам нужно будет поместить все, кроме shinApp(), в global.R, если у вас есть пользовательский интерфейс в ui.R и сервер в 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))
    })
  }
)