Related
Questions
Why when I click the "Next" button and then return to the first screen using the "Back" button, the condition works and I can't go forward until I click in at least one option, but the first time it does not work that way?
Are there any workaround to create dynamic screens / inputs and use its status to control the steps like a dynamic form?
Explanation
I use insertUI() with a glide() inside it in the server function. To create the first screen of the glide I use shinyglide::screenOutput() and since shinyglide use the same syntax as conditionalPanel() the next_condition parameter is based in this [conditionalPanel problem][1] from Dean Attali's github.
Code
# libraries
library(shiny)
library(shinyglide)
library(shinyjs)
# ui
ui <- fluidPage(useShinyjs(),
tags$div(id = 'placeholder'),
actionButton("btn",
"button"))
# server
server <- function(input, output, session) {
# insertUI() when btn is clicked
observeEvent(input$btn, {
disable("btn")
insertUI(selector = '#placeholder',
ui = tags$div(fixedPage(
glide(
id = "glide",
screenOutput(outputId = "screen",
next_condition = "output['next_condition'] == 1"),
screen(p("Second screen."))
)
)))
})
# screenOutput() for the first screen
output$screen <- renderUI({
checkboxGroupInput("checkbox", "checkbox", list("A", "B"))
})
# condition to shinyglide works
outputOptions(output, "screen", suspendWhenHidden = FALSE)
# output variable in the server code that is used in argument 'next_condition' in screenOutput()
output$next_condition <- reactive({
if (isTruthy(input$checkbox)) {
1
} else {
0
}
})
# condition to output works
outputOptions(output, "next_condition", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
[1]: https://github.com/daattali/advanced-shiny/blob/master/server-to-ui-variable/app.R
I am trying to hide the conditional panel illustrated below when there is any user input other than the user clicking on the action button "Delete" or making a selection in the selectInput() function rendered in the conditional panel, as shown in the below image. Other user inputs will be added (action buttons, radio buttons, selectInputs, etc.) so it isn't feasible to list each action that causes the conditional panel to hide. That conditional panel should always render upon the click of "Delete". Any suggestions for how to do this? Code is shown at the bottom.
Code:
library(rhandsontable)
library(shiny)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3,conditionalPanel(condition = "input.delCol",uiOutput("delCol"))) # js here
)
)
server <- function(input, output) {
output$mytable = renderRHandsontable(df())
df <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol,
{output$delCol<-renderUI(selectInput("delCol",label=NULL,choices=colnames(mydata),selected="Col 1"))}
)
}
shinyApp(ui,server)
Per Mike´s comment I started with shinyjs and this simple example from the shinyjs reference manual, with minor modification for 2 buttons:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(), # Set up shinyjs
actionButton("btn", "Click to show"),
actionButton("btn1","Click to hide"),
hidden(p(id = "element", "I was invisible"))
)
server = function(input, output) {
observeEvent(input$btn, {show("element")})
observeEvent(input$btn1,{hide("element")})
}
shinyApp(ui,server)
Then I expanded it to my code in the OP per the below. Note that this will still require an observeEvent() for each user action that triggers selectInput() to hide instead of a global hide every time there's any user input other than a click of "Delete" action button. I'm not sure this is possible but will continue researching. Multiple observeEvents() won't be too bad of an option in any case.
Resolving code:
library(rhandsontable)
library(shiny)
library(shinyjs)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(
useShinyjs(), # set up shinyjs
br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3, hidden(uiOutput("delCol2")))) # hide selectInput()
)
server <- function(input,output,session){
output$mytable = renderRHandsontable(dat())
dat <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol, show("delCol2")) # clicking Delete button reveals selectInput()
observeEvent(input$addCol, hide("delCol2")) # clicking Add hides selectInput()
output$delCol2 <-renderUI({
selectInput(
"delCol3",
label=NULL,
choices=colnames(mydata),
selected="Col 1"
)
})
}
shinyApp(ui,server)
I am creating a shiny app that uses a DataTable. I want to create keyboard shortcuts for different elements in this app, which I can. However these shortcuts should only be triggered if the user has the search-bar blurred out. Expressed in another way: The shortcuts should not activate if the build in search-bar is focused.
I tried with the code below which works for a standard input-field. For some reason the DataTable search is not counted as a input-field as it does not react to the js-code. Does anyone know of a way to make a focus/blur check (onfocus or onblur events) for the DataTable searchbar?
library(shiny)
library(DT)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
tags$script('$(document).on("keypress", function (e) {Shiny.onInputChange("keytyped", [e.which,e.timeStamp]);});'),
tags$script('$(document).ready(function() {
$("input").on("focus", function(){
Shiny.onInputChange("foc", 1);
});
$("input").on("blur", function(){
Shiny.onInputChange("foc", 0);
});
});'),
DT::dataTableOutput("datdata"),
textInput("test", "Test:")
)
server <- function(input, output, session) {
output$datdata <- DT::renderDataTable(mtcars
## THIS CALLBACK ONLY DOES SOMETHING WHEN SEARCHING! I NEED IT TO DO SOMETHING ON FOCUS!
# , callback = JS(
# 'table.on("search.dt", function(){
# Shiny.onInputChange("foc", 1);
# })'
# )
)
observe({
req(input$keytyped)
req(is.null(input$foc) | !input$foc)
## (Big letter codes) R = 82, S = 83, T = 84
check <- round(input$keytyped[1]) %in% c(82,83,84)
if(check){
print("ACTIVATE!")
}
})
# Print DataTable search and if input-fields are focussed.
observe(print(input$datdata_search))
observe(print(input$foc))
}
shinyApp(ui, server)
I know above code is not bullet proof (Typing "R" then clicking anywhere else but the test-field 'activates' the shortcut), but I just wanted to provide a small example.
TLDR; Is it possible to make the app print 1 or 0 depending on whether the search bar from DataTable is focused or not.
EDIT: SmokeyShakers did what I asked for. But an addition I needed was that it should ONLY be on the search-bar the value should change. Removing
tags$script('$(document).ready(function() {
$("#test").on("focus", function(){
Shiny.onInputChange("foc", 1);
});
$("#test").on("blur", function(){
Shiny.onInputChange("foc", 0);
});
});')
and then replacing "input" with "#datdata input" in the solution code solved my problem!
htmlwidgets::onRender can solve this issue. Try this for your datatable:
output$datdata <- DT::renderDataTable(
htmlwidgets::onRender(
DT::datatable(mtcars), jsCode = HTML('function() {
$("input").on("focus", function(){
Shiny.onInputChange("foc", 1);
});
$("input").on("blur", function(){
Shiny.onInputChange("foc", 0);
});
}')))
I am trying to highlight elements of my bsModal with the r wrapper for intro.js, however cannot get it to work. I have also tried to include custom js scripts, but my js is terrible.
I have also set up multiple different tests hoping it would snag onto something, however it seem like intro.js cannot find the modal's div or any any of the of the elements inside it. I am using rintrojs
Here are some example of people getting it to work in javascript:
https://github.com/usablica/intro.js/issues/302
How do I fire a modal for the next step in my introjs?
But I personally don't know Javascript well enough to integrate a custom solution myself. I've already tried :(
Here's a link to an example I've hosted with the issue:
https://arun-sharma.shinyapps.io/introjs/
Does anyone know how I can get the following dummy example to work?
library(rintrojs)
library(shiny)
library(shinydashboard)
intro_df <- data.frame(element = c('#plot_box', '#bttn2', '#box', '#modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'test modal'))
ui <- shinyUI(fluidPage(
introjsUI(),
mainPanel(
bsModal('modal', '', '', uiOutput('plot_box'), size = 'large'),
actionButton("bttn", "Start intro")
)))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
actionButton('bttn2', 'dummy'),
plotOutput('plot'), width = '100%'
)
})
observeEvent(input$bttn,{
toggleModal(session, 'modal', toggle = 'toggle')
introjs(session, options = list(steps = intro_df))
})
})
shinyApp(ui = ui, server = server)
Ultimately, I think this request could make for some useful features in the rintrojs library. In any case, your problems are two-fold:
introjs should not fire until the modal is available in the HTML. The easiest way to do this is to use a button within the modal to fire the tutorial. If you want it to be automatic, you will need some JavaScript that waits until the Modal is ready before firing.
introjs wants to grey out the background and highlight the current item in the tutorial. This means it needs to "interleave" with the modal children. Because the modal is its own stacking context, introjs needs to be fired from within the modal to look at modal children. If you want to look at the entire modal, then it is sufficient to fire introjs from the parent. This functionality does not seem to be in the rintrojs package yet, but is in the JavaScript library.
In order to accomplish #1, I added a JavaScript function to fire introjs on Modal load (after a configurable delay for HTML elements to load). This requires the shinyjs package. Notice the introJs(modal_id), this ensures that the tutorial fires within the modal. In pure JavaScript, it would be introJs('#modal'):
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
I also added a simple helper for closing the introjs tutorial when navigating away from the modal.
introjs_exit <- function(){
runjs("introJs().exit()")
}
There was also a single line of CSS necessary to fix the modal-backdrop from getting over-eager and taking over the DOM:
.modal-backdrop { z-index: -10;}
And a (large / not minimal) working example with multiple modals.
library(rintrojs)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
intro_df <- data.frame(element = c('#plot_box', '#bttn2', '#box', '#modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'test modal'))
intro_df2 <- data.frame(element = c('#plot_box2'),
intro = c('test plot_box'))
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
introjs_exit <- function(){
runjs("introJs().exit()")
}
ui <- shinyUI(fluidPage(
useShinyjs(),
tags$head(tags$style(".modal-backdrop { z-index: -10;}")),
introjsUI(),
mainPanel(
bsModal('modal', '', '', uiOutput('plot_box'), size = 'large'),
bsModal('modalblah', '', '', uiOutput('plot_box2'), size = 'large'),
actionButton("bttn", "Start intro")
)))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot2 <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
actionButton('bttn2', 'dummy'),
plotOutput('plot'), width = '100%'
)
})
output$plot_box2 <- renderUI({
box(id = 'box2',
plotOutput('plot2'), width = '100%'
)
})
run_introjs_on_modal_up("#modal",intro_df, 1000)
run_introjs_on_modal_up("#modalblah",intro_df2, 1000)
observeEvent(input$bttn,{
toggleModal(session, 'modal', toggle = 'toggle')
})
observeEvent(input$bttn2, {
toggleModal(session, 'modal', toggle = 'toggle')
introjs_exit()
toggleModal(session, 'modalblah', toggle = 'toggle')
})
})
shinyApp(ui = ui, server = server)
I was able to fix the problem by adding
.introjs-fixParent.modal {
z-index:1050 !important;
}
to my CSS.
Working example:
library(rintrojs)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
intro_df <- data.frame(element = c('#plot_box', '#bttn2_intro', '#box', '#plot', '#shiny-modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'plot', 'test modal'))
ui <- shinyUI(fluidPage(
dashboardPage(dashboardHeader(title = "Test"),
dashboardSidebar(sidebarMenu(menuItem("item1", tabName = "item1"))),
dashboardBody(tabItems(tabItem("item1", actionButton("bttn", "start intro"))))),
useShinyjs(),
tags$head(tags$style(".introjs-fixParent.modal {
z-index:1050 !important;
}")),
introjsUI()
))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
div(id = "bttn2_intro", actionButton('bttn2', 'dummy')),
plotOutput('plot'), width = '100%'
)
})
observeEvent(input$bttn,{
showModal(modalDialog(uiOutput('plot_box')))
})
observeEvent(input$bttn2, {
introjs(session, options = list(steps = intro_df))
})
})
shinyApp(ui = ui, server = server)
I'm working on a shiny app in which I only want to want textouput on hover or mouse over action
I tried adding an action button
UI:
fluidRow(box (title = p("Rates by Gender and Race", actionButton("titleBtId", "", icon=icon('question-circle'),class = "btn-xs", title = "Info"),textOutput("text_id"),hover=T), width = 15, status = 'primary', solidHeader = TRUE,tabPanel('',plotlyOutput("racegender",height = "100%"))%>% withSpinner(color="#0dc5c1")))
Server:
output$text_id <- renderText({
paste0("hi")
})
I'm not sure how would I edit it to only display text on hover
An alternative to modal popups, depending on what user experience you want, is to use tooltips from the shinyBS package, which has functions for subtle but effective popups and tooltips. Here is an example of the different functionality of hovering or clicking, and putting the tooltips in the UI or in the server, with equivalent experience. Note that theoretically you could put a hover tooltip in the UI using tipify(), but for some reason this doesn't seem to be working with actionButtons though it continues to work for other input elements.
library(shiny)
library(shinyBS)
ui <- fluidPage(
titlePanel("ShinyBS tooltips"),
actionButton("btn", "On hover"),
tipify(actionButton("btn2", "On click"), "Hello again! This is a click-able pop-up", placement="bottom", trigger = "click")
)
server <- function(input, output, session) {
addTooltip(session=session,id="btn",title="Hello! This is a hover pop-up. You'll have to click to see the next one.")
}
shinyApp(ui, server)
Got it working using ModalDialog
UI
fluidRow(
box (title = p("Rates by Gender and Race", tags$head( tags$style(HTML('#titleBtId{background-color:black}'))), actionButton("titleBtId", "", icon=icon('question-circle'),class = "btn-xs", title = "Info"),hover=T), width = 15, status = 'primary', solidHeader = TRUE, tabPanel('',plotlyOutput("racegender",height = "100%"))%>% withSpinner(color="#0dc5c1")))
Server:
observeEvent(input$titleBtId, {
showModal(modalDialog(
title = "Note",
"This chart if independent of Date-range and Age-range selections",
easyClose = TRUE
))
})