Reuse input in Rshiny app - r

i'd like to reuse an input field in a tabbed shiny app. my code is below.
library(shiny)
ui <- navbarPage("Iris data browser",
tabPanel("Panel 1",
selectInput("species", "Species",
unique(iris$Species)),
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1),
tableOutput("table1")),
tabPanel("Panel 2",
selectInput("species", "Species",
unique(iris$Species)),
tableOutput("table2")))
server <- function(input, output) {
output$table1 <- renderTable({
iris[iris$Species == input$species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)
i'd like to use the same selectInput() on both panels. the expected result is that when i change the input value in "Panel 1" it will take on the same value in "Panel 2" and vice versa. of course, the filtering should also be applied to the tables on both panels. additionally, the input for species is shared on both panels, but the slider for sepal length should only appear on panel 1. therefore, sidebarLayout() is no solution.
thanks!

Here is a solution that uses 2 selectInputs but links them so that they have the same choices selected. Explanation of changes is below the code:
library(shiny)
ui <- navbarPage("Iris data browser",
tabPanel("Panel 1",
selectInput("species1", "Species", choices=unique(iris$Species)),
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1),
tableOutput("table1")),
tabPanel("Panel 2",
selectInput("species2", "Species", choices=unique(iris$Species) ),
uiOutput("select2"),
tableOutput("table2")))
server <- function(session, input, output) {
Selected<-reactiveValues(Species=NULL)
observeEvent(input$species1, Selected$Species<-(input$species1))
observeEvent(input$species2, Selected$Species<-(input$species2))
observeEvent(Selected$Species, updateSelectInput(session, "species1", selected=Selected$Species))
observeEvent(Selected$Species, updateSelectInput(session, "species2", selected=Selected$Species))
output$table1 <- renderTable({
iris[iris$Species == Selected$Species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == Selected$Species ,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)
1) In the ui I changed the inputIds to "species1" and "species2"
2) I added the session parameter to your server function.
3) I created a reactiveValues object called Selected with an element called Species to store the currently selected species, it starts out as NULL.
4) The first two observeEvents will fire when the user chooses a species and stores that choice in Selected$Species. It does not matter which selector is used and will always have the value selected last.
5) The next two observeEvents update the two selectInputs to have the the selected choice be Selected$Species so that when you change the value in one tab it will change in the other automatically. You need to use the session argument here which is why I added it earlier.
6) I changed the tables to filter based on Selected$Species
There are a few advantages of this system. It would be easy to add more tabs with more selecteInputs and just add new observeEvent statements for them. If you have a bunch of these it might be worth you while to look into shiny modules.
Here, the tables just use Selected$Species but if you wanted to you could add more logic and they could sometimes update and sometimes not if that made sense for your app. That allows you to produce complicated behavior -for example if some values don't make sense for one of your displays you could catch that ahead of time and alert the user or display something else.

Not ideal, but this is what I meant in the comments:
library(shiny)
ui <- navbarPage("Iris data browser",
position = "fixed-top",
tabPanel("SideMenu",
sidebarPanel(
#push it down 70px to avoid going under navbar
tags$style(type="text/css", "body {padding-top: 70px;}"),
selectInput("species", "Species",
unique(iris$Species)),
conditionalPanel("input.myTabs == 'Panel 2'",
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1))
)
),
mainPanel(
tabsetPanel(id = "myTabs",
tabPanel("Panel 1",
tableOutput("table1")),
tabPanel("Panel 2",
tableOutput("table2"))
)
)
)
server <- function(input, output) {
output$table1 <- renderTable({
iris[iris$Species == input$species,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)

Related

MathJax output dependent on reactive SelectInput choices

I am having trouble getting Rshiny to do what I want.
I would like the user to select an input from the SelectInput choices and based on that input I would like some Text output that is mathematical notation.
I have tried to implement this with withMathJax(), but I cannot seem to get the code right.
Here is some toy code illustrating what I have already:
######################################
ui <-navbarPage(title = "test",
helpText("Here we select which parameters we want to include in our model"),
selectInput("torchp",
label = h4("Torching Parameters"),
choices = list("One parameter",
"Two parameters" ),
selected = 1),
mainPanel(
textOutput("torchvalue")
)
)
server <- function(input, output) {
withMathJax()
torchp_input <- reactive({
switch(input$torchp,
"One parameter" = '$$q$$',
"Two parameters" = '$$q_m, q_f$$'
)
})
output$torchvalue <- renderText({
paste("You have selected", torchp_input())
})
}
shinyApp(ui = ui, server = server)
###################################
The output I get does not recognise my mathematical notation.
Thanks.
Discovered an answer thanks to help in the comments by #Limey.
The issue was which rendering function I used.
In this instance you should use uiOutput and renderUI as follows:
In the UI put:
uiOutput("torchvalue")
In the server use:
output$torchvalue <- renderUI({ p( withMathJax("you have selected", torchp_input())) })

Removing UI drop-down element dynamically in R Shiny

Probably very basic question - but can't translate similar posts I've found to my exact issue.
Within an R Shiny app, I have a first drop-down menu that is populated by a vector produced on the server - this allows me to make one set of choices.
I want to have a tick box that then introduces a second drop down - but I want that drop down to disappear if I un-tick the tick box.
I've had a go - see MWE below - the graph is just there to keep to the structure of my original code (obviously I'm aware my drop-downs do nothing but that's not the case in the original but wanted the MWE to be as 'M' as possible).
If I remove the removeUI() line then ticking the tick-box does create a new drop down as required - but then un-ticking the tick box fails to remove it.
I'm obviously missing something; any help much appreciated as I totally suck at R Shiny but really want to get better!
library(shiny)
library(shinyMobile)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
htmlOutput("reactive_drop_down") #second drop down
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
library(ggplot2)
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
observeEvent(input$initial_choice, {
# trying to add second drop down based on action in switch - not convinced my use of observeEvent is quite right - issue likely sits in here.
observeEvent(input$switch, {
if(input$switch == T){
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
}else{
removeUI(selector ="#reactive_drop_down")
}
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Could you use conditionalPanel? Put your htmlOutput for your second input there in your ui. I would avoid using nested observeEvent and output.
library(shiny)
library(shinyMobile)
library(ggplot2)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
conditionalPanel(
condition = "input.switch==1",
htmlOutput("reactive_drop_down") #second drop down
)
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
}
# Run the application
shinyApp(ui = ui, server = server)

navigating to specific tab from external link shiny

I'm trying to give access to a specific view of my shiny dashboard to an external application. Basically, I want to give them a url link with a filter parameter so that when they click on the link, my shiny dashboard opens up on the specific view with the filters applied. I came across some other posts regarding the same on SO
Externally link to specific tabPanel in Shiny App
I tried using the code to figure out the solution, but haven't been able to. This is what I currently have, what I'd like to have is something like
http://127.0.0.1:7687/?url=%22Plot%202%22&species=%22setosa%22
This should open up the Plot 2 tab of the dashboard and apply the relevant filters. Any help on this would be great. Thanks!
library(shiny)
library(DT)
# Define UI for application that draws a histogram
ui <- navbarPage(title = "Navigate", id = 'nav',
# Application title
tabPanel("Plot",
plotOutput("distPlot")
),
tabPanel("Plot 2",
selectInput("species", "Select Species", choices = c("setosa", "virginica"),
multiple = T, selected = NULL),
dataTableOutput("tbl1")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
query <- parseQueryString(session$clientData$url_search)
if(!is.null(query$url)) {
url <- strsplit(query$url,"/")[[1]]
updateTabsetPanel(session, 'nav', url)
}
})
output$distPlot <- renderPlot({
hist(rnorm(100), col = 'darkgray', border = 'white')
})
output$tbl1 <- renderDataTable({
tmp <- iris
if(!is.null(input$species))
tmp <- iris[which(iris$Species %in% input$species), ]
datatable(tmp)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your observe should be the following:
observe({
query <- parseQueryString(session$clientData$url_search)
if(!is.null(query$url)) {
url <- strsplit(query$url,"\"")[[1]][2]
species <- strsplit(query$species, "\"")[[1]][2]
updateTabsetPanel(session, 'nav', url)
updateSelectInput(session, 'species',selected = species)
}
})

Unchecked boxes using checkboxGroupInput in Shiny

EDIT: My original question asked about checkboxInput(), but I've updated to checkboxGroupInput() to better reflect my problem...
I am trying to get my Shiny app to do one of two things based on the (un)checked status of a checkboxGroupInput.
When the boxes are checked, I can get my code to work. However, I can't figure out how to make unchecking all boxes lead to a unique result.
How do I do this?
This google groups question asked this 4+ years ago, but the response then was that this is simply a bug. I'm assuming this has been addressed since??
Below is a reproducible example.
- In this example, unchecking the box leads to an error reading "Error in if: argument is of length zero."
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId = "test.check", label = "", choices = "Uncheck For 2", selected = "Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(input$test.check == "Uncheck For 2") {
1
} else {
2
}
})
}
shinyApp(ui = ui, server = server)
Is there perhaps an "if.unchecked" type of function I can use?
I've tried is.null after the else statement with the same result as the above example....
Here's code that works:
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId="test.check", label="", choices="Uncheck For 2", selected="Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(!is.null(input$test.check)) {
1
} else{
2
}
})
}
shinyApp(ui = ui, server = server)

Multiple reactiveValues In a Shiny App

I use reactiveValues in Shiny a lot as they are more flexible than just the input and output objects. Nested reactiveValues are tricky since any changes in any of the children also triggers the reactivity linked to the parents. To get around this, I tried to make two different reactiveValues objects ( not two objects in the same list, but two different lists altogether ) and it seems to be working. I'm not able to find any example of this and want to find out if it's suppose to work this way. Are there any issues that might arise because of this?
In this app, there are two reactive values objects - reac1 and reac2. Each of them are linked to a drop down, column1 and column2 respectively. Changing column1 or column2 updates the reactive values with the latest time, updates the plot, and prints the latest values in reac1 and reac2.
ui = fluidPage(
titlePanel("Multiple reactive values"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "column1", "Reac1", letters, selected = "a"),
selectInput(inputId = "column2", "Reac2", letters, selected = "a")
),
mainPanel(
plotOutput("plot1")
)
)
)
server = function(input, output, session) {
reac1 <- reactiveValues(asdasd = 0)
reac2 <- reactiveValues(qweqwe = 0)
# If any inputs are changed, set the redraw parameter to FALSE
observe({
input$column2
reac2$qweqwe = Sys.time()
})
observe({
input$column1
reac1$asdasd = Sys.time()
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$plot1 <- renderPlot({
print(paste(reac1$asdasd, 'reac1'))
print(paste(reac2$qweqwe, 'reac2'))
hist(runif(1000))
})
}
shinyApp(ui, server)
ReactiveValues are like a read/write version of input$, and you can have several 'independent' variables inside one reactiveValue list. So, you do not need two reactive values in your example. See code below.
ui = fluidPage(
titlePanel("Multiple reactive values"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "column1", "Reac1", letters, selected = "a"),
selectInput(inputId = "column2", "Reac2", letters, selected = "a")
),
mainPanel(
verbatimTextOutput("txt1"),
verbatimTextOutput("txt2")
)
)
)
server = function(input, output, session) {
reac <- reactiveValues()
#reac2 <- reactiveValues(qweqwe = 0)
# If any inputs are changed, set the redraw parameter to FALSE
observe({
reac$asdasd = input$column1
})
observe({
reac$qweqwe = input$column2
})
# Only triggered when the copies of the inputs in reac are updated
# by the code above
output$txt1 <- renderPrint({
print('output 1')
print(paste(reac$asdasd, 'reac1'))
})
output$txt2 <- renderPrint({
print('output2')
print(paste(reac$qweqwe, 'reac2'))
})
}
shinyApp(ui, server)

Resources