We have a very complex app which contains 20 downloadHandler instances that serve either .csvs, .rmds, or .zip files. Until this past week they all worked, we've been doing a lot of work on other pieces, haven't tested the downloadHandlers specifically this week and at some point all of them stopped working except for one single .csv exporting one in the middle of the bunch. That one still correctly starts a download, every other one just opens a new tab in the browser with a new instance of the app, no download.
We're running this on the local machine in browser, not in the RStudio pane.
The full app is very complex so I don't have a non-working reprex for the moment, though here: https://github.com/samdupre/OSDSReprex is a reprex for an earlier very slimmed down version which has this broken functionality working throughout (bottom of each page). I've also cut out working and non-working examples of the functionality from the full app and included it below.
Because shiny.fluent does not work with downloadHandler well, we're using the recommended workaround (https://github.com/Appsilon/shiny.fluent/issues/39) where the server section of our app.R file contains downloadHandler which is triggered programmatically using shinyjs::click() based on a button present in each topic .R file. Here is the single working one and one of the non-working ones.
IN APP.R
### THIS ONE DOES NOT WORK
observeEvent(input$page1_dd,
click("page1_ddb"))
page1_data <- imported_data %>% filter(Metric == "Population")
output$page1_ddb <- downloadHandler(
filename = function() {
'demographic-social-data.csv'
},
content = function(file) {
write.csv(page1_data, file)
}
)
### THIS ONE WORKS
observeEvent(input$page6_dd,
click("page6_ddb"))
page6_data <- imported_data %>% filter(Metric %in% c("CrudeDeathRate","Deaths"))
output$page6_ddb <- downloadHandler(
filename = function() {
'mortality-data.csv'
},
content = function(file) {
write.csv(page6_data, file)
}
)
and the individual page files contain:
IN TOPIC_PAGE_1.R (DOES NOT WORK)
makeCard(" ",
div(
Text(i18n$t("Export demographic and social data (in .csv format)")),
useShinyjs(),
Stack(tokens = list(childrenGap = 10), horizontal = TRUE,
DefaultButton.shinyInput("page1_dd", text = i18n$t("Download Demographic and Social Data"), iconProps = list(iconName = "Download Demographic and Social Data")),
div(style = "visibility: hidden;", downloadButton("page1_ddb", label = "")))
),
size = 11
)
IN TOPIC_PAGE_6.R (WORKS)
makeCard(" ",
div(
Text(i18n$t("Export mortality data (in .csv format)")),
useShinyjs(),
Stack(tokens = list(childrenGap = 10), horizontal = TRUE,
DefaultButton.shinyInput("page6_dd", text = i18n$t("Download Mortality Data"), iconProps = list(iconName = "Download Mortality Data")),
div(style = "visibility: hidden;", downloadButton("page6_ddb", label = "")))
),
size = 11
)
Any advice on why all except one random one out of the bunch has now stopped generating a download and instead just opens a new tab instance of the app would be greatly appreciated.
Thanks in advance!
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.
I've been working for some days with Handsontable in Shiny and I got stuck in what I guess will be a very dumb question but I have not this much idea how to solve.
I have a Handsontable that has a custom function that allows searching and it works. It works but is not intuitive enough because you have to right-click on the table to pop the search option.
Because of this, I decided that I would like to have a textInput that does the same function but in a prettier way. I know that it should be related with an observeEvent of the input variable (input$searchId) but I have no idea of how to do it due to my lack of experience with Shiny and Handsontable.
This is the code from server.R that prints the table and that has a custom function that allows the user to search.
output$hot <-renderRHandsontable({rhandsontable(Dataset(),height = 600)%>%
hot_table( columnSorting = TRUE,highlightCol = TRUE, highlightRow = TRUE, search = TRUE) %>%
hot_context_menu(
customOpts = list(
search = list(name = "Search",
callback = htmlwidgets::JS(
"function (key, options) {
var aux = document.getElementById('searchId').value;
var srch = prompt(Search);
this.search.query(srch);
this.render();
}")))) })
And what I would like is to archive the same result but without having to right-click on the table and create a prompt.
Thank you so much,
Well I've been able to solve my problem. I've been inspired by this post
and then I got with something like:
js_search <- "
$(document).ready(setTimeout(function() {
document.getElementById('searchId').onchange = function(e){
var hot_instance = HTMLWidgets.getInstance(hot).hot
console.log('hola')
var aux = document.getElementById('searchId').value;
hot_instance.search.query(aux);
hot_instance.render();
}
}))
"
that has to be included in your ui.R with a tags$head(tags$script(HTML(js_search)))
That's all the problem I was having is that I ahd no idea of how to get the "this" from the custom operation in the server side I had before. Once you know that is hot_instance. where hot is the name of my table, I think is easy.
I am trying to use the TableTools extension for DataTables to get a toolbar with copy, save, print and other options above a table in my Shiny App.
This is my server.R:
output$table <- DT::renderDataTable({
DT::datatable(datasetInput(),extensions = 'TableTools',options = list(
"sDom" = 'T<"clear">lfrtip',
"oTableTools" = list(
"sSwfPath" = "//cdnjs.cloudflare.com/ajax/libs/datatables-tabletools/2.1.5/swf/copy_csv_xls.swf",
"aButtons" = list(
"copy",
"print",
list("sExtends" = "collection",
"sButtonText" = "Save",
"aButtons" = c("csv","xls")
))
)
))
})
This is the output:
As you can see, there is no copy button. Also, when I click on the Save button, a tiny bar appears below it and the screen goes gray but nothing happens next.
This only happens when I try to run the app using Run in Window (R Studio). If I run it as External in Chrome, then there are no issues. Any help would be much appreciated. Thanks!
I want to add a tooltip which pops up (at the position of the curser) by mouse hovering over the specific entry in a menubar.
I am using Windows, gwidgets with RGtk2 and R version 3.0.3
My code looks like this:
PG_top <- gwindow(...)
action_list = list (
open = gaction(label = "Open...", tooltip = "Open a File", icon = "open", handler = openDialogHandler, parent = PG_top)
)
menu_bar_list <- list(File = list (
Open = action_list$open
)
)
menu_bar <- gmenu(menu_bar_list, cont=PG_top)
I get no error messages nor any tooltip. Is this a toolkit Problem? I found a Handler called "addHandlerMouseMotion" but I don't know if this works for my kind of problem and what to do inside this Handler. If I try
tooltip<-(action_list[["open"]],"Open File")
or
tooltip<-(action_list$open,"Open File")
I get the errormessage: Error in (...): unexpected ","
Hope you can help me!