ShinyApp中的表格：第三天笔记

shiny中的表格

除了在shinyapp中生成图片，有时还需要生成表格，用于查看数据，以及保存下载表格分为两类：动态和静态。静态的表格更有利于打印和输出pdf,而动态的表格提供了更多的交互式选项，还会响应屏幕的大小来进行缩放

静态表格：shiny中自带的table

shiny中自带的表格，有利于减少其他依赖包，降低内存消耗，定制和美化会受到限制

## 多文件结构的shinyapp,每个*.r代表一个R文件## global.r## 存放一些需要运行的代码
library(tidyverse)
library(shiny)
data.main <- starwarsmin_height <- unique(min(starwars$height, na.rm = TRUE))
max_height <- unique(max(starwars$height, na.rm = TRUE))## ui.r
navbarPage("shiny::renderTable",tabPanel("Start Narrow",uiOutput('height_narrow_slider'),  #增加滑块tableOutput('star_narrow')   #表格),tabPanel("Start Wide",uiOutput('height_wide_slider'),tableOutput('star_wide')),tabPanel("Start List",tableOutput('star_lists'))
)## server.r
function(input, output, session){# Input widgetsoutput$height_narrow_slider <- renderUI({sliderInput(inputId = "height_limit_star_narrow",label = "height limit",min = min_height,max = max_height,value = min_height)})output$height_wide_slider <- renderUI({sliderInput(inputId = "height_limit_star_wide",label = "height limit",min = min_height,max = max_height,value = min_height)})# Tableoutput$star_narrow <- renderTable({starwars %>%select(name, species, homeworld, height) %>%filter(height <= input$height_limit_star_narrow) %>%arrange(desc(height))})# striped = TRUE,# hover = TRUE,# na = "[Missing]")output$star_wide <- renderTable({starwars %>%select(name:species) %>% filter(height <= input$height_limit_star_wide) %>%arrange(desc(height))})output$star_lists <- renderTable({starwars %>%select(name, films, vehicles, starships) %>%# unnest()mutate_if(is.list, list(~map_chr(.,~paste(.x, collapse = "<br>"))))}, width = "100%",sanitize.text.function = function(x) x)}

静态表格：kableExtra

kableExtra包的表格，也是静态的，比shiny中自带的表格具有更大的灵活性 kableExtra在server部分并不使用 render*() 函数，但ui部分还是使用tableOutput这个函数输出
说明文档链接：https://cran.r-project.org/web/packages/kableExtra/vignettes/awesome_table_in_html.html#From_other_packages

## ui.r
#install.packages("kableExtra")
library(kableExtra)navbarPage("kableExtra",tabPanel("Star Narrow",fluidPage(tableOutput('star_narrow'))),tabPanel("Star Wide",fluidPage(tableOutput('star_wide'))),tabPanel("Star List",fluidPage(tableOutput('star_lists'))),collapsible = TRUE
)## server.r
library(kableExtra)
library(tidyverse)function(input, output, session){output$star_narrow <- function(){starwars %>%select(name, species, homeworld, height) %>%arrange(desc(height)) %>%kable() %>%kable_styling(bootstrap_options = c("striped", "hover"))}output$star_wide <- function(){starwars %>%select(name:homeworld) %>%arrange(desc(height)) %>%kable() %>%kable_styling()}output$star_lists <- function(){starwars %>%select(films:starships) %>%kable() %>%kable_styling() ##支持list，会将list内容用逗号分隔}}

动态表格：Rstudio 的 DT

DT包的表格，这个属于动态表格，具有灵活交互式展现表格的特点
使用文档链接：https://rstudio.github.io/DT/

## ui.r
library(DT)navbarPage("DT Interactive Tables",tabPanel("Star Narrow",fluidPage(DTOutput('star_narrow'))),tabPanel("Star Wide",fluidPage(checkboxInput("show_rownames",label = "Show rownames?"),DTOutput('star_wide'))),tabPanel("Star List",fluidPage(DTOutput('star_lists'))),collapsible = TRUE
)## server.r
library(DT)
library(tidyverse)
function(input, output, session) {output$star_narrow <- renderDT({starwars %>%select(name, species, homeworld, height) %>%arrange(desc(height))})output$star_wide <- renderDT({starwars %>%select(name:homeworld) %>%arrange(desc(height)) %>%datatable(extensions = "Responsive", rownames = input$show_rownames)})output$star_lists <- renderDT({starwars %>%select(films:starships) %>%datatable()})}

制作基因信息列表

## help.r
# 创建基因信息链接
# createLink for GeneCards ------------------------------------------------
geneCardsLink <- function(val,name) {sprintf('<a href="https://www.genecards.org/cgi-bin/carddisp.pl?gene=%s" target="_blank" class="btn btn-primary">%s</a>',val,name)
}# createLink for NCBI -----------------------------------------------------
ncbiLink <- function(val,ncbi) {sprintf('<a href="https://www.ncbi.nlm.nih.gov/gene/?term=%s" target="_blank" class="btn btn-primary">%s</a>',val,ncbi)
}# createLink for Esemble --------------------------------------------------
ensemblLink <- function(val,ensembl) {sprintf('<a href="https://www.ensembl.org/Homo_sapiens/Gene/Summary?db=core;g=%s" target="_blank" class="btn btn-primary">%s</a>',val,ensembl)
}# ui.r
fluidPage(DT::DTOutput("gene_info")
)# server.r
library(readr)
data <- read_csv("data/geneInfo.csv")
source("helper.R")function(input, output, session){geneInfo <- reactive({tmp <- datatmp$NCBI <- ncbiLink(tmp$SYMBOL,tmp$SYMBOL)tmp$Ensembl.ASIA <- ensemblLink(tmp$ENSEMBL,tmp$ENSEMBL)tmp$GeneCards <- geneCardsLink(tmp$SYMBOL,tmp$SYMBOL)tmp})output$gene_info <- DT::renderDT(#output$preview3 <- reactable::renderReactable({DT::datatable( geneInfo(), escape = FALSE,  #决定超链接能否被渲染出来rownames = F,extensions = "Responsive", ##缩小页面在所在行的最前面出现加号，点击显示被隐藏的列options=list(pageLength = 15,lengthMenu = list(c(15, 50, 100, -1),c(15, 50, 100, "ALL")),#-1显示所有的scrollX = TRUE,scrollY = TRUE,fixedColumns = TRUE,fixedHeader = TRUE)))}

作业：热门的词云图+基因信息表格

# help.r
# createLink for GeneCards ------------------------------------------------
geneCardsLink <- function(val,name) {sprintf('<a href="https://www.genecards.org/cgi-bin/carddisp.pl?gene=%s" target="_blank" class="btn btn-primary">%s</a>',val,name)
}# createLink for NCBI -----------------------------------------------------
ncbiLink <- function(val,ncbi) {sprintf('<a href="https://www.ncbi.nlm.nih.gov/gene/?term=%s" target="_blank" class="btn btn-primary">%s</a>',val,ncbi)
}# createLink for Esemble --------------------------------------------------
ensemblLink <- function(val,ensembl) {sprintf('<a href="https://www.ensembl.org/Homo_sapiens/Gene/Summary?db=core;g=%s" target="_blank" class="btn btn-primary">%s</a>',val,ensembl)
}# ui.r
fluidPage(sliderInput("num", label = h3("选择热门基因的数量"), min = 1, max = 200, value = c(100)),# Copy the line below to make a set of radio buttonsradioButtons("radio", label = h3("please choose taxid"),choices = list("human" = 9606, "pig" = 9823),  selected = 9606),shiny::plotOutput( "cloud"),DT::DTOutput("gene_info")# server.r
fluidPage(sliderInput("num", label = h3("选择热门基因的数量"), min = 1, max = 200, value = c(100)),# Copy the line below to make a set of radio buttonsradioButtons("radio", label = h3("please choose taxid"),choices = list("human" = 9606, "pig" = 9823),  selected = 9606),shiny::plotOutput( "cloud"),DT::DTOutput("gene_info")

image-20210504211148970

【参考资料】

https://mp.weixin.qq.com/s/VCRukFCQaagTF6GKu2DLgA