I am trying to allow the user to type the value in the selectizeInput to find what they are searching from a long list (thus avoiding the scrolling action). When the user deletes the default value "None" (in this example), they are kicked out of the input box where they have to go back and type what they are seeking. Is there a way to avoid this so the user can backspace "None" to delete it and search for a value without being pushed out of the box?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectizeInput("heir1","Heirarchy1",c("NONE",letters),selected="NONE"),
selectizeInput("heir2","Heirarchy2",c("NONE",letters),selected="NONE"),
selectizeInput("heir3","Heirarchy3",c("NONE",letters),selected="NONE")
)
)
server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c(letters)
observe({
hei1<-input$heir1
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectizeInput(session,"heir1",choices=choice1,selected=hei1)
updateSelectizeInput(session,"heir2",choices=choice2,selected=hei2)
updateSelectizeInput(session,"heir3",choices=choice3,selected=hei3)
})
}
shinyApp(ui, server)
You can use any of the Selectize JS plugins via the options argument to selectizeInput().
Note only the first input is updated.
Here is the code:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectizeInput("heir1","Heirarchy1",c("NONE",letters),selected="NONE",
# use this syntax to bring in selectize.js plugins :)
options = list(plugins = list('restore_on_backspace'))),
selectizeInput("heir2","Heirarchy2",c("NONE",letters),selected="NONE"),
selectizeInput("heir3","Heirarchy3",c("NONE",letters),selected="NONE")
)
)
server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c(letters)
observe({
hei1<-isolate(input$heir1) # don't allow re-evaluation as users type
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectizeInput(session,"heir1",choices=choice1,selected=hei1)
updateSelectizeInput(session,"heir2",choices=choice2,selected=hei2)
updateSelectizeInput(session,"heir3",choices=choice3,selected=hei3)
})
}
shinyApp(ui, server)
Note that isolate() is necessary to prevent updateSelectizeeInput() from being re-called and messing everything up as your users type.
EDIT:
Sorry mate, misread your desired behavior when I answered. I think you will get what you want if you remove the options =, but keep the isolate().
selectizeInput("heir1","Heirarchy1",c("NONE",letters),selected="NONE")
It is the updateSelectizeInput() without isolate() that is causing the cursor to leave the input field and requiring your users to re-click after a deletion.
Let me know if that's not what you were describing. Cheers!
Related
In order to make an app where panels are created dynamically, I would like to remove, hide and/or update panels from the package shinyWidgets.
I didn't find any function to do so nor way to add IDs to these panel.
If you have the solution or a way around, I would be more than happy. Thank you in advance !
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
panel(
heading = "Test panel",
actionButton("remove_panel", "Remove this panel")
)
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
print("remove panel")
})
}
shinyApp(ui = ui, server = server)
There is no official method you can use to change the panel states, but we can do it with custom expressions.
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
panel(
heading = "Test panel1",
id = "test_panel1",
actionButton("remove_panel", "Remove this panel")
),
panel(
heading = "Test panel2",
id = "test_panel2",
"some content"
),
actionButton("hide_panel", "Hide this panel")
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
removeUI('.panel:has([id="test_panel1"])', immediate = TRUE)
})
observeEvent(input$hide_panel,{
toggle(selector = '.panel:has([id="test_panel2"])')
if(input$hide_panel %% 2 == 1) return(updateActionButton(inputId = "hide_panel", label = "Show this panel"))
updateActionButton(inputId = "hide_panel", label = "Hide this panel")
})
}
shinyApp(ui = ui, server = server)
To remove:
add an ID argument to your panel, and use removeUI to remove it. Remember to change the ID in you own case.
To hide/show:
We can use toggle from shinyjs to show or hide some elements we choose.
Use updateActionButton to also change it text when hidden.
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)
I have been trying to make a login for a single tabPanel in Shiny. I have used the shinyAlert method, (as described here: How to access Shiny tab ids for use with shinyalerts?) which works, but unfortunately, it shows parts of the tabPanel's content before the user is logged in.
Is there a way to change this? I am trying to figure out how to make the "backdrop" of the shinyAlert just a white page until the user is successfully logged in. I read that this might be possible with CSS, but it is unclear to me how.
Or is there another method to do this, that I haven't considered? I am pretty new to Shiny.
Edit: the relevant parts of the code.
ui <- fluidPage(navbarPage("Eksempel", theme = shinytheme("cerulean"),
tabPanel("Home", icon = icon("home"),
fluidRow(
box(
Title = "Welcome to the example layout",
width = 10,
solidHeader = TRUE,
"Welcome text")
)),
tabPanel("Prototype", icon = ("chart-line"),
fluidPage(tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets"))),
# other tabPanels
server <- function(input, output, session){
output$secrets <- renderUI({
req(input$user == "admin", input$password == "shiny")
fluidPage( #contents of tabPanel, containing different plots ect.
)
})
The contents of the fluidPage I am trying to hide works fine when I don't try to hide it.
You can use req in combination with a renderUI and uiOutput to hide stuff until someone authenticates.
library(shiny)
ui <- fluidPage(
tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets")
)
)
server <- function(input, output) {
output$secrets <- renderUI({
req(input$user == "admin", input$password == "stackoverflow")
wellPanel("Hello admin! These are the secrets!")
})
}
shinyApp(ui = ui, server = server)
If you want a more enterprise-ready approach, you can try ShinyProxy or Shiny-Server Pro.
I have a server generated sidebar. After its creation, I want to hide its first element. The observer doing the hiding is executed, however, the menuitem is not hidden. I am trying to figure out, why it does not work. Any thoughts?
PS. The CSS selector appears to be correct, as all works when the UI is not created on the server.
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
uiOutput("sidebar_ui")
),
dashboardBody(
shinyjs::useShinyjs()
)
)
server <- function(session, input, output)
{
rv <- reactiveValues()
output$sidebar_ui <- renderUI({
rv$trigger_sidebar_config <- 0
cat("\nSidebar create")
sidebarMenu(id = "sidebar",
menuItem("Menu1", tabName = "tab_menu_1"), # to be hidden
menuItem("Menu2", tabName = "tab_menu_2") )
})
observeEvent(rv$trigger_sidebar_config, {
cat("\nSidebar config")
shinyjs::hide(selector = '[data-value="tab_menu_1"]') # hide menuitem
})
}
shinyApp(ui, server)
Your observeEvent is executed too early because the reactive value trigger_sidebar_config is updated during the same cycle as renderUI. Accordingly shiny tries to hide an UI element which isn't existing yet (you would have to wait for the UI beeing rendered, instead of it's calculation beeing triggered, for this to work).
You can test this e.g. via delaying the execution of shinyjs::hide - it works when triggered by an actionButton (Please see my below example) or you have a look at the reactlog:
Here you can see, that the observeEvent triggered via trigger_sidebar_config finished calculating after 3ms but the sidebar wasn't ready at this time (30ms).
If you want the tab to be hidden on startup you can use hidden() in your renderUI call (see Menu3):
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
uiOutput("sidebar_ui")
),
dashboardBody(
shinyjs::useShinyjs(),
actionButton("hide", "hide tab")
)
)
server <- function(session, input, output)
{
rv <- reactiveValues()
output$sidebar_ui <- renderUI({
rv$trigger_sidebar_config <- 0
cat("\nSidebar create")
sidebarMenu(id = "sidebar",
menuItem("Menu1", tabName = "tab_menu_1"), # to be hidden
menuItem("Menu2", tabName = "tab_menu_2"),
shinyjs::hidden(menuItem("Menu3", tabName = "tab_menu_3")))
})
observeEvent(input$hide, {
cat("\nSidebar config")
shinyjs::hide(selector = '[data-value="tab_menu_1"]') # hide menuitem
})
}
shinyApp(ui, server)
In this context please also see ?renderMenu().
My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!