0%

Shiny用法整理(四)

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