R语言shiny动态面板_shiny-demo.zip

## 注释：更改文件路径 library(shiny) library(htmltools) library(DT) #install.packages("heatmaply") library(heatmaply) library(dplyr) library(datasets) sample <- data.frame(stringsAsFactors=FALSE, NANA = c("ABCB1", "ACVR1B", "ACVR2A", "APC", "ARID1A", "ARID1B"), NADriver = c(1, 1, 1, 1, 1, 1), NAsnv_t_013 = c(0, 0, 0, 1, 0, 1), NAsnv_o_013 = c(1, 0, 0, 1, 0, 1), NAindel_t_013 = c(0, 0, 0, 0, 1, 1), NAindel_o_013 = c(0, 0, 0, 0, 1, 1), NADeleted_ot_013 = c(0, 0, 0, 0, 1, 1), NADeleted_o_013 = c(0, 0, 0, 0, 0, 1)) ## 文件路径改成wine的路径 wine = read.table('C:/Users/ping/Documents/Multi-Statis/shiny_demo/wine.data', sep=',') q = wine$V1 q = gsub("1", "first", q, fixed = T) q = gsub("2", "second", q, fixed = T) q = gsub("3", "third", q, fixed = T) wine$V1 = q wine plotHeight <- 800 obj <- list(sample = sample, iris = iris, wine=wine) if (!"list" %in% class(obj)) obj = list(obj) if (is.null(names(obj))) names(obj) = paste0("data", seq(1, length(obj))) #UI---- ui <- shiny::shinyUI( shiny::fluidPage( shiny::sidebarLayout( shiny::sidebarPanel( htmltools::h4('Data'), shiny::uiOutput('data'), shiny::checkboxInput('showSample','Subset Data'), shiny::conditionalPanel('input.showSample',shiny::uiOutput('sample')), # br(), htmltools::hr(),htmltools::h4('Data Preprocessing'), shiny::column(width=4,shiny::selectizeInput('transpose','Transpose',choices = c('No'=FALSE,'Yes'=TRUE),selected = FALSE)), shiny::column(width=4,shiny::selectizeInput("transform_fun", "Transform", c(Identity=".",Sqrt='sqrt',log='log',Scale='scale',Normalize='normalize',Percentize='percentize',"Missing values"='is.na10', Correlation='cor'),selected = '.')), shiny::uiOutput('annoVars'), htmltools::br(),htmltools::hr(),htmltools::h4('Row dendrogram'), shiny::column(width=6,shiny::selectizeInput("distFun_row", "Distance method", c(Euclidean="euclidean",Maximum='maximum',Manhattan='manhattan',Canberra='canberra',Binary='binary',Minkowski='minkowski'),selected = 'euclidean')), shiny::column(width=6,shiny::selectizeInput("hclustFun_row", "Clustering linkage", c(Complete= "complete",Single= "single",Average= "average",Mcquitty= "mcquitty",Median= "median",Centroid= "centroid",Ward.D= "ward.D",Ward.D2= "ward.D2"),selected = 'complete')), shiny::column(width=12,shiny::sliderInput("r", "Number of Clusters", min = 1, max = 15, value = 2)), #column(width=4,numericInput("r", "Number of Clusters", min = 1, max = 20, value = 2, step = 1)), htmltools::br(),htmltools::hr(),htmltools::h4('Column dendrogram'), shiny::column(width=6,shiny::selectizeInput("distFun_col", "Distance method", c(Euclidean="euclidean",Maximum='maximum',Manhattan='manhattan',Canberra='canberra',Binary='binary',Minkowski='minkowski'),selected = 'euclidean')), shiny::column(width=6,shiny::selectizeInput("hclustFun_col", "Clustering linkage", c(Complete= "complete",Single= "single",Average= "average",Mcquitty= "mcquitty",Median= "median",Centroid= "centroid",Ward.D= "ward.D",Ward.D2= "ward.D2"),selected = 'complete')), shiny::column(width=12,shiny::sliderInput("c", "Number of Clusters", min = 1, max = 15, value = 2)), #column(width=4,numericInput("c", "Number of Clusters", min = 1, max = 20, value = 2, step = 1)), htmltools::br(),htmltools::hr(), htmltools::h4('Additional Parameters'), shiny::column(3,shiny::checkboxInput('showColor','Color')), shiny::column(3,shiny::checkboxInput('showMargin','Layout')), shiny::column(3,shiny::checkboxInput('showDendo','Dendrogram')), htmltools::hr(), shiny::conditionalPanel('input.showColor==1', htmltools::hr(), htmltools::h4('Color Manipulation'), shiny::uiOutput('colUI'), shiny::sliderInput("ncol", "Set Number of Colors", min = 1, max = 256, value = 256), shiny::checkboxInput('colRngAuto','Auto Color Range',value = T), shiny::conditionalPanel('!input.colRngAuto',shiny::uiOutput('colRng')) ), shiny::conditionalPanel('input.showDendo==1', htmltools::hr(), htmltools::h4('Dendrogram Manipulation'), shiny::selectInput('dendrogram','Dendrogram Type',choices = c("both", "row", "column", "none"),selected = 'both'), shiny::selectizeInput("seriation", "Seriation", c(OLO="OLO",GW="GW",Mean="mean",None="none"),selected = 'OLO'), shiny::sliderInput('branches_lwd','Dendrogram Branch Width',value = 0.6,min=0,max=5,step = 0.1) ), shiny::conditionalPanel('input.showMargin==1', htmltools::hr(), htmltools::h4('Widget Layout'), shiny::column(4,shiny::textInput('main','Title','')), shiny::column(4,shiny::textInput('xlab','X Title','')), shiny::column(4,shiny::textInput('ylab','Y Title','')), shiny::sliderInput('row_text_angle','Row Text Angle',value = 0,min=0,max=180), shiny::sliderInput('column_text_angle','Column Text Angle',value = 45,min=0,max=180), shiny::sliderInput("l", "Set Margin Width", min = 0, max = 200, value = 130), shiny::sliderInput("b", "Set Margin Height", min = 0, max = 200, value = 40) ) ), shiny::mainPanel( shiny::tabsetPanel( shiny::tabPanel("Heatmaply", htmltools::tags$a(id = 'downloadData', class = paste("btn btn-default shiny-download-link",'mybutton'), href = "", target = "_blank", download = NA, shiny::icon("clone"), 'Download Heatmap as HTML'), htmltools::tags$head(htmltools::tags$style(".mybutton{color:white;background-color:blue;} .skin-black .sidebar .mybutton{color: green;}") ), plotly::plotlyOutput("heatout",height=paste0(plotHeight,'px')) ), shiny::tabPanel("Data", DT::dataTableOutput('tables') ) ) ) ) ) ) #Server---- server <- function(input, output, session) { output$data=shiny::renderUI({ d<-names(obj) selData=d[1] shiny::selectInput("data","Select Data",d,selected = selData) }) data.sel=shiny::eventReactive(input$data,{ as.data.frame(obj[[input$data]]) }) shiny::observeEvent(data.sel(),{ output$annoVars<-shiny::renderUI({ data.in=data.sel() NM=NULL if(any(sapply(data.in,class)=='factor')){ NM=names(data.in)[which(sapply(data.in,class)=='factor')] } shiny::column(width=4, shiny::selectizeInput('annoVar','Annotation',choices = names(data.in),selected=NM,multiple=T,options = list(placeholder = 'select columns',plugins = list("remove_button"))) ) }) #Sampling UI ---- output$sample<-shiny::renderUI({ list( shiny::column(4,shiny::textInput(inputId = 'setSeed',label = 'Seed',value = sample(1:10000,1))), shiny::column(4,shiny::numericInput(inputId = 'selRows',label = 'Number of Rows',min=1,max=pmin(500,nrow(data.sel())),value = pmin(