I use the package shinyjs to allow the user to reload the page by clicking on "Reload the page" button in Tab 2 and I would like to stay on Tab 2 after reloading the page. But after realoading, the page is taking to Tab1 instead of Tab2
How can we fix it ? This is my code below :
library(shiny)
library(shinyjs)
jscode <- "shinyjs.refresh = function() { history.go(0); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "refresh"),
tabsetPanel(
tabPanel("Tab 1"),
tabPanel("Tab 2", actionButton("mybutton", "Reload the page",
onclick ="javascript:window.location.reload(true)")))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Some help would be appreciated
You can resort to plain JavaScript. The idea is that you provide an id to tabsetPanel such that you can use updateTabsetPanel in the server.
All you have to do then is to let the reloaded page know that you want to start on the second tab. As a refresh typically resets all of the inputs and reactives (you are aware of that, right?), you cannot use reactives and you have to rely on another way of communication. The query string would be one possibility.
With these ingredients you can:
Write a simple JavaScript function that reloads the page and adds a parameter to the url.
Parse the query string in the server and if the parameter is found, react on it accordingly.
library(shiny)
js <- HTML("
function doReload(tab_index) {
let loc = window.location;
let params = new URLSearchParams(loc.search);
params.set('tab_index', tab_index);
loc.replace(loc.origin + loc.pathname + '?' + params.toString());
}")
ui <- fluidPage(
tags$head(tags$script(js, type ="text/javascript")),
tabsetPanel(
tabPanel("Tab 1", value = "tab1"),
tabPanel("Tab 2", value = "tab2",
actionButton("mybutton", "Reload the page",
onclick = "doReload('tab2')")),
id = "tabsets"
)
)
server <- function(input, output, session) {
observe({
params <- parseQueryString(session$clientData$url_search)
if ("tab_index" %in% names(params)) {
updateTabsetPanel(session, "tabsets", selected = params$tab_index)
}
})
}
shinyApp(ui = ui, server = server)
Related
I am trying to build a simple To do list app using Shiny, the application is very simple, there's a textInput where I put things I want to do, and submit it, and it creates a checkbox. What I want to achieve is, if I check the box, there will be a text on the right side that says: "you have done XXX", the XXX is the information of the checkbox.
So far, I have managed to figure out how to insert a checkbox back into the UI however, I have problems in: writing the party of the code that once the checkbox is checked, generate a text which says " you have done XXX"
The two main difficulties is : 1. listen to the inserted UI (each checkbox needs a special id, but I can't write logic in the server components that has indeterministic checkbox id. Also, I can figure out a way to extract the content of the checkbox from the server side, the input$checkbox only gives me true or false value.
This is the code I am working on so far, I am wondering if this functionality is achievable using Shiny-R?
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxInput("checkbox","Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
inserted <- c()
observeEvent(input$todoBnt, {
insertUI(
selector = "#start",
where = "afterEnd",
ui = checkboxInput("chekcbox",input$todo)
)
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({ input$checkbox }) ##this gives "TRUE" value, I don't think it's right.
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)
I have tried to search answer online, but I think the checkbox in Shiny-R is mainly used to filter graphs etc... So I am not sure if the function I want is actually achievable using the langague. Please help!
Instead of inserting each checkbox separately one option would be to switch to a checkboxGroupInput which you could update in your observeEvent. Doing so makes it easy to get a list of things you have done. However, doing so requires to track the things to do for which I use a reactiveVal choices which gets updated each time a new item is added to the to-do list:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxGroupInput("checkbox", label = "", choices = "Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
choices <- reactiveVal("Submit One Job Application")
inserted <- c()
observeEvent(input$todoBnt, {
selected <- input$checkbox
choices(c(choices(), input$todo))
updateCheckboxGroupInput(inputId = "checkbox", choices = choices(), selected = selected)
updateTextInput(inputId = "todo", value = "")
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({
paste(input$checkbox, collapse = "\n")
})
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)
I'd like to make a shiny app that pulls a value from the url, but doesn't need to have an input element to work. E.g. I know I could do:
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "Text", ""),
textOutput("outtext")
),
server = function(input, output, session) {
output$outtext <- renderText(input$text)
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['text']])) {
updateTextInput(session, "text", value = query[['text']])
}
})
}
)
and that would pull from the app's url after /?text=abc, but what I'd really like is to be able to print the value from the url without having a textInput box. Is this possible?
Yes; render the query parameter directly:
library(shiny)
shinyApp(
ui = fluidPage(
textOutput("outtext")
),
server = function(input, output, session) {
output$outtext <- renderText(getQueryString()[["text"]])
}
)
I want to insert a fixed hyperlink in a shiny::info pop up
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- (
fluidPage(
useShinyjs(),
div(
id = "main_page",
fluidRow( # -------------------------------------------------------
infoBox(title=NULL, icon=shiny::icon(""), subtitle = HTML("<a id=\"infobutton\"
href=\"#\" class=\"action-button\"><i class=\"fa fa-info-circle\"></i></a>"))
)
)
)
)
server <- (
function(input, output, session) {
observeEvent(input$infobutton, {
shinyjs::info("It's me Mario")
})
}
)
shinyApp(ui = ui, server = server)
I've tried with a TagList but the pop up just display what's inside the tagList
shinyjs::info(tagList("It' me Mario:", a("Mario", href="https://en.wikipedia.org/wiki/Mario")))
Thanks !
You cannot (or should not) be able to insert HTML into there. It only supports plain text.
shinyjs::info() is running the javascript alert() function - here's the official documentation for it.
Notice the message parameter is:
A string you want to display in the alert dialog, or, alternatively, an object that is converted into a string and displayed.
It's not meant to accept HTML. I'm honestly very surprised that it's able to parse HTML within RStudio, browsers are supposed to only show plain text. If you want to show a pop up message with HTML you need to use something more advanced like shinyalert package or shiny modals.
You can directly generate the needed HTML with HTML:
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- (
fluidPage(
useShinyjs(),
div(
id = "main_page",
fluidRow( # -------------------------------------------------------
infoBox(title=NULL, icon=shiny::icon(""), subtitle = HTML("<a id=\"infobutton\"
href=\"#\" class=\"action-button\"><i class=\"fa fa-info-circle\"></i></a>"))
)
)
)
)
server <- (
function(input, output, session) {
observeEvent(input$infobutton, {
shinyjs::info(HTML("<p>It's me Mario:</p> <a href='https://en.wikipedia.org/wiki/Mario'>Mario</a>"))
})
}
)
shinyApp(ui = ui, server = server)
It is possible to use a tabPanel id into a link ? I speak of id like #tab-6584-1 or #tab-6985-1 that shows when your cursor is over a tab in a Shiny app running in a browser :
Image of dynamic tabPanel() id example with Firefox
I would like to use this to put a top left link in a Shiny app to redirect on app "home" page.
From your question, I'm not sure, but it seems like you want to mimic navigation to "subpages" in your app. If that's the case, there's a way of doing that in Shiny by reading and writing the value of the hash string at the end of the app's URL (link to gist):
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
tags$a("Go to Panel 1", href = "#panel1"), br(),
tags$a("Go to Panel 2", href = "#panel2"), br(),
tags$a("Go to Panel 3", href = "#panel3")
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Panel 1", h1("Panel 1"), value = "#panel1"),
tabPanel("Panel 2", h1("Panel 2"), value = "#panel2"),
tabPanel("Panel 3", h1("Panel 3"), value = "#panel3")
)
)
)
)
server <- function(input, output, session) {
# When we change from one `tabPanel` to another, update the URL hash
observeEvent(input$tabs, {
# No work to be done if input$tabs and the hash are already the same
if (getUrlHash() == input$tabs) return()
# The 'push' argument is necessary so that the hash change event occurs and
# so that the other observer is triggered.
updateQueryString(
paste0(getQueryString(), input$tabs),
"push"
)
# Don't run the first time so as to not generate a circular dependency
# between the two observers
}, ignoreInit = TRUE)
# When the hash changes (due to clicking on the link in the sidebar or switching
# between the `tabPanel`s), switch tabs and update an input. Note that clicking
# another `tabPanel` already switches tabs.
observeEvent(getUrlHash(), {
hash <- getUrlHash()
# No work to be done if input$tabs and the hash are already the same
if (hash == input$tabs) return()
valid <- c("#panel1", "#panel2", "#panel3")
if (hash %in% valid) {
updateTabsetPanel(session, "tabs", hash)
}
})
}
shinyApp(ui, server)
I am building a shiny app which has a lot of conditional panel. I have a back button in the app itself to navigate between the conditional panel. I would like to disable the web browsers back button as clicking that button goes to previous webpage(away from my app). Is there a way to do this?
You can write some javascript to do this. Here I have two examples, note that I only tested this on Chrome
Example 1 will return a message upon activation of the back button within the browser
rm(list = ls())
library(shiny)
jscode <- 'window.onbeforeunload = function() { return "Please use the button on the webpage"; };'
ui <- basicPage(
mainPanel(tags$head(tags$script(jscode)))
)
server <- function(input, output,session) {}
runApp(list(ui = ui, server = server))
Example 2 will disable navigation altogether. Personally I don't like this method as people might be annoyed that your site doesn't offer standard navigation functionalities
rm(list = ls())
library(shiny)
jscode2 <- "history.pushState(null, null, document.title);
window.addEventListener('popstate', function () {
history.pushState(null, null, document.title);});"
ui <- basicPage(
mainPanel(tags$head(tags$script(jscode2)))
)
server <- function(input, output,session) {}
runApp(list(ui = ui, server = server))