I'm building a shiny app in which a query from textInput is made when the user clicks on the "search" action button. I'd like that button to be disabled if the textInput box is empty. I'm using shinyjs::toggleState() here, but I can't figure out what logic it needs to apply to see that the text box is empty. In my reproducible file below, the logic I put in place is is.null(input$query). I've also tried with is.na(input$query), length(input$query) == 0, and input$query == '', all without success What should I put there instead?
Here's the app.r file:
library(shiny)
library(shinyjs)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
useShinyjs(),
textInput(inputId = "query", label = "Enter query:", value = ""),
actionButton(inputId = "search", label = "Search", icon = icon("search"))
),
mainPanel()
)
)
server <- function(input, output) {
observe({
toggleState("search", !is.null(input$query))
})
}
shinyApp(ui = ui, server = server)
Something like this do?
observe({
if(is.null(input$query) || input$query == ""){
disable("search")
}
else{
enable("search")
}
})
As per #Sagar you can also do:
observe({
toggleState("search", input$query != "" | is.null(input$query))
})
or
observeEvent(input$query,{
toggleState("search", input$query != "" | is.null(input$query))
})
Related
I'm trying to add an external link to the tab panel title in a shiny navbar. The link itself works fine, but it moves the tab with the link into a separate row.
How can I include a link and maintain the placement of the tab in the same row as any other tabs that don't contain links?
Here is my minimalistic code:
library(shiny)
ui <- navbarPage(
title = "",
id = "navbar",
header = "",
tabsetPanel(id="tabs",
tabPanel(
title = "Tab1", value = "tab1"
),
tabPanel(
title = a("Tab2",
href = "https://www.google.com/"),
value = "tab2"
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have tried using the HTML function to see if that for some reason gives a different result, but as expected it didn't:
tabPanel(
title = HTML("<a href = 'https://www.google.com/'>tab2</a>"),
value = "tab2"
)
I would really appreciate your advice!
If you also happen to have any idea on how to remove the title row from the navbarPage, that would also be much appreciated.
If you look at the HTML for your tabs, you can see that the tabs themselves already have a <a href ...> tag. So what you're doing is adding another one below the existing one.
A work-around is to do something like
Observe when Tab2 is pressed
Navigate to the URL
library(shiny)
ui <- navbarPage(
title = "",
id = "navbar",
header = "",
tabsetPanel(
id = "tabs",
tabPanel(title = "Tab1"),
tabPanel(title = "Tab2")
)
)
server <- function(input, output, session) {
observeEvent(input$tabs, {
print(input$tabs)
if( input$tabs == "Tab2" ) {
browseURL("https://www.google.com/")
}
})
}
shinyApp(ui, server)
One way to do this, is to use a javascript function to do the linking for us. Then we do not need to include <a href> inside the tab which is already a link!.
We can easily set up a Js function with {shinyjs} and extendShinyjs(). Then we call it in an observeEvent() when the tab is clicked.
library(shiny)
library(shinyjs)
ui <- navbarPage(
# use shinyjs
useShinyjs(),
# write JS function to open window
shinyjs::extendShinyjs(text = "shinyjs.myfun = function() { window.open('https://www.google.com/', '_self'); }",
functions = c("myfun")),
title = "",
id = "navbar",
header = "",
tabsetPanel(id="tabs",
tabPanel(
title = "Tab1", value = "tab1"
),
tabPanel(
title = "Tab2",
value = "tab2"
)
)
)
server <- function(input, output, session) {
# use observeEvent to check if user clicks tab no 2
observeEvent(input$tabs,
{
if (input$tabs == "tab2") {
shinyjs::js$myfun()
}
})
}
shinyApp(ui, server)
Below I press the first actionButton() "Show" to display another actionButton() but I would like also a second actionButton() named "Hide" that will hide the actionButton() that is displayed after clicking the "Show".
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
uiOutput("button2")
)
)
))
server = shinyServer(function(input, output, session) {
observeEvent(input$button1, {
output$button2 <- renderUI({
actionButton("button2", label = "Press Button 2")
})
})
})
shinyApp(ui = ui, server = server)
One option is to put the second button inside a conditionalPanel and set a toggle to display/hide the panel. See working code below.
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
conditionalPanel(condition = "output.display",
actionButton("button2", label = "Press Button 2"))
)
)
))
server = shinyServer(function(input, output, session) {
r <- reactiveValues(
toggle = NULL
)
observeEvent(input$button1, {
r$toggle = 1
})
observeEvent(input$button1b, {
r$toggle = 0
})
output$display <- reactive({
r$toggle
})
outputOptions(output, "display", suspendWhenHidden = FALSE)
})
shinyApp(ui = ui, server = server)
Another option is to dynamically insert and remove UI elements. But that option requires creation/destruction of UI elements every time the buttons are clicked. See example here
I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)
writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)
At the moment the app ends when the user clicks on a button Q. I would like this app to end when the user clicks Quit on the navbar. Unfortunately I can't figure out how to do this. Will be thankful for any help!
EDIT:
It would be great to know how to shift Quit tab to the right :)
ui <- shinyUI(navbarPage(title = "Test",
tabPanel(title = "Content",
actionButton(inputId = "quit", label = "Quit")
),
tabPanel(title = "Quit", icon = icon("circle-o-notch"))
)
)
server <- shinyServer(function(input,output) {
observe({
if (input$quit == 1) stopApp()
})
})
shinyApp(ui, server)
The solution for your problem is to create an id for the navbar, with that, you can call observer like you did but changing the input. The only problem is to identificate that you need to create a new id for the navbarPage.
shinyApp(
ui = navbarPage(title = "Test", id="navbar",
tabPanel(title = "Content"),
tabPanel(title = "Quit", value="stop", icon = icon("circle-o-notch"))
), #Close UI
server = function(input,output,session) {
observe({
if (input$navbar == "stop")
stopApp()
})
} #Close server
) #Close shinyApp