I have created a datatable in an R shiny app at the top of the page with input controls at the bottom that determine the data displayed in that table.
The table is long, and the user must therefore scroll down to access the input controls. But upon changing any single input control, the app will automatically scroll to the top of the page.
How can I prevent automatic scrolling to the top of the page when changing the inputs? (Note that I do not want to delay updating of the table until all inputs are changed by having, for example, an 'Update table' button that must be clicked, in which case automatic scrolling would be OK.)
Note that this hasn't worked for me:
R shiny: how to stop sliderInput label click from causing scroll to top of page?
Example code:
library(shiny)
library(DT)
# Define UI
ui <- shinyUI(
fluidRow(
column(3,
DT::dataTableOutput("exampleOutput"),
numericInput("var", h5("Row value"), value = 100)
)
)
)
server <- function(input, output) {
exampleTable <- reactive({
transactionCostsDataFrame <- data.frame(
"Transaction" = rep(input$var, 100))
})
output$exampleOutput <- DT::renderDataTable(
DT::datatable(exampleTable(), escape = FALSE,
options = list(dom = "t", ordering = FALSE,
bFilter = 0, pageLength = 100))
)
}
# Run the app
shinyApp(ui = ui, server = server)
Related
Is it possible to create a tick-box to record an user's input without using Shiny?
For example
A program is launched
A window with boxes to tick is open
The user ticks one of the boxes
The input is sent to a variable
Is this possible?
its done with the runGadget ability that miniUI adds to shiny
i.e. make a lightweight shiny app that can pop up in a dialog window and the values get returned to the calling environment. example for you .
library(miniUI)
library(shiny)
checker <- function() {
ui <- miniPage(
gadgetTitleBar(paste("Tick Boxes")),
miniButtonBlock(
checkboxInput(inputId = "check_1",
label = "check 1 ?"),
checkboxInput(inputId = "check_2",
label = "check 2 ?")
)
)
server <- function(input, output) {
observeEvent(input$done, {
stopApp(list(
c1 = input$check_1,
c2 = input$check_2
))
})
observeEvent(input$cancel, {
stopApp(NULL)
})
}
runGadget(ui, server,viewer = dialogViewer("my diag"))
}
checker()
I want the user to click a button and then the renderDataTable function gets called
This is what I'm doing now:
The UI has this:
ui <- fluidPage(
actionButton("tbl","Show Table"),
DT::dataTableOutput("t_all")
)
Server:
server <- function(input, output){
summary_table_RCT <- eventReactive(input$tbl, {summary_table})
output$t_all <-
DT::renderDataTable(
summary_table_RCT(),
filter = 'top',
class = "cell-border stripe",
rownames = FALSE,
extensions = c("FixedColumns"),
options = list(searchHighlight = TRUE,
regex = TRUE,
scrollX = TRUE,
fixedColumns = list(leftColumns = 5))
)
}
shinyApp(ui, server)
Not sure why it's not working this is almost the same as some of the examples I've seen for eventReactive(). I see the button show up, but it doesn't do anything when clicked.
Found the answer, hopefully someone who has to go through the same frustration finds this before it makes them nuts. But in a different tab in the app, another developer used a submitButton(), which basically interrupts ALL reactive events until the button is pressed. Should only only be used in very simple apps, where you only have one button.
With Shiny when you use SelectizeInput with multiple = TRUE:
a dropdown menu with all the element appears as soon as you are in
that box.
Then, when you start typing, the result in the dropdown
menu are filtered depending on what you type.
When the list is very long, sometimes the point 1 is pointless. Is it possible to see the dropdown only when you start typing (only from point 2)?
Reproducible example:
ui <- fluidPage(
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
selectizeInput has an options argument, which is a list of parameters to initialize the selectize input. One of these options is openOnFocus which is
Show the dropdown immediately when the control receives focus.
Turning off openOnFocus solves the issue.
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE,
options = list(openOnFocus = FALSE,
#If the user write aa then delete it all, the complete list will show up again,
#use maxOptions to solve this issue
maxOptions = 3))
See the full list here selectize
/
selectize.js.
I am developing a Shiny application which has two components Sankey Diagram and one action button which pop up "SaveMsg" dialog box on click of button .
I am seeing unexpected behavior where, If I user actionbutton and Sankeyvisualization in one dashboard, on click of action button, dashboard screen greyed out.
however If I comment Sankey code and keep only Action button on UI, Action button works as expected by showing pop up message of "save successfull".
If I comment action button code and keep only Sankey code in UI, I am able to see sankey output on dashboard.
Sankey code and action button both are working as expected separately, however if I place both in one dashboard action button greyed outscreen dashboard screen.
I have also attached sample code-
library(shiny)
library(networkD3)
library(shinydashboard)
value <- c(12,21,41,12,81)
source <- c(4,1,5,2,1)
target <- c(0,0,1,3,3)
edges2 <- data.frame(cbind(value,source,target))
names(edges2) <- c("value","source","target")
indx <- c(0,1,2,3,4,5)
ID <- c('CITY_1','CITY_2','CITY_3','CITY_4','CITY_5','CITY_6')
nodes <-data.frame(cbind(ID,indx))
ui <- dashboardPage(
dashboardHeader(
),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidPage(
actionLink("savebtn", "Save button")
,sankeyNetworkOutput("simple")
)
)
)
server <- function(input, output,session) {
# Show modal when button is clicked.
observeEvent(input$savebtn, {
showModal(modalDialog(
title = "Save successful"))
})
output$simple <- renderSankeyNetwork({
sankeyNetwork(Links = edges2, Nodes = nodes,
Source = "source", Target = "target",
Value = "value", NodeID = "ID"
,units = "SSN" )
})
}
shinyApp(ui = ui, server = server)
I haven't dug into the problem so I'm not sure why that's happening. But in case the modal you want to show is just some text (doesn't contain shiny elements), you can use shinyalert which also does modals (not on CRAN yet, haven't published it yet). Here's your code using shinyalert. Hope that helps
library(shiny)
library(networkD3)
library(shinyalert)
value <- c(12,21,41,12,81)
source <- c(4,1,5,2,1)
target <- c(0,0,1,3,3)
edges2 <- data.frame(cbind(value,source,target))
names(edges2) <- c("value","source","target")
indx <- c(0,1,2,3,4,5)
ID <- c('CITY_1','CITY_2','CITY_3','CITY_4','CITY_5','CITY_6')
nodes <-data.frame(cbind(ID,indx))
ui <- dashboardPage(
dashboardHeader(
),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidPage(
useShinyalert()
,actionLink("savebtn", "Save button")
,sankeyNetworkOutput("simple")
)
)
)
server <- function(input, output,session) {
# Show modal when button is clicked.
observeEvent(input$savebtn, {
shinyalert("Save successful")
})
output$simple <- renderSankeyNetwork({
sankeyNetwork(Links = edges2, Nodes = nodes,
Source = "source", Target = "target",
Value = "value", NodeID = "ID"
,units = "SSN" )
})
}
shinyApp(ui = ui, server = server)
UPDATE (2019.05.20)
This issue has been resolved with the dev version of shiny and should be released on CRAN soon as shiny v1.3.3.
This issue has already been reported here, and I believe it's similar to what was reported here. The JavaScript used by sankeyNetwork() adds a <foreignObject><xhtml:body>... to wrap the SVG titles to facilitate multi-line titles in older versions of IE. That structure apparently conflicts with what bootstrap-datepicker does, and after a little bit of testing, I can verify that this seems to be at the root of what is happening here as well. There is a pull request already that should fix this on the networkD3 end, but it has not been vetted and merged yet. Once it has, installing and using the dev version of networkD3 should resolve this problem. I think this should also be fixed upstream since the <foreignObject><xhtml:body>... structure seems to be valid HTML/SVG.
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.