dropdown does not work if added with insertUI in Shiny R.
Please help making it work.
Here is the minimal example code demonstrating the issue:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdown(textInput("text", label = NULL, value = "text"),
icon = icon("table"), label = "works"),
actionButton("add", "Add content to div2"),
div(id = "div2")
)
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(selector = "#div2",
where = "beforeEnd",
ui = dropdown(textInput("text", label = NULL, value = "text"),
icon = icon("table"), label = "does not work"))
})
}
shinyApp(ui = ui, server = server)
Solved by updating shinyWidgets to 0.7.3 and shiny to 1.7.2
Apparently, this was related to a known issue with scripts inside insertUI() and was solved by a recent update.
https://github.com/rstudio/shiny/issues/1545
Related
I am trying to build a simple To do list app using Shiny, the application is very simple, there's a textInput where I put things I want to do, and submit it, and it creates a checkbox. What I want to achieve is, if I check the box, there will be a text on the right side that says: "you have done XXX", the XXX is the information of the checkbox.
So far, I have managed to figure out how to insert a checkbox back into the UI however, I have problems in: writing the party of the code that once the checkbox is checked, generate a text which says " you have done XXX"
The two main difficulties is : 1. listen to the inserted UI (each checkbox needs a special id, but I can't write logic in the server components that has indeterministic checkbox id. Also, I can figure out a way to extract the content of the checkbox from the server side, the input$checkbox only gives me true or false value.
This is the code I am working on so far, I am wondering if this functionality is achievable using Shiny-R?
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxInput("checkbox","Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
inserted <- c()
observeEvent(input$todoBnt, {
insertUI(
selector = "#start",
where = "afterEnd",
ui = checkboxInput("chekcbox",input$todo)
)
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({ input$checkbox }) ##this gives "TRUE" value, I don't think it's right.
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)
I have tried to search answer online, but I think the checkbox in Shiny-R is mainly used to filter graphs etc... So I am not sure if the function I want is actually achievable using the langague. Please help!
Instead of inserting each checkbox separately one option would be to switch to a checkboxGroupInput which you could update in your observeEvent. Doing so makes it easy to get a list of things you have done. However, doing so requires to track the things to do for which I use a reactiveVal choices which gets updated each time a new item is added to the to-do list:
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "sketchy"),
titlePanel("A simple todo App"),
sidebarLayout(
sidebarPanel(
# Date configuration
dateInput("date", label = "Date Configuration"),
# Things to do
h3("Daily Todo", id="start", style = "color:grey", align = "center"),
checkboxGroupInput("checkbox", label = "", choices = "Submit One Job Application"),
textInput("todo", label = "Other things to do"),
actionButton("todoBnt", label = "Submit"),
br(),
br(),
textInput("learnt", label = "Key things learnt"),
actionButton("learntBnt", label = "Submit")),
mainPanel(
h1(textOutput("timing"), align = "center"),
h1("What have I done",align = "center"),
verbatimTextOutput("value"),
h1("What have I learnt", align = "center"),
h2(textOutput("selected_var"),align = "center"),
p(textOutput("summary"),align="center"))
)
)
server <- function(input, output) {
choices <- reactiveVal("Submit One Job Application")
inserted <- c()
observeEvent(input$todoBnt, {
selected <- input$checkbox
choices(c(choices(), input$todo))
updateCheckboxGroupInput(inputId = "checkbox", choices = choices(), selected = selected)
updateTextInput(inputId = "todo", value = "")
})
output$timing <- renderText({
paste0("Today is ", as.character(input$date))
})
output$value <- renderText({
paste(input$checkbox, collapse = "\n")
})
output$summary <- renderText({
paste0("I have learnt to ", input$learnt, "!")
})
}
shinyApp(ui = ui, server = server)
I use the package shinyjs to allow the user to reload the page by clicking on "Reload the page" button in Tab 2 and I would like to stay on Tab 2 after reloading the page. But after realoading, the page is taking to Tab1 instead of Tab2
How can we fix it ? This is my code below :
library(shiny)
library(shinyjs)
jscode <- "shinyjs.refresh = function() { history.go(0); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "refresh"),
tabsetPanel(
tabPanel("Tab 1"),
tabPanel("Tab 2", actionButton("mybutton", "Reload the page",
onclick ="javascript:window.location.reload(true)")))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Some help would be appreciated
You can resort to plain JavaScript. The idea is that you provide an id to tabsetPanel such that you can use updateTabsetPanel in the server.
All you have to do then is to let the reloaded page know that you want to start on the second tab. As a refresh typically resets all of the inputs and reactives (you are aware of that, right?), you cannot use reactives and you have to rely on another way of communication. The query string would be one possibility.
With these ingredients you can:
Write a simple JavaScript function that reloads the page and adds a parameter to the url.
Parse the query string in the server and if the parameter is found, react on it accordingly.
library(shiny)
js <- HTML("
function doReload(tab_index) {
let loc = window.location;
let params = new URLSearchParams(loc.search);
params.set('tab_index', tab_index);
loc.replace(loc.origin + loc.pathname + '?' + params.toString());
}")
ui <- fluidPage(
tags$head(tags$script(js, type ="text/javascript")),
tabsetPanel(
tabPanel("Tab 1", value = "tab1"),
tabPanel("Tab 2", value = "tab2",
actionButton("mybutton", "Reload the page",
onclick = "doReload('tab2')")),
id = "tabsets"
)
)
server <- function(input, output, session) {
observe({
params <- parseQueryString(session$clientData$url_search)
if ("tab_index" %in% names(params)) {
updateTabsetPanel(session, "tabsets", selected = params$tab_index)
}
})
}
shinyApp(ui = ui, server = server)
I am building an shiny app, where users upload a bunch of data and than choose which should be computed. The computation itself is rather timeconsuming and should be stored in a list. To keep shiny responsive during the calculation (for the user and other users) I tried to utilize promises and future. The problem is that I am not able to get an input into future function. I always get Warning: Error in $: Can't access reactive value 'mem_pos' outside of reactive consumer. i Do you need to wrap inside reactive() or observe()? [No stack trace available]. I tried to read about reactive but I am simply stuck.
Here is a minimal example of the problem (to display it, the list has only one value each):
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( input$mem_pos ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lies the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
If the problematic line is exchanged by observeEvent(input$mem_button, {future({return(subfct( 5 ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) it basically works. But I am not able to get the user input into the function. I am grateful for a direct help or an explanation of reactive for my specific problem.
I solved it. Not enterily sure why, but isolate does the trick.
This code works for me:
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( isolate(input$mem_pos) ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lied the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
You may try to use delay() function from shinyjs package. This enables the code to run only after the times set lapses. e.g.
library(shinyjs)
ui<-fluidPage(useShinyjs(),
...)
server<-function(input,output, session){
delay (ms=,
...)
}
shinyApp(ui,server)
I am building a shiny app and I am using two sidebarLayouts. I’m looking for a way to minimize them. I have try put each sidebarLayout into a box.
Example code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
headerPanel("Here goes the heder"),
box(sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs"))),
width = 12,
title = "BB",
collapsible = T,
collapsed = F
)
)
server <- function(input, output) {
output$someinputs <- renderText({
"Here will go the inputs"
})
output$someoutputs <- renderText({
"Here will go the outputs"
})
}
shinyApp(ui, server)
Output:
When I press the collapsible button the Layout does not collapse. Why is this happening? What should I do? Is there other way to do this?
Because you didn't use shinydashboard. The box comes from shinydashboard package. You need to use shinydashboard::dashboardPage instead of fluidPage.
dashboardPage Loads required javascripts and CSS files to toggle the button.
library(shiny)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)
)
)
If you don't want to use dashboardPage, you can write your own scripts to control the button:
library(magrittr)
library(shiny)
ui <- fluidPage(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)%>% {.$attribs[['id']] <- 'example-box'; .},
tags$head(tags$script(
"$(document).ready(function(){
$('#example-box button').attr({
'data-toggle':'collapse',
'data-target':'#example-box .box-body',
'aria-expanded':false
})
})"
))
)
I used a hack to assign an ID to the box %>% {.$attribs[['id']] <- 'example-box'; .}, and use some jquery to control the button. Be sure the ID in the script matches the ID you assign in UI, example-box in this case. In javascript, you add # for ID searching, so #example-box.
I wouldn't recommend you to use the second way. You can see in your UI, it's not really a box. It has no border and the button is not at the right place. If you use dashboardPage, you can see the difference.
I have been working on a shiny app and within my action buttons I save the output as html using render::rmarkdown() and its working perfect, however if I want to add with progress to the app, it doesnt count the rmarkdown saving time which is the actual waiting time for the user
sample of part of my problem:
test_fun <- function()
{
for (i in 1:15) {
incProgress(1/15)
sum(runif(10000000,0,1))
}
}
ui part:
sidebarLayout(
sidebarPanel(
actionButton("nplrhits", 'DSS top Hits')
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("nplrwfall")
server script:
observeEvent(input$nplrhits, {
output$nplrwfall <- renderPlotly({
withProgress(message = 'Calculation in progress',
detail = 'This may take a while...', value = 0, {
test_fun()
})
rmarkdown::render(paste0(dir_path,"/R_scripts/Hits_Waterfall.Rmd"), output_file = paste0(dir_path,"/results/Patient/",input$txt, "/Hits_Waterfall.html"))
plotly::ggplotly(pn)})
})