I have a shiny app where the outputs are some tables generated with tableby() and kbl(). I finally found the way to download those tables as sheets on an excel file, but then i wanted to remove the html tags that were still witten there. I think aplying a function to a list for that purpose is messing with the column names on the .xlsx, which now look weird. I tried using unname() to fix it, but it dind't change anything. Is there a way to fix this, or another wey to go around downloading "clean" versions of the tables? Any help would be much appreciated!
Here is the code:
library(shiny)
library(tidyverse)
library(readxl)
library(arsenal)
library(kableExtra)
ui <- fluidPage(
titlePanel("(in true app, user uploads the data)"),
sidebarLayout(
sidebarPanel(
downloadButton(
outputId = "downloadTable",
label = "Descargar tabla"
)
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Tabla 1",
htmlOutput("table")
),
tabPanel(
"Tabla 2",
htmlOutput("table2")
)
)
)
)
)
server <- function(input, output, session) {
ID <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19)
Provincia <- c("Santa Fe", "Santa Fe", "Cordoba", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Cordoba", "Santa Fe")
Ciudad <- c("Carlos Paz", "Esperanza", "Rafaela", "Carlos Paz", "Carlos Paz", "Rafaela", "Villa General", "Belgrano", "Villa General Belgrano", "Rafaela", "Esperanza", "Rafaela", "Esperanza", "Esperanza", "Villa General", "Belgrano", "Carlos Paz", "Carlos Paz", "Esperanza")
Valor1 <- rpois(n = 19, lambda = 10)
Valor2 <- runif(n = 19, min = 1, max = 10)
Color <- c("Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo")
df <- data.frame(ID, Provincia, Ciudad, Valor1, Valor2, Color)
base <- reactive({
df
})
controles <- reactive({
tableby.control(
test = T,
total = T,
numeric.test = "anova", cat.test = "chisq",
numeric.stats = c("meanCI"),
cat.stats = c("countpct"),
stats.labels = list(
meanCI = "Media (95%CI)",
countpct = "n (%)"
)
)
})
tabla1 <- reactive({
x <- base()
my_controls <- controles()
tab1 <- tableby(Color ~ Valor1 Valor2,
data=x,
control=my_controls)
as.data.frame(summary(tab1,digits=1, text = "html"))
})
output$table <- function(){
kable(tabla1(),align = "lccccc", escape = FALSE)%>%
kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
}
tabla2 <- reactive({
x <- base()
my_controls <- controles()
tab2 <- tableby(Provincia ~ Valor1 Valor2,
data=x,
control=my_controls)
as.data.frame(summary(tab2,digits=1, text = "html"))
})
output$table2 <- function(){
kable(tabla2(),align = "lccccc", escape = FALSE)%>%
kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
}
data_list <- reactive({
lista <- list(
tabla1(),
tabla2()
)
lapply(rapply(lista, function(x)
gsub("<strong>|</strong>| ", "", x), how = "list"),
as.data.frame)
})
output$downloadTable <- downloadHandler(
filename = function() {"prueba1.xlsx"},
content = function(file) {write_xlsx(data_list(), path = file)}
)
}
CodePudding user response：
We can use str_remove_all to get rid of the undesired HTML. Because we have a list and the column we want to edit doesn't have any names it got a little bit convoluted at the end.
Let's change data_list reactive to:
data_list <- reactive({
lista <- list(
tabla1(),
tabla2()
)
map(lista, ~ {
.x[[1]] %>%
str_remove_all("<strong>|</strong>") %>%
str_remove_all(" ") %>%
cbind(.x[, -1]) %>%
set_names(c("", names(.x)[-1]))
})
})
A simpler manual approach:
data_list <- reactive({
lista <- list(
tabla1(),
tabla2()
)
lista[[1]][[1]] <- lista[[1]][[1]] %>%
str_remove_all("<strong>|</strong>") %>%
str_remove_all(" ")
lista[[2]][[1]] <- lista[[2]][[1]] %>%
str_remove_all("<strong>|</strong>") %>%
str_remove_all(" ")
lista
})
APP:
library(shiny)
library(readxl)
library(arsenal)
library(kableExtra)
library(writexl)
library(tidyverse)
ui <- fluidPage(
titlePanel("(in true app, user uploads the data)"),
sidebarLayout(
sidebarPanel(
downloadButton(
outputId = "downloadTable",
label = "Descargar tabla"
)
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Tabla 1",
htmlOutput("table")
),
tabPanel(
"Tabla 2",
htmlOutput("table2")
)
)
)
)
)
server <- function(input, output, session) {
ID <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19)
Provincia <- c("Santa Fe", "Santa Fe", "Cordoba", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Cordoba", "Santa Fe")
Ciudad <- c("Carlos Paz", "Esperanza", "Rafaela", "Carlos Paz", "Carlos Paz", "Rafaela", "Villa General", "Belgrano", "Villa General Belgrano", "Rafaela", "Esperanza", "Rafaela", "Esperanza", "Esperanza", "Villa General", "Belgrano", "Carlos Paz", "Carlos Paz", "Esperanza")
Valor1 <- rpois(n = 19, lambda = 10)
Valor2 <- runif(n = 19, min = 1, max = 10)
Color <- c("Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo")
df <- data.frame(ID, Provincia, Ciudad, Valor1, Valor2, Color)
base <- reactive({
df
})
controles <- reactive({
tableby.control(
test = T,
total = T,
numeric.test = "anova", cat.test = "chisq",
numeric.stats = c("meanCI"),
cat.stats = c("countpct"),
stats.labels = list(
meanCI = "Media (95%CI)",
countpct = "n (%)"
)
)
})
tabla1 <- reactive({
x <- base()
my_controls <- controles()
tab1 <- tableby(Color ~ Valor1 Valor2,
data = x,
control = my_controls
)
as.data.frame(summary(tab1, digits = 1, text = "html"))
})
output$table <- function() {
kable(tabla1(), align = "lccccc", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = TRUE)
}
tabla2 <- reactive({
x <- base()
my_controls <- controles()
tab2 <- tableby(Provincia ~ Valor1 Valor2,
data = x,
control = my_controls
)
as.data.frame(summary(tab2, digits = 1, text = "html"))
})
output$table2 <- function() {
kable(tabla2(), align = "lccccc", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = TRUE)
}
data_list <- reactive({
lista <- list(
tabla1(),
tabla2()
)
map(lista, ~ {
.x[[1]] %>%
str_remove_all("<strong>|</strong>") %>%
str_remove_all(" ") %>%
cbind(.x[, -1]) %>%
set_names(c("", names(.x)[-1]))
})
})
output$downloadTable <- downloadHandler(
filename = function() {
"prueba1.xlsx"
},
content = function(file) {
write_xlsx(data_list(), path = file)
}
)
}
shinyApp(ui, server)