在数据框中，我有一个操作按钮，我希望它可以更改颜色，标签，还可以增加数据库中的“是”值，然后可以下载。
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
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, {
selectedRow <- as.character("yes")
updateSelectInput(session, inputId = "f_check", choices = c("All", selectedRow))
updateActionButton(session, inputId = "button_", label = "Yes")
})
这是完整的代码。
library(DT)
library(readODS)
library(dplyr)
library(shinydashboard)
library(shinyWidgets)
library(shiny)
library(shinyjs)
base <- read_ods("base.ods")
createLink <- function(val) {
sprintf('<a href= "%s" target="_blank" class="btn btn-primary">Fiches données</a>',val)
}
ui <- dashboardPage(
dashboardHeader(title ="MobiDiag"),
dashboardSidebar(
tags$head(tags$style(HTML('.logo {
background-color: #8eb06a !important;
}
.navbar {
background-color: #a7cd7f !important;
}'
))),
h4(strong("Critères de sélection"), align="center"),
prettyCheckboxGroup("territoire", "Territoire",
thick = TRUE,
shape = "curve",
animation = "pulse",
choices = c("Communes centrales" = "Communes.centrales", "Communes pôles urbain" = "Communes.poles.urbain", "Communes secondaires" = "Communes.secondaires", "Communes rurales" = "Communes.rurales", "Ensemble territoire" = "Ensemble.territoire", "Périmètre élargit" = "Perimetre.elargit")),
prettyCheckboxGroup("doc", "Documents de planification existants",
thick = TRUE,
shape = "curve",
animation = "pulse",
choices = c("Volet mobilité SCOT" = "Volet.mobilite.SCOT", "PDU obligatoire" = "PDU.obligatoire", "PGD volontaire" = "PGD.volontaire", "PLUI","Plan de mobilité rurale" = "Plan.mobilite.rurale", "PCAET", "PLUIHD")),
actionButton("submit", ("Extraction")),
),
dashboardBody(
fluidPage(
useShinyjs(),
inlineCSS(list(.green = "background: #A7CD7F")),
actionButton(inputId = "button_", label = "test"),
mainPanel(width = 12,
tabsetPanel(
tabPanel("Extraction",
fluidRow(
br(),
column(width=2,
selectInput("f_st",
"Sous-thèmes :",
"")
),
column(width=2,
selectInput("f_don",
"Données :",
"")
),
column(width=2,
selectInput("f_check",
"Validation :",
"")
),
column(width=2,
selectInput("f_doc",
"Documents de planification :",
"")
),
column(width=12, DT::dataTableOutput("Synthese"))
)
),
tabPanel("Statistiques",
fluidRow(
br(),
valueBoxOutput("mdbox", width = 2),
valueBoxOutput("tcbox", width = 2),
valueBoxOutput("atcbox", width = 2),
valueBoxOutput("crbox", width = 2),
valueBoxOutput("marchbox", width = 2),
valueBoxOutput("stabox", width = 2),
valueBoxOutput("peibox", width = 2),
valueBoxOutput("mmbox", width = 2),
valueBoxOutput("terbox", width = 2)
)
),
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"))
)
),
tabPanel("Aide",
fluidRow(br(),
"Documentation sur l'outil"
)
)
)
))))
server = function(input, output, session) {
output$mdbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Mode doux"),
"Modes doux",
icon = icon("bicycle"),
color = "olive"
)
})
output$tcbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Transports en commun"),
"Transports en commun",
icon = icon("bus"),
color = "orange"
)
})
output$atcbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Autres transports collectifs"),
"Autre transports collectifs",
icon = icon("bus"),
color = "maroon"
)
})
output$crbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Circulation routière"),
"Circulation routière",
icon = icon("car"),
color = "red"
)
})
output$marchbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Marchandise"),
"Marchandise",
icon = icon("dolly-flatbed"),
color = "yellow"
)
})
output$stabox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Stationnement"),
"Stationnement",
icon = icon("parking"),
color = "purple"
)
})
output$peibox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Pôles d'échanges et intermodalité"),
"Pôles d'échanges et intermodalité",
icon = icon("arrows-alt"),
color = "navy"
)
})
output$mmbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Management de la mobilité"),
"Management de la mobilité",
icon = icon("map-marked"),
color = "blue"
)
})
output$terbox <- renderValueBox({
valueBox(
sum(FinalData()$sous.themes == "Caractéristiques du territoire"),
"Caractéristiques du territoire",
icon = icon("globe"),
color = "light-blue"
)
})
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
df <- reactiveValues(data = data.frame(
validation = shinyInput(actionButton, 1,
id = "button_",
label = "Check",
onclick = 'Shiny.onInputChange(\"select_button\", this.id)',
stringsAsFactors = FALSE),
lien_fiches = createLink(base$fiches.donnees)[1]
))
create_rules <- reactive({
paste(c(input$territoire, input$doc), "== 'Oui'", collapse = " | ")
})
FinalData <- eventReactive(input$submit,{
if(is.null(c(input$territoire, input$doc)))
return()
else (base %>% filter_(create_rules()))
})
fdt <- eventReactive(input$submit,{
tmp_fdt <- cbind(FinalData()[1:2], df$data)
colnames(tmp_fdt) <- c("Sous-thèmes", "Données", "Validation", "Fiches données")
tmp_fdt
})
filter <- reactive({
filtered_data <- fdt()
if (input$f_st != "Tous" & input$f_don == "Tous"){
filtered_data <- filtered_data[FinalData()$sous.themes == input$f_st,]
}
if (input$f_don != "Tous" & input$f_st == "Tous"){
filtered_data <- filtered_data[FinalData()$donnees == input$f_don,]
}
if (input$f_st != "Tous" & input$f_don != "Tous"){
filtered_data <- filtered_data[FinalData()$sous.themes == input$f_st & FinalData()$donnees == input$f_don,]
}
return(filtered_data)
})
output$Synthese <- DT::renderDT(DT::datatable({
filter()
},
escape = FALSE,
selection = "none",
extensions="Buttons",
options = list(
pageLength = 10,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#1A242F', 'color': '#fff'});",
"}"),
dom="Bfrtip",
buttons = list(list(
extend = "collection",
filename = "Extraction",
buttons = c("copy", "csv", "excel", "pdf"),
text = "Télécharger la sélection")
),
language = list(paginate =
list('next'="suivant",
'previous'="précédent"),
info = "Pages de _PAGE_ à _PAGES_",
search = "Rechercher",
infoFiltered = "(filtre des _MAX_ lignes)")
)
))
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))
})
observeEvent(input$select_button, {
addCssClass(id = "button_", class = "green")
updateSelectInput(session, inputId = "f_check", choices = c("Tous", "Ok", "Check"))
})
}
shinyApp(UI, server)
在流畅的页面中，我制作了一个“测试”操作按钮以尝试addCssClass，它可以工作，但不能与数据框中的操作按钮一起使用。
谢谢