Collect All user inputs throughout the Shiny App - r

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.

Related

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

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

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)

How to use debounce in R Shiny without using dyplr or magrittr pipes

I'm trying to get debounce to work without using dplyr or magrittr as my server (at work) seems unable to render output when I load these libraries. I'm sure I'm missing something basic here but I can't seem to get my head around getting debounce to work for me.
ui.R
library(shiny)
fluidPage(
titlePanel("Debounce Test")
,selectizeInput("rweek", "Select number(s):"
,c(1,2,3)
,multiple = TRUE
,selected = "1"
,width = '100%')
,textInput(inputId = "abctext", label = "Type anything")
,textOutput(outputId = "finalText")
)
server.R
server <- function (input, output) {
finalSelections <- reactive ({
typedtext <- input$abctext
weeklist<- input$rweek
countt <- length(weeklist)
typedtextd <- debounce(typedtext,2000)
weeklistd <- debounce(weeklist,2000)
counttd <- length(weeklistd)
final_data <- c(typedtextd, counttd)
#final_data <- c(typedtext, countt)
return(final_data)
})
output$finalText <- renderText({
paste0("You have typed: ", finalSelections()[1], "; You have selected ", finalSelections()[2], " item(s)")
})
}
The code works fine when I comment out the debounce sections. I want to be able to wait a bit for the user to select inputs (especially SelectizeInput) before printing out the output.
Welcome to Stackoverflow!
debounce() needs a reactive expression to work - Please see ?debounce(). In your code you are passing strings (inside a reactive expression).
I guess this is what you are after:
library(shiny)
ui <- fluidPage(
titlePanel("Debounce Test"),
selectizeInput("rweek", "Select number(s):", c(1, 2, 3), multiple = TRUE, selected = "1", width = '100%'),
textInput(inputId = "abctext", label = "Type anything"),
textOutput(outputId = "finalText")
)
server <- function(input, output, session) {
typedtext <- reactive({input$abctext})
weeklist <- reactive({input$rweek})
typedtextd <- debounce(typedtext, 2000)
weeklistd <- debounce(weeklist, 2000)
finalSelections <- reactive ({
countt <- length(weeklist())
counttd <- length(weeklistd())
final_data <- c(typedtextd(), counttd)
#final_data <- c(typedtext(), countt)
return(final_data)
})
output$finalText <- renderText({
paste0(
"You have typed: ",
finalSelections()[1],
"; You have selected ",
finalSelections()[2],
" item(s)"
)
})
}
shinyApp(ui = ui, server = server)

Shiny Modules with Observes and reactiveValues

I have been trying to reconstruct the following simplistic Shiny app using modules since I believe that will be the best way to organize this code inside a much larger application where I will use these kinds of linked-slider-numeric inputs in many places.
However, I cannot figure out how to achieve the same kind of functionality from within a module.
Here's an example app that works exactly as intended, but not using modules:
library(shiny)
# Let's build a linked Slider and Numeric Input
server <- function(input, output) {
values <- reactiveValues(numval=1)
observe({
values$numval <- input$slider
})
observe({
values$numval <- input$number
})
output$slide <- renderUI({
sliderInput(
inputId = 'slider'
,label = 'SN'
,min = 0
,max = 10
,value = values$numval
)})
output$num <- renderUI({
numericInput(
inputId = 'number'
,label = 'SN'
,value = values$numval
,min = 0
,max = 10
)
})
}
ui <- fluidPage(
uiOutput('slide'),
uiOutput('num')
)
shinyApp(ui, server)
Here's my attempt. (Note that "mortalityRate" and associated strings are just an example of the variable name(s) I'll be using later). I have tried several variations on this attempt, but inevitably I get errors, usually indicating I'm doing something that can only be done inside a reactive context:
numericSliderUI <- function(id, label = "Enter value", min = 1, max = 40, value) {
ns <- NS(id)
tagList(
sliderInput(inputId = paste0(ns(id), "Slider"), label = label, min = min, max = max, value = value),
numericInput(inputId = paste0(ns(id), "Numeric"), label = label, min = min, max = max, value = value)
)
}
numericSlider <-
function(input,
output,
session,
value,
mortalityRateSlider,
mortalityRateNumeric
) {
values <- reactiveValues(mortalityRate = value())
observe({
values[['mortalityRate']] <- mortalityRateSlider()
})
observe({
values[['mortalityRate']] <- mortalityRateNumeric()
})
return( reactive( values[['mortalityRate']] ) )
}
library(shiny)
# source("modules.R") # I keep the modules in a separate file, but they're just pasted above for convenience here on StackOverflow.
ui <- fluidPage(
uiOutput('mortalityRate')
)
server <- function(input, output) {
values <- reactiveValues(mortalityRate = 1)
mortalityRateValue <- callModule(
numericSlider,
id = 'mortalityRate',
value = values[['mortalityRate']],
mortalityRateSlider = reactive( input$mortalityRateSlider ),
mortalityRateNumeric = reactive( input$mortalityRateNumeric )
)
values[['mortalityRate']] <- reactive( mortalityRateValue() )
output$mortalityRate <- renderUI(numericSliderUI('mortalityRate', value = values[['mortalityRate']]))
}
shinyApp(ui = ui, server = server)
I know that I must be doing something wrong with the reactiveValues and the way I'm using the observe statements inside the module, but this is my best attempt at using the module structure, so any help figuring out what I'm doing wrong would be very helpful.
Here is working code. There are a variety of changes, so I'll direct you to this Github page that also sets up a structure for using renderUI with modules. In general, I think the problems in your code involved trying to define reactive values inside the callModule function, and in passing the values of the sliders and numeric box back and forth.
Other features of using modules are that in your actual UI call, you need to call the UI module, where in turn you can call uiOutput. Inside renderUI is where you can set up the inputs. Additionally, inside modules you don't need the session namespaces, but you do need to wrap those ids in session$ns() to ensure they work across modules.
UI and Server Modules:
numericSliderUI <- function(id) {
ns <- NS(id)
uiOutput(ns('mortalityRate'))
}
numericSlider <- function(input, output, session) {
values <- reactiveValues(mortalityRate = 1)
observe({
values[['mortalityRate']] <- input$Slider
})
observe({
values[['mortalityRate']] <- input$Numeric
})
output$mortalityRate <- renderUI(
tagList(
sliderInput(inputId = session$ns("Slider"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']]),
numericInput(inputId = session$ns("Numeric"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']])
)
)
return(list(value = reactive({values[['mortalityRate']]})))
}
UI and Server functions:
ui <- fluidPage(
numericSliderUI('mortalityRate')
)
server <- function(input, output, session) {
mortalityRateValue <- callModule(numericSlider, 'mortalityRate')
}
shinyApp(ui = ui, server = server)

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

Resources