Shiny articles

Shiny · 發表 2019-04-28 22:54:50

摘要：繼續整理shiny的幾個用法 Download existing file 在shiny用法整理（三）中，提到對於多個檔案的下載，可在downloadHandler 中將多個輸出檔案進行壓縮後作為單個檔案進行下載，比如我有100個檔案要生成： library(shin...

繼續整理shiny的幾個用法

Download existing file

在shiny用法整理（三）中，提到對於多個檔案的下載，可在downloadHandler 中將多個輸出檔案進行壓縮後作為單個檔案進行下載，比如我有100個檔案要生成：

library(shiny)

ui <- fluidPage(
downloadButton(outputId = "download", label = "Download Single Boxplot Plot")
)

server <- function(input, output, session) {
output$download <- downloadHandler(
filename = "xxx.zip",
contentType = "application/zip",
content = function(file){
fs <- c()
for (i in 1:10) {
filepath <- paste0(tempdir(), "/", i, ".txt")
fs <- c(fs, filepath)
data <- matrix(1:100000, nrow = 1000)
write.table(data, file = filepath, sep = "\t", quote = F)
}
zip(zipfile = file, files = fs)
file.remove(fs)
}
)
}

shinyApp(ui, server)

但是，當我將輸出檔案設定為100或者更多時，則會出現一種BUG，瀏覽器在傳送下載請求時，shiny還是生成並壓縮該100個檔案，但是由於其中生成過程時間較長，會造成連線中斷（即shiny後臺還在處理檔案，但是下載連線卻先中斷了）；在這種情況下，我們需要做一些改變，將生成檔案的過程從downloadHandler 中挪出，放到一個observeEvent 下，並將生出處理檔案的過程放到臨時資料夾中，這樣我們相當於是將一個已生成的檔案通過download按鈕下載下來，如下：

library(shiny)

ui <- fluidPage(
actionButton(inputId = "button", label = "Submit! Go!", icon = icon("refresh")),
br(),
downloadButton(outputId = "download", label = "Download Single Boxplot Plot")
)

server <- function(input, output, session) {
observeEvent(input$button, {
fs <- c()
for (i in 1:100) {
filepath <- paste0(tempdir(), "/", i, ".txt")
fs <- c(fs, filepath)
data <- matrix(1:100000, nrow = 1000)
write.table(data, file = filepath, sep = "\t", quote = F)
}
zip(zipfile = paste0(tempdir(), "/xxx.zip"), files = fs)
file.remove(fs)
})

output$download <- downloadHandler(
filename = "xxx.zip",
contentType = "application/zip",
content = function(file){
file.copy(paste0(tempdir(), "/xxx.zip"), file)
file.remove(paste0(tempdir(), "/xxx.zip"))
}
)
}

shinyApp(ui, server)

為了增加一些體驗度，使用進度條來提醒shiny工具使用者：後臺正在處理檔案，這種在observeEvent 中使用shiny的progress 即可：

library(shiny)

ui <- fluidPage(
actionButton(inputId = "button", label = "Submit! Go!", icon = icon("refresh")),
br(),
downloadButton(outputId = "download", label = "Download Single Boxplot Plot")
)

server <- function(input, output, session) {
observeEvent(input$button, {
fs <- c()

progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = "Begin to process files, Please wait...", value = 0)

for (i in 1:100) {
filepath <- paste0(tempdir(), "/", i, ".txt")
fs <- c(fs, filepath)
data <- matrix(1:100000, nrow = 1000)
write.table(data, file = filepath, sep = "\t", quote = F)

progress$inc(1/100, detail = "Please wait...")
}

progress$set(message = "Begin to zip files, Please wait...", value = 0.5)

zip(zipfile = paste0(tempdir(), "/xxx.zip"), files = fs)
file.remove(fs)

progress$set(message = "Over...", value = 1)
})

output$download <- downloadHandler(
filename = "xxx.zip",
contentType = "application/zip",
content = function(file){
file.copy(paste0(tempdir(), "/xxx.zip"), file)
file.remove(paste0(tempdir(), "/xxx.zip"))

}
)
}

shinyApp(ui, server)

Select rows using checkboxes in DT

DT包其實已經支援對row/column進行單選/複選的功能，如：https://yihui.shinyapps.io/DT-selection

但是如果想在DT輸出的表格中有一列更加直觀的checkboxes，那麼可以考慮用以下這個模板：

library(shiny)
library(DT)
shinyApp(
ui = fluidPage(DT::dataTableOutput('x1'), verbatimTextOutput('x2')),

server = function(input, output) {
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, ...) {
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}

# obtain the values of inputs
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}

# a sample data frame
res = data.frame(
v1 = shinyInput(numericInput, 100, 'v1_', value = 0),
v2 = shinyInput(checkboxInput, 100, 'v2_', value = TRUE),
v3 = rnorm(100),
v4 = sample(LETTERS, 100, TRUE),
stringsAsFactors = FALSE
)

# render the table containing shiny inputs
output$x1 = DT::renderDataTable(
res, server = FALSE, escape = FALSE, selection = 'none', options = list(
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
# print the values of inputs
output$x2 = renderPrint({
data.frame(v1 = shinyValue('v1_', 100), v2 = shinyValue('v2_', 100))
})
}
)

感謝謝益輝大神的提供的解決方案https://github.com/rstudio/DT/issues/93

Shiny table rendering html

shiny app中對於表格的展示，除了DT包外，還有常規函式tableOutput ，但是其預設引數是不會將單元格中R程式碼渲染成HTML程式碼，比如：

library(shiny)

ui <- fluidPage(
tableOutput("table")
)

server <- function(input, output, session) {
output$table <- renderTable({
r <- data.frame(ID = 1, url = as.character(tags$a(href = "www.baidu.com", "r")))
})
}

shinyApp(ui, server)

其結果表格中url是以<a href="www.baidu.com">r</a> 顯示的，說明html程式碼未被渲染；這時需要xtable包中print.xtable 函式的一個引數sanitize.text.function ，其能將上述html渲染為一個超連結

兩者的區別，網上給出的說法是（我的理解是renderTable 是將R物件轉化為html，可供xtable 來渲染，renderTable 預設情況下，sanitize.text.function 是關閉的，可看print.xtable 函式的幫助文件）：

It looks unlikely, as sanitize.text.function is from the xtable package which itself writes the html – renderTable is just passing parameters to it. It is probably possible to embed html in a way that renderDataTable will properly display it…

因此解決方法如下：

library(shiny)

ui <- fluidPage(
tableOutput("table")
)

server <- function(input, output, session) {
output$table <- renderTable({
r <- data.frame(ID = 1, url = as.character(tags$a(href = "https://www.baidu.com/", "r")))
}, sanitize.text.function = function(x) x)
}

shinyApp(ui, server)

參考自：r shiny table not rendering html

Display checkboxGroupInput horizontally

checkboxGroupInput 函式本身複選框是垂直排序的，可以使用其inline = TRUE 將複選框變成水平排布，但是其有個問題是有時會不對齊，這不太美觀

網上搜下了，解決辦法如下，新增一個CSS，相當於修改shiny預設的checkbox 的inline樣式

tags$head(
tags$style(
HTML(
".checkbox-inline { 
margin-left: 0px;
margin-right: 10px;
}
.checkbox-inline+.checkbox-inline {
margin-left: 0px;
margin-right: 10px;
}
"
)
) 
)

可以從這裡https://github.com/rstudio/shiny/blob/master/inst/www/shared/bootstrap/css/bootstrap.css 看到，其屬於bootstrap的樣式，shiny預設於bootstrap的CSS是這樣的：

.checkbox-inline {
position: relative;
display: inline-block;
padding-left: 20px;
margin-bottom: 0;
font-weight: normal;
vertical-align: middle;
cursor: pointer;
}

.checkbox-inline + .checkbox-inline {
margin-top: 0;
margin-left: 10px;
}

總是shiny想要學的好，HTML/CSS/JS還是必不可少。。要學的還是有好多誒

本文出自於http://www.bioinfo-scrounger.com 轉載請註明出處

Shiny articles

Download existing file

Select rows using checkboxes in DT

Shiny table rendering html

Display checkboxGroupInput horizontally

您可能也會喜歡…