KeepNotes blog

Stay hungry, Stay Foolish.

0%

Shiny用法整理（四）

Posted on Edited on In
Symbols count in article: 6.2k Reading time ≈ 6 mins.

继续整理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转载请注明出处

Related Posts