shiny addpopover function doesnt work with uioutput - r

I have created the following shiny App in R
First we import the necessary libraries
library(shiny)
library(shinyBS)
The next step is to create a UI as follows
ui = fluidPage( sidebarLayout( sidebarPanel(sliderInput("bins", "Number of bins:", min = 1, max =
50,value = 30), selectInput(inputId = "Select1", label = "Select1", choices = c('A', 'B', 'C'),
selected = "A"), selectInput(inputId = "Select2", label = "Select2", choices = c('A1', 'B1', 'C1'),
selected = "A1"), bsTooltip("bins", "Read", "right", options = list(container = "body")) ),
mainPanel(uiOutput("namelist") ) ))
We now create the Server as follows
server =function(input, output, session) {
content<-reactive({
input$Select2
})
output$namelist<-renderUI({
textInput(inputId = "text1", label =input$Select1)
})
addPopover(session, "namelist", "Data", content =content() , trigger = 'click') }
shinyApp(ui, server)
The App on running will create a slider and two select boxes and an output that reacts dynamically to user input. the tooltip displays the bubble with read when one hovers over the slider. I am unable to get the addpopover function to work. It should work such that based on the input of select 2, the text rendered in the popover message box should change. The App is crashing . When i place the addpopover command within a reactive environment, I am the renderUI functions output- namely the textbox disappears. I request someone to help me here.

You can wrap addPopover in observe or observeEvent. I would prefer observeEvent, as recommended here.
addPopover will be updated each time content() changes, which is what we want since this popover is supposed to show content(). However, there is something strange about the behaviour of this popover (clicks are sometimes ineffective) but I guess this is not related to your app in particular.
library(shiny)
library(shinyBS)
ui = fluidPage(sidebarLayout(
sidebarPanel(
sliderInput(
"bins",
"Number of bins:",
min = 1,
max =
50,
value = 30
),
selectInput(
inputId = "Select1",
label = "Select1",
choices = c('A', 'B', 'C'),
selected = "A"
),
selectInput(
inputId = "Select2",
label = "Select2",
choices = c('A1', 'B1', 'C1'),
selected = "A1"
),
bsTooltip("bins", "Read", "right", options = list(container = "body"))
),
mainPanel(uiOutput("namelist"))
))
server =function(input, output, session) {
content<-reactive({
input$Select2
})
output$namelist<-renderUI({
textInput(inputId = "text1", label = input$Select1)
})
observeEvent(content(), {
addPopover(session, "namelist", "Data", content = content() , trigger = 'click')
})
}
shinyApp(ui, server)

Related

How do I use input from `selectizeInput` to filter a list of options and then `updateSelectizeInput`?

BACKGROUND:
I have a large list of stock symbols, 27,000 rows, that I would like to be choices in a selectizeInput() on a shinyApp. Since the list is large I am using server = T in updateSelectizeInput().
AIM:
I would like the options list to not load/render until a user starts typing a string into selectizeInput(), so that I can return all symbols that start with that letter, to reduce loading all 27,000 rows in the input. I would like input$ticker to be what is observed and then what triggers the filtering code logic. How can i achieve this without using a specific button?
Shown below is
intended output, but with a button to produce the behavior instead of the user being in the text box. This is along the lines of what I would like, but does not automatically start searchign when I type in the box and has bad code smell to me.
current logic, using input$ticker in an observer to trigger selection of df and populate updateSelectize() with new choices, but is failing and the app is evaluating too soon?\
trying to load choices once, using upload button only doesn't work
REPREX:
1.
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
choice <- reactive(
tickers[startsWith(tickers$symbol, input$ticker), ]
)
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choice(),
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize, glitches and `input$ticker` observer causes loop gltich?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# updateSelectizeInput(
# session = session,
# label = "Ticker:",
# inputId ="ticker",
# choices = tickers,
# server = TRUE
# )
observeEvent(input$ticker, {
choices <- tickers[startsWith(tickers$symbol, input$ticker), ]
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choices,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# One call to try and load ticker df
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = ticker,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
SEE SIMILAR POSTS:
SO POST 1, SO POST 2, SO POST 3
What do you think about something like this?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- fluidPage(
tags$head(
tags$script(
HTML(
'document.addEventListener("keydown", function(e) {
Shiny.setInputValue("key_pressed", e.key);
})'
)
)
),
fluidRow(
column(2, selectizeInput("select", "Select", choices = "")),
column(1, actionButton("btn", "Search"))
)
)
server <- function(input, output, session) {
observeEvent(input$btn, {
req(input$key_pressed)
updateSelectizeInput(session, "select", choices = tickers[startsWith(tickers, input$key_pressed)], server = TRUE)
})
}
shinyApp(ui, server)
Basically I think it is not possible to just use the words which are putted to the selectInput and we need separate input. I think that selectInput is truthy (isTruthy()) only after some option was chosen (and it can't be "" of course), so we can't use anything which is putted as a word to the selectInput box before some option is actually chosen. I'm not sure, but if I'm right, it is necessary to have separate input for what you want.
However, if we could assume that:
User will use only one letter to get the options to choose
Then we can use "keydown" event (keydown). Now the user doesn't need to put anything to the selectInput box, she/he can just use a key in the keyboards, like C (letter size does matter here, because we are using startsWith()) and then push "Search" button (but of course this letter can still be put to the selectInput box to mimic what you tried to achieve). We could even imagine solution without the button, but I'm afraid in most use-cases it will be not recommended, I mean if user can interact with the app using keyboard not only to choose the options, but also for other purposes, then we would recompute new options everytime user uses key in the keyboard for - well - nothing.
Turns out that selectizeInput doesn't accept a df and must be an atomic vector. When I used tickers[[1]], the issue seemed to be solved, and the list would no longer flash.

How to clear the mainPanel if a selectInput choice has changed?

I am trying to create an app that will show you results depending on a selectInput and the changes are controlled by actionButtons.
When you launch the app, you have to select a choice: Data 1 or Data 2. Once you have selected your choice (e.g. Data 1), you have to click the actionButton "submit type of data". Next, you go to the second tab, choose a column and then click "submit".
The output will be: one table, one text and one plot.
Then, if you go back to the first tab and select "Data 2", everything that you have generated is still there (as it is expected, since you didn't click any button).
However, I would like to remove everything that is in the mainPanel if I change my first selectInput as you could see it when you launch the app for the first time.
The idea is that since you have changed your first choice, you will have to do the same steps again (click everything again).
I would like to preserve and control the updates with actionButtons as I have in my code (since I am working with really long datasets and I don't want to depend on the speed of loading things that I don't want until I click the button). Nevertheless, I cannot think a way to remove everything from mainPanel if I change the choice of the first selectInput.
Does anybody have an idea how I can achieve this?
Thanks in advance
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(id="histogram",
tabPanel("Selection",
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
)
),
tabPanel("Pick the column",
br(),
selectizeInput(inputId = "list_columns", label = "Choose the column:", choices=character(0)),
actionButton(
inputId = "button2",
label = "Submit")
))
),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
)
)
server <- function(input, output, session) {
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button2)
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees), options=list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[,input$list_columns])
})
}
if (interactive())
shinyApp(ui, server)
Here is an example using a reset button - using the selectInput you'll end up with a circular reference:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(sidebarPanel(tabsetPanel(
id = "histogram",
tabPanel(
"Selection",
useShinyFeedback(),
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(
style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle")
)
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
actionButton(
inputId = "reset",
label = "Reset",
icon = icon("xmark")
)
),
tabPanel(
"Pick the column",
br(),
selectizeInput(
inputId = "list_columns",
label = "Choose the column:",
choices = character(0)
),
actionButton(inputId = "button2",
label = "Submit")
)
)),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
))
server <- function(input, output, session) {
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactiveVal(NULL)
observe({
if (input$type == "data1") {
mydata(mtcars)
} else if (input$type == "data2") {
mydata(iris)
} else {
mydata(data.frame())
}
}) %>% bindEvent(input$button2)
observeEvent(input$reset, {
mydata(data.frame())
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees),
options = list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[, input$list_columns])
})
}
shinyApp(ui, server)

Update multiple shiny apps inputs with different input widget types

I have designed a Shiny app with two action buttons, Save and Clear. When users click Save, the input values will be stored using local storage of the web browser. When users click Clear, the inputs and local storage would be cleaned.
These functionalities involves updating multiple inputs with update...Input. In this example, I have three inputs all with different widget types. I can specifically write them one by one, which works fine. However, I am wondering if there is a more efficient way to achieve this, such as using for loop or lapply. From this post (https://stackoverflow.com/a/41061114/7669809), it seems like I can use reactiveValuesToList to get all inputs. The real challenge to me is how to dynamically call different update...Input functions for the associated input widget types?
Please let me know if you have any suggestions.
### This script creates an example of the shinystore package
# Load packages
library(shiny)
library(shinyStore)
ui <- fluidPage(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
initStore("store", "shinyStore-ex1"),
textInput(inputId = "Text1", label = "Enter some texts")
),
mainPanel = mainPanel(
fluidRow(
numericInput(inputId = "Number1", label = "Enter a number", value = NA),
sliderInput(inputId = "Slider1", label = "Pick a number", min = 0, max = 100, value = 50),
actionButton("save", "Save", icon("save")),
actionButton("clear", "Clear", icon("stop"))
)
)
)
)
server <- function(input, output, session) {
observe({
if (input$save <= 0){
updateTextInput(session, inputId = "Text1", value = isolate(input$store)$Text1)
updateNumericInput(session, inputId = "Number1", value = isolate(input$store)$Number1)
updateSliderInput(session, inputId = "Slider1", value = isolate(input$store)$Slider1)
}
updateStore(session, name = "Text1", isolate(input$Text1))
updateStore(session, name = "Number1", isolate(input$Number1))
updateStore(session, name = "Slider1", isolate(input$Slider1))
})
observe({
if (input$clear > 0){
updateTextInput(session, inputId = "Text1", value = NA)
updateNumericInput(session, inputId = "Number1", value = NA)
updateSliderInput(session, inputId = "Slider1", value = 50)
updateStore(session, name = "Text1", value = NA)
updateStore(session, name = "Number1", value = NA)
updateStore(session, name = "Slider1", value = 50)
}
})
}
shinyApp(ui, server)
Unfortunately there is no generic updateInput function in shiny. It is still possible to build a wrapper that identifies a certain name to a certain input type, but that will also require to know which argument is allowed or no. For example, updateActionButton doesn't have value or choices as an argument so we'll need numerous if statements.
A possible workaround is to take advantage of renderUI and directly pass the stored values. The only downside is that some functions like SliderInput throw an error when some arguments are NULL, so an if statement is needed to appoint a default value for the first time the app runs. Alternatively a mock app can be executed once to only fill the first values.
Code:
library(shiny)
library(shinyStore)
library(tidyverse)
ui <- fluidPage(
initStore("store", "shinyStore-ex1"),
uiOutput('ui_all'))
server <- function(input, output, session) {
output$ui_all <- renderUI({
tagList(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
textInput(inputId = "Text1", label = "Enter some texts",value = input$store$Text1)
),
mainPanel = mainPanel(
fluidRow(
numericInput(inputId = "Number1", label = "Enter a number", value = input$store$Number1),
sliderInput(inputId = "Slider1", label = "Pick a number", min = 0, max = 100, value = if(is.null(input$store$Slider1)){50} else{input$store$Slider1}),
actionButton("save", "Save", icon("save")),
actionButton("clear", "Clear", icon("stop"))
)
)
))
})
input_nms <- map(c('Text', 'Number', 'Slider'), ~str_c(.x, 1:1)) %>%
reduce(c)
#or if every type of input is repeteated n different times.
# input_nms <- map2(c('Text', 'Number', 'Slider'), c(n1, n2, n3), ~str_c(.x, 1:.y)) %>%
# reduce(c)
observeEvent(input$save, {
input_nms %>%
walk(~updateStore(session = session, name = .x, value = isolate(input[[.x]])))
session$reload() #to force the UI to render again with the new values
})
observeEvent(input$clear, {
input_nms %>%
walk2(c(NA, NA, 50), ~updateStore(session = session, name = .x, value = .y))
})
}
shinyApp(ui, server)

R Shiny SelectizeInput dropdown avoid auto close

How to prevent the selectizeInput/pickerInput dropdown from closing by clicking outside in R Shiny?. Here is the sample code to explain the problem. I need to always see the selectizeInput choices even the user clicks the shiny body somewhere. The main selectizeInput dropdown should not close.
library(shiny)
library(shinyjs)
library(shinyWidgets)
ui <- fluidPage(
div(HTML("<br><br><br>")),
selectizeInput(
'upwardId', label = "Select Number", choices = 1:40,
options = list(maxItems = 20)
),
div(HTML("<br><br><br>")),
pickerInput(
inputId = "month",
label = "Select a month",
choices = c("Jan","Feb","March","Apr","May"),
multiple = TRUE,
options = pickerOptions(
maxOptions=3,
dropupAuto = FALSE,
actionsBox = TRUE,
title = "Please select a month",
header = "title..."
))
)
server <- function(input, output, session){}
shinyApp(ui, server)

Dynamically adding a user interface with multiple inputs

I am trying to dynamically add an input to a Shiny page. I want the user to select from a dropdown a choice and then have the option to add a numeric input corresponding to that choice.
Once I run the app I have two fields "Choice" and "Number". I want the user to click the "Add UI" button and be presented with another "Choice 2" and a "Number 2", when they click again they get "Choice 3" and "Number 3" etc.
Currently all I can manage to add is just another dropdown box. When I try to add numericInput(inputId = "numericWhichGoesWithIndicatorChoice", label = "Number", value = 3) to the insertUI part of the code I get errors.
Additionally, I would like to make it dynamic in the sense that the user can add as many inputs as they want and the inputs will be stored. i.e, inputId = "indicatorChoice", inputId = "indicatorChoice2", inputId = "indicatorChoice3" etc.
Code:
library(shiny)
ui <- fluidPage(
actionButton("add", "Add UI"),
wellPanel(
selectInput(inputId = "indicatorChoice", label = "Choice", choices = c("choice1", "choice2", "choice3")),
numericInput(inputId = "numericWhichGoesWithIndicatorChoice", label = "Number", value = 3)
)
)
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui = selectInput(inputId = "indicatorChoice", label = "Choice 2", choices = c("choice1", "choice2", "choice3"))
)
})
}
shinyApp(ui, server)

Resources