Вот мой способ сделать это.Основная периодическая таблица имеет 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))
})
}
)
