问题描述
我是RShiny的新手，一段时间以来我一直在尝试解决如何重置我的应用程序的问题，但是我还没有找到可行的解决方案。为了提出问题，我已经缩短了应用程序。共有三个标签：一个用于“数据上传”，一个用于“分析选项”，另一个用于显示生物标记的描述性统计信息。我希望我的整个应用在用户每次上传新数据集时都能恢复到原始状态。我试过使用Shinyjs的reset函数，但它只重置输入，因此当用户上载新数据集时，以前的输出仍显示在Descriptive Statistics选项卡中。每次用户上载新数据时，是否有可能有一个干净的状态，从而不会显示以前的输出？以下是我的应用的摘要：
ui.R
library(shinydashboard)
library(shinydashboardPlus)
library(dashboardthemes)
library(shiny)
library(openxlsx)
library(Cairo)
options(shiny.usecairo=T)
options(DT.TOJSON_ARGS = list(na = 'string'))
# Define UI ----
ui<-tagList(
dashboardPage(
dashboardHeader(title = shinyDashboardLogoDIY(boldText = "Stat",mainText = "App",textSize=30,badgeText = "v1",badgeTextColor = "white",badgeTextSize = 4,badgeBackColor = "rgb(44,62,80)",badgeBorderRadius = 3
),titleWidth = 275),dashboardSidebar(width = "275px",sidebarMenu(
menuItem("Data Upload",tabName = "upload",icon = icon("file-upload")),menuItem("Analysis",tabName = "opt",icon = icon("cogs")),menuItem("Descriptive Statistics",tabName = "st",icon=icon("calculator"))
)
),dashboardBody(
tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 63px; line-height: 60px; text-align: center; vertical-align: middle; } .info-box-content {padding-top: 0px; padding-bottom: 0px;}'))),tags$head(tags$style(HTML(".box {margin: 5px;}"))),waiter::waiter_show_on_load(html = tagList(waiter::spin_fading_circles(),"Loading ...")),tabItems(
#Data Upload
tabItem(tabName = "upload",fluidPage(
fluidRow(
box(status = "primary",width = 5,solidHeader=TRUE,title=strong("Please upload a .csv,.xls,or .xlsx file"),br(),fileInput("file1","Select File",accept = c(".csv",".xlsx",".xls")),conditionalPanel(condition="output.xlOut",uiOutput("xlOut")),selectizeInput("mname",label = helpText("Please select the marker name indicator:"),choices = NULL,options=list(maxOptions = 2000)),actionButton("goData","Submit")
),fluidRow(
conditionalPanel(condition = "output.contents",box(status = "primary",width=12,DT::dataTableOutput("contents")))))
)),#Analysis Options
tabItem(tabName="opt",fluidRow(
column(12,offset=3,shinyjs::useShinyjs(),div(id = "anlysopt",box(status = "primary",h2("Data Options"),box(title="Outcome Variable",status = "primary",solidHeader = TRUE,collapsible = TRUE,fluidRow(
column(5,selectizeInput("select.outcome",label = helpText("Please select the outcome variable:"),options=list(maxOptions = 2000)))),selectizeInput("select.case",label=helpText("Please select the cases:"),choices=NULL,options=list(maxOptions = 2000))),column(6,selectizeInput("select.ctrl",label=helpText("Please select the controls:"),options=list(maxOptions = 2000)))))
))
)),shinyalert::useShinyalert(),# Set up shinyalert
waiter::use_waiter(),# Set up shinyalert
fluidRow(div(actionButton("goButton","Submit"),style="text-align: center;"))
),#Descriptive Statistics
tabItem(tabName = "st",fluidPage(
shinyjs::useShinyjs(),div(id = "stat",fluidRow(
valueBoxOutput("nsamp",width = 3),valueBoxOutput("ncase",valueBoxOutput("nctrl",valueBoxOutput("nbiom",width = 3)),fluidRow(box(width=12,status="primary",title="Descriptive Statistics",shinycssloaders::withSpinner(DT::dataTableOutput("desc"))))))
)
)
)
)
)
server.R
options(shiny.maxRequestSize=30*1024^2)
server <- function(input,output,session) {
waiter::waiter_hide() # will hide *on_load waiter
#User upload
d0<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
getExtension <- function(file){
ex <- strsplit(basename(file),split="\\.")[[1]]
return(ex[-1])
}
p.ext=getExtension(inFile$datapath)
return(list(inFile=inFile,p.ext=p.ext))
})
#If user uploads excel file,they chose an excel sheet to analyze
output$xlOut<-renderUI({
req(input$file1)
if(d0()$p.ext=="xlsx"|d0()$p.ext=="xls"){
ch=readxl::excel_sheets(input$file1$datapath)
selectizeInput("selectxl",label = "Choose an excel sheet:",choices = ch)
}
})
outputOptions(output,'xlOut',suspendWhenHidden=FALSE)
#Read data set
Data0<-reactive({
req(input$file1,d0()$p.ext)
if(d0()$p.ext=="csv"){
newdat<-read.csv(input$file1$datapath,header=F,stringsAsFactors = F)
newdat.df<-as.data.frame(newdat)
w1=as.numeric(length(which(newdat.df[,1]==""))+1) #row
w2=as.numeric(length(which(newdat.df[1,]==""))+1) #col
}else if(d0()$p.ext=="xlsx"|d0()$p.ext=="xls"){
req(input$selectxl)
sh=paste0(input$selectxl,sep="")
newdat<-readxl::read_excel(input$file1$datapath,sheet=sh,col_names =F)
newdat.df<-as.data.frame(newdat)
w1=as.numeric(which(duplicated(cumsum(is.na(newdat.df[,1])))==TRUE)[1]) #row
w2=as.numeric(which(duplicated(cumsum(is.na(newdat.df[1,])))==TRUE)[1]) #col
}
return(list(ns=newdat.df,row=w1,col=w2))
})
#User chooses name of markers
observe({
req(input$file1,Data0()$ns)
mname.ch=Data0()$ns[c(1:(Data0()$row-1)),Data0()$col]
updateSelectizeInput(session,"mname",label = "Please select the marker name indicator:",choices = mname.ch)
})
#Finalized data based on user marker selection
Data<-reactive({
req(input$mname)
w4=which(Data0()$ns[,Data0()$col]==input$mname)
#New data
dataf2=Data0()$ns[-c(1:Data0()$row),]
colnames(dataf2)[1:Data0()$col]=Data0()$ns[Data0()$row,1:Data0()$col]
colnames(dataf2)[(Data0()$col+1):ncol(dataf2)]=Data0()$ns[w4,(Data0()$col+1):ncol(dataf2)]
return(list(wide=dataf2))
})
#Only display data after file is uploaded (no prior error)
dis <- eventReactive(input$goData,{
input$contents
})
#Display data (wide format)
output$contents <- DT::renderDataTable(rownames=FALSE,options = list(pageLength=25,scrollX = TRUE),{
dis()
isolate(Data()$wide)
})
outputOptions(output,'contents',suspendWhenHidden=FALSE)
#Auto-fill drop-down list to select outcome
observeEvent(input$mname,{
req(Data()$wide)
col.w1 <- colnames(Data()$wide)
# Can use character(0) to remove all choices
if (is.null(col.w1))
col.w1 <- character(0)
# Can also set the label and select items
updateSelectizeInput(session,"select.outcome",label = "Please select the outcome variable:",choices = col.w1)
})
#Auto-fill drop-down list to select cases/ctrls
observeEvent(input$select.outcome,{
req(Data()$wide)
outc=Data()$wide[,which(colnames(Data()$wide)==input$select.outcome)]
# Can also set the label and select items
updateSelectizeInput(session,"select.case",label = "Please select the cases:",choices = outc)
updateSelectizeInput(session,"select.ctrl",label = "Please select the controls:",choices = outc)
})
#Data Step: Determine Outcome & markers depending on user input
Data_outlong<-reactive({
data=Data()$wide
col=Data0()$col
#Outcome and Z
y=sapply(data[,which(colnames(data)==input$select.outcome)],as.numeric)
z=sapply(data.frame(data[,c((col+1):ncol(data))]),as.numeric)
colnames(z)=colnames(data)[c((col+1):ncol(data))]
return(list(y=y,z=z))
})
#Give error if n1<1 or n0<1
observeEvent(input$goButton,{
y=Data_outlong()$y
len=length(unique(y))
x=tryCatch(len,warning=function(w){ w })
if(x<2){
shinyalert::shinyalert("Error","Outcome variable must have more than one level",type="error",immediate = T)
}else if (x>=2){
#Display results of "Descriptive Statistics" tab only after click submit
react <- eventReactive(input$goButton,{
input$stats
input$desc
})
#Waiter and Shiny Alert after "Analysis Options"
observeEvent(input$goButton,once = T,{
waiter::waiter_show(html = waiter::spin_fading_circles())
waiter::waiter_hide()
shinyalert::shinyalert("Analysis Complete",type = "success",immediate = T)
})
#Descriptive Stat calc
stats<-reactive({
req(input$goButton,Data_outlong(),input$select.case,input$select.ctrl)
#Outcome and z
y=Data_outlong()$y
z=Data_outlong()$z
if(is.character(y)){ #if y is character: "case","control",etc.....
ca=input$select.case
ctr=input$select.ctrl
}else if(is.numeric(y)){ #if y is numeric: 0,1,etc.....
ca=as.numeric(input$select.case)
ctr=as.numeric(input$select.ctrl)
}
#Descriptive
n.samp=nrow(z)
cas=which(y==ca)
cont=which(y==ctr)
n.case=length(cas)
n.ctrl=length(cont)
n.bio=ncol(z)
stat.df=data.frame(SAMP=n.samp,CASE=n.case,CTRL=n.ctrl,BIO=n.bio)
case=data.frame(z[cas,])
colnames(case)=colnames(z)
ctrl=data.frame(z[cont,])
colnames(ctrl)=colnames(z)
desc.over=t(round(apply(z,2,function(x) { c(mn = mean(x),std = sd(x),med=median(x),q1=quantile(x)[[2]],q3=quantile(x)[[4]])}),2))
desc.over=data.frame("All Samples",desc.over)
desc.over <- cbind(rownames(desc.over),data.frame(desc.over,row.names=NULL))
colnames(desc.over)[1:2]=c("Markers","Category")
desc.case=t(round(apply(case,2))
desc.case=data.frame("Cases",desc.case)
desc.case <- cbind(rownames(desc.case),data.frame(desc.case,row.names=NULL))
colnames(desc.case)[1:2]=c("Markers","Category")
desc.ctrl=t(round(apply(ctrl,2))
desc.ctrl=data.frame("Controls",desc.ctrl)
desc.ctrl <- cbind(rownames(desc.ctrl),data.frame(desc.ctrl,row.names=NULL))
colnames(desc.ctrl)[1:2]=c("Markers","Category")
desc.df=rbind(desc.over,desc.case,desc.ctrl)
colnames(desc.df)[3:7]<-c("Mean","Standard Deviation","Median","Q1","Q3")
desc.df=desc.df[order(desc.df$Markers),]
return(list(stat=stat.df,desc=desc.df,CAS=cas,CONT=cont))
})
#ValueBox- No of samples
output$nsamp <- renderValueBox({
react()
valueBox(
paste0(stats()$stat$SAMP),"Number of Samples",icon = icon("vials"),color="aqua"
)
})
#ValueBox- No of Cases
output$ncase <- renderValueBox({
react()
valueBox(
paste0(stats()$stat$CASE),"Number of Cases",icon = icon("briefcase-medical"),color="aqua"
)
})
#ValueBox- No of Controls
output$nctrl <- renderValueBox({
react()
valueBox(
paste0(stats()$stat$CTRL),"Number of Controls",icon = icon("briefcase"),color="aqua"
)
})
#ValueBox- No of Biomarkers
output$nbiom <- renderValueBox({
react()
valueBox(
paste0(stats()$stat$BIO),"Number of Biomarkers",icon = icon("microscope"),color="aqua"
)
})
#Descriptive Statistics Table pt 2
output$desc <- DT::renderDataTable(rownames=FALSE,extensions = c('Buttons','RowGroup'),scrollX = TRUE,rowGroup = list(dataSrc=c(0))),{
react()
isolate(stats()$desc)
})
}
})
#Reset Inputs
observeEvent(input$file1,{
shinyjs::reset("anlysopt")
shinyjs::reset("stat")
})
}
以下是使用我随附的特定测试数据集时在应用程序中进行的选择：
- 请选择标记物名称指示器：蛋白质
- 请选择结果变量： CaCo
- 请选择案例： 1
- 请选择控件： 0
链接到数据集：https://www.dropbox.com/s/sv3c0qodf70mk8t/Sample%20Data.csv?dl=0
任何帮助将不胜感激！
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）