R Shiny Application Conditional calculations and panel with condition on the output - r

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".

Related

R Shiny: How to make the initial value for numericInput dynamic, based on user input

I'm trying to make the value argument for shiny::numericInput() dynamic, based on input from a user.
Both code chunks below will run, but they fail to set a dynamic initial value.
Chunk 1:
idOptions <- c("1","2","3")
ui <- shiny::fluidPage(
shiny::selectInput(inputId = "idSelection", "Identification: ", idOptions),
shiny::numericInput("num", "Number associated with id:", value=shiny::verbatimTextOutput("numberOut")),
)
server <- function(input, output) {
df <- data.frame(id = c("1","2","3"), number = c(100,227,7))
output$numberOut <- shiny::renderText({ input$idSelection })
}
shiny::shinyApp(ui, server)
Chunk 2:
idOptions <- c("1","2","3")
ui <- shiny::fluidPage(
shiny::selectInput(inputId = "idSelection", "Identification: ", idOptions),
shiny::numericInput("num", "Number associated with id:", value=shiny::verbatimTextOutput("numberOut")),
)
server <- function(input, output) {
df <- data.frame(id = c("1","2","3"), number = c(100,227,7))
dfReactive <- shiny::reactive({
dataOut <- df %>%
dplyr::filter(., id %in% input$idSelection)
return(dataOut)
})
shiny::observe({
output$numberOut <- shiny::renderText({
return(dfReactive()$number)
})
})
}
shiny::shinyApp(ui, server)
I want the initial value for shiny::numericInput to change like so:
When the user selects "1" for Identification, the initial value is 100:
When the user selects "2" for Identification, the initial value is 227:
The idea behind this is to have an appropriate initial value suggested to the user based on the identification of the input.
I'm guessing the problem might be with shiny::verbatimTextOutput("numberOut"), but I don't know a way to render a simple numeric value to pass into the value argument of shiny::numericInput.
Any thoughts?
Thanks much.
One way would be to use renderUI and do the computation on the server side:
idOptions <- c("1","2","3")
shiny::shinyApp(
ui = shiny::fluidPage(
shiny::selectInput(inputId = "idSelection", "Identification: ", idOptions),
shiny::uiOutput("num")
),
server = function(input, output) {
df <- data.frame(id = c("1","2","3"), number = c(100,227,7))
output$num <- shiny::renderUI({
shiny::numericInput("num",
"Number associated with id:",
value = df$number[as.numeric(input$idSelection)])
})
})
The alternative is to leave the input on the UI side and use updateNumericInput inside an observeEvent:
idOptions <- c("1","2","3")
shiny::shinyApp(
ui = shiny::fluidPage(
shiny::selectInput(inputId = "idSelection",
"Identification: ",
idOptions),
shiny::numericInput("num",
"Number associated with id:",
value = NULL)
),
server = function(input, output, session) {
df <- data.frame(id = c("1","2","3"),
number = c(100,227,7))
observeEvent(input$idSelection, {
updateNumericInput(session,
inputId = "num",
value = df$number[as.numeric(input$idSelection)])
})
})

Access dynamic id in shiny R

So this is an extension to my previous question.
Dynamic repeating conditionalPanel in R shiny dashboard
Here is the shiny code I am using right now.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
br(),
selectInput("inpt", "Input Number", seq(1,50), selectize = FALSE),
br(),
uiOutput("selectors")
)
server <- function(input, output, session){
output[["selectors"]] <- renderUI({
n <- input[["inpt"]]
selectors <- lapply(1:n, function(i){
selectInput(paste0("id",i), "Select number", seq(1,24), selected = 1)
})
do.call(function(...){
box(..., width = 2, status = "primary")
}, selectors)
})
}
shinyApp(ui, server)
It will generate selection windows depending on 'inpt' number selection.
Now my issue is that I want to access the value of generated selection input.
Example: If I have selected 3, three inputs will be generated with id1, id2, id3.
How to access these ids? If I want to print them, how can I?
for (j in 1:inpt){
print(eval(parse(text = paste0("input$", paste0("id",j)))))
}
But output for this is:
NULL
NULL
NULL
I thought my eval and parse method is wrong so I tried with just inpt
for (j in 1:inpt){
print(eval(parse(text = paste0("input$", paste0("in","pt")))))
}
Output was (3 was selected in selection input)
3
3
3
So my eval, parse method was correct I guess.
So how to access id1, id2, ..., idn in above example?
Please check the following:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
br(),
selectInput("inpt", "Input Number", seq(1,50), selectize = FALSE),
br(),
uiOutput("selectors"),
uiOutput("printMyDynamicInputs"),
uiOutput("printMyFirstDynamicInput")
)
server <- function(input, output, session){
output[["selectors"]] <- renderUI({
n <- input[["inpt"]]
selectors <- lapply(1:n, function(i){
selectInput(paste0("id",i), "Select number", seq(1,24), selected = 1)
})
do.call(function(...){
box(..., width = 2, status = "primary")
}, selectors)
})
myDynamicInputs <- reactive({
lapply(1:input$inpt, function(i){
input[[paste0("id",i)]]
})
})
output$printMyDynamicInput <- renderUI({
paste("You selected:", paste(myDynamicInputs(), collapse = ", "))
})
output$printMyFirstDynamicInputs <- renderUI({
paste("You selected:", input$id1)
})
}
shinyApp(ui, server)

Collect All user inputs throughout the Shiny App

Is there a way to show the value from textInput() elsewhere in the UI without having to go through server.R with something very verbose like the following?
ui.R
library(shiny)
shinyUI(
fluidPage(
textInput('text_in', label = 'Write text here'),
# elsewhere in the UI...
textOutput('text_out')
))
server.R
library(shiny)
shinyServer(function(input, output) {
output$text_out = renderText(input$text_in)
})
It's not too bad for this example, but it becomes very verbose when I need to do it many times. My desire is to collect all the inputs the user enters throughout the app and compile them into a nice table at the end so they can confirm everything is laid out right.
I've seen you can reference input elements without going through the server when using a JavaScript expression in conditionalPanel() but I'm not sure how to implement that outside of this specific instance.
For accessing all inputs, you can use reactiveValuesToList server-side. You can access input values via Javascript Events like below (I have taken the example from #Pork Chop) :
library(shiny)
ui <- basicPage(
fluidRow(
column(
width = 6,
textInput('a', 'Text A',"a1"),
textInput('b', 'Text B',"b1"),
textInput('c', 'Text A',"c1"),
textInput('d', 'Text B',"d1"),
textInput('e', 'Text A',"e1"),
textInput('f', 'Text B',"f1")
),
column(
width = 6,
tags$p("Text A :", tags$span(id = "valueA", "")),
tags$script(
"$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'a') {
$('#valueA').text(event.value);
}
});
"
),
tableOutput('show_inputs')
)
)
)
server <- shinyServer(function(input, output, session){
AllInputs <- reactive({
x <- reactiveValuesToList(input)
data.frame(
names = names(x),
values = unlist(x, use.names = FALSE)
)
})
output$show_inputs <- renderTable({
AllInputs()
})
})
shinyApp(ui = ui, server = server)
Since your overall objective is to collect all the user inputs and then compile them into a table I will show you how to achieve that with example below. As you can see all of the input variables can be accessed by names from server. I kept them in a reactive just in case you need it for further analysis or for some renderUI functionality.
#rm(list=ls())
library(shiny)
ui <- basicPage(
textInput('a', 'Text A',"a1"),
textInput('b', 'Text B',"b1"),
textInput('c', 'Text A',"c1"),
textInput('d', 'Text B',"d1"),
textInput('e', 'Text A',"e1"),
textInput('f', 'Text B',"f1"),
tableOutput('show_inputs')
)
server <- shinyServer(function(input, output, session){
AllInputs <- reactive({
myvalues <- NULL
for(i in 1:length(names(input))){
myvalues <- as.data.frame(rbind(myvalues,(cbind(names(input)[i],input[[names(input)[i]]]))))
}
names(myvalues) <- c("User Input","Last Value")
myvalues
})
output$show_inputs <- renderTable({
AllInputs()
})
})
shinyApp(ui = ui, server = server)
If the Shiny inputs all have different lengths and the above does not work (e.g. if you have combination of radio buttons, checkboxgroup, textInput, etc.) this will work and can produce a table of variable:value that you can parse later:
AllInputs <- reactive({
myvalues <- NULL
newvalues <- NULL
for(i in 1:length(names(input))){
newvalues <- paste(names(input)[i], input[[names(input)[i]]], sep=":")
myvalues <- append(myvalues, newvalues)
}
myvalues
})
output$show_inputs <- renderTable({
AllInputs()
})
Borrowing from both Pork Chop and mysteRious, here's a solution that works for multiple types of text & number inputs in shiny.
library(shiny)
AdvRchp3 <- "While you’ve probably already used many (if not all)
of the different types of vectors, you may not have thought
deeply about how they’re interrelated. In this chapter,
I won’t cover individual vectors types in too much detail,
but I will show you how all the types fit together as a whole.
If you need more details, you can find them in R’s documentation."
ui <- fluidPage(
fluidRow(
h4("Text Inputs"),
textInput("text_input", "Input some Text", value = "some text"),
passwordInput("password_input", "Input a Password", value = "1234"),
textAreaInput("text_area_input", "Input lots of Text", rows = 3, value = AdvRchp3)
),
fluidRow(
h4("Numeric Inputs"),
numericInput("numeric_input", "Number 1", value = 1, min = 0, max = 100),
sliderInput("slider_input_single", "Number 50", value = 50, min = 0, max = 100),
sliderInput("slider_input_ranges", "Range 10 to 20", value = c(10, 20), min = 0, max = 100)
),
fluidRow(
tableOutput("show_inputs")
)
)
server <- function(input, output, session) {
all_inputs <- reactive({
input_df <- NULL
df_row <- NULL
for(i in 1:length(names(input))){
df_row <- as.data.frame(cbind(names(input)[i], input[[names(input)[i]]]))
input_df <- as.data.frame(dplyr::bind_rows(input_df, df_row))
}
names(input_df) <- c("input_id", "input_val")
input_df
})
output$show_inputs <- renderTable({
all_inputs()
})
}
shinyApp(ui, server)
notice: the rbind is now dplyr::bind_rows, but plyr::rbind.fill will also work.

R Shiny : dynamic number of tables within a tab

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

Unexpected values from text input in Rshiny

I am making an app that takes input from a slider to create the matching number of input text boxes. However, when I print the values from the input boxes it does not always update.
Example:
Pick 3 on slider input. Put 1,2,3 into the 3 text boxes respectively.Hit submit. Prints number = 1 number = 2 number = 3. When I move the slider to 2 and hit enter, I get number = 1 number = 2 despite no values being in the text input anymore. If I move the slider to 4, I will than get the output number = NA number = NA number = 3 number = NA.
Clearly it is remembering previous input values, but I cannot understand why or how to fix it.
ui.R
shinyUI(fluidPage(
fluidRow(
column(4, wellPanel(
sliderInput("numObs", "Number of observations", 1, 30, 3),
uiOutput("buttons"),
submitButton(text = "Apply Changes", icon = NULL)
)),
column(8,
textOutput("a")
)
)
))
server.R
shinyServer(function(input, output) {
output$buttons <- renderUI({
obs <- input$"numObs";
objs <-list();
for (i in 1:obs ){
objs <- list(objs, numericInput(inputId = paste0("t", i), "Day:", NA),br());
}
objs <- fluidRow(objs);
})
t<- function(){
for(i in 1:input$"numObs"){
if(i ==1){
t <- c(as.numeric(input[[paste0("t",i)]])[1]);
}
else{
t <- c(t,as.numeric(input[[paste0("t",i)]])[1]);
}
}
return(t);
}
output$a<- renderText({
paste("number = ", t());
})
})
I made some changes and introduced a few things to your code. Its better to use actionButton than the submitButton as it is more flexible. If you dont like the style of the actionButton, look into Shiny Themes
rm(list = ls())
library(shiny)
ui =(fluidPage(
fluidRow(
column(4, wellPanel(
sliderInput("numObs", "Number of observations", 1, 30, 3),
uiOutput("buttons"),
actionButton("goButton", "Apply Changes")
)),
column(8,textOutput("a"))
) ))
server = (function(input, output) {
output$buttons <- renderUI({
obs <- input$"numObs";
objs <-list();
for (i in 1:obs ){
objs <- list(objs, numericInput(inputId = paste0("t", i), "Day:", NA),br());
}
objs <- fluidRow(objs);
})
# keep track if the Number of obseervations change
previous <- eventReactive(input$goButton, {
input$numObs
})
t <- eventReactive(input$goButton, {
for(i in 1:input$"numObs"){
if(i ==1){
t <- c(as.numeric(input[[paste0("t",i)]])[1]);
}
else{
t <- c(t,as.numeric(input[[paste0("t",i)]])[1]);
}
}
return(t)
})
output$a<- renderText({
if(previous() != input$numObs){
return()
}
paste("number = ", t());
})
})
runApp(list(ui = ui, server = server))

Resources