Skip to content

Commit 1a1024d

Browse files
Ronlee12355Ronlee12355
committed
fix Shiny app bugs
1 parent 3fc51b4 commit 1a1024d

1 file changed

Lines changed: 109 additions & 82 deletions

File tree

‎inst/shiny/app.R‎

Lines changed: 109 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -175,113 +175,140 @@ server <- function(input, output, session){
175175
}
176176
})
177177

178-
observeEvent(input$Expr,{
178+
observeEvent(input$Expr, {
179179
req(input$Expr$datapath)
180180
df <- read.csv(input$Expr$datapath, check.names = F)
181-
if(!('Gene_ID' %in% colnames(df))){
182-
message <- 'Column names should include Gene_ID in the file to identify gene ids.'
181+
if (!('Gene_ID' %in% colnames(df))) {
182+
message <-
183+
'Column names should include Gene_ID in the file to identify gene ids.'
183184
data.inputs$message <- F
184-
output$mRNA_msg<-renderUI({
185-
p(icon('window-close'),message,style='color:red;')
185+
output$mRNA_msg <- renderUI({
186+
p(icon('window-close'), message, style = 'color:red;')
186187
})
188+
return()
187189
}
188190

189-
if(sum(duplicated(df$Gene_ID)) > 0 || any(df$Gene_ID == '')){
191+
if (sum(duplicated(df$Gene_ID)) > 0 || any(df$Gene_ID == '')) {
190192
message <- 'duplicate or empty Gene_ID are not allowed.'
191193
data.inputs$message <- F
192-
output$mRNA_msg<-renderUI({
193-
p(icon('window-close'),message,style='color:red;')
194+
output$mRNA_msg <- renderUI({
195+
p(icon('window-close'), message, style = 'color:red;')
194196
})
195-
}else{
196-
data.inputs$mRNA<-read.csv(input$Expr$datapath, check.names = F, row.names = 'Gene_ID')
197-
if(any(is.na(data.inputs$mRNA))){
198-
message <- 'Gene expression profile cannot contain any NA value(s).'
199-
data.inputs$message <- F
200-
output$mRNA_msg<-renderUI({
201-
p(icon('window-close'),message,style='color:red;')
202-
})
203-
}else if(any(data.inputs$mRNA < 0, na.rm = T)){
204-
message <- 'Gene expression profile cannot contain any negative value(s).'
205-
data.inputs$message <- F
206-
output$mRNA_msg<-renderUI({
207-
p(icon('window-close'),message,style='color:red;')
208-
})
209-
}else if(any(colnames(data.inputs$mRNA) %in% c("SYMBOL","ENSEMBL","ENTREZID", "REFSEQ"))){
210-
message <- 'Sample names in expression profile should not contain "SYMBOL", "ENSEMBL", "ENTREZID" and "REFSEQ".'
211-
data.inputs$message <- F
212-
output$mRNA_msg<-renderUI({
213-
p(icon('window-close'),message,style='color:red;')
214-
})
215-
}else if(ncol(data.inputs$mRNA) <= 1){
216-
message <- 'Sample size in expression profile should be larger than one.'
217-
data.inputs$message <- F
218-
output$mRNA_msg<-renderUI({
219-
p(icon('window-close'),message,style='color:red;')
220-
})
221-
}else{
222-
data.inputs$message <- T
223-
output$mRNA_msg<-renderUI({
224-
p(icon('check-square'),'Data is ready to upload',style='color:green;')
225-
})
226-
}
197+
return()
198+
}
227199

228-
output$mRNA_view<-renderTable({
229-
data.inputs$mRNA[1:8,1:5]
230-
}, rownames = T)
200+
data.inputs$mRNA <-
201+
read.csv(input$Expr$datapath,
202+
check.names = F,
203+
row.names = 'Gene_ID')
204+
if (any(is.na(data.inputs$mRNA))) {
205+
message <- 'Gene expression profile cannot contain any NA value(s).'
206+
data.inputs$message <- F
207+
output$mRNA_msg <- renderUI({
208+
p(icon('window-close'), message, style = 'color:red;')
209+
})
210+
} else if (any(data.inputs$mRNA < 0, na.rm = T)) {
211+
message <-
212+
'Gene expression profile cannot contain any negative value(s).'
213+
data.inputs$message <- F
214+
output$mRNA_msg <- renderUI({
215+
p(icon('window-close'), message, style = 'color:red;')
216+
})
217+
} else if (any(colnames(data.inputs$mRNA) %in% c("SYMBOL", "ENSEMBL", "ENTREZID", "REFSEQ"))) {
218+
message <-
219+
'Sample names in expression profile should not contain "SYMBOL", "ENSEMBL", "ENTREZID" and "REFSEQ".'
220+
data.inputs$message <- F
221+
output$mRNA_msg <- renderUI({
222+
p(icon('window-close'), message, style = 'color:red;')
223+
})
224+
} else if (ncol(data.inputs$mRNA) <= 1) {
225+
message <-
226+
'Sample size in expression profile should be larger than one.'
227+
data.inputs$message <- F
228+
output$mRNA_msg <- renderUI({
229+
p(icon('window-close'), message, style = 'color:red;')
230+
})
231+
} else{
232+
data.inputs$message <- T
233+
output$mRNA_msg <- renderUI({
234+
p(icon('check-square'), 'Data is ready to upload', style = 'color:green;')
235+
})
231236
}
237+
238+
output$mRNA_view <- renderTable({
239+
data.inputs$mRNA[1:8, 1:5]
240+
}, rownames = T)
232241
})
233242

234243
observeEvent(input$submit, {
235-
showModal(modalDialog(
236-
tagList(
237-
h3(
238-
img(src="Loading_icon.gif", heigth='35%', width='35%'),
239-
br(),
240-
'Gastric cancer molecular subtype prediction is processing......',
241-
align = 'center',
242-
style = 'color:black;'
243-
)
244-
),footer = NULL,size='l'))
244+
showModal(modalDialog(tagList(
245+
h3(
246+
img(
247+
src = "Loading_icon.gif",
248+
heigth = '35%',
249+
width = '35%'
250+
),
251+
br(),
252+
'Gastric cancer molecular subtype prediction is processing......',
253+
align = 'center',
254+
style = 'color:black;'
255+
)
256+
), footer = NULL, size = 'l'))
245257

246258
Sys.sleep(1.5)
247259
tryCatch({
248260
res <- GCclassifier::classifyGC(
249-
Expr = data.inputs$mRNA, method = input$method ,idType = input$idType,
261+
Expr = data.inputs$mRNA,
262+
method = input$method ,
263+
idType = input$idType,
250264
minPosterior = ifelse(is.null(input$minPosterior), 0.5, input$minPosterior),
251265
useMinPosterior = ifelse(input$useMinPosterior == 'Yes', T, F),
252-
maxp = NULL, verbose = F)
266+
maxp = NULL,
267+
verbose = F
268+
)
269+
res$subtype <- as.character(res$subtype)
270+
res[is.na(res)] <- 'Unclassified'
271+
output$prediction_result <- DT::renderDataTable(server = F, {
272+
DT::datatable(
273+
res,
274+
rownames = F,
275+
extensions = 'Buttons',
276+
width = '100%',
277+
options = list(
278+
paging = TRUE,
279+
searching = TRUE,
280+
scrollX = TRUE,
281+
fixedColumns = F,
282+
autoWidth = F,
283+
ordering = TRUE,
284+
dom = 'Bfrtip',
285+
pageLength = 30,
286+
columnDefs = list(list(
287+
className = 'dt-center', targets = "_all"
288+
)),
289+
buttons = c('copy', 'csv', 'excel', 'pdf')
290+
)
291+
)
292+
})
293+
removeModal()
253294
},
254-
error = function(e){
295+
error = function(e) {
255296
removeModal()
256297
showModal(modalDialog(
257-
title = p(icon('exclamation'),strong("Error information")),
298+
title = p(icon('exclamation'), strong("Error information")),
258299
tagList(
259-
h3('An error happens, please check your upload file or parameters and refresh the webpage, below is the error info from server', style='color:red;', align='center'),
260-
h4(as.character(e), align='center')
261-
), footer = NULL, easyClose = F, size='l'))
262-
},
263-
finally = {
264-
res <- NULL
265-
return(res)
266-
}
267-
)
268-
res$subtype <- as.character(res$subtype)
269-
res[is.na(res)] <- 'Unclassified'
270-
output$prediction_result<-DT::renderDataTable(server = F, {
271-
DT::datatable(
272-
res,
273-
rownames=F,
274-
extensions = 'Buttons',width = '100%',
275-
options = list(
276-
paging = TRUE,searching = TRUE,
277-
scrollX=TRUE,fixedColumns = F,
278-
autoWidth = F,ordering = TRUE,
279-
dom = 'Bfrtip', pageLength = 30,
280-
columnDefs = list(list(className = 'dt-center', targets = "_all")),
281-
buttons = c('copy', 'csv', 'excel', 'pdf')
282-
))
300+
h3(
301+
'An error happens, please check your upload file or parameters, below is the error info from server',
302+
style = 'color:red;',
303+
align = 'center'
304+
),
305+
h4(as.character(e), align = 'center')
306+
),
307+
footer = NULL,
308+
easyClose = T,
309+
size = 'l'
310+
))
283311
})
284-
removeModal()
285312
})
286313
}
287314

0 commit comments

Comments
 (0)