I'm trying to use {{gt}} in conjunction with {{shinyscreenshot}}. The resulting screenshot seems to crop numeric columns:
Is this due to rendering in the gt package or caused by shinyscreenshot and how can this be avoided?
Thanks!
library(shiny)
library(gt)
library(magrittr)
library(shinyscreenshot)
gt_tbl <-
gtcars %>%
gt() %>%
cols_hide(contains("_"))
ui <- fluidPage(
gt_output(outputId = "table"),
actionButton("screenshot", "Screenshot gt"),
)
server <- function(input,
output,
session) {
output$table <-
render_gt(
expr = gt_tbl,
height = px(600),
width = px(600)
)
observeEvent(input$screenshot, {
shinyscreenshot::screenshot(id = "table")
})
}
if (interactive()) {
shinyApp(ui, server)
}
this worked: saves the gt as temp file and uses file.copy to download
library(shiny)
library(gt)
library(dplyr)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- reactive({
mtcars[1:5, 1:5] %>%
gt()
})
my_image <- reactive({
outfile <- tempfile(fileext = ".png")
gtsave(data = my_table(),
filename = outfile,
vwidth = 400,
vheight = 300)
outfile
})
output$report <- downloadHandler(
filename = "download.png",
content = function(file) {
file.copy(my_image(), file)
},
contentType = 'image/png'
)
}
shinyApp(ui, server)
Related
I would like to have a shiny app that, when run for the first time, displays a dataframe defined as a template, and then the user can upload a new one (in csv only) that replaces the current one. Therefore, in case the user imports a file of the wrong type, it produces a message instead. Here is my code, which results in an error, and I don't know why it doesn't work
library(shiny)
library(DT)
library(dplyr)
library(shiny)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
tableOutput("head")
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = NULL
)
observe({
if(is.null(rv$dataframe)){
dataFrameFile <- reactive({
df <- data.frame(
x = seq(1:12),
y = rnorm(12))
rv$dataframe <- datatable(df)
return(rv$dataframe)
})
} else {
dataFrameFile <- reactive({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
validate(" Please upload a .csv file")
)
})
}
})
output$head <- renderDT({
datatable(dataFrameFile())
})
}
shinyApp(ui, server)
A few corrections/simplifications:
Used DTOutput instead of tableOutput to correspond to renderDT
directly initialized rv
put the validate in the renderDT
library(shiny)
library(DT)
library(dplyr)
library(shiny)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
DTOutput("head")
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = data.frame(
x = seq(1:12),
y = rnorm(12))
)
observe({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
NULL)
})
output$head <- renderDT({
validate(need(!is.null(rv$dataframe)," Please upload a .csv file"))
rv$dataframe
})
}
shinyApp(ui, server)
I'm hoping to insert an rclipboard::rclipButton() into a DataTable in RShiny and am having trouble figuring out how to do it. Have tried the following (based on: Using renderDataTable within renderUi in Shiny):
library(shiny); library(tidyverse); library(rclipboard)
ui <- fluidPage(
mainPanel(
rclipboardSetup(),
uiOutput('myTable')
)
)
server <- function(input, output) {
output$myTable <- renderUI({
output$myTable <- renderUI({
iris <- iris %>% filter(row_number()==1:2)
iris$button <- rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = "test",
icon = icon("clipboard")
)
output$aa <- renderDataTable(iris)
dataTableOutput("aa")
})
})
}
shinyApp(ui, server)
But looks like this:
"[object Object]"
Have also tried paste0()'ing the rclipButton() into the DataTable but that just renders as a long string of HTML.
Any suggestions much appreciated!
Well, rclipButton() call will generate shiny.tag objects, and you need to change it to string so DT can parse it. Then the key is to use escape = F in datatable.
I also rewrite the way to generate the DT table.
library(shiny); library(tidyverse); library(rclipboard)
ui <- fluidPage(
mainPanel(
rclipboardSetup(),
DT::dataTableOutput("aa")
)
)
server <- function(input, output) {
output$aa <- DT::renderDataTable({
iris2 <- iris %>% filter(row_number()==1:2)
iris2$button <- rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = "test",
icon = icon("clipboard")
) %>% as.character()
DT::datatable(iris2, escape = F)
})
}
shinyApp(ui, server)
I am writing a shiny app which:
creates a gt table
saves the gt table as an image (temporary file)
passes that image into a word doc using {officer} package
I am having difficulty with the image creation .... any help appreciated... here is my reprex
library(shiny)
library(gt)
library(dplyr)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- render_gt(
mtcars[1:5,1:5] %>%
gt()
)
my_image <-reactive({
outfile <- tempfile(fileext='.png')
gtsave(my_table, outfile, width = 400, height = 300)
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
print(read_docx() %>%
body_add_img(my_image()),
target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
There are several issues with your code:
You use render_gt instead of reactive.
Your reactive my_image does not return the name of the temporary file which is needed to add it to the docx. Additionally, as my_table is or should be a reactive use my_table()
In gtsave use vwidth and vheight. See ?webshot::webshot.
In officer::body_add_img you have to set a width and height in inches.
Reproducible code:
library(shiny)
library(gt)
library(dplyr)
library(officer)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- reactive({
mtcars[1:5, 1:5] %>%
gt()
})
my_image <- reactive({
outfile <- tempfile(fileext = ".png")
gtsave(my_table(), outfile, vwidth = 400, vheight = 300)
outfile
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
read_docx() %>%
body_add_img(my_image(), width = 4, height = 3) %>%
print(target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
I am trying to work on a functioniality for our shiny app where in the user can download a powerpoint with all the tables and charts. I did see a standalone app where I know how to use it if all the tables and plots are in the server component. Since our code base is increasing and we are trying to use modules to break the app I am unable to identify where should I have the downloadhandler. If I have it in the server component how can I pass my tables and plots from the modules to this function in server. Below is the code of a standalone download to powerpoint code.
library(shiny)
library(officer)
library(flextable)
library(dplyr)
my_table <- data.frame(
Name = letters[1:4],
Age = seq(20, 26, 2),
Occupation = LETTERS[15:18],
Income = c(50000, 20000, 30000, 45000)
)
ui <- fluidRow(
column(
width = 12,
align = "center",
tableOutput("data"),
br(),
downloadButton("download_powerpoint", "Download Data to PowerPoint")
)
)
server <- function(input, output) {
output$data <- renderTable({
my_table
})
output$download_powerpoint <- downloadHandler(
filename = function() {
"employee_data.pptx"
},
content = function(file) {
flextable_prep <- flextable(my_table) %>%
colformat_num(col_keys = c("Age", "Income"), digits = 0) %>%
width(width = 1.25) %>%
height_all(height = 0.35) %>%
theme_zebra() %>%
align(align = "center", part = "all")
example_pp <- read_pptx() %>%
add_slide(layout = "Title Slide", master = "Office Theme") %>%
ph_with_text(
type = "ctrTitle",
str = "Employee Data"
) %>%
ph_with(
location = ph_location_type(type = "subTitle"),
value = "Company 2019 Report"
) %>%
add_slide(layout = "Title and Content", master = "Office Theme") %>%
ph_with_text(
type = "title",
str = "2019 Data"
) %>%
ph_with_flextable_at(
value = flextable_prep,
left = 2.5,
top = 2
)
print(example_pp, target = file)
}
)
}
shinyApp(ui, server)
There are several ways to pass data from a module to another.
You can for example return a reactive from one module, and use it in another.
See (I removed the powerpoint generation here to focus on the implementation of the reactivity) :
library(shiny)
library(officer)
library(flextable)
library(dplyr)
showui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("table"), "table", choices = c("iris", "mtcars")),
tableOutput(ns("data"))
)
}
show <- function(input, output, session){
ns <- session$ns
my_table <- reactive({
get(input$table)
})
output$data <- renderTable({
head(my_table())
})
my_table
}
dlui <- function(id){
ns <- NS(id)
tagList(
downloadButton(
ns("download_powerpoint"),
"Download Data"
)
)
}
dl <- function(input, output, session, my_table){
ns <- session$ns
output$download_powerpoint <- downloadHandler(
filename = function() {
"employee_data.csv"
},
content = function(file) {
write.csv(my_table(), file)
}
)
}
ui <- fluidRow(
column(
width = 12,
align = "center",
showui("showui"),
br(),
dlui("dlui")
)
)
server <- function(input, output) {
my_table <- callModule(show, "showui")
callModule(dl, "dlui", my_table)
}
shinyApp(ui, server)
All I am trying to do is read, render and download excel. Not sure how we can display specific UI details such as uploading excel button in dashboard sidebar and rendering and download button in dashboard body
Only error when I tried to get rid this error in mod_exampleUI module function.
Error in mod_example("example_mod") :
argument "output" is missing, with no default
Please find the code below
library(shiny)
library(magrittr) # Load magrittr for the piping operator %>%
library(DT)
library(readxl)
library(tidyselect)
library(writexl)
library(dplyr)
library(tidyr)
library(readxl)
library(stringr)
# Increase band width for shiny to handle bigger file
options(shiny.maxRequestSize=300*1024^2)
# Module UI to display sidebar content
mod_exampleUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"), "Choose XLSX File (Convert xls to xlsx)",accept=c(".xlsx")),
tags$hr(),
downloadButton(ns("downloadData"), "Download")
)
}
# Module UI to display Body content
mod_example_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Function to read all excel sheet necessary
mod_example_display <- function(input, output, session) {
output$contents <- DT::renderDataTable({
DT::datatable(readxl::read_excel(input$file1$datapath)
,options = list(pageLength = 7,scrollX = TRUE))
})
output$downloadData <- downloadHandler(
filename = function() {
paste("updated file dated-", Sys.Date(), ".xlsx")
},
content = function(file) {
write_xlsx(DT::datatable(readxl::read_excel(input$file1$datapath),file))
}
)
}
ui <- fluidPage(
shinydashboard::dashboardPage(
skin = "yellow",
# HEADER -----
shinydashboard::dashboardHeader(
title = "Modularizing App"
),
# SIDEBAR -----
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(
shinydashboard::menuItem('Example', tabName = 'example', icon = shiny::icon('file')),
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_exampleUI("example_sidemod"))
)
)
),
# BODY -----
shinydashboard::dashboardBody(
shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")),
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_example_displayUI("example_bodymod"))
)
)
)
)
server <- function(input, output) {
shiny::callModule(mod_example_display, "mod_example")
}
shinyApp(ui,server)
Pleased to share answer so that it might helkp other shiny developers.
Although it is no elegant but mich appreciated if UI could be improved by experts.
library(shiny)
library(magrittr) # Load magrittr for the piping operator %>%
library(DT)
library(readxl)
library(tidyselect)
library(writexl)
library(dplyr)
library(tidyr)
library(readxl)
library(stringr)
# Increase band width for shiny to handle bigger file
options(shiny.maxRequestSize=30*1024^2)
# Function to read all excel sheet necessary
read_excel_allsheets <- function(filename, tibble = FALSE) {
sheets <- readxl::excel_sheets(filename)
x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X, col_names = T, skip = 5
,col_types = "text"
))
if(!tibble) x <- lapply(x, as.data.frame)
names(x) <- sheets
x
}
# Module UI to read content
mod_readUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"), h6("Choose xlsx file")
,accept=c(".xlsx"))
)
}
# Module UI to display content
mod_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Module UI to download content
mod_downloadUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
downloadButton(ns("downloadData"), "Download")
)
}
# Server functions
mod_display <- function(input, output, session, file) {
# In case want to alter the data to download
# myfile = reactive({as.data.frame(file()[,1])})
output$contents <- DT::renderDataTable({
DT::datatable(file()
,options = list(pageLength = 7,scrollX = TRUE))
})
reactive({
file()
# myfile()
})
}
mod_read <- function(input, output, session){
getData <- reactive({
req(input$file1)
inFile <- input$file1
mysheets <- read_excel_allsheets(inFile$datapath)
ppm <- mysheets$Download
ppm
})
### In ordert to send data as reactive
reactive({
getData()
})
}
mod_download <- function(input, output, session, displayData){
output$downloadData <- downloadHandler(
# browser(),
filename = function() {
paste("Updated file dated-", Sys.Date(), ".xlsx")
},
content = function(file) {
write_xlsx(displayData(),file)
}
)
}
ui <- fluidPage(
shinydashboard::dashboardPage(
skin = "yellow",
# HEADER -----
shinydashboard::dashboardHeader(
title = "Modularizing App"
),
# SIDEBAR -----
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "menu",
shinydashboard::menuItem('Example', tabName = 'example', icon = shiny::icon('file')),
conditionalPanel("input.menu == 'example'",
shinydashboard::menuSubItem(mod_readUI("sidemod")),
shinydashboard::menuSubItem(mod_downloadUI("downmod"))
)
)
),
# BODY -----
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_displayUI("bodymod"))
)
)
)
)
server <- function(input, output) {
readFile <- shiny::callModule(mod_read, "sidemod")
displayFile <- shiny::callModule(mod_display, "bodymod", file = readFile)
shiny::callModule(mod_download, "downmod", displayFile)
}
shinyApp(ui,server)