Связать изображение и внешний вид с помощью actionButton

Question

Я немного застрял в своей программе на R. Я создал 2 столбца с помощью действия Button.

Первый должен разрешить мне проверить строку, нажав на кнопку.Проблема в том, что я не могу изменить внешний вид кнопки.

Второй должен показать мне PDF, нажав на него.Файлы хранятся в папке www там же, где и сценарий R, а имя файла хранится в столбце моего базового файла, который я вызываю в самом начале.Но оно показывает мне окно «Не найдено».

Мои 2 столбца хранятся в реактивном значении:

df <- reactiveValues(data = data.frame(
      validation = shinyInput(actionButton, 1, 
                              id = "button_", 
                              label = "Check", 
                              style = "color: white; background-color: #222D32",
                              onclick = 'Shiny.onInputChange(\"select_button\",  this.id)')
    ))

Для столбца «проверка» я создаю Наблюдение за событием, чтобы изменить внешний вид

observeEvent(input$select_button, {
      updateActionButton(session, inputId = "button_",label = "OK", style = "color: white; background-color: #a2db99")
    })

Для столбца "lien_fiches" я создаю функцию для отображения pdf-файла в папке www

createLink <- function(val) {
  sprintf('<a href="" target="_blank" class="btn btn-primary">Fiches données</a>',val)
}

И называю имя файла в столбце "fiches.donnees"с моей базы

df <- reactiveValues(data = data.frame(
      lien_fiches = createLink("fiches.donnees")
    ))

Вот весь мой код:

library(DT)
library(readODS)
library(dplyr)
library(shinydashboard)
library(shinyWidgets)

#Lecture du fichier
base <- read_ods("base.ods")

createLink <- function(val) {
  sprintf('<a href="www/" target="_blank" class="btn btn-primary">Fiches données</a>',val)
}

  ui <- dashboardPage(
    dashboardHeader(title =""),

    #Mise de en forme de la Sidebar
    dashboardSidebar(

      #Couleurs de l'entête
      tags$head(tags$style(HTML('.logo {
                                background-color: #8eb06a !important;
                                }
                                .navbar {
                                background-color: #a7cd7f !important;
                                }
                                '))),

      #Texte principal
      h4(strong("Critères de sélection"), align="center"),

      #Liste des critères de sélection
      prettyCheckboxGroup("territoire", "Territoire",
                          thick = TRUE, 
                          shape = "curve", 
                          animation = "pulse", 
                          choices = c("Communes.centrales", "Communes.poles.urbain", "Communes.secondaires", "Communes.rurales", "Ensemble.territoire", "Perimetre.elargit")),
      prettyCheckboxGroup("doc", "Documents de planification existants",
                          thick = TRUE, 
                          shape = "curve", 
                          animation = "pulse",
                          choices = c("Volet.mobilite.SCOT", "PDU.obligatoire", "PGD.volontaire", "PLUI", "Plan.mobilite.rurale", "PCAET", "PLUIHD")),

      #Et le miracle fut !
      actionButton("submit", ("Extraction"))
    ),

      #Mise en forme de la page principale
      dashboardBody(
        fluidPage(


          #Onglets Extraction et Ajout de données
          mainPanel(width = 12,
            tabsetPanel(

              #Onglet Extraction
              tabPanel("Extraction",
                fluidRow(
                  br(),
                  #Liste des différents filtres possibles sur le résultat
                  column(width=3,
                         selectInput("f_st",
                                     "Sous-thèmes :",
                                     "")
                  ),
                  column(width=3,
                         selectInput("f_don",
                                     "Données :",
                                     "")
                  ),
                  column(width=3,
                         selectInput("f_check",
                                     "Validation :",
                                     "")
                  ),
                  column(width=3,
                         selectInput("f_doc",
                                     "Documents de planification :",
                                     "")
                  ),
                  column(width=12, DT::dataTableOutput("Synthese"))

                )
              ),

            #Onglet Ajout de données (on utilise pas pour le moment)
            tabPanel("Ajout de données",
              fluidRow(
                br(),
                selectInput("sous.themes.insert","Sous-Thèmes :", c("", unique(as.character(base$sous.themes)))),
                textInput("donnees.insert","Données :"),

                actionButton("insert", ("Ajout"))
              )
            ),

            #Onglet Aide (on utilise pas pour le moment)
            tabPanel("Aide",
                     fluidRow(br(),
                              "Documentation sur l'outil"
                     )
            )
      )
  ))))

  server = function(input, output, session) {

    #Definition de la commande shinyInput pour le bouton
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }

    #Création de la colonne bouton
    df <- reactiveValues(data = data.frame(
      validation = shinyInput(actionButton, 1, 
                              id = "button_", 
                              label = "Check", 
                              style = "color: white; background-color: #222D32",
                              onclick = 'Shiny.onInputChange(\"select_button\",  this.id)'),
      lien_fiches = createLink("fiches.donnees")
    ))

    #Création de la règle de filtre a partir des critères
    create_rules <- reactive({
      paste(c(input$territoire, input$doc), "== 'Oui'",  collapse = " | ")
    })

    #Méthode pour le click
    FinalData <- eventReactive(input$submit,{
      if(is.null(c(input$territoire, input$doc)))
        return()
      else (base %>% filter_(create_rules()))
    })

    #Rendu de la table d'extraction
    output$Synthese <-  DT::renderDT(DT::datatable({

      #Assemblage de l'extraction et de la colonne boutton
      fdt <- cbind(FinalData()[1:2], df$data)

      #Validation des filtres du tableau
      if (input$f_st != "Tous") {
        fdt <- fdt[fdt$sous.themes == input$f_st,]
      } else fdt$sous.themes

      if (input$f_don != "Tous") {
        fdt <- fdt[fdt$donnees == input$f_don,]
      } else fdt$donnees

      if (input$f_doc != "Tous") {
        fdt <- fdt[input$doc == input$f_doc,]
      } else input$doc

      #Renomme les colonnes
      colnames(fdt) <- c("Sous-thèmes", "Données", "Validation", "Fiches données")

      #Affiche le tableau
      fdt

        },

        #Argument sans quoi la colonne bouton n'apparait pas !!!!
        escape = FALSE,

        extensions="Buttons",
         options = list(

           #Couleur du header de l'extraction
          initComplete = JS(
            "function(settings, json) {",
            "$(this.api().table().header()).css({'background-color': '#1A242F', 'color': '#fff'});",
            "}"),

          #Paramètrage des boutons d'export
          dom="Bfrtip",
          buttons =  list(list(
            extend = "collection",
            filename = "Extraction",
            buttons = c("copy", "csv", "excel", "pdf"),
            text = "Télécharger la sélection")
            ))
        ))


    #Mise à jour des filtres du tableau
    observe({
      updateSelectInput(session, inputId = "f_st", choices = c("Tous", FinalData()$sous.themes))
      updateSelectInput(session, inputId = "f_don", choices = c("Tous", FinalData()$donnees))
      updateSelectInput(session, inputId = "f_doc", choices = c("Tous", input$doc))
    })

    #Evenement lié au click bouton
    observeEvent(input$select_button, {
      selectedRow <- as.character("Oui")
      updateSelectInput(session, inputId = "f_check", choices = c("Tous", selectedRow))
      updateActionButton(session, inputId = "button_",label = "OK", style = "color: white; background-color: #a2db99")
    })

}

shinyApp(ui, server)

Есть идеи?

Большое спасибо!