Hi all,
I have somehow tried this shiny application with pop up window. Everything works fine, except the download feature. The user when clicked on "open window", the pop up window opens. In this window the user should be able to download the table. I have tried this below code but getting error
library(tidyverse)
library(DT)
library(xtable)
library(shiny)
library(shiny)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output, session) {
samdt <- structure(list(Domain = c("a", "a", "b", "b", "b"),
sub_domain = c("a1", "a1", "b1", "a1", "b1"),
Reviews = c(1234, 2311, 3123, 4311, 5211),
Ratings = c(1,2,1,2,1),
text = c("asd","dfdsf","sdfs","sdfs","sdf")), row.names = c(NA,-5L), class = c("tbl_df", "tbl", "data.frame"))
new_sam <- samdt %>% group_by(Domain) %>% summarise(nReviews = n())
subs <- samdt %>% group_by(Domain, sub_domain) %>% summarise(nReviews = n(),Ratings_e = toString(Ratings), Text_e = toString(text),
table_html = purrr::map2(Ratings_e,Text_e,
function(ca,cb){
ca <- unlist(strsplit(ca,','))
cb <- unlist(strsplit(cb,','))
p1 <- '<table border=1><button>Export HTML Table To CSV File</button><br></br><tr><th>Ratings_e</th><th>Text_e</th></tr>'
p2 <- paste(glue::glue("<tr><td>{ca}</td><td>{cb}</td></tr>"),collapse = '')
p3 <- '</table>'
paste(p1,p2,p3,sep='')
})) %>% ungroup() %>% mutate(
rn=row_number(),
launcher_html =
glue::glue('<script>
function openWindow{rn}() {{
var newtab{rn} = window.open("", "anotherWindow", "width=300,height=150");
newtab{rn}.document.open();
newtab{rn}.document.write("{table_html}");
newtab{rn}.exportTableToCSV = exportTableToCSV;
newtab{rn}.downloadCSV = downloadCSV;
}}
function exportTableToCSV(scopedWindow,filename) {
var csv = [];
var rows = scopedWindow.document.querySelectorAll("table tr");
for (var i = 0; i < rows.length; i++) {
var row = [], cols = rows[i].querySelectorAll("td, th");
for (var j = 0; j < cols.length; j++)
row.push(cols[j].innerText);
csv.push(row.join(","));
}
scopedWindow.downloadCSV(csv.join("\n"), filename);
}
function downloadCSV(csv, filename) {{
var csvFile;
var downloadLink;
// CSV file
csvFile = new Blob([csv]);
// Download link
downloadLink = document.createElement("a");
// File name
downloadLink.download = filename;
// Create a link to the file
downloadLink.href = window.URL.createObjectURL(csvFile);
// Hide download link
downloadLink.style.display = "none";
// Add the link to DOM
document.body.appendChild(downloadLink);
// Click download link
downloadLink.click();
}}
</script>
<button onclick="openWindow{rn}()"> Open Window </button>
')
) %>% group_by(Domain) %>% nest() %>% rowwise() %>% mutate(
htmltab = HTML(print(xtable(data),type="HTML",
sanitize.text.function=function(x)x))
)
samdt_x <- left_join(new_sam,subs)
add_collapse_content <- function(x, id) {
tagList(
tags$button(
"data-toggle" = "collapse",
"data-target" = paste0("#", id),
"More Info"
),
div(
"id" = id,
"class" = "collapse",
x
)
) %>% as.character()
}
samdt_x2 <- samdt_x %>% rowwise() %>% mutate(html_buttons =
add_collapse_content(htmltab,Domain)) %>%
relocate(html_buttons) %>% select(-data,-htmltab)
output$table <- renderDT({
datatable(samdt_x2,rownames = F,escape = F
,options = list(
columnDefs = list(
list(orderable = FALSE, className = 'details-control', targets = c(0))
))
)})
}
shinyApp(ui, server)