I created a table containing some HTML links using Shiny's renderDataTable. The links are not clickable, though, instead they render literally:
https://samizdat.shinyapps.io/zakazky/
Do you have any idea what could be wrong? It worked fine before upgrading Shiny to the version 0.11... Thanks!
I had the same problem. The escape = FALSE option for renderDataTable solved it, as you mentioned in the comments.
Here is complete code for an app with a table that has links.
If you are doing this, you will want each link to be unique based on a value in the table. I move this code into a function so its cleaner.
#app.R#
library(shiny)
createLink <- function(val) {
sprintf('Info',val)
}
ui <- fluidPage(
titlePanel("Table with Links!"),
sidebarLayout(
sidebarPanel(
h4("Click the link in the table to see
a google search for the car.")
),
mainPanel(
dataTableOutput('table1')
)
)
)
server <- function(input, output) {
output$table1 <- renderDataTable({
my_table <- cbind(rownames(mtcars), mtcars)
colnames(my_table)[1] <- 'car'
my_table$link <- createLink(my_table$car)
return(my_table)
}, escape = FALSE)
}
shinyApp(ui, server)
Related
In Shiny, one can use the following line to force displaying/refreshing an output even if not displayed within the ui:
outputOptions(output, "my_output", suspendWhenHidden = FALSE)
Is there a similar way to "force" input widget creation?
My context: I do have a button that pre-populate a textinput on another tab. Potentially, this textinput may not been generated yet if user didn't go to this specific tab. In such a case, the pre-population legitimely fails.
Good practice would probably be to use a reactiveValues, to feed it with the "pre-populate value" when clicking the button, and then to use this rv within the input widget creation. But I was wondering if a similar option as the above was available in Shiny.
Here’s a simple, working example of the situation I think you are describing.
That is, you don’t need to do anything special.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", textInput("b_text", "Add some B text"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
}
shinyApp(ui, server)
If the input you want to update is generated with uiOutput() then you can
use outputOptions() to force evaluation, like you already mentioned:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", uiOutput("b_panel"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
output$b_panel <- renderUI({
textInput("b_text", "Add some B text")
})
outputOptions(output, "b_panel", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
There are numerous posts regarding changing titles of other pieces of Shiny apps, e.g.:
Change the title by pressing a shiny button Shiny R
Shiny page title and image
Shiny App: How to dynamically change box title in server.R?
My question is related, but not answered by any of these. I would like to make the <head><title>...</title></head> tag reactive, or at least controllable from within an observeEvent in server.R.
The following does not work, since ui can't find theTitle, but is the kind of approach I'd hope is possible:
library(shiny)
ui <- fluidPage(
title = theTitle(),
textInput("pageTitle", "Enter text:")
)
server <- function(input, output, session) {
theTitle <- reactiveVal()
observeEvent( input$pageTitle, {
if(is.null(input$pageTitle)) {
theTitle("No title yet.")
} else {
theTitle(input$pageTitle)
}
})
}
I've tried making output$theTitle <- renderText({...}) with the if..else logic in that observeEvent, and then setting title = textOutput("theTitle") in ui's fluidPage, but that generates <div ...> as the title text, or <span ...> if we pass inline=True to renderText.
In case this clarifies what I'm looking for, the answer would make something equivalent to the literal (replacing string variables with that string) ui generated by
ui <- fluidPage(
title = "No title yet.",
....
)
before the user has entered any text in the box; if they have entered "Shiny is great!" into input$pageTitle's box, then we would get the literal
ui <- fluidPage(
title = "Shiny is great!",
....
)
One way would be to write some javascript to take care of that. For example
ui <- fluidPage(
title = "No title yet.",
textInput("pageTitle", "Enter text:"),
tags$script(HTML('Shiny.addCustomMessageHandler("changetitle", function(x) {document.title=x});'))
)
server <- function(input, output, session) {
observeEvent( input$pageTitle, {
title <- if(!is.null(input$pageTitle) && nchar(input$pageTitle)>0) {
input$pageTitle
} else {
"No title yet."
}
session$sendCustomMessage("changetitle", title)
})
}
shinyApp(ui, server)
This was created following the How to send messages from the browser to the server and back using Shiny guide
As of June 2021, there is an R package called shinytitle that can update the window title from within Shiny's reactive context: https://cran.r-project.org/package=shinytitle
I have a code that takes inputs using the readlines(prompt = ) function. Could you tell me which input function in Shiny will be adequate to adapt this code to a Shiny app?
I need an interactive function, I can't use a simple input with selectInput() because I have a lot of readlines(prompt = ) statements.
Something similar to this question:
Include interactive function in shiny to highlight "readlines" and "print"
Florian's answer is nice and easy to use, I would definitely recommend that! But in case you are keen on using prompts for inputs I am adding another solution, using javaScript:
This one shows a prompt when the user presses an actionButton and stores it in an input variable. (it doesn't necessarily have to be after a button press)
library(shiny)
ui <- fluidPage(
tags$head(tags$script("
$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'go') {
var text = prompt('Write me something nice:');
Shiny.onInputChange('mytext', text);
}
});"
)),
actionButton("go", "Click for prompt"),
textOutput("txt")
)
server <- function(input, output, session) {
output$txt <- renderText( {
input$mytext
})
}
shinyApp(ui, server)
Maybe you could use textArea for this purpose. Working example below, hope this helps!
library(shiny)
ui <- fluidPage(
tags$textarea(id="text", rows=4, cols=40),
htmlOutput('val')
)
server <- function(input,output)
{
output$val <- renderText({
text = gsub('\n','<br>',input$text)
text
})
}
shinyApp(ui,server)
I have taken a sample code of one of the Shiny Flexdashboard.
In the sample code there is a drop down menu to select one region at a time.
I just want to know is there a way to select all the values in the drop down menu?
Kindly find the code in below link,
beta.rstudioconnect.com/jjallaire/shiny-embedding
for code, click "Source Code" on the top extreme right.
Regards,
Mohan
You can do
library(shiny)
ui = fluidPage(
selectInput("sel", NULL, letters[1:2], multiple = T),
actionButton("but", "all")
)
server <- function(input, output, session) {
observeEvent(input$but, {
updateSelectInput(session, "sel", selected = letters[1:2])
})
}
shinyApp(ui, server)
Use ?updateSelectInput to access the documentation on that function.
I am writing some Shiny code where the user will enter some inputs to the app and then click a an action button. The action button triggers a bunch of simulations to run that take a long time so I want once the action button is clicked for it to be disabled so that the user can't keep clicking it until the simulations are run. I came across the shinyjs::enable and shinyjs::disable functions but have been having a hard time utilizing them. Here is my server code:
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
shinyjs::enable("Button1")}
})
However, when I use this code, and click the action button nothing happens. I.e., teh action button doesn't grey out nor does the table get generated. However, when I take away the shinyjs::enable() command, i.e.,
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
}
})
The table gets generated first, and then the button goes grey, however I would have expected the button to go grey and then the table to generate itself.
What am I doing wrong here?
Here is my updated code based on Geovany's suggestion yet it still doesn't work for me
Button1Ready <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
RunButton1Ready$ok <- FALSE
RunButton1Ready$ok <- TRUE
})
output$SumUI1= renderUI({
if(Button1Ready$ok){
tableOutput("table")
shinyjs::enable("Button1")
}
})
where for clarification I have also:
output$table <- renderTable({
#My code....
)}
I think that you are using shinyjs::disable and shinyjs::enable in the same reactive function. You will only see the last effect. I will recommend you to split in different reactive functions the disable/enable and use an extra reactive variable to control the reactivation of the button.
I don't know how exactly your code is, but in the code below the main idea is illustrated.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("Button1", "Run"),
shinyjs::hidden(p(id = "text1", "Processing..."))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plotReady <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
shinyjs::show("text1")
plotReady$ok <- FALSE
# do some cool and complex stuff
Sys.sleep(2)
plotReady$ok <- TRUE
})
output$plot <-renderPlot({
if (plotReady$ok) {
shinyjs::enable("Button1")
shinyjs::hide("text1")
hist(rnorm(100, 4, 1),breaks = 50)
}
})
}
shinyApp(ui, server)