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.
Related
It appears that DT::dataTableProxy is not possible with SearchPanes extension because:
SearchPanes requires Select extension.
Select extension requires DT::renderDT(server = FALSE) option.
DT::dataTableProxy does not work on the client side and throws DT error.
library(shiny)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
shiny::selectInput("rows", label = "Rows", choices = 1:nrow(mtcars)),
shiny::actionButton("new", label = "New Data")
),
dashboardBody(DT::dataTableOutput("cars"))
)
server <- function(input, output) {
rows <- reactive({ input$rows })
output$cars <- DT::renderDataTable(server = FALSE, {
expr = DT::datatable(
data = mtcars |> head(rows())
#,
#extensions = c("SearchPanes", "Select", "Buttons"),
#options = list(
# dom = "Btip",
# buttons = list("searchPanes")
#)
)
})
dtProxy <- DT::dataTableProxy("cars")
observeEvent(input$new, label = "Observe button proxy update", {
doubledata <- bind_rows(mtcars, mtcars)
DT::replaceData(proxy = dtProxy,
data = doubledata,
resetPaging = FALSE)
})
}
shinyApp(ui, server)
Try this code using server = FALSE, click New Data, you will receive DT Warning:
DataTables warning: table id=DataTables_Table_0 - Invalid JSON response. For more information about this error, please see http://datatables.net/tn/1
Remove server = FALSE and proxy runs.
Remove the commented section, and search panes appear, but with no actual filters represented, and message stating that if we really want to use select extension then set select = 'none'.
Here are some reference materials:
RStudio DT Extensions
Matt Herman Tutorial
What I ended up doing was use only the DT::datatableProxy feature, then use a custom button for the search panes. Custom button was found here How to add custom button in R Shiny datatable. This required making a new reactive which was invalidated by the first, and checking if the inputs had any new values. Then the proxy received the filtered data.
Maybe someday they will add support for search panes.
Add server-side support for SearchPanes extension #877
I have downloaded and would like to incorporate in my R Shiny app the following JavaScript library: GitHub link
As you can see in the snippet below, I have incorporated the sequence-viewer.min.js file in the head of the UI. Additionally, using the tags$div(id="sequence-viewer") I am able to see the corresponding <div> tag in the source of the web page, so up to this point I think everything is fine.
Using the following code, I construct and render a sample Datatable with sequences. From the link of the last column, I would like to dynamically change the value of the var seq=new Sequence(''); with the sequences of the Datatable and draw the result in the sequence-viewer div every time a link is clicked.
library(shiny)
ui <- fluidPage(
theme = shinytheme("yeti"),
useShinyjs(),
useShinyalert(),
tags$head(tags$script(src = "handlebars.js"),
tags$script(src = "sequence-viewer.min.js")),
mainPanel( DT::dataTableOutput("DTtable"),
br(),
tags$div(id="sequence-viewer")
)
)
server <- function(input, output) {
exp1 <- reactive({
tbl <- as.data.frame(c("MALWMPGPGAGSL", "MALKYTFDCVBJUYGFGPGAGSL", "IUYTFVBNMKIUYF"))
names(tbl) <- "Sequence"
tbl$link <- createLink(tbl$Sequence)
return(tbl)
})
createLink <- function(val) {
link <- paste0("<a href='#' onclick='var seq=new Sequence('",val,"'); seq.render('#sequence-viewer');'>Show seq</a>", sep="")
return(link)
}
output$DTtable <- DT::renderDataTable({ exp1()
}, escape = FALSE, options = list(scrollX = TRUE, dom = 'lfrtip', pageLength = 10,
lengthMenu=c(10, 25, 50, 100)), rownames = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
I have read many threads and tutorials on how to run custom javascript code in R Shiny, but all the examples that I've found make the call in the ui , not in the server side, could you please advice me how to get the desired output?
NOTE: According to the instructions on github page, the dependencies jquery, handlebars and bootstrap.min.css are required. I suppose that only the handlebars.js has to manually be added given that R Shiny comes already with bootstrap and jquery?
UPDATE 1: Ok, I think I'm now almost there. Thanks to the comments of #YBS I managed to get the idea of how to work with external javascript libraries. The code below works fine if I click the actionLink but it does not work when clicking the custom links inside the Datatable that I create using the createLink function. I get the following exception in the console of the browser: Uncaught ReferenceError: js$seque is not defined. Any ideas why this is happening?
library(shiny)
library(shinyjs)
jsCode = '
shinyjs.seque = function(params) {
var defaultParams = {
seq : "LKJHGFVBJKUGFKGFFGHJKUYTRFGHJUYTGHJIUYT"
};
params = shinyjs.getParams(params, defaultParams);
var seq=new Sequence(params.seq);
seq.render("#sequence-viewer");
}
'
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode, functions = c("seque")),
tags$head(tags$script(src = "handlebars.js"),
tags$script(src = "sequence-viewer.min.js")
),
mainPanel( DT::dataTableOutput("DTtable"),
br(),
actionLink(inputId = "action",
label = "action"),
br(),
tags$div(id="sequence-viewer")
)
)
server <- function(input, output) {
exp1 <- reactive({
tbl <- as.data.frame(c("MALWMPGPGAGSL", "MALKYTFDCVBJUYGFGPGAGSL", "IUYTFVBNMKIUYF"))
names(tbl) <- "Sequence"
tbl$link <- createLink(tbl$Sequence)
return(tbl)
})
createLink <- function(val) {
link <- paste0("<a href='#' onclick='js$seque(",val,")' id='",val,"' class='action-button shiny-bound-input'>Show sequence</a>", sep="")
return(link)
}
observeEvent(input$action, {
js$seque("MALKYTFDCVBJUYGFGPGAGSL")
})
output$DTtable <- DT::renderDataTable({
exp1()
}, escape = FALSE, options = list(scrollX = TRUE, dom = 'lfrtip', pageLength = 10,
lengthMenu=c(10, 25, 50, 100)), rownames = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
UPDATE 2:
After many hours of debbugging I managed to solve the issue by replacing the onclick='js$seque(",val,")' event of the button in the createLink function with the following: onclick='shinyjs.seque(\"",val,"\")' - or alternatively even clearer onclick='shinyjs.seque(JSON.stringify(val))'
In short, the js$seque call was incorrect at this point, I had to replace this line with shinyjs.seque, namely with the actual name of the function in JS. On the other hand, a typical R actionButton element requires js$seque. I will try to write a clear MRE code and provide it as an answer of this thread.
The usage of shinyjs is an overkill in your case, because you do not want to call the JS function from R but anyways through the client. Thus you can simply use plain JavaScript like in this toy example:
library(shiny)
js <- HTML("seque = function(seq) {
alert(seq);
}")
ui <- fluidPage(tags$head(tags$script(js)),
tags$a(hreg = "#", onclick = "seque('test message')",
"Click me to send test message"))
server <- function(...) {}
shinyApp(ui, server)
Don't get me wrong shinyjs: has its merits, but the typical use case is that you want to trigger JavaScript code from the R side like in this example:
library(shiny)
library(shinyjs)
js_code <- HTML("shinyjs.seque = function(par) {
var def_par = {seq: 'test message'};
par = shinyjs.getParams(par, def_par);
alert(par.seq);
}")
ui <- fluidPage(useShinyjs(),
extendShinyjs(text = js_code, functions = "seque"),
actionButton("click", "Click me to send message"))
server <- function(input, output, session) {
observeEvent(input$click, {
js$seque("test message from R")
})
}
shinyApp(ui, server)
In this example I use shinyjs to call JS directly from R, while in the previous example the JS is called via the onclick.
For your example you could use an actionLink in your table and add an observer and in this you call js$queue but since you will have one link per line this may be tricky (yet not impossible) to code (basically you need dynamic listeners),
Thus, relying on pure JS (onclick) as in your example may be the better option, but then you don't need shinyjs.
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 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)
selectize.js has an item creation option as mentioned on http://brianreavis.github.io/selectize.js/. I'm trying to add the same feature in an R Shiny implementation of selectize but unable to figure out how.
Thanks for your help!
PS: Some more details about what exactly I'm doing - I have some sort of free text vector that I let the user add to. However, I want Shiny to prompt the user with the existing free text values that have previously been added in case the user wants to repeat one of them.
All you have to do is to set create option to true:
library(shiny)
shinyApp(
server = function(input, output, session) {
observe({ print(input$foo) })
},
ui = fluidPage(
selectizeInput(
"foo", "foo", c(), selected = NULL, multiple = TRUE,
options = list(create = TRUE))
)
)