I want to create an app that allows you to select one variable based on a condition.
So I have create a switchInput with conditions Yes, and No, and as you can see, a stratify SelectInput should appear in case Yes is marked.
However, no new SelectInput is displayed:
# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
# Data
library(readxl)
library(dplyr)
# Plots
library(ggplot2)
not_sel <- "Not Selected"
# User interface
ui <- navbarPage(
main_page <- tabPanel(
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
switchInput(
inputId = "Id013",
onLabel = "Yes",
offLabel = "No"
),
conditionalPanel(
condition = "Id013 == 'Yes'", selectInput("Stratify", "Stratify", choices = c(not_sel)), #uiOutput("factor"),
),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph")
)
)
)
)
)
)
# Server
server <- function(input, output){
# Dynamic selection of the data. We allow the user to input the data that they want
data_input <- reactive({
#req(input$xlsx_input)
#inFile <- input$xlsx_input
#read_excel(inFile$datapath, 1)
iris
})
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
I understand, based on the conditionalPanel function:
Creates a panel that is visible or not, depending on the value of a JavaScript expression. The JS expression is evaluated once at startup and whenever Shiny detects a relevant change in input/output.
That the change on the switchInput value should be enough to generate this changes in the UI interface.
As said in the docs of conditionalPanel():
For example, if you have an input with an id of foo, then you can use input.foo to read its value.
So you need to use input.Id013 instead of Id013 in the condition. Also, even if the labels of the switch are "Yes" or "No", it returns a value TRUE/FALSE (which are written "true" or "false" in Javascript). So the condition you need to use is:
condition = "input.Id013 == true"
Related
I would like to create a dynamic app that depending on an input pops out other inputs or not. In the code below I want to pop out the checkboxInput with label x when the selectInput with label mdl is "First model". When I run the app and select the First model from the list the other checkboxInput does not appear. I know the condition has to be in javascript but I don't know that language. However I think that one of the conditions is right. Any suggestions? i have tried both codes shown below.
library(shiny)
ui <- fluidPage(
selectInput(inputId = "mdl", label = "Model", choices = list("First model",
"Second model", "Third model"),
conditionalPanel(
condition = "input.mdl == 'First model'",
checkboxInput(inputId = "x", label = "Length")
)
),
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
library(shiny)
ui <- fluidPage(
selectInput(inputId = "mdl", label = "Model", choices = list("First model",
"Second model", "Third model"),
conditionalPanel(
condition = "input.mdl == First model",
checkboxInput(inputId = "x", label = "Length")
)
),
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
I am a novice programmer, please excuse if I am not clear or missing relevant information. I have a shiny app written that imports a dataframe from another set of code. I would like to update that dataframe with user input in the app. I have gotten this to work where I upload the dataframe as a reactive variable using the code below:
DATA
current.shiny <- data.frame("Task" = as.character(c("Task 1", "Task 2", "Task 3")), "Completed" = as.character(c("Yes", "NO", "Yes")),"Date.Completed" = as.Date(c("2020-10-19","2020-10-20", "2020-10-21")))
UI
ui<- fluidPage(
# Application title
titlePanel("Week of 11.02.2020"),
# Sidebar with reactive inputs
sidebarLayout(
sidebarPanel(
selectInput(inputId = "task.choice", label = "Task",
choices = c(as.list(current.shiny$Task))),
selectInput(inputId = "completed", label = "Completed?",
choices = c("Yes" = "Yes", "No" = "No")),
dateInput(inputId = "date.completed", label ="Date Completed"),
actionButton("update","Update Sheet")
),
# a table of reactive outputs
mainPanel(
mainPanel(
#DT::dataTableOutput("dt_table", width = 500)
)
)
),
# column(12,
# DT::dataTableOutput("data", width = "100%")),
column(12,
DT::dataTableOutput("xchange", width = "100%"))
)
SERVER 1
server <- function(input, output) {
# # Re-read data for any changes, write to csv new changes, ignore startup
observeEvent(input$update,{
test.data<-current.shiny
test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
ignoreInit=T
})
# #Reactive variable xchange that updates the values of data
xchange<-reactive({
test.data<-current.shiny
test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
test.data$Date.Completed[test.data$Task == input$task.choice]<-as.Date(input$date.completed)
test.data
})
#Display the most recent file, with the most recent changes
output$xchange <- renderDataTable({
datatable(xchange(), options = list(dom = "t"))
})
}
shinyApp(ui,server)
This works to a degree. However, it is over-reactive in that I need it to only update the table once a button is pressed. The observeEvent function in the above code doesn't seem to do anything (it was mostly copy/pasted from another stack overflow thread). I've tried to set this up below, but I cannot get it to run.
SERVER 2
server <- function(input, output, session) {
rxframe <- reactiveVal(
as.data.frame(current.shiny)
)
observeEvent(input$update, {
rxframe$Completed[rxframe$Task == input$task.choice]<-as.character(input$completed)
})
output$xchange <- shiny::renderTable( rxframe() )
}
shinyApp(ui, server)
Can anyone see some way that I am calling the observeEvent incorrectly that is causing it to not function properly? Any insight would be greatly appreciated, I've been stuck on this for some time.
Your code directly reacted to every change because you are using reactive.
If you want to delay the reaction you can use observeEvent along with reactiveValues or eventReactive.
Here is an example using reactiveVal and observeEvent:
library(shiny)
library(DT)
current.shiny <- data.frame(
"Task" = as.character(c("Task 1", "Task 2", "Task 3")),
"Completed" = as.character(c("Yes", "NO", "Yes")),
"Date.Completed" = as.Date(c("2020-10-19", "2020-10-20", "2020-10-21"))
)
ui <- fluidPage(
# Application title
titlePanel("Week of 11.02.2020"),
# Sidebar with reactive inputs
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "task.choice",
label = "Task",
choices = c(as.list(current.shiny$Task))
),
selectInput(
inputId = "completed",
label = "Completed?",
choices = c("Yes" = "Yes", "No" = "No")
),
dateInput(inputId = "date.completed", label = "Date Completed"),
actionButton("update", "Update Sheet")
),
mainPanel(column(
12,
DT::dataTableOutput("xchangeOut", width = "100%")
))
))
server <- function(input, output) {
xchange <- reactiveVal(current.shiny)
observeEvent(input$update, {
test.data <- xchange()
test.data$Completed[test.data$Task == input$task.choice] <-input$completed
test.data$Date.Completed[test.data$Task == input$task.choice] <- input$date.completed
xchange(test.data)
# write.csv
})
#Display the most recent file, with the most recent changes
output$xchangeOut <- renderDataTable({
datatable(xchange(), options = list(dom = "t"))
})
}
shinyApp(ui, server)
The purpose is to choose a county from a state. I first create a selectInput widget for choosing a state. Then I create a selectInput widget for choosing a county from the selected state. In an R Markdown, the code is as follows:
inputPanel(
selectInput(inputId = "State", label = "Choose a state:", choices = state.name),
selectInput(inputId = "County", label = "Choose a county:", choices = input.State)
)
I guess the use of input.State is problematic, but I don't have any other idea.
Thanks for your time!
There are a number of ways to create conditional/dynamic UI in Shiny (see here). The most straightforward is usually renderUI. See below for a possible solution for you. Note that this requires Shiny so if you’re using R Markdown make sure to specify runtime: shiny in the YAML header.
library(shiny)
# I don't have a list of all counties, so creating an example:
county.name = lapply(
1:length(state.name),
function(i) {
sprintf("%s-County-%i",state.abb[i],1:5)
}
)
names(county.name) = state.name
shinyApp(
# --- User Interface --- #
ui = fluidPage(
sidebarPanel(
selectInput(inputId = "state", label = "Choose a state:", choices = state.name),
uiOutput("county")
),
mainPanel(
textOutput("choice")
)
),
# --- Server logic --- #
server = function(input, output) {
output$county = renderUI({
req(input$state) # this makes sure Shiny waits until input$state has been supplied. Avoids nasty error messages
selectInput(
inputId = "county", label = "Choose a county:", choices = county.name[[input$state]] # condition on the state
)
})
output$choice = renderText({
req(input$state, input$county)
sprintf("You've chosen %s in %s",
input$county,
input$state)
})
}
)
Hope this helps!
I am trying to write a script in shiny, which has two inputs and stores the inputs in two different variables and runs a code using these input variables.But i am getting an error which says :Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
The following is my ui code:
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin",
label = "Origin:",
choices = milk_runs$Origin),
selectInput(inputId = "destination",
label = "Destination:",
choices = milk_runs$Dest),
actionButton("go", "")
),
mainPanel(
tableOutput(
"view"))
)
)
server code :
server<- function(input, output){
origin <- input$origin
destination <- input$destination
observeEvent(input$go,source("nr9.R"))
output$summary <- renderPrint({
#dataset <- datasetInput()
summary(Tnetwork)
})
Can you please tell me how to get correct results.
I think (it would help if you provided a fully reproducible example) that the error is occurring because you are trying to run input$origin without reactive(). The input$origin will not invalidate and update based on user input unless put inside reactive. Based on the example you provided:
library(shiny)
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin", label = "Origin:", choices = c("A","B","C","D","E","F")),
selectInput(inputId = "destination", label = "Destination:", choices = c("A","B","C","D","E","F")),
actionButton("go", "GO")
),
mainPanel( tableOutput( "view"))
)
)
server<- function(input, output){
origin <- reactive(input$origin)
destination<-reactive(input$destination)
observeEvent(input$go,{
cat(origin(),'nextword',destination(),sep="-")
})
output$view <- renderTable({data.frame(origin=origin(),destination=destination())})
}
shinyApp(ui, server)
should print 'origin-nextword-destination' to the console when 'go' is activated, and the table should update. I changed a few bits in your example because it was not reproducible but hopefully it helps.
I built a R Shiny application with multiple tabs, which have some filters in common. Right now, all filters are stand-alone and do not synchronize across multiple tabs. Hence, when I change selectInput1 from value "a" to value "b", I have to repeat this handling on the next tab which contains selectInput2 with the same options/meaning.
I thought about making the filters dynamic, hence rendering them using the server side of R Shiny. Then of course, I can always make selectInput2 equal to selectInput1. But what if the user changes selectInput2 rather than selectInput1? It creates kind of a loop in the logic.
I spent quite some time finding a solution for this problem, and somehow I'm sure I'm not the first one encountering this problem. Suggestions or useful links would be really helpful!
Example:
## UI.R
shinyUI(
dashboardPage("Dashboard",
# Create tabs
tabPanel("Start",
p("This is the frontpage")
),
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)
)
and:
## Server.R
library(shiny)
shinyServer(function(input, output,session){
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
})
I would personally use a single input control to control the different tab panels. One way is to include that single input under your tabs:
shinyApp(
fluidPage(
fluidRow(
tabsetPanel(
tabPanel("Tab1",
verbatimTextOutput("choice1")),
tabPanel("Tab2",
verbatimTextOutput("choice2"))
)
),
fluidRow(
selectInput("id1", "Pick something",
choices = c("a","b","c"),
selected = "a")
)
),
function(input, output, session){
output$choice1 <- renderPrint(input$id1)
output$choice2 <- renderPrint({
paste("The choice is:", input$id1)
})
}
)
Or, as you use a shinydashboard, you could actually add that control in the sidebar, possibly again in its own row under a set of tabs if you must.
I can't think of a reason to have multiple inputs who automatigically select the same thing. Other than slowing down your app, I can't see any gain. But if you insist, you make the selected choice a reactive value using reactiveVal and you use eg observeEvent() to update that reactive value. A small example using shinydashboard:
library(shinydashboard)
library(shiny)
ui <- shinyUI(
dashboardPage(title = "Dashboard",
dashboardHeader(),
dashboardSidebar(
tabsetPanel(
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)),
dashboardBody(
verbatimTextOutput("selected")
)
)
)
server <- shinyServer(function(input, output,session){
thechoice <- reactiveVal("a")
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
observeEvent(input$id2,{
thechoice(input$id2)
})
observeEvent(input$id1,{
thechoice(input$id1)
})
output$selected <- renderPrint({
c(input$id1, input$id2)
})
})
shinyApp(ui, server)