R - count Shiny download button clicks
I think there is no build-in method. But you could build it yourself.
You can do this by adding a click listener to the button with javascript:
observe({
if(is.null(input$rnd)){
runjs("
var click = 0;
Shiny.onInputChange('rnd', click)
var dwnldBtn = document.getElementById('dwnldBtn')
dwnldBtn.onclick = function() {click += 1; Shiny.onInputChange('rnd', click)};
")
}
})
The output from Shiny.onInputChange('rnd', click) will be accessible in Shiny via input$rnd.
Edit: For multiple buttons you can use:
observe({
for(btn1 in 1:2){
if(is.null(input[[paste0("rnd", btn1)]])){
runjs(
paste0("
var counter", btn1 ,"= 0;
var dwnldBtn = document.getElementById('", paste0("dwnldBtn", btn1), "')
dwnldBtn.onclick = function() {counter", btn1, " +=1; Shiny.onInputChange('", paste0("rnd", btn1), "', counter", btn1,")};
")
)
}
}
})
For a working example see below:
library(shiny)
library(shinyjs)
data <- matrix(1:20, nrow=5)
ui <- fluidPage(title = 'Count Button Clicks',
useShinyjs(),
fluidRow(style = "padding-bottom: 20px;",
column(width=6,
textOutput("actionclickCount"),
br(),
textOutput("downloadclickCount")
),
column(width=6,
actionButton("actionBtn", "Action Button"),
br(),
downloadButton("dwnldBtn", "Download Button")
)
)
)
server <- function(input, output, session) {
output$actionclickCount <- renderText({
paste('Action Button Clicks =',input$actionBtn)
})
output$downloadclickCount <- renderText({
paste('Download Button Clicks =', input$rnd)
})
output$dwnldBtn <- downloadHandler(
filename = 'data.csv',
content = function(file){
write.csv(data, file)
},
contentType = 'csv'
)
observe({
if(is.null(input$rnd)){
runjs("
var click = 0;
Shiny.onInputChange('rnd', click)
var dwnldBtn = document.getElementById('dwnldBtn')
dwnldBtn.onclick = function() {click += 1; Shiny.onInputChange('rnd', click)};
")
}
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)
download count in shinyapps.io
I needed to do that once, so I had some code lying around. It basically kept track of everything in a csv that I appended to. Here I built it into a shiny test platform.
- it uses the
session$tokenfor the id (maybe there is something better) - it uses
write.tableandread.tablebecause they behave better with theappendoption. - it increments the count by calling out to
writetologin the shiny download handler but you can also increment the count manually with an extra button (which is only for test purposes obviously) - It has two output, one is a summary of the log, the other is a dump of what is in the log. These are for debugging as the
downloadHandlercan be a bit "challenging" at times when interacting with all this reactivity.
Here is that code modified to be an example like about what you need:
library(shiny)
logfname <- "log.csv"
writetolog <- function(newcount,newsessionid,operation){
time <- format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z")
df <- data.frame(time=time,count=newcount,sessionid=newsessionid,operation=operation)
doappend <- file.exists(logfname)
if (doappend){
write.table(df,logfname,append=T,quote=F,col.names=F,sep=",",row.names=F)
} else {
write.table(df,logfname,append=F,quote=F,sep=",",row.names=F)
}
}
getcounts <- function(){
if (!file.exists(logfname)){
return(list(count=0,sessioncount=0))
}
df <- read.table(logfname,header=T,sep=",")
nr <- nrow(df)
rlst <- list(count=sum(df$count),sessioncount=length(unique(df$sessionid)),
lastop=df$operation[nr],lasttime=df$time[nr])
return(rlst)
}
ui <- fluidPage(
titlePanel("Keep a download log"),
sidebarLayout(
sidebarPanel(
actionButton("inccount","Increment Count"),
actionButton("getcount","Refresh Summary"),
actionButton("showlog","Show Log"),
downloadButton("dodownload", "Save to .csv")
),
mainPanel(
h2("Summary of Download Log"),
verbatimTextOutput("showcount"),
h2("Dump of Download Log"),
verbatimTextOutput("loglog")
)
)
)
server <- function(input, output,session) {
observeEvent(input$inccount,{
print("writetolog")
writetolog(1,session$token,"inc count")
})
output$showcount <- renderPrint({
input$getcount
rv <- getcounts()
time <- format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z")
print(sprintf("%s - count:%d sessioncount:%d",time,rv$count,rv$sessioncount))
})
output$loglog <- renderPrint({
input$showlog
if (!file.exists(logfname)) return(NULL)
ldf <- read.csv(logfname)
print(ldf)
})
output$dodownload<-downloadHandler(
filename = function() {
paste(input$table_name, '.csv', sep='')
},
content = function(file) {
write.csv(mtcars, file)
writetolog(1,session$token,"save file")
}
)
}
shinyApp(ui = ui, server = server)
Screen shot:
R Shiny App- How to get download button working and how to display the number of rows?
Standard Download
This will download the original data set.
Not sure what you want to name the downloaded file so I've hard-coded it to test.csv.
output$downloadData <- downloadHandler(
filename = function() {
paste("test.csv", sep = "")
},
content = function(con) {
write.csv(data, con, row.names = TRUE)
}
)
Filtered Download
This will subset the data based on what year, country and continent is selected and download that.
The filename will be made up of the selections delimited by a dash, unless no selections have been made, then the file name will be 'AllData.csv'.
output$downloadData <- downloadHandler(
filename = function() {
selected <-c()
if (input$year != "All") {
selected <-c(selected, input$year)
}
if (input$country != "All") {
selected <-c(selected, input$country)
}
if (input$continent != "All") {
selected <-c(selected, input$continent)
}
if (length(selected) == 0) {
selected <- c("AllData")
}
paste0(paste(selected, collapse="-"), ".csv")
},
content = function(con) {
if (input$year != "All") {
data <- df[df$Year == input$year,]
}
if (input$country != "All") {
data <- df[df$Country == input$country,]
}
if (input$continent != "All") {
data <- df[df$Continent == input$continent,]
}
write.csv(data, con, row.names = TRUE)
}
)
Adding a download button to shiny, which prints the output of the server function
As You didnt post reproducible example, i assume that You do not have any problems with plotting and you can see the plot in Your app, please try this:
Place Your whole code inside of the function, like:
testplot <- function() {
if (input$Select1 == "Absolute Worthaufigkeiten") {
if (input$Select2 == "AFD") {
AAA %>%
filter(AFD > 2) %>%
ggplot(aes(word, AFD, Jahr)) +
geom_col(colour = "white", fill = "red2")
}
else{
if (input$Select2 == "CDU") {
AAA %>% ...
}
}
}
}Render the function
testplot():output$Plot <- renderPlot({testplot()})Download the plot using
downloadHandler():output$down <- downloadHandler(
filename = function() {
paste("AAA", input$var3, sep = ".")
},
content = function(file) {
if (input$var3 == "pdf") {
pdf(file, width = 30, height = 20)
}
else{
png(file, width = 1200, height = 800, units = "px", pointsize = 12, bg = "white", res = NA)
}
print(testplot())
dev.off()
}
)
Saving time on clicking action button in shiny
Use global variables would work. Example below (edited to use per-session global variable).
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Header"),
sidebarLayout(
sidebarPanel(
actionButton("start", "Start"),
tags$br(),
actionButton("end", "End"),
tags$br(),
downloadButton("downloadData", "Download")
),
mainPanel(
)
)
))
server <- shinyServer(function(input, output) {
starttime <- NULL
endtime <- NULL
observeEvent(input$start, {
starttime <<- Sys.time()
})
observeEvent(input$end, {
endtime <<- Sys.time()
})
output$downloadData <- downloadHandler(
filename = function() {
"download.csv"
},
content = function(file) {
data <- data.frame(start=starttime, end=endtime)
write.csv(data, file, row.names = F)
}
)
})
shinyApp(ui = ui, server = server)
Shiny Application, Download button for graphs
This should work for you:
server.R:
library(shiny)
shinyServer(function(input,output,session){
observe({
inFile<-input$file1
#print(inFile)
if(is.null(inFile)) return(NULL)
dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
updateSelectInput(session, "product", choices = names(dt))
updateSelectInput(session, "familia", choices = c("realAll","realline","realplus","real0to1","counts","binom"))
})
testplot <- function(){
require(gamlss)
inFile<-input$file1
dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
k<-input$k
m <- fitDist(dt[,input$product], type=input$familia, k=k)
par(mfrow=c(2, 2))
for (i in 1:4) {
denst <- density(dt[,input$product])
res <- histDist(dt[,input$product], family=names(m$fits)[i],
main=names(m$fits)[i],
xlab=input$product,
line.wd=3,
line.ty=1,
line.col='dodgerblue2',
ylim=c(0, 1.3 * max(denst$y)))
param <- c('mu', 'sigma', 'nu', 'tau')
np <- length(res$parameters)
fun1 <- function(x) eval(parse(text=x))
hat.param <- sapply(as.list(paste('res$', param[1:np], sep='')),
fun1)
hat.param <- round(hat.param, digits=2)
txt <- paste('hat(', param[1:np], ')==', hat.param, sep='')
txt <- paste(txt, collapse=', ')
legend('topright', bty='n',
legend=eval(parse(text=paste('expression(', txt, ')'))))
}
}
output$distPlot <- renderPlot({testplot()})
output$descarga<-downloadHandler(
filename=function(){
paste("grafica","png",sep=".")
},content=function(file){
png(file)
print(testplot())
dev.off()
}
)
})
I wrapped Your code inside of the function (testplot()) which i have further used to renderPlot and inside of downloadHandler.
*For the future it would be better if you give/attach sample data, so Your code could be easily run in R
Display download button in Shiny R only when output appears in Main Panel
On server side you can use:
output$download <- renderUI({
if(!is.null(input$file1) & !is.null(input$file2)) {
downloadButton('OutputFile', 'Download Output File')
}
})
and on ui side you replace the download button with:
uiOutput("download")
In R Shiny, how to invoke download handler from radio buttons?
You may also stick with observeEvent:
observeEvent(input$mainPanelBtnTab2,{
req(input$mainPanelBtnTab2 == "Downloads")
showModal(modalDialog(
selectInput("downloadItem","Selection:",c("Yield plot")),
downloadButton("download", "Download")
))}
) # close observeEvent
Or use if instead of req as @RonakShah did.
How to have a single download button for all datatables in R shiny webpage
(a) If you only want "one downloadButton visible in the header common to all pages that downloads the table in the active page or tab", it needs firstly to know the active page and tab based on the page / tab IDs. (b) If you only need a single button to download all the tables, you can download them into a .xlsx file (see download data onto multiple sheets from shiny). (c)If you need a button for each tab, place the button in each tab and you can simply save table as .csv.
Here is the code for situation (a).
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Header",
dropdownMenuOutput("updatedTimeOutput"),
dropdownMenu(type = "notifications",
badgeStatus = "warning",
icon = icon("bullhorn", "fa-lg"),
notificationItem(icon = icon("bullhorn", "fa-1x"),
status = "info",
text = tags$span(
tags$b("Please notice!")
)
))),
dashboardSidebar( sidebarMenu(id = "pages", # use unique id for pages
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
# Add download button
downloadButton('downloadData', 'Download Table',
style="font-weight:bold;"
),
helpText(
hr(style = "border-top: 1px solid #000000;"),
),
tabItems(
tabItem(
tabName = "page1",
tabsetPanel(id="tabs",
tabPanel("tab1",
column(12,
DT::dataTableOutput("table1")
)),
tabPanel( "tab2",
column(12,
DT::dataTableOutput("table2")
))
)
)
,
tabItem(
tabName = "page2",
fluidRow(
column(12,
DT::dataTableOutput("table3")
))
)
)
)
)
server <- function(input, output) {
# table1
tbl1 <- mtcars[1:30, ] # tables 1, 2, 3 use different rows of mtcars to differentiate tables
output$table1 <- DT::renderDataTable({
datatable( tbl1,
# options = DToptions, # no such object called "DToptions"
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table2
tbl2 <- mtcars[5:45, ]
output$table2 <- DT::renderDataTable({
datatable( tbl2,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table3
tbl3 <- mtcars[11:35, ]
output$table3 <- DT::renderDataTable({
datatable( tbl3,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
page_name <- reactive({
input$pages
})
# select table on the active page / tab
selected_table <- reactive({
if(page_name() == "page1"){
tbl.list <- list("tab1" = tbl1, "tab2" = tbl2)
select_tbl <- tbl.list[input$tabs]
}else{
select_tbl <- tbl3
}
return(select_tbl)
})
# download table
output$downloadData <- downloadHandler(
filename = function() {"table.csv"},
content = function(file) {write.csv(selected_table(), file, row.names=TRUE)}
)
}
shinyApp(ui, server)
Related Topics
How to Use Aws Cli to Only Copy Files in S3 Bucket That Match a Given String Pattern
Check If R Package Is Installed Then Load Library
How to Pass Pandoc_Args to Yaml Header in Rmarkdown
How to Loop Over the Length of a Dataframe in R
Exporting R Regression Summary for Publishable Paper
Clear Memory Allocated by R Session (Gc() Doesnt Help !)
Multiple Filled.Contour Plots in One Graph Using with Par(Mfrow=C())
How Can Library() Accept Both Quoted and Unquoted Strings
Unquote the Variable Name on the Right Side of Mutate Function in Dplyr
Adding Scale Bar to Ggplot Map
Difference Between Installing a Package from Source and from Compiled Binary
R: Calculating 5 Year Averages in Panel Data
Rcharts with Highcharts as Shiny Application
Access Data Frame Column Using Variable
Reshaping a Data Frame with More Than One Measure Variable
Create a Table in R with Header Expanding on Two Columns Using Xtable or Any Package