I want to change colour of the actionLink once it is clicked. I could not find any post which will achieve this.
What I found:
R Shiny toggle text of actionLink
shiny module: update color of button
But these were of no help. Here is the sample code from the answer from the first link (by #Julien Navarre)
library(shiny)
library(shinyjs)
shinyApp(
ui = shinyUI(
fluidPage(useShinyjs(),
actionLink("button", "Show additional"),
hidden(div(id='text_div', verbatimTextOutput("text")))
)
),
server = function(input, output, session){
observeEvent(input$button, {
toggle('text_div')
output$text <- renderText({"Additional"})
if (input$button %% 2 == 1) {
txt <- "Hide Additional"
} else {
txt <- "Show Additional"
}
updateActionButton(session, "button", label = txt)
})
}
)
In this code, once the label is changed, the colour of the label should also change. For example, Show Additional link should have a green colour, whereas Hide Additional should have red colour.
I tried updateactionLink with color argument but there is no such argument.
How can I achieve this?
One way would be to use css and addClass, removeClass from {shinyjs}:
library(shiny)
library(shinyjs)
shinyApp(
ui = shinyUI(
fluidPage(useShinyjs(),
tags$head(
tags$style(HTML("
a.action-button {
color: #00ff00;
}
a.action-button.red {
color: #ff0000;
}"))
),
actionLink("button", "Show additional"),
hidden(div(id='text_div', verbatimTextOutput("text")))
)
),
server = function(input, output, session){
observeEvent(input$button, {
if (input$button %% 2 == 1) {
txt <- "Hide Additional"
shinyjs::addClass("button", "red")
} else {
txt <- "Show Additional"
shinyjs::removeClass("button", "red")
}
toggle('text_div')
output$text <- renderText({"Additional"})
updateActionButton(session, "button", label = txt)
})
}
)
Related
let's say a generic code of validate function of shiny R :
## Only run examples in interactive R sessions
if (interactive()) {
ui <- fluidPage(
checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
selectizeInput('in2', 'Select a state', choices = state.name),
plotOutput('plot')
)
server <- function(input, output) {
output$plot <- renderPlot({
validate(
need(input$in1, 'Check at least one letter!'),
need(input$in2 != '', 'Please choose a state.')
)
plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', '))
})
}
shinyApp(ui, server)
}
Could you think it's possible to replace mesage error in character ('Check at least one letter!') by an image (png, jpeg format) ? I tried with renderImage function or , with the help of package imager, and don't manage to do it.
many thanks to you,
echoes
Thanks you for your quick answer, it could be a great solution for my shiny application, and it works !
in :
tags$style(HTML("
.shiny-output-error-validation {
background-image: URL(https://stackoverflow.design/assets/img/logos/so/logo-stackoverflow.svg);
background-repeat: no-repeat;
}
"))
It would be nice to display a random or personalized image, who depends on user action. shinipsum package offer a random_image function, which could be quoted, something as :
tags$style(HTML("
.shiny-output-error-validation {
background-image: plotOutput("random_image");
background-repeat: no-repeat;
}
"))
and in server part :
output$random_image <- renderImage({
random_image()
},deleteFile=FALSE)
Do you think it's possible to use output of ui part in tags$style or tagsList parts ?
many thanks, echoes
A random ggplot:
library(shiny)
library(shinipsum)
ui <- fluidPage(
checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
plotOutput('plot')
)
server <- function(input, output) {
output$plot <- renderPlot({
test <- need(input$in1, "")
if(!is.null(test)) {
random_ggplot()
} else {
plot(1:10, main = input$in1)
}
})
}
shinyApp(ui, server)
A random image:
library(shiny)
library(shinipsum)
library(imager)
ui <- fluidPage(
checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
plotOutput('plot')
)
server <- function(input, output) {
output$plot <- renderPlot({
test <- need(input$in1, "")
if(!is.null(test)) {
img <- load.image(random_image()$src)
plot(img)
} else {
plot(1:10, main = input$in1)
}
})
}
shinyApp(ui, server)
Ase they say in this tutorial you can add css style to validation messages. Just target with the selector .shiny-output-error-validation.
In this case I rendernder stackoverflow logo as background to the validation html element.
library(shiny)
ui <- fluidPage(
tags$head(
tags$style(HTML("
.shiny-output-error-validation {
background-image: URL(https://stackoverflow.design/assets/img/logos/so/logo-stackoverflow.svg);
background-repeat: no-repeat;
}
"))
),
checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
selectizeInput('in2', 'Select a state', choices = state.name),
plotOutput('plot')
)
server <- function(input, output) {
output$plot <- renderPlot({
validate(
need(input$in1, " ")
)
plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', '))
})
}
shinyApp(ui, server)
I manage to do something with css tags in two parts, part one here :
css_content1 <- "
.shiny-output-error-validation {
background-image:"
writeLines(text = css_content1, con = "styles1.css")
css1 <- readLines(con = "styles1.css") %>% paste(collapse = "\n")
part two :
css_content2 <- "
background-repeat: no-repeat;
}
"
writeLines(text = css_content2, con = "styles2.css")
css2 <- readLines(con = "styles2.css") %>% paste(collapse = "\n")
I modify server file as below, using renderUi function :
server <- function(input, output) {
output$plot <- renderPlot({
validate(
need(input$in1, " ")
)
plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', '))
})
output$css_style <- renderUI({
tags$head( tags$style(HTML(paste0(css1,"URL(test",sample(1:4,1),".png);",css2,collapse="\n"))
))
})
output$css_style_text <- renderText({
HTML(paste0(css1,"test",sample(1:4,1),".png",");",css2,collapse="\n"))
})
}
with test1.png, test2.png etc ... in a www directory.
I add in UI file part :
ui <- fluidPage(
uiOutput("css_style"),
checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
selectizeInput('in2', 'Select a state', choices = state.name),
plotOutput('plot')
)
I didn't manage to use a random_image function from shinipsum package.
thanks for your help
I have a web app that does some transformation and allows the user to control it, and then download the results. I want to update the label on the button so that the user knows the content that he will download.
Basically,
ui <- fluidPage(
checkboxInput("use_avg", "Use averages"),
actionButton("b1", "Download"),
)
server <- function(input, output, session) {
observeEvent(input$use_avg, {
if (input$use_avg == TRUE) {
updateActionButton(inputId = "b1", label = "Download averages")
} else {
updateActionButton(inputId = "b1", label = "Download")
}
})
}
Is there a way to do this with a downloadButton, or a way to use
actionButton with downloadHandler?
This option would work with either the downloadButton() or the actionButton(). In the ui side, I made a uiOutput(), which changes the button depending on the checkboxInput(). It isn't exactly changing the label, but rather creating a different button depending on the checkbox.
**Edited to show the use of toggleState() with this solution, disabling or enabling based on a checkbox as asked for in the comment.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
checkboxInput("use_avg", "Use averages"),
uiOutput("D1"),
checkboxInput("Disable", 'toggleState checkbox?', value = T)
)
server <- function(input, output, session) {
output$D1<-renderUI({
if (input$use_avg == TRUE) {
downloadButton(outputId = "b1", label = "Download averages")
} else {
downloadButton(outputId = "b1", label = "Download")
}
})
observeEvent(input$Disable, {
toggleState("b1")
})
}
shinyApp(ui, server)
There is no official way to do so, but here is a workaround:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
checkboxInput("use_avg", "Use averages"),
downloadButton("download", "Download")
)
server <- function(input, output, session) {
observeEvent(input$use_avg, {
if (input$use_avg == TRUE) return(runjs('$("#download")[0].childNodes[2].nodeValue = " Download averages"'))
runjs('$("#download")[0].childNodes[2].nodeValue = " Download"')
})
}
shinyApp(ui, server)
Goal:
In my app, the user is supposed to upload a .csv file. If a file other than .csv is uploaded, a warning message (showFeedbackWarning()) should appear around the the fileInput() widget. If the user corrects his input and uploads a .csv file, the message should disappear again (hideFeedback()).
All this already works in the app. But now I would like to change the colour of the progress bar in fileInput() to another colour for example red (like in this example). However, the warning message should still appear in its default colour orange.
Problem:
shinyFeedback overwrites my custom CSS and the colour of the progress bar is not changed. I can of course use !important, but then the colour of the bar in the warning message also turns red and I don't want this.
Do any of you know how to solve this problem?
Reprex:
library(shiny)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(),
fileInput(
inputId = "upload",
label = "Upload file:",
accept = ".csv"
),
tags$style(".progress-bar {
background-color: red;
}"),
verbatimTextOutput("text")
)
server <- function(input, output, session) {
data_in <- reactive({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
if (ext == "csv") {
hideFeedback("upload")
read.delim(
input$upload$datapath,
sep = ";"
)
} else {
showFeedbackWarning(
inputId = "upload"
)
}
})
output$text <- renderPrint({
class(data_in())
})
}
shinyApp(ui, server)
We can use shinyjs to change the color dynamically:
library(shiny)
library(shinyjs)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(),
useShinyjs(),
fileInput(
inputId = "upload",
label = "Upload file:",
accept = ".csv"
),
# tags$style(".progress-bar {
# background-color: blue;
# }"),
verbatimTextOutput("text")
)
server <- function(input, output, session) {
data_in <- reactive({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
if (ext == "csv") {
hideFeedback("upload")
runjs('document.querySelector("#upload_progress > div").style.setProperty("background-color", "green", "important");')
read.delim(
input$upload$datapath,
sep = ";"
)
} else {
showFeedbackWarning(
inputId = "upload",
color = "red"
)
}
})
output$text <- renderPrint({
class(data_in())
})
}
shinyApp(ui, server)
I was trying to add reactive elements to the bottom panel in dialog viewer. But it seems the css class "shiny-html-output" used by uiOutput is causing incorrect css styling of the page, pushing the tab buttons down below the window.
Here's a minimum example.
library(shiny)
library(miniUI)
testfun <- function() {
ui <- miniPage(
gadgetTitleBar("testgadget"),
miniTabstripPanel(
miniTabPanel("Data", icon = icon("table"),
miniContentPanel(
tags$p("Some data")
)
),
miniTabPanel("Visualize", icon = icon("area-chart"),
miniContentPanel(
tags$p("Some figure")
)
),
between = list(
uiOutput("sometext")
)
)
)
server <- function(input, output) {
output$sometext <- renderUI({
return("some text")
})
observeEvent(input$done, {
stopApp()
})
}
runGadget(ui, server, viewer = dialogViewer("test"))
}
Is there any workaround to this? Thanks!
The goal is to have a shiny module ui1.R activating the submit button only when something is typed in lsuId. The current code doesn't retrieve any errors, but it seems it never calls toggleState.
ui.R
library(shiny)
library(shinyjs)
htmlOutput("page")
server.R
rm(list = ls())
library(shiny)
library(dplyr)
library(shinyjs)
Logged <- FALSE
shinyServer(function(input, output) {
observeEvent(input$"ui1Output-confirm", {
Logged <<- T
})
observe({
input$"ui1Output-confirm"
if (Logged == FALSE) {
output$page <- renderUI({
ui1Output('ui1Output')
})
output$lsuId <- renderText({ input$lsuId })
}
if (Logged == TRUE)
{
output$page <- renderUI({ ui2 })
}
})
callModule(ui1,'ui1')
})
ui1.R
library(shinyjs)
ui1Output <- function(id, label = "ui1") {
ns <- NS(id)
shinyUI(fluidPage(
useShinyjs(),
titlePanel("Form"),
div(textInput(ns("lsuId"), "This has to be filled", ""),
actionButton(ns("confirm"), "Submit", class = "btn-primary")
)
))
}
ui1 <- function(input, output, session) {
shinyjs::toggleState(id = "confirm", condition = F)
observeEvent(input$lsuId!="", {
shinyjs::toggleState(id = "confirm", condition = T)
})
}
ui2.R
ui2<- shinyUI(fluidPage(
div("well done!")
))
global.R
source('ui1.R') #login page
source('ui2.R')
Here's how I would approach this one:
ui.R
library(shiny)
shinyUI(
fluidPage(
fluidRow(column(width = 12,
align = 'center',
h1('Conditional Submit Button'))),
fluidRow(column(width = 12,
align = 'center',
textInput(inputId = 'text.field',
label = 'What is your greatest fear?',
value = ''),
uiOutput('submit.button')))
)
)
server.R
library(shiny)
shinyServer(
function(input, output) {
output$submit.button <-
renderUI(expr = if (nchar(input$text.field)) {
submitButton()
} else {
NULL
})
}
)
This approach doesn't use shinyjs, which I think is a positive (fewer dependencies), but I don't know if there's some reason you are interested in doing it with shinyjs that isn't stated in your question.
Here, ui.R simply has a textInput UI element with inputId 'text.field' and a promise that another UI element will be rendered in server.R called 'submit.button'.
In server.R, output$submit.button is set to NULL if the number of characters in input$text.field is 0, and set to submitButton() otherwise.
observe({
if (is.null(input$lsuId) || input$lsuId == "") {
shinyjs::disable("submit")
} else {
shinyjs::enable("submit")
}
})