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)
Related
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)
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 am building an app that presents a data table and which allows you to add data. The adding of data is build by means of a form. This form is written by a module. What I want to happen is that one may fill out the form, press an 'add' button and that the data inside the table is updated.
As an example, could you help me figure out how to complete the following piece of code:
library(shiny)
library(shinydashboard)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
# Do stuff here,
# -> let the parent module or server know that something has happened
})
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
# print the currently open tab
output$module.pressed <- renderPrint({
#-> Write that we have pressed the button of the module
})
callModule(module,"first")
}
shinyApp(ui = ui, server = server)
All I thus want to do is find an easy way to present TRUE in the output field module.pressed when something happend inside the module.
Thanks!
Modules can pass reactive expression(s) to calling apps/modules by returning them in their server function. The documentation provides a few examples on how to set up interactions between modules and calling apps - https://shiny.rstudio.com/articles/modules.html
If a module needs to use a reactive expression, take the reactive expression as a function parameter. If a module wants to return reactive expressions to the calling app, then return a list of reactive expressions from the function.
library(shiny)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
action1 <- reactive(input$action1)
return(reactive(input$action1))
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
action1 <- callModule(module,"first")
output$module.pressed <- renderPrint({
print(action1())
})
}
shinyApp(ui = ui, server = server)
I am new to shiny. When I made my project, I need to hide the dashboardHeader in server side.
In the shinydashboard website, I found the code dashboardHeader(disable = TRUE). I tried this, but it was not work.
However, I tried use shinyjs to solve the problem.
<code>
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(
extendShinyjs(text = 'shinyjs.hidehead = function(params) {
$("header").addClass("sidebar-collapse") }'),
),
dashboardSidebar(),
dashboardBody(
actionButton("button","hide_header",width = 4 )
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead()
})}
shinyApp(ui, server)</code>
I guess you already known, it still not worked.
Any ideas for my case?
Shinyjs is a great library. The problem with your code is that you need first to initialize shinyjs with shinyjs::useShinyjs() and put it inside the dashboarBody function. Also, to hide/show the header you don't need to add the class "sidebar-collapse" that is actually for the sidebar. You only need to add style="display:none" to hide the header, and remove it to show the header. Below is your code modified to hide/show the header. The JS code used is very simple and it receive the parameter to add directly from the js$hidehead() function.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
# initialize shinyjs
shinyjs::useShinyjs(),
# add custom JS code
extendShinyjs(text = "shinyjs.hidehead = function(parm){
$('header').css('display', parm);
}"),
actionButton("button","hide header"),
actionButton("button2","show header")
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead('none')
})
observeEvent(input$button2, {
js$hidehead('')
})
}
shinyApp(ui, server)
I'm trying to collapse a box programmatically when an input changes. It seems that I only need to add the class "collapsed-box" to the box, I tried to use the shinyjs function addClass, but I don't know how to do that becuase a box doesn't have an id. Here as simple basic code that can be used to test possible solutions:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(collapsible = TRUE,p("Test")),
actionButton("bt1", "Collapse")
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
# collapse the box
})
}
shinyApp(ui, server)
I've never tried using boxes before so keep in mind that my answer might be very narrow minded. But I took a quick look and it looks like simply setting the "collapsed-box" class on the box does not actually make the box collapse. So instead my next thought was to actually click the collapse button programatically.
As you said, there isn't an identifier associated with the box, so my solution was to add an id argument to box. I initially expected that to be the id of the box, but instead it looks like that id is given to an element inside the box. No problem - it just means that in order to select the collapse button, we need to take the id, look up the DOM tree to find the box element, and then look back down the DOM tree to find the button.
I hope everything I said makes sense. Even if it doesn't, this code should still work and will hopefully make things a little more clear :)
library(shiny)
library(shinydashboard)
library(shinyjs)
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = "collapse"),
actionButton("bt1", "Collapse box1"),
actionButton("bt2", "Collapse box2"),
br(), br(),
box(id = "box1", collapsible = TRUE, p("Box 1")),
box(id = "box2", collapsible = TRUE, p("Box 2"))
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
js$collapse("box1")
})
observeEvent(input$bt2, {
js$collapse("box2")
})
}
shinyApp(ui, server)