R: Why are my icons not showing on my datatable? (Shiny app) - r

I have hundreds of images stored locally which I want to include in my Shiny App table. I start by creating a path to each image as a variable
path = "/Users/author/folder/subfolder/"
df%<>% mutate(Image = paste(path, ID, ".png", sep = ""))
I subsequently process them as advised on Adding an image to a datatable in R
for (i in df$Image) {
df$ProcessedIcon <- knitr::image_uri(i)
}
I then create the Icon variable with the processed information
df%<>% mutate(Icon = paste("<img src=", ProcessedIcon ,"></img>", sep = ""))
my server looks like
server <- function(input, output) {
table2 <- reactive ({
df %>%
select(Icon, Category, SubCategory, Item)
})
output$foodtable <- DT::renderDataTable({
DT::datatable(table2(), escape = FALSE)
})
}
My icons still looks like this
Why are the icons not loading properly?
What am I missing?

Related

How to download rhandsontable output from an rshiny to a shadow document

I'm creating an application to track soccer statistics for a high school team. The coach wants it to be like an excel sheet, where player data can be inputted and saved to be looked at later. I've figured out how to do that with rhandsontable, but I can't get it to download to my shadow document from my r shiny. I was able to get the shadow doc to work before adding the rhandsontable, but it is no longer working. I'm attaching the code from the server that I'm using to create the table. The player_names is a csv with columns for player name, team level, goals scored,.... other stats. I'm first looking at only one team level (ie varsity), then making the table. It works great in the shiny, but I don't how to save it from there.
output$hot <- renderRHandsontable({
player_names %>%
filter(Team == input$team_level) %>%
rhandsontable()
})
values <- reactiveValues(data = NULL)
observe({
values$data <- hot_to_r(input$hot)
})
# 3. I assign this df to a variable call df1
df1 <- reactive({
values$data
})
Code to make shadow doc:
output$downloadReport <- downloadHandler(
filename = function() {
paste("ophs_soccer", sep = ".", switch(
input$format, PDF = "pdf", HTML = "html", Word = "docx"
))
},
content = function(file) {
src <- normalizePath("shadow_page.Rmd")
# temporarily switch to the temp dir, in case you do not have write
# permission to the current working directory
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, "shadow_page.Rmd", overwrite = TRUE)
library(rmarkdown)
out <- render("shadow_page.Rmd", switch(
input$format,
PDF = pdf_document(), HTML = html_document(), Word = word_document()
))
file.rename(out, file)
I tried to create output in the shadow doc like I did with the other reactive inputs, and it did not work. I get an error when trying to download the document.

Download existing docx object from R Shiny app

I am working on an R Shiny app where a user supplies information that modifies an existing Word document for the user to download. I've had trouble getting R Shiny to download the resulting new Word document. I've tried regular hyperlinks, and that doesn't seem to work.
(Edit: After typing up this post, I came across how to download files with hyperlinks. I forgot files need to be placed inside a www folder, as specified here: Shiny hyperlink relative path to a file. So although I can get my Shiny App to work using this approach, I'd still like to know why my example below is not working).
I came across Github Issue #145 (https://github.com/davidgohel/officer/issues/145) which almost has the solution. But the pptx being downloaded is created from scratch whereas I want to start from an EXISTING Word docx.
In my code example, there are 3 downloadHandler buttons:
Uses the original pptx download code example from Github Issue #145
The second modifies the above to download a docx
The third button is my attempt to download an existing and modified docx file
The third button is not working as I had hoped. If I had to guess, I think it has to do with my template being from from read_docx. It looks like it creates some temporary file behind the scenes. But I don't know where to go from here.
For completeness, here are some related links:
Reporters package to download docx report from shiny (uses ReporeRs which is older than officer R package)
Writing word documents with the officer package: How to combine several rdocx objects? (Helpful if merging existing docx to the tempfile in my example)
downloadHandler reference: https://shiny.rstudio.com/reference/shiny/latest/downloadHandler.html
# -------- Example code ------------
library(shiny)
library(officer)
library(mschart)
library(dplyr)
# Create template folder and file. (Irrelevant if already exists.)
dir.create("www")
read_docx() %>%
body_add_par("My template file") %>%
print(., target = "www/template.docx")
# Existing file as Template
mytemplate <- read_docx(path = "www/template.docx")
# For Button 1
gen_pptx <- function(chart, file) {
read_pptx() %>%
add_slide(layout = "Title and Content", master = "Office Theme") %>%
ph_with_chart(chart = chart) %>%
print(target = file)
}
chart <- data.frame(x = letters[1:3], y = 1:3) %>%
ms_barchart(x = "x", y = "y")
# For button 2
gen_docx <- function(file) {
read_docx() %>%
body_add_par("Hello World") %>%
print(target = file)
}
# For button 3
gen_docx2 <- function(file, doc) {
file %>%
body_add_par("Hello World") %>%
body_add_docx(src = doc) %>%
print(target = file)
}
ui <- fluidPage(
titlePanel("Example"),
downloadButton("chart", "Get Chart"),
downloadButton("document", "Get New Doc"),
downloadButton("document2", "Get Doc from Template"),
tags$hr(),
tags$p("Example hyperlink works"),
tags$a(href='template.docx', target='_blank', 'Can only download from www folder', download = 'template.docx')
)
server <- function(input, output) {
output$chart <- downloadHandler(
filename = function() paste0("chart_", Sys.Date(), ".pptx"),
content = function(file) {
file_pptx <- tempfile(fileext = ".pptx")
gen_pptx(chart, file_pptx)
file.rename( from = file_pptx, to = file )
}
)
output$document <- downloadHandler(
filename = function() paste0("doc_", Sys.Date(), ".docx"),
content = function(file) {
file_docx <- tempfile(fileext = ".docx")
gen_docx(file_docx)
file.rename( from = file_docx, to = file )
}
)
output$document2 <- downloadHandler(
filename = function() paste0("doc_", Sys.Date(), ".docx"),
content = function(file) {
file_docx <- tempfile(fileext = ".docx")
gen_docx2(file_docx, mytemplate)
file.rename( from = file_docx, to = file )
}
)
}
shinyApp(ui = ui, server = server)
Do not use print to generate docx file in helper function gen_docx2.
Instead, you should use print as a last step in content function to return file to the downloadHandler.
Simple example:
gen_docx2 <- function(file, doc) {
file %>%
body_add_par("Hello World") %>%
body_add_docx(src = doc)
}
notice the function above does not print anything
outputdocument2 <- downloadHandler(
filename = function() {
paste0("doc_", Sys.Date(), ".docx")
},
content = function(file) {
doc <- read_docx() %>% gen_docx2(file_docx, mytemplate)
print(doc, target = file)
}
)
Use read_docx() to generate temporary word file and then use print(doc, target = file) in the end to pass it to the downloadHandler. The function file.rename is not needed.

Download Handler with reactive datatable (R Shiny)

I have simplified a lot the shiny app I'm trying to build, but, in the idea, I have two functions :
choose_input <- function(n1,n2,n3){
x1 <<- n1+n2
x2 <<- n2+n3
x3 <<- (n1*n2)/n3
}
createmydata <- function(n){
c1 <- c(1:n)
c2 <- c1+(x2*x3)
c3 <- c2+x1
df <- data.frame("column1"=c1,"column2"=c2,"column3"=c3)
return(df)
}
You'll tell me that I can do simply one function with these two because they are very simple, but in my app there are a lot of lines and I have to separate the two. Anyway, here is my simulated code :
ui <- fluidPage(
numericInput("n1",label="Choose the first parameter",min=0,max=100,value=3),
numericInput("n2",label="Choose the second parameter",min=0,max=100,value=4),
numericInput("n3",label="Choose the third parameter",min=0,max=100,value=5),
numericInput("n",label="Choose dataframe length",min=1,max=10000,value=100),
radioButtons("filetype", "File type:",
choices = c("csv", "tsv")),
downloadButton('downloadData', 'Download'),
tableOutput("data")
)
server <- function(input,output){
RE <- reactive({
choose_input(input$n1,input$n2,input$n3)
createmydata(input$n)
})
output$data <- renderTable({
RE()
})
output$downloadData <- downloadHandler(
filename = function() {
paste(name, input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
}
shinyApp(ui = ui, server=server)
As you can see, I'd like to download the output table to a csv or excel file... I let you try the code and then try to click on the download button, it does not work...
Debugging
When I run the code up above and attempted to download the data set, I received the following warning and error message in the Console Pane within RStudio.
Warning: Error in paste: object 'name' not found
Stack trace (innermost first):
1: runApp
Error : object 'name' not found
This led me to examine the paste() function used within the filename argument in shiny::downloadHandler(). In your code, you use the object name without ever assigning it a value.
I replaced name with the text "customTable" within the filename argument inside of downloadHandler().
output$downloadData <- downloadHandler(
filename = function() {
paste( "customTable", input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
Downloading Data in Browser
After running the app.R script, I clicked on the Open in Browser button to view the Shiny app in a new tab on Chrome. Once there, I was successfully able to download both a .csv and .tsv file after hitting the download button.
Note: I'm looking for a better reason as to why this action needs to occur, but for now, I came across this relevant SO post Shiny app: downloadHandler does not produce a file.

Downloading file from a datatable and pdf graph with 2 download buttons

I need to export the graph and the xls from 2 SQL queries
My graph is linked with the datatable by clicking on a row
I placed the 2 download buttons but I don't know how to trig the exports with buttons (maybe with another reactive function ?)
Thank you for your help
Here my UI.R :
mainPanel(
DT::dataTableOutput("table"), #My Table
plotOutput("plot")) # My graph
downloadButton("plot_export", "PDF"),
# Button
downloadButton("downloadData", "XLS")
))
Here the server.R :
cpk_total <- reactive({
data_testeur <- odbcConnect(input$base, uid="uid")
SQL query to feed my dataTable
Close connexion data_testeur
return result created from the SQL query
})
output$Table <- DT::renderDataTable({
DT::datatable(cpk_total(),...) # Formating table
})
output$plot <- renderPlot({
dta <- cpk_total()
data_testeur <- odbcConnect(input$base, uid="uid")
another SQL query to trace the graph for 1 item selected
#This SQL query use a variable from the created cpk_total table
Close connexion data_testeur
graph <- ....
)
you need to add some thing like this for the table
output$downloadData <- downloadHandler (
filename = function() {
#some function to generate your file name
},
content = function(file) {
dta <- cpk_total()
write.csv2(dta, file, row.names = FALSE, fileEncoding = "UTF-8", quote = FALSE, na = "")
}
)
and for the chart I would pull the code out from the renderPlot into a seperate reactive just like you have done with cpk_total()
and the add something like this for the download of the plot
output$downloadData <- downloadHandler (
filename = function() {
#some function to generate your file name
},
content = function(file) {
p <- reactive_plot()
export(p, file = file)
}
)

R Shiny - How to round numbers, convert to percentage and download .csv-file

I wrote a shiny app which will be used for searching and downloading a quite large dataset. The app works and is nearly done, but some functionalities do not work as I want:
I tried several ways of adding a function in order to download the chosen data as .csv-file. All of them failed and I was only able to download all data instead of the displayed ones.
I was not able to include a function to round data and show some columns as percentage instead of numbers. The formatRound() function within datatable() works well and I would like to use it, but the problem is that I was not able to include it in the server function. Since the user should get the whole number (with all numbers also behind the comma) for his or her work, the data should only be rounded when displayed. If I would be able to fix the rounding, the percentage problem will also be solved, since I would use the similar function formatPercentage().
I made an example using the mtcars-data and removed all wrong or not-working codes for the download and rounding problem. Any hints how I could solve my problem would be extremely appreciated! Thanks in advance!
EDIT3: Rounding problem solved with the code below thanks to #Claud H. The download function exports an empty file (no file-type) named download. Do you have any idea where the error is?
EDIT4: problems solved thanks to #Claud H. I changed mt_cars_filtered()[, c(input$results_columns_selected)]into mt_cars_filtered()[, input$indicator]. Also, I didn't know first that I had to open the web browser to download the data.
library(tidyverse)
library(shiny)
library(shinythemes)
library(DT)
library(ggthemes)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=3,
h3("title", align = 'center'),
checkboxGroupInput("cylinder", "Cylinder", choices = c(4,6), selected = c(4)),
checkboxGroupInput('indicator', label = 'Indicators', choices = colnames(mtcars)[1:7],
selected = colnames(mtcars)[c(1:7)]),
fluidRow(p(class = 'text-center', downloadButton('download', label = 'Download')))),
mainPanel(
tabsetPanel(
tabPanel('Table',
DT::dataTableOutput('results'))
)
)
))
server <- function(input, output){
mtcars_filtered <- reactive({
mtcars %>%
filter(cyl %in% input$cylinder)
})
# Output Table
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable(style = 'bootstrap', selection = list(target = 'column'), options = list(paging = FALSE, dom = 't')) %>%
formatRound(input$indicator[grep('t', input$indicator)], 2)
})
# Download Data
output$download <- downloadHandler(
filename = function() { paste('filename', '.csv', sep = '') },
content = function(file) {
write.csv(mtcars_filtered()[,input$indicator], file, row.names = FALSE)
})
}
shinyApp(ui = ui, server = server)
Suggest looking at ?"%>%" from magrittr package
Also, check this and this answers on SO.
Your table should be fine with this kind of syntax
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable() %>%
formatCurrency( input your code here) %>%
formatPercentage( and so on ... )
}, style = 'bootstrap', options = list(paging = FALSE, dom = 't'))
Also, I didnt quite get the question about downloading. If you want to download a data FROM server, use downloadHandler() function. Something like:
output$save_data <- downloadHandler(
filename = function() { paste("filename", '.csv', sep = '') },
content = function(file) {
write.csv(mydata(), file, row.names = FALSE)
})
and downloadButton("save_data", "download") in ui.R
edit: as per your changes, download isn't working because you got wrong columns selected: there is no table called tableId, and you need to take the columns from the table called results:
write.csv(mtcars_filtered()[, c(input$results_columns_selected)], file, row.names = FALSE)
as of rounding problem, you can use your indicator variable to see if column is selected input$indicator %in% c('drat', 'qsec', 'wt') then use subsetting to select only columns with TRUE, if there are any: formatRound(input$indicator[input$indicator %in% c('drat', 'qsec', 'wt')], 2)
edit2
Seems I've understood everything you wanted to do right.
To select columns in the downloadHandler function based on your checkboxes , use indicator variable to filter it:
mtcars_filtered()[, input$indicator]
Otherwise, if you want to select them from the table itself with the mouse clicks, use input$results_columns_selected, like this:
mtcars_filtered()[, c(input$results_columns_selected)]

Resources