What I have learnt from the differences between the ADD and REMOVE Button.
As we can see from the codes below, the main difference is how the ADD and REMOVE buttons affect the scenarios line. The REMOVE button effectively uses the scenarios[-length(scenarios)] command to remove the immediate last scenario while keeping the other codes constant with the ADD button.
A very simple one-line code solution, and yet elegant approach to solve the problem. I learned alot again. Thank you all.
observeEvent(input$add, {
if (!(shock %in% scenarios)) {
scenarios <<- sort(c(scenarios, shock))
updateCheckboxGroupInput(session, "scenarios",choices = scenarios,selected = scenarios)
}
observeEvent(input$remove,{
scenarios <<- scenarios[-length(scenarios)]
updateCheckboxGroupInput(session, "scenarios",choices = scenarios,selected = scenarios)
})
This should do:
library(shiny)
ui <- fluidPage(
numericInput("shock", "Shock", value = round(runif(1) * 1000), 0),
actionButton("add", "Add"),
actionButton("remove", "Remove"),
checkboxGroupInput("scenarios", "Scenarios", choices = c(), selected = c()),
verbatimTextOutput("o1")
)
scenarios <- c(-100, -50, 0, 50, 100)
server <- function(input, output, session) {
updateCheckboxGroupInput(session, "scenarios",
choices = scenarios,
selected = scenarios)
observeEvent(input$add,{
shock <- isolate(input$shock)
if (!(shock %in% scenarios)) {
scenarios <<- sort(c(scenarios, shock))
updateCheckboxGroupInput(session, "scenarios",choices = scenarios,selected = scenarios)
}
# put a new random value
updateNumericInput(session, "shock", value = round(runif(1) * 1000))
})
observeEvent(input$remove,{
scenarios <<- scenarios[-length(scenarios)]
updateCheckboxGroupInput(session, "scenarios",choices = scenarios,selected = scenarios)
})
output$o1 <- renderPrint({
x <- input$scenarios
str(x)
cat(paste0("length: ", length(x), "\n"))
cat(paste0(x, "\n"))
})
}
shinyApp(ui, server)
Related
I am new to Shiny. What I want to do in my application is, running & displaying some part of the code only when a condition on another calculation is met.
The conditionalPanel works fine with the conditions on input values but I could not figure out how to do this with the 'output' values, i.e., conditionally on the output values of the functions. Below is my example code:
library(shiny)
msLocation <- "msLoc"
searchMWText <- "searchMW"
bid <- "2333333"
fulltext <- "fullDisplay"
ui <- fluidPage(
titlePanel("Run server codes conditionally"),
sidebarLayout(
sidebarPanel(
helpText("Evaluate input and run different parts of the code depending on the output functions"),
br(),
sliderInput("rand", "select seed", min = 1, max = 50, step = 1, value = 1)
),
mainPanel(
fluidRow(conditionalPanel("output.rand == 1"),
tags$h4("Here comes the default part"),
br(),
textOutput("defaultCalc")),
fluidRow(conditionalPanel("output.randomint != 1",
tags$h4("I can evaluate if the chosen number is even or odd."),
br(),
textOutput("evenodd")
),
fluidRow(conditionalPanel("output.evenodd == 'Number is even'",
tags$h4("Number even calculation "),
textOutput("msLoc"),
br(),
textOutput("searchMW"),
br(),
textOutput("defaultID"),
br()
),
fluidRow(conditionalPanel("output.evenodd == 'Number is odd'",
tags$h4("Here is some id:", textOutput("id")),
textOutput("displayFull")
)
)
)
)
)))
#
server <- function(input, output) {
rand1 <- reactive({
if(is.null(input$rand)){return(NULL)}
rn <- input$rand
return(rn)
})
randomint <- reactive({
seedn <- rand1()
set.seed(seedn)
rint <- sample(1:50, 1)
return(rint)
})
calc1 <- reactive({
intn <- randomint()
modn <- intn %% 2
return(modn)
})
evenOdd <- reactive({
modn <- calc1()
if(modn == 0){valueText = "Number is even"}
if(modn != 0){valueText = "Number is odd"}
return(valueText)
})
idtext <- reactive({
idint <- sample(1:10000, 3)
idint <- as.character(idint)
idint <- paste(idint, collapse = "")
return(idint)
})
output$defaultCalc <- renderText({
as.character(randomint())
})
output$evenodd <- renderText({
evenOdd()
})
output$searchMW <- renderText({
searchMWText
})
output$defaultID <- renderText({
bid
})
output$id <- renderText({
idtext()
})
output$displayFull <- renderText({
fulltext
})
}
shinyApp(ui = ui, server = server)
The problem is, the parts after default always appear, e..g., 'Here is some id' text always appears and this is not what I want. I want to display 'Here is some id' and run the calculation (idtext) only when the number is odd.The number is not coming from the slider input, the slider input is providing the seed only. The number is also calculated and depends on its value, the other parts should be run and displayed. Until the user selects a slider input value, only the 'default part' should be displayed and nothing else.
I searched a lot and could not find a solution that mentions the conditions on output. What is the best way to solve this?
Do:
randomint <- reactive({
seedn <- rand1()
set.seed(seedn)
rint <- sample(1:50, 1)
return(rint)
})
output$randomint <- reactive(randomint())
outputOptions(output, "randomint", suspendWhenHidden = FALSE)
Then you can use "output.randomint !== 1".
My shiny app begins with a checkboxGroupInput which contains the names of three companies: A, B and C. It also has 3 hidden numeric inputs, each corresponding to a company. Potential investors may select the name of the company they wish to invest in and specifiy the amount they are willing to invest. When the name of a company is checked, the corresponding numeric input shows up. Also, when the company name is unchecked, the numeric input disappears.
The checkboxGroupInput is called company. The 3 numericInput fields are respectively called amountA, amountB and amountC and are all generated inside a uiOutput. They are hidden with the hidden function of shinyjs.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observeEvent(eventExpr = input$company, handlerExpr = {
if(length(input$company) == 0){
for(i in num_ids){
shinyjs::hide(id = i)
}
} else {
for(i in input$company){
shinyjs::toggle(id = paste0("amount", i), condition = input$company)
}
}
})
}
shinyApp(ui = ui, server = server)
The problem with my app is that the intended dynamics between the checkboxGroupInput and the numericInput fields are not working as intended. For instance, once a numericInput is shown, it cannot be hidden anymore by unchecking the boxes. How can I handle this?
The code pasted above is fully functional. Thank you very much.
I fixed your code by explicitly show/hide the numericInput when the corresponding check box is selected/unselected. Also I change the observeEvent with observe to make sure that the observer reacts when none of the check boxes are selected.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observe({
for(i in company_names){
if (i %in% input$company) {
shinyjs::show(id = paste0("amount", i))
} else {
shinyjs::hide(id = paste0("amount", i))
}
}
})
}
shinyApp(ui = ui, server = server)
first I know there is a lot of threads covering my problem, I read them all, but I did not manage to do it. I got a list of 10 data.frame which I built through the following code :
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
I want the user to enter n, the number of tables he wants to see. And then display n random tables from the list_of_df. I want to display those tables inside tabs. Here is what I did, I grabbed some ideas here and there, but obviously it does not work and I do not know why.
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = "numput",label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[[index]]
})
size<-reactive({
length(random_tables())
})
for (i in 1:size()) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
}
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', 1: nTabs), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui, server)
So, if you see what I should do ...
Here is a working version:
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = 'numput',label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[index]
})
size<-reactive({
input$numput
})
observe({
lapply(seq_len(size()), function(i) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
})
})
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', seq_len(nTabs)), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui=ui,server=server)
A couple issues, you subset the list with double brackets, but it isn't working like you think it is, you need single brackets. Next when you select a single table random_table() is a data.frame so when you call length you get 2, the number of columns. So just use the input$numput for size() since they are the same anyways. Also, I put the dynamic output in an observe so that it can access the reactive size(). A small thing, but I used seq_len instead of 1:aNumber since it is more robust.
Hope this helps
I was wondering if it was possible to set the value of a numeric input via updateNumericInput to be equal to 0 if a checkbox is not clicked. Below is how my code is set up at the moment to generate the check boxes and numeric inputs. I had to use loops to create a dynamic number of check boxes and inputs due to the nature of the app so I would really appreciate any help linking the two while keeping the functionality.
Server file:
shinyServer(function(input, output, session) {
output$inputs1 <- renderUI({
numSliders <- input$sources
lapply(1:numSliders, function(i) {
numericInput(
inputId = paste0('slider1', i),
label = df[i,2],
value = df[i,3]*(input$budget)/100)
})
})
output$checks1 <- renderUI({
numSliders <- input$sources
lapply(1:numSliders, function(i) {
checkboxInput(
inputId = paste0('check1', i),
label = df[i,2],
value = TRUE
)
})
})
}
UI:
shinyUI(fluidPage(fluidRow(
sidebarLayout(
sidebarPanel(
column(5,numericInput("budget", "Budget", value = 0),
uiOutput("checks1")),
column(5,uiOutput("inputs1"))),
mainPanel()
)
)
)
)
Please let me know if there is any sort of workaround for this.
Thanks in advance!
Since you can only generate a finite number of widgets the easiest way of creating an observer for each checkboxInput is to create a global variable, say, max_widgets which gives an upper bound on widgets. You then restrict the maximal value of numericInput which controls a number of widgets to max_widgets (so input$sources) and require within renderUIs that
req(numSliders > 0 & numSliders <= max_widgets)
(I would use validate and need to inform the user that the number of widgets has to be non negative and is bound to max_widgets but in my shiny version there is a bug and validate doesn't work as supposed.)
You then create observers for each checkboxInput on the server side:
lapply(1:max_widgets, function(i) {
observeEvent(input[[paste0('check', i)]], {
print(paste0("update of numeric", i))
updateNumericInput(session, inputId = paste0('numeric', i),
value = 0)
})
})
Note that this will create observers for all possible checkboxes (checkboxes may not even exist - shiny won't complain :) )
This may not be perfect but, as said, you will have only one observer for each checkbox.
If you dynamically generate observers in a following way (without a global variable max_widgets)
observe({
lapply(1:input$sources, function(i) {
observeEvent(input[[paste0('check', i)]], {
print(paste0("numeric", i, " = ", input[[paste0('numeric', i)]]))
updateNumericInput(session, inputId = paste0('numeric', i),
value = 0)
})
})
it will work too but each time you will generate new widgets you will also create an observer for it. So you may get multiple observers for each checkboxInput!
If your app is small then it won't matter much but in general it may lead to bugs. You can easy deal with it but it makes the code slightly more complicated - there was a question that touched on this problem.
Full example:
library(shiny)
rm(list = ls())
max_widgets <- 15
server <- shinyServer(function(input, output, session) {
output$inputs1 <- renderUI({
numSliders <- input$sources
# My shiny version has a bug and can't use validate(need(...)) because
# it doesn't work as suppossed
req(numSliders > 0 & numSliders <= max_widgets)
lapply(1:numSliders, function(i) {
numericInput(
inputId = paste0('numeric', i),
# label = df[i,2],
paste0("Input ", i),
# value = df[i,3] * (input$budget) / 100)
value = i * (input$budget) / 100)
})
})
output$checks1 <- renderUI({
numSliders <- input$sources
req(numSliders > 0 & numSliders <= max_widgets)
lapply(1:numSliders, function(i) {
list(
checkboxInput(
inputId = paste0('check', i),
# label = df[i,2],
label = paste0("Checkbox ", i),
value = TRUE
),
br()
)
})
})
lapply(1:max_widgets, function(i) {
observeEvent(input[[paste0('check', i)]], {
print(paste0("update of numeric", i))
updateNumericInput(session, inputId = paste0('numeric', i),
value = 0)
})
})
})
ui <- shinyUI(fluidPage(fluidRow(
sidebarLayout(
sidebarPanel(
column(5,
numericInput("budget", "Budget", value = 0),
hr(),
br(),
uiOutput("checks1")
),
column(5,
numericInput("sources", "Sources", value = 0, min = 0, max = max_widgets),
hr(),
uiOutput("inputs1")
)
),
mainPanel()
)
)))
shinyApp(ui, server)
I am trying to dynamically render multiple text output from multiple text input. I tried to use this very helpfull example and this one too.
This conversation is also helpfull.
But when I try to adapt this examples on the following script, I have a problem of output update. Apparently, only the last element was read and updated. It's probably a reactivity problem but it seems to be difficult to associate reactive{()} and renderUI{()}functions.
rm(list = ls())
library(shiny)
creatDataElem <- function(ne, input) {
x1 <- lapply(1:ne, function(i) {
textInput(paste0("elemName", i),
label = h4(strong("Name of dataset element")),
value = "")
})
return(x1)
}
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3)
,
conditionalPanel(
condition = "input.elemNb == 1",
creatDataElem(1)
),
conditionalPanel(
condition = "input.elemNb == 2",
creatDataElem(2)
),
conditionalPanel(
condition = "input.elemNb == 3",
creatDataElem(3)
)
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
max_elem <- 3
# Name
output$nameElem <-renderUI({
nameElem_output_list <- lapply(1:input$elemNb, function(i) {
elemName <- paste0("elemName", i)
tags$div(class = "group-output",
verbatimTextOutput(elemName)
)
})
do.call(tagList, nameElem_output_list)
})
for (i in 1:max_elem) {
local({
force(i)
my_i <- i
elemName <- paste0("elemName", my_i)
output[[elemName]] <- renderPrint(input[[elemName]])
})
}
}
runApp(list(ui = ui, server = server))
The idea with a reactive({}) function is to add an independant object (a function in this case) like:
nameElem <- reactive({
if (input$goElem == 0) {
return()
} else {
isolate({
if (is.null(input$elemName)) {
return()
} else if (test(input$elemName)) {
return("TEST RESULT")
} else {
return(input$elemName)
}
})
}
})
and to use renderUI on this object (with an ActionButton).
So, if someone knows why the output does not return the good object...
I think one of your problems is that your creatDataElem function is such that when it is called with argument ne=3, the first and second textInput elements are created again (and their value "lost").
Anyway, I think one solution would be to create those textInput elements as an "uiOutput".
You'll find a possible solution below which (I think) does what you want.
Lise
rm(list = ls())
library(shiny)
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3),
uiOutput("myUI")
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
output$myUI=renderUI({
w=""
for (i in 1:input$elemNb){
w=paste0(w,
textInput(paste0("elemName",i),label='Name of dataset element'))
}
HTML(w)
})
output$nameElem <-renderUI({
elems=c("<div>")
for(i in 1:input$elemNb){
elems=paste(elems,"</div><div>",input[[paste0("elemName",i)]])
}
elems=paste0(elems,"</div>")
HTML(elems)
})
}
runApp(list(ui = ui, server = server))
Found a solution:
library(readr)
library(dplyr)
library(shiny)
df <- data.frame(symbol = 1:10)
uiOutput("myUI")
createUI <- function(dfID, symbol) {
div(class="flex-box",paste0(symbol, " - 10"))
}
output$myUI <- renderUI({
w <- lapply(seq_len(nrow(df)), function(i) {
createUI(i, df[i,"symbol"])
})
do.call(fluidPage,w)
})