How to listen to checkbox event that has been insert into ui using `insertUI` in Shiny-R - shiny

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)

Related

How can I use the searchPanes extension and server-side processing in my R Shiny app?

I've been able to create a working Shiny app with the datatables searchPanes extension. The problem is that my table is huge, which makes searchPanes go too slow; plus I have the cascadePanes option turned on, which slows down my table row filtering even more. Currently the data processing is done on the client side but I have read that it is more efficient on the server side, therefore I would like to change the configuration of my app to work on the server side.
This link on the datatables website explains how to configure searchPanes with server processing, but I don't know how to apply this information to my shiny application.
I attach a minimal example of my application with the iris data:
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output) {
output$table <- renderDT({
datatable(
iris,
class = 'white-space: nowrap cell-border',
extensions = c("SearchPanes", "Select", "Buttons", "Scroller"),
selection = "none", rownames = F, filter = "none",
options = list(
select = "multiple",
scrollY = "497px", scrollCollapse = TRUE, searching = TRUE,
scrollX = FALSE, autoWidth = FALSE,
info = TRUE,
paging = TRUE,
dom = "Brtip",
buttons = list(
# searchPanes button
list(
extend="searchPanes",
config = list(cascadePanes = T,combiner="and")
),
# clear filters button
list(
extend="searchPanes",
text="clear filters",
action=JS(
"function(e, table, node, config){",
" table.searchPanes.clearSelections();",
"}"
)
),
# select all rows
list(
extend='selectAll',
className='selectAll',
text="select all",
action = JS(
"function(e, table, node, config) {",
" table.rows({ search: 'applied'}).deselect();",
" table.rows({ search: 'applied'}).select();",
"}"
)
),
# deselect all rows
"selectNone",
# page length button
"pageLength"
),
language = list(
# show number of active filters in button text
searchPanes = list(collapse = paste("Filter rows: ",'Filters Selected - %d'))
)
)
)
},server = F)
}
shinyApp(ui, server)
I have read this post where the user Kraggle uses the function dataTableProxy() from the DT package, but I don't know how to capture the button input from searchpanes since I have defined it inside a custom button.

Reload a page and switch to tab

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)

dropdown does not work if added with insertUI in Shiny R

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

How to minimize a sidebarLayout in a Shiny App?

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.

How to programmatically collapse a box in shiny dashboard

I'm trying to collapse a box programmatically when an input changes. It seems that I only need to add the class "collapsed-box" to the box, I tried to use the shinyjs function addClass, but I don't know how to do that becuase a box doesn't have an id. Here as simple basic code that can be used to test possible solutions:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(collapsible = TRUE,p("Test")),
actionButton("bt1", "Collapse")
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
# collapse the box
})
}
shinyApp(ui, server)
I've never tried using boxes before so keep in mind that my answer might be very narrow minded. But I took a quick look and it looks like simply setting the "collapsed-box" class on the box does not actually make the box collapse. So instead my next thought was to actually click the collapse button programatically.
As you said, there isn't an identifier associated with the box, so my solution was to add an id argument to box. I initially expected that to be the id of the box, but instead it looks like that id is given to an element inside the box. No problem - it just means that in order to select the collapse button, we need to take the id, look up the DOM tree to find the box element, and then look back down the DOM tree to find the button.
I hope everything I said makes sense. Even if it doesn't, this code should still work and will hopefully make things a little more clear :)
library(shiny)
library(shinydashboard)
library(shinyjs)
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = "collapse"),
actionButton("bt1", "Collapse box1"),
actionButton("bt2", "Collapse box2"),
br(), br(),
box(id = "box1", collapsible = TRUE, p("Box 1")),
box(id = "box2", collapsible = TRUE, p("Box 2"))
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
js$collapse("box1")
})
observeEvent(input$bt2, {
js$collapse("box2")
})
}
shinyApp(ui, server)