Shiny: Make list of UIs relate dynamic - r

With shiny it is very easy to create n inputs by creating a list of UIs like so (I am using ... to save space):
output$test <- renderUI({
lapply(1:input$count, function(x) numericInput(paste0('numId',x),...))
})
Let's say I want to dynamically set each numericInput's minimum to be the value of the previous numericInput. This won't work:
output$test <- renderUI({
lapply(1:input$count, function(x)
if (x==1) numericInput(paste0('numId',x),...))
else numericInput(paste0('numId',x),min=eval(parse(text=paste0("input$numId",x-1))),...))
})
It seems that using eval/parse to use the previous input as a parameter fails.
My next idea was to try adding this to the original code:
observe({
if (input$count>1) {
for (i in 2:input$count) {
updateNumericInput(paste0("numId",i),min=eval(parse(text=paste0("input$numId",i-1))))
}}})
Problem here is that observe doesn't know to respond when the numId's are updated because none of the objects input$numIdx are actually in the observe statement, just strings that are turned into those objects when observe is run.
Any ideas on how to handle this? It would be very nice to be able to generate n inputs, and make them relate to each other dynamically.
Regards

Related

Shiny - renderUI with a large number of items

I am developing a shiny application that needs to show a variable number of elements in the screen. Since, I have no previous idea of how many items there are, I chose to use the uiOutput and on my server.R I use the renderUI to build the dynamic UI. When I have only a few items, it works perfectly, but when there are a lot of items (which is my case) it takes way too long to load the page because it renders all of them at once.
Since only a few of the items are visible on screen at each time, I was thinking about doing some sort of pagination or lazy loading but I could not find how to implement this in shiny.
Here is a simplified version of my renderUI function:
output[['custom.ui']] <- renderUI({
lapply(1:nrow(items), function(i) {
# Some code
box(my_custom_ui())
})
})
I tried using the withSpinner with no success. It shows the spinners, but they all render at the same time.
output[['custom.ui']] <- renderUI({
lapply(1:nrow(items), function(i) {
ui.id <- str_glue('box_{i}')
output[[ui.id]] <- renderUI({
# Some code
box(my_custom_ui())
})
uiOutput(ui.id) %>% withSpinner()
})
})

How to make changes reflect in many places when input is changed without ObserveEvent() in shiny

I have an input variable input$shop_id. Which is used to get data in server function using:
observeEvent(input$shop_id,{id<<-input$shop_id})
`Data=dbGetQuery(connection_name,paste0("SELECT * FROM tab_name WHERE id_shop=",id"))`
That Data is further used to create dynamic UI using selectInput()
output$dependant=renderUI({
selectInput("choice","Choose the Data you want to view",names(Data))
})
I can't come up with the logic of the arrangement of these functions. I cannot get it to work. I have created a sample data and similar sample code for someone to try on:
library(shiny)
library(ggplot2)
ui=fluidPage(
column(6,uiOutput("shop_select")),
column(6,uiOutput("cust_select")),
column(6,uiOutput("select3")),
column(12,offset=6,uiOutput("plot"))
)
server = function(input, output) {
#sample data
shopdata=data.frame(id=c(1,2,3,4,5,6,7,8,9,10),name=c("a","b","c","d","e","f","g","h","i","j"))
cdata=data.frame(id=c(123,465,6798,346,12341,45764,2358,67,457,5687,4562,23,12124,3453,12112),
name=c("sadf","porhg","wetgfjg","hwfhjh","yuigkug","syuif","rtyg","dygfjg","rturjh","kuser","zzsdfadf","jgjwer","jywe","jwehfhjh","kuwerg"),
shop=c(1,2,1,2,4,6,2,8,9,10,3,1,2,5,7),
bill_total=c(12341,123443,456433,234522,45645,23445,3456246,23522,22345,23345,23454,345734,23242,232456,345456),
crating=c(4,4.3,5,1.2,3.2,4,3.3,2.4,3.8,3,3.2,3.3,1.4,2.8,4.1))
output$shop_select=renderUI({
selectInput("shop_id","Shop ID",shopdata$id)
})
output$cust_select=renderUI({
selectInput("cust_id","Customer ID",cdata$id,multiple = T)
})
output$select3=renderUI({
a=input$shop_id
selectInput("choice","Choose the Data you want to view",names(cdata))
})
output$plot=renderUI({
renderPlot({
require(input$choice)
plotOutput(
ggplot(cdata,aes(x=cust_id,y=input$choice))
)})})
}
shinyApp(ui=ui,server=server)
I know I am not clear on the question. Fixing the code which I posted is more than enough to clear my doubt. Basically, I just need to know what is the logic when we have to use while using a renderUI() which is dependent on another renderUI()

If you want to set up a series of subsetting operations and then call renderUI()s on each subset, you will need to take advantage of Shiny's reactive({}) expressions.
Reactive expressions are code chunks that produce variables and their magic is that they "watch" for any changes to their input data. So in your case one you select a shop_id in the first UI element, the reactive expression detects that and updates itself, automatically!
Here is an example showing the updating, just select different shop_id's and watch the available cust_ids change on the fly.
library(shiny)
library(ggplot2)
library(tidyverse)
ui=fluidPage(
column(6,uiOutput("shop_select")),
column(6,uiOutput("cust_select")),
column(6,uiOutput("select3")),
column(12,offset=6,tableOutput("plot"))
)
server = function(input, output) {
#sample data
shopdata=data.frame(id=c(1,2,3,4,5,6,7,8,9,10),name=c("a","b","c","d","e","f","g","h","i","j"))
cdata=data.frame(id=c(123,465,6798,346,12341,45764,2358,67,457,5687,4562,23,12124,3453,12112),
name=c("sadf","porhg","wetgfjg","hwfhjh","yuigkug","syuif","rtyg","dygfjg","rturjh","kuser","zzsdfadf","jgjwer","jywe","jwehfhjh","kuwerg"),
shop=c(1,2,1,2,4,6,2,8,9,10,3,1,2,5,7),
bill_total=c(12341,123443,456433,234522,45645,23445,3456246,23522,22345,23345,23454,345734,23242,232456,345456),
crating=c(4,4.3,5,1.2,3.2,4,3.3,2.4,3.8,3,3.2,3.3,1.4,2.8,4.1))
output$shop_select=renderUI({
selectInput("shop_id","Shop ID",shopdata$id)
})
cdata_reactive <- reactive({
req(input$shop_id)
filter(cdata, shop == input$shop_id)
})
output$cust_select=renderUI({
selectInput("cust_id","Customer ID",cdata_reactive()$id, multiple = T)
})
output$select3=renderUI({
selectInput("choice","Choose the Data you want to view",names(cdata_reactive()))
})
output$plot <- renderTable({
filter(cdata_reactive(), id %in% input$cust_id) %>%
.[input$choice]
})
}
shinyApp(ui=ui,server=server)

A renderUI generates UI elements. Therefore it can only contain ui functions. You need to use it to generate the plotOutput and then use renderPlot separately to add content.
The names you assign in the aes call are the names of variables in the data frame you provided. Therefore x should be id not the values of input$cust_id (which must be called as input$cust_id, since it refers to an input object.
input$choice returns a string, not an object, so you can't use it normally in aes (recall that if this was a normal dataframe your aes would be aes(x=id, y=choice) not aes(x='id', y='choice'). Therefore, you need to use aes_ with the as.name function to convert those strings into proper variable names.
What I think you want to do with input$cust_id is filter cdata to only include rows with the chosen id values. dplyr::filter is the best way to do that.
Finally, you're missing a geom_* in your ggplot call which is needed to actually render your data.
If you replace your output$plot <- ... call with the below code it should work the way I think you want it to:
output$plot=renderUI({
plotOutput('plotout')
})
output$plotout <- renderPlot({
ggplot(dplyr::filter(cdata, id %in% input$cust_id),
aes_(x=as.name('id'),y=as.name(input$choice))) +
geom_point()
})
As for the question in your title, you only need to use observeEvent if you want to limit the code in the expression to only run when a specific trigger occurs. Any reactive expression (reactive, observe, render_ etc.) will become invalidated and update itself if any reactive value (either a reactiveValues object or an input$...) changes. If you have an input$ or a reactive value in a render_ block, it will update if they change -- no observeEvent needed.

Is it possible to have a Shiny ConditionalPanel whose condition is a global variable?

My goal is to have a tabsetPanel wrapped in a conditionalPanel whose condition is a global variable being false.
ui.R
mainPanel(
conditionalPanel("searchPage == \"false\"",
tabsetPanel(
tabPanel("Summary",htmlOutput("summary")),
tabPanel("Description", htmlOutput("description"))
))),
global.R
searchPage <- "true"
then in server.R I assign new values to it a few different times, but all like this:
observeEvent(input$openButton,
output$results <- renderUI({
textOutput("")
searchPage <- "false"
}))
No matter what I do, I always get "Uncaught ReferenceError: searchPage is not defined". I've tried changing the global.R to multiple different combinations of using quotes, not using quotes, using <- or <<-, making it this.searchPage, my.searchPage and numerous other things (of course always making server.R and ui.R match too), but haven't had much luck at all.

As mentioned in a comment on the question's post, this is a perfect usecase for the shinyjs toggle()/show()/hide() functions. Whenever you need to conditionally show something where the condition is not a simple javascript expression of an input, it's easy to use these functions instead of a conditionalPanel().
In order to use these functions, you need to have some way to specify the element you want to hide/show (in this case, the mainPanel()). The easist way to do this is to just wrap the entire panel in a div with an id. So define the panel like mainPanel(div(id = "mainpanel", ...)) and voila, there's an id to your panel, and now you can call shinyjs::show("mainpanel") or hide() whenever you want in the server code.

What you are trying to do is not really possible the way you are trying to do it (the server and client are in different environments and don't share variables). You will need to explicitly pass the value from server to client, and there are different approaches to doing that. One way:
library(shiny)
runApp(list(ui = fluidPage(
conditionalPanel(condition='output.bool',
HTML("Hello world")),
actionButton("btn","Press me to toggle")
),
server = function(input, output, session) {
value=TRUE
output$bool <- eventReactive(input$btn,{
value
})
outputOptions(output,"bool",suspendWhenHidden=FALSE)
observeEvent(input$btn,
value <<- !value
)
}))
There are probably better approaches. Hope this helps

Dynamically loading file in Shiny

I am using Shiny to build an interface for dealing with some files locally. I have a directory with three .dta files. I would like the user to be able to select a file and then view it.
server.R
output$choose_dta <- renderUI(selectInput('file',"Choose a file:", choices =
c('file1','file2','file3')))
myData <-
eventReactive(input$button,{
foreign::read.dta(paste0("//my dir//",input$file,".dta"))
})
output$table <- renderTable({
data <- myData()
data
})
ui.R
sidebarPanel(uiOutput('choose_dta'),actionButton('button','Load Data'))
mainPanel(tableOutput('table'))
I have a couple issues. One, the .dta files are large and require some time to load. Is it possible to make the page non-interactive (and make it clear that it is loading) while it is loading the data? Secondly, and more importantly, once the data loads (which I know because I get a warning from read.dta) the table never renders. How can I set up the table to render only once the data is loaded?
Kind Regards

First question: if you know some CSS, you could add some "masking/shield" element to the page (and give it a large zindex). Before starting to read, make it visible with shinyjs::show() and after reading remove it with shinyjs::hide(). That's one way to do it, there might be better ways.
Second question: perhaps it will work better if you use reactiveValues? For example, something like this (pseudocode):
values <- reactiveValues(data = NULL)
observeEvent(input$btn, {
data <- read.csv(file)
values$data <- data
})
output$table <- renderTable({
values$data()
})
Try something like that maybe

Reactive Function Parameters

My goal is to make a reactive shiny function in R. There are multiple outputs (e.g. tables) which can be bind to a similar function. However I need the function to react on some parameter, specific to one table. Here is some simple sample code, which isn't working but it makes my idea clear - I hope:
output$tableOne <- DT::renderDataTable({
getData(foo)
})
getData <- reactive(function(funParameter){
corrStartDate <- input$StartDate
corrEndDate <- input$EndDate
return(someData(corrStartDate, corrEndDate, funParameter))
})
In all tables (if there is more then one) I wan't to show data with different base parameter (getData(x, y, foo)). So the second table could use "getData(x, y, bar)". I don't want to write every time the same function for another table.
The solution above is not working, since reactive functions do not support parameters.
How would you solve this?

This should work instead:
getData <- eventReactive(input$funParameter, {
corrStartDate <- input$StartDate
corrEndDate <- input$EndDate
return(someData(corrStartDate, corrEndDate, input$funParameter))
})
eventReactive only updates if arguments stated up front change. Practically speaking, this reactive will not trigger if input$StartDate or input$EndDate changes.
If this is not what you want, normal reactive functions should work. I.e.:
getData <- reactive({
funParameter <- input$funParameter
corrStartDate <- input$StartDate
corrEndDate <- input$EndDate
return(someData(corrStartDate, corrEndDate, funParameter))
})
which will trigger if any of the inputs change

Resources