library('HTqPCR')
library('ddCt')
library('Xtools')
shinyApp(
## UI section
ui = fluidPage(
## header
includeCSS("www/style.css"),
includeHTML("www/header.html"),
HTML("<div class='content'>"),
titlePanel("RT-qPCR data analysis"),
## Layout
sidebarLayout(
## sidebar panel
sidebarPanel(
downloadLink('template', 'Download Ct template file here.'),
fileInput("dtfile", h4("Upload file"), accept = c('text/csv', 'text/comma-separated-values', 'text/tab-separated-values',
'text/plain', '.csv', '.txt')),
radioButtons("Sep", h4("Data seperator (in file)"), choices=c('comma', 'tab', 'space'), inline=TRUE),
checkboxGroupInput("Refs", h4("Set reference gene(s)"), choices=''),
radioButtons("Mock", h4("Set control sample"), choices='')
),
## main panel
mainPanel(
tabsetPanel(
tabPanel("Data view",
tableOutput("datax")
),
tabPanel("Ct quality", plotOutput("FigNorm", width="600px", height="600px")),
tabPanel("Expression",
tabsetPanel(type='pills',
tabPanel("Relative levels",
h4("Gene expression levels are normalized with 'Control sample'"),
conditionalPanel(
condition="output.ddctRelative",
downloadButton('saveRelative', 'download result'), br(), br()
),
tableOutput("ddctRelative")
),
tabPanel("Obsolute values",
h4("Gene expression levels are normalized with reference genes only."),
conditionalPanel(
condition="output.ddctAbsolute",
downloadButton('saveAbsolute', 'download result'), br(), br()
),
tableOutput("ddctAbsolute")
)
)
),
tabPanel("P value",
radioButtons("compType", h4("Pair-wised comparison"), choices=c("Single control", "Free input"), inline=TRUE),
HTML('<label for="Comps">Single control: input a sample name (copy from left panel).</br>',
'Free input: input comparisons like this:T1:CK, T2:CK</label><input id="Comps" type="text" value="" style="width: 95%" />'
),
br(),
conditionalPanel(
condition="output.resultLimma",
downloadButton('saveLimma', 'download result')
),
br(),
tableOutput("resultLimma")
),
tabPanel("Help", includeHTML("www/data.format.html"))
)
)
),
## end UI
HTML("</div>"),
includeHTML("www/footer.html")
),
## server section
server = function(input, output, session) {
## set files
setData <- reactive({
f <- input$dtfile
if(is.null(f)) return(NULL)
else filex <- f$datapath
sep <- '\t'
if (input$Sep=='comma') sep <- ','
if (input$Sep=='space') sep <- ' '
xx <- read.table(filex, header=TRUE, stringsAsFactor=FALSE, sep=sep)
## 内参基因设置选项
genes <- unique(xx$gene)
refs <- grep('^(ACT|UBQ|REF|RF).*', genes, ignore.case=TRUE)
if (length(refs)==0) refs <- genes[length(genes)]
else refs <- genes[refs]
updateCheckboxGroupInput(session, 'Refs', choices=genes, selected=refs)
## 设置qPCR数据
htset <- NULL
ddset <- NULL
xdata <- read.qPCRtable(filex, sep=sep)
if(!is.null(xdata)) {
htset <- xdata$data.ht
ddset <- xdata$data.ddct
samples <- unique(as.character(pData(htset)$Sample))
updateRadioButtons(session, 'Mock', choices=samples, selected=samples[1])
if(length(samples) > 4 | max(nchar(samples)) > 6) {
updateSliderInput(session, 'side1', value=8)
updateSliderInput(session, 'xsrt', value=30)
}
}
return(list(data=xx, data.ht=htset, data.ddct=ddset))
})
## 原始数据输出
output$datax <- renderTable({
info <- setData()
if(is.null(info)) NULL else setData()$data
})
## HTqPCR:数据分析
resultHTqPCR <- reactive({
info <- setData()
if(is.null(info)) return(NULL)
refs <- input$Refs
ctype <- if( input$compType == "Single control") 1 else 2
comps <- input$Comps
res <- calHTqPCR(info$data.ht, refs, comps, ctype)
return(res)
})
## Limma (HTqPCR)
calLimma <- reactive({
info <- resultHTqPCR()
if(is.null(info)) return(NULL)
if(is.null(info$result)) return(NULL)
cts <- info$contrast
cns <- names(cts)
##data.frame(cns)
res <- NULL
for (i in 1:length(cts)) {
aa <- info$result[[i]]
aa$Label <- rep(cns[i], nrow(aa))
aa <- aa[, c("Label", "genes", "FC", "t.test", "p.value", "adj.p.value")]
res <- rbind(res, aa)
}
res <- res[order(res$Label, res$genes), ]
res[! res$genes %in% input$Refs, ]
})
## HTqPCR:输出Limma结果
output$resultLimma <- renderTable({
dt <- calLimma()
if(is.null(dt)) return(NULL)
dt
})
## Limma结果下载UI
output$saveLimma <- downloadHandler(
filename = "results.expr.limma.csv",
content = function(file){
write.csv(calLimma(), file, row.names=FALSE, sep='\t')
})
## 归一化结果图
output$FigNorm <- renderPlot({
info1 <- setData()
info2 <- resultHTqPCR()
if(is.null(info1) || is.null(info2)) return(NULL)
plot(exprs(info1$data.ht), exprs(info2$d.norm), pch = 20, main = "DeltaCt normalisation",
col = rep(brewer.pal(6, "Spectral")))
})
## ddCt计算
resultDdct <- reactive({
info <- setData()
if(is.null(info)) return(NULL)
ddct.raw <- info$data.ddct
if(is.null(ddct.raw)) return(NULL)
mock <- input$Mock
refs <- input$Refs
result.dd <- ddCtExpression(ddct.raw, calibrationSample = mock, housekeepingGene = refs)
result.dd <- elist(result.dd)
expr.rel <- result.dd[, c("Sample", "Detector", "exprs", "level.err")]
colnames(expr.rel) <- c('Sample', 'Gene', 'FC', 'FC.sd')
expr.rel <- expr.rel[! expr.rel$Gene %in% refs, ]
expr.abs <- result.dd[, c("Sample", "Detector", "dCt", "dCt.error")]
colnames(expr.abs) <- c('Sample', 'Gene', 'expr', 'expr.sd')
aa <- expr.abs$expr
bb <- expr.abs$expr.sd
expr.abs$expr <- 2^(- aa) * 1000
expr.abs$expr.sd <- abs(expr.abs$expr - 2^(-(aa + bb)) * 1000)
expr.abs <- expr.abs[! expr.abs$Gene %in% refs, ]
##updateRadioButtons(session, 'geneNameRel', choices=targets, selected=targets[1])
##updateCheckboxGroupInput(session, 'geneNameAbs', choices=targets, selected=targets)
list(relative=expr.rel, absolute=expr.abs)
})
## 输出相对表达量
output$ddctRelative <- renderTable({
info <- resultDdct()
if(is.null(info)) return(NULL)
info$relative
})
## 输出绝对表达量
output$ddctAbsolute <- renderTable({
info <- resultDdct()
if(is.null(info)) return(NULL)
info$absolute
})
## 相对表达量下载UI
output$saveRelative <- downloadHandler(
filename = "results.expr.rel.csv",
content = function(file){
write.csv(resultDdct()$relative, file, row.names=FALSE, sep='\t')
})
## 绝对表达量下载UI
output$saveAbsolute <- downloadHandler(
filename = "results.expr.abs.csv",
content = function(file){
write.csv(resultDdct()$absolute, file, row.names=FALSE, sep='\t')
})
output$template <- downloadHandler(
filename = 'template.Ct.data.csv',
content = function(file) {
data(Ct.demo)
write.csv(Ct.demo, file, row.names=FALSE)
}
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.