I am learning R and shiny and have been trying to play around with some of the code from the shiny package documentation here. I have been trying to figure out why the conditional I have added is not responding to my condition.
What am I doing wrong as I do not get an error?
ui <- fluidPage(
uiOutput("ex")
)
server <- function(input, output) {
output$ex <- renderUI({
tagList(
selectInput("n","Please Select :",
choices = c("N","U","T")),
conditionalPanel(condition = "n"=="N",
textInput("inmean"," Mean:",0.25),
textInput("invsd","Sd", 0.02)),
conditionalPanel(condition = "n"== "U",
textInput("inmean","Mean:",0.25),
textInput("insd","Sd", 0.02))
)
})
}
shinyApp(ui, server)
Personally I wouldn't do it this way. I would use an observe({}) statement looking at the input of "n" and use updateTextInput() to change the value.
But this seems to work with the method you're using:
ui <- fluidPage(
selectInput("n","Please Select :",
choices = c("N","U","T")),
uiOutput('ex')
)
server <- function(input, output) {
output$ex <- renderUI({
if(input$n == 'N'){
tagList(
textInput("inmean"," Mean:",0.25),
textInput("invsd","Sd", 0.02)
)
}else if(input$n == 'U'){
tagList(
textInput("inmean","Mean:",0.2),
textInput("insd","Sd", 0.01)
)
}
})
}
shinyApp(ui, server)
Related
I have a small Shiny app to randomize speaker's list using insertUI (in case there is be more of them).
The problem is that I only got it working using textInput and I fail to get it done without the input box - just to display the text without the box.
It's more of an aesthetics thing but after many hours of unsuccessful trials I'm reaching out for help here.
I really appreciate your help.
Herunia
Here is the code:
if (interactive()) {
ui <- fluidPage(
actionButton("add", "Next speaker")
)
# Server logic
server <- function(input, output, session) {
a <- sample(c("Speaker 1","Speaker 2","Speaker 3","Speaker 4","Speaker 5"))
uiCount = reactiveVal(0)
observeEvent(input$add, {
uiCount(uiCount()+1)
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(paste0("txt", input$add), paste0("Speaker #", uiCount() , ": "),
placeholder = a[uiCount()] ),
)
})
}
shinyApp(ui, server)
}
Is this closer to what you want?
ui <- fluidPage(
actionButton("add", "Next speaker"),
uiOutput("txt")
)
server <- function(input, output, session) {
a <- sample(c("Speaker 1","Speaker 2","Speaker 3","Speaker 4","Speaker 5"))
uiCount = reactiveVal(0)
observeEvent(input$add, {
uiCount(uiCount()+1)
output$txt <- renderUI({
div(
p(
paste0("Speaker #", uiCount(), " :", a[uiCount()])
) #close p
) #close div
})
})
}
shinyApp(ui, server)
I'm trying to write a shiny app where I produce a list and add and delete some elements.
I have a module to add somethind to my list.
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- list()
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})
}
Then I call it twice and connect the 2 different inputs. Now I want to choose the elements to delete but this doesn't work.
source('/cloud/project/Queue/find_input.R')
library(shiny)
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- eventReactive(input$combine, {
return(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended <<- appended()[-input$delete]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Maybe anybody can tell me what's wrong so far?
Thanks in advance!
Below is an app which seems to work but I'm not sure to understand what your app is intended to do.
In general, prefer reactive values (reactiveVal) instaed of using the non-local assignment <<-.
The code appended <<- appended()[-input$delete] is not correct. It does not replace the output of appended() by its originalvalue minus the input$delete index.
library(shiny)
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- reactiveVal(list())
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue(append(queue(), queue_append))
})
queue_ret <- eventReactive(input$press, {
list(queue=queue(), add=input$press)
})
}
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- reactiveVal(list())
observeEvent(input$combine, {
appended(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended(appended()[-as.integer(input$delete)])
})
}
# Run the application
shinyApp(ui = ui, server = server)
This is a slight extension of an earlier question.
Note: This solution now works after a typo was identified in the code and corrected. I hope this is a useful pattern that others can use too.
I would like different output types to be displayed via uiOutput, but in a modular framework.
What I have so far is:
module_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("output_type"),
label = "Select type of output",
selected = "table",
choices = c("table", "barplot", "graph")
),
uiOutput(ns("diff_outputs"))
)
}
module_server <- function(input, output, session){
ns <- session$ns
output$table <- renderTable({head(women)})
output$barplot <- renderPlot({barplot(women$height)})
output$scatterplot <- renderPlot({plot(women$height ~ women$weight)})
output_selected <- reactive({input$output_type})
output$diff_outputs <- renderUI({
if (is.null(output_selected()))
return()
switch(
output_selected(),
"table" = tableOutput(ns("table")),
"barplot" = plotOutput(ns("barplot")),
"graph" = plotOutput(ns("scatterplot"))
)
})
}
ui <- fluidPage(
titlePanel("Dynamically generated user interface components"),
fluidRow(
module_ui("module")
)
)
server <- function(input, output){
callModule(module_server, "module")
}
shinyApp(ui = ui, server = server)
The problem is that uiOutput is currently blank.
If a solution were found for this kind of problem, it would be very helpful indeed.
I think only very minor modifications are needed, but I am still new to using shiny modules.
It works but you have a typo: taglist should be tagList.
I'm trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)
I am pretty new to Shiny and dealing with the following problem, upon pressing an actionButton in shiny, I want it to do multiple calculations. I use the handler of observeEvent.
An example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(`
actionButton("calc","calculate stuff")),
mainPanel(
textOutput("result")
)
)
)
server <- function(input,output){
observeEvent(input$calc, {output$result <- renderText({"only this is not enough"}) })
}
shinyApp(ui,server')`
Now what I would want is where the output$result is made in the server-observeEvent, I would like to perform additional tasks, say assign a variable a <- 12, calculate B4 <- input$ID1*inputID2 etc.
This can not be hard I imagine.. but I am just not getting there.
kind regards,
Pieter
You can use isolate, see this example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = 'x', label = 'Select a value for x', value = 1),
actionButton( "calc", "calculate stuff" )
),
mainPanel(
textOutput("result")
)
)
)
server <- function(input, output) {
output$result <- renderText({
input$calc
isolate({
y<- input$x *2
paste("The result is:", y)
})
})
}
shinyApp(ui, server)