在Shiny中，如何添加图标checkboxgroup输入以根据选择创建datatable，其中列名称上包含图标而不是文本？_R_Shiny_Shinydashboard

在Shiny中，如何添加图标checkboxgroup输入以根据选择创建datatable，其中列名称上包含图标而不是文本？

r shiny

在Shiny中，如何添加图标checkboxgroup输入以根据选择创建datatable，其中列名称上包含图标而不是文本？,r,shiny,shinydashboard,R,Shiny,Shinydashboard,我已经创建了这个应用程序，其中包含在列名上带有图标或徽标的datatable。每一步都是可以单独完成的，但问题在于如何完全执行它们。如果无法将图像添加到复选框中，但必须将图像添加到数据表中，则我可以这里的问题是，我无法合并它们以获得结果带有徽标的复选框“如果可能，则不包含文本”，以控制列数，其中列名上也仅包含徽标 library(shiny) library(DT) library(shinythemes) library(shinydashboard) brands <- c("ki

我已经创建了这个应用程序，其中包含在列名上带有图标或徽标的datatable。每一步都是可以单独完成的，但问题在于如何完全执行它们。如果无法将图像添加到复选框中，但必须将图像添加到数据表中，则我可以

这里的问题是，我无法合并它们以获得结果带有徽标的复选框“如果可能，则不包含文本”，以控制列数，其中列名上也仅包含徽标

library(shiny)
library(DT)
library(shinythemes)
library(shinydashboard)
brands <- c("kia", "opel", "bmw")
logos <- c( "https://www.logospng.com/images/88/royal-azure-blue-kia-icon-free-car-logo-88484.png",
        "https://i.wheelsage.org/pictures/opel/autowp.ru_opel_logo_1.jpg",
        "https://cdn.iconscout.com/icon/free/png-256/bmw-4-202746.png")
ui <- fluidPage(theme=shinytheme("yeti"),
                dashboardPage(
                  dashboardHeader(title = "title", titleWidth = 230), 
                  dashboardSidebar(),
                  dashboardBody(fluidRow(
                    checkboxGroupInput("brands", "Brands",
                                       choiceNames = mapply(brands, logos, FUN = function(brand,logoUrl) {tagList(tags$img(src=logoUrl, width=20))}, 
                                                            SIMPLIFY = FALSE, USE.NAMES = FALSE),
                                       choiceValues = brands, 
                                       inline = TRUE,
                                       #All values i.e. brands will be initially/pre selected. 
                                       #With brands[1] the first value in brands will be pre selected. 
                                       #selected = brands             
                                       ),
                    DT::dataTableOutput("myTable")))))
server <- function(input, output, session) {

  logoList = data.frame(
    name = c("opel", "kia", "bmw"),
    logo = c(
      "<img height='50' title= 'opel'     src='https://i.wheelsage.org/pictures/opel/autowp.ru_opel_logo_1.jpg'></img>",
      "<img height='50' src='https://www.logospng.com/images/88/royal-azure-    blue-kia-icon-free-car-logo-88484.png'></img>",
      "<img height='50' src='https://cdn.iconscout.com/icon/free/png-256/bmw-    4-202746.png'></img>" ),
    stringsAsFactors = FALSE)
  myData = reactiveVal( {
    logo_name_match <- merge(
      x = data.frame(
        row_id = 1:length(colnames(testmatrixnew)),
        cols = colnames(testmatrixnew), 
        stringsAsFactors = FALSE), 
      y = logoList, 
      by.x = "cols", 
      by.y = "name", 
      all.x = TRUE)
    logo_name_match <- logo_name_match[with(logo_name_match, order(row_id)),]
    new_colnames <- ifelse(!is.na(logo_name_match$logo),logo_name_match$logo, logo_name_match$cols)
    colnames(testmatrixnew) <- new_colnames
    testmatrixnew})
  observe(print(myData()))  #To see what we're working with
  output$myTable = renderDataTable({
    req(input$brands) #Show the Table only after one box at least is checked 
    myData = myData()
    #browser()
    #DT::datatable(myData, escape = FALSE)
    col_names = grep(paste(input$brands,collapse = '|'), names(myData), value = TRUE)
    DT::datatable(myData[, c('brand', col_names), drop = FALSE], options = list(pageLength = 15, lengthChange = FALSE,dom = 't'), escape = FALSE)
    })}

shinyApp(ui, server)

以下是每个步骤的图像这里是

库（闪亮）
库（数据表）
ui这里有一个选项，使用grep
将input$brands
与myData列名匹配
library(shiny)
library(DT)
library(shinythemes)
library(shinydashboard)
brands <- c("kia", "opel", "bmw")
logos <- c( "https://www.logospng.com/images/88/royal-azure-blue-kia-icon-free-car-logo-88484.png",
        "https://i.wheelsage.org/pictures/opel/autowp.ru_opel_logo_1.jpg",
        "https://cdn.iconscout.com/icon/free/png-256/bmw-4-202746.png")
ui <- fluidPage(theme=shinytheme("yeti"),
                dashboardPage(
                  dashboardHeader(title = "title", titleWidth = 230), 
                  dashboardSidebar(),
                  dashboardBody(fluidRow(
                    checkboxGroupInput("brands", "Brands",
                                       choiceNames = mapply(brands, logos, FUN = function(brand,logoUrl) {tagList(tags$img(src=logoUrl, width=20))}, 
                                                            SIMPLIFY = FALSE, USE.NAMES = FALSE),
                                       choiceValues = brands, 
                                       inline = TRUE,
                                       #All values i.e. brands will be initially/pre selected. 
                                       #With brands[1] the first value in brands will be pre selected. 
                                       #selected = brands             
                                       ),
                    DT::dataTableOutput("myTable")))))
server <- function(input, output, session) {

  logoList = data.frame(
    name = c("opel", "kia", "bmw"),
    logo = c(
      "<img height='50' title= 'opel'     src='https://i.wheelsage.org/pictures/opel/autowp.ru_opel_logo_1.jpg'></img>",
      "<img height='50' src='https://www.logospng.com/images/88/royal-azure-    blue-kia-icon-free-car-logo-88484.png'></img>",
      "<img height='50' src='https://cdn.iconscout.com/icon/free/png-256/bmw-    4-202746.png'></img>" ),
    stringsAsFactors = FALSE)
  myData = reactiveVal( {
    logo_name_match <- merge(
      x = data.frame(
        row_id = 1:length(colnames(testmatrixnew)),
        cols = colnames(testmatrixnew), 
        stringsAsFactors = FALSE), 
      y = logoList, 
      by.x = "cols", 
      by.y = "name", 
      all.x = TRUE)
    logo_name_match <- logo_name_match[with(logo_name_match, order(row_id)),]
    new_colnames <- ifelse(!is.na(logo_name_match$logo),logo_name_match$logo, logo_name_match$cols)
    colnames(testmatrixnew) <- new_colnames
    testmatrixnew})
  observe(print(myData()))  #To see what we're working with
  output$myTable = renderDataTable({
    req(input$brands) #Show the Table only after one box at least is checked 
    myData = myData()
    #browser()
    #DT::datatable(myData, escape = FALSE)
    col_names = grep(paste(input$brands,collapse = '|'), names(myData), value = TRUE)
    DT::datatable(myData[, c('brand', col_names), drop = FALSE], options = list(pageLength = 15, lengthChange = FALSE,dom = 't'), escape = FALSE)
    })}

shinyApp(ui, server)

库（闪亮）
图书馆（DT）
图书馆（shinythemes）
图书馆（shinydashboard）
第一个代码段没有UI。第二个返回checkboxGroupInput中的错误（“显示变量”、“拾取”、名称（testmatrixnew），：找不到对象“testmatrixnew”
。Google drive抱歉，您请求的文件不存在。
亲爱的@A.Suliman感谢您的支持，updatedDear@A.Suliman，在本例中，我们通过复选框控制列的外观，如果我们转置了表并需要通过复选框控制行，该怎么办所需的修改，尝试了几种方法但没有成功请查看我的更新“用旧的更改输出$myTable”。此外，我在ui中修复了一个我昨天忘记的结束括号。一切都像一个符咒，我非常感谢任何帮助：）亲爱的@a.Suliman，我说不出话来。谢谢你的努力
#Using dput
testmatrixnew <- structure(list(brand = c("generation_x", "generation_y", "generation_z"
), kia = c(80, 94, 37), vw = c(59, 4, 66), mit = c(56, 1, 72), 
bmw = c(64, 7, 37), audi = c(98, 47, 2), lw = c(91, 99, 32
), lada = c(92, 34, 19), RR = c(55, 68, 88), opel = c(67, 
81, 49), LBGN = c(85, 69, 83), Jeep = c(56, 97, 43)), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))

output$myTable = renderDataTable({
    req(input$brands) #Show the Table only after one box at least is checked 
    myData = myData()
    #browser()
    #DT::datatable(myData, escape = FALSE)
    #Transpose myData to myData_trans
    #Here is simple example you can run R console using testmatrixnew
    #t_testm <- data.frame(cbind(colnames(testmatrixnew)[-1], t(testmatrixnew[,-1])), row.names = NULL)
    #names(t_testm) <- c('brand','generation_x','generation_y','generation_z')
    myData_trans <- data.frame(cbind(colnames(myData)[-1], t(myData[,-1])), row.names = NULL)
    names(myData_trans) <- c('brand','generation_x','generation_y','generation_z')
    #Match input$brands with column brand
    rw_names <- grep(paste(input$brands,collapse = '|'), myData_trans$brand)
    DT::datatable(myData_trans[rw_names, , drop = FALSE], options = list(pageLength = 15, lengthChange = FALSE,dom = 't'), escape = FALSE)
  })