Commit 9476b0cb authored by stevenn's avatar stevenn
Browse files

Initial commit

parents
GetDataFromBIOM <-function(dataBIOM)
{
counts = biom_data(dataBIOM)
taxo = observation_metadata(dataBIOM)
return(list(counts=counts,taxo=taxo))
}
GetDataFromCT <-function(dataC,dataT)
{
counts = dataC
taxo = dataT
return(list(counts=counts,taxo=taxo))
}
DescriptiveStat <-function(vect)
{
nbmiss = length(which(is.na((vect))))
nbval = length(vect) - nbmiss
sum = sum(vect,na.rm=TRUE)
moy = mean(vect,na.rm=TRUE)
var = var(vect,na.rm=TRUE)
sd = sd(vect,na.rm=TRUE)
CV = sd/moy
stat = c(nbval,nbmiss,sum, summary(vect),var,sd,CV)
names(stat) = c("Nb valeurs","Nb manquants","Somme","Min",
"1er Quartile","Mediane",'Moyenne',"3eme Quartile","Max","Variance","Ecart-type","Coeff Variation")
return(stat)
}
DescriptiveStatQuali <-function(dataQuali,namesQuali,indic)
{
res = matrix(0,ncol=5)
for(i in 1:ncol(dataQuali))
{
datatmp = dataQuali[,i]
tabQuali = table(datatmp)
res2 = c(names(tabQuali),"Total")
res1 = c(namesQuali[i],rep(NA,length(res2)-1))
res3 = c(tabQuali,sum(tabQuali))
res4 = signif(c(tabQuali/sum(tabQuali),1)*100,2)
res5 = c(signif(cumsum(tabQuali/sum(tabQuali))*100,2),NA)
res = rbind(res,cbind(res1,res2,res3,res4,res5))
}
res=res[-1,]
rownames(res)=res[,1]
res=res[,-1]
colnames(res) = c("Modalites","Effectifs","%","% cumules")
res = res[,c(1,indic+1)]
res=as.data.frame(res)
return(res)
}
### Gerate 1D plots
generateUniPlot<-function(input,data)
{
ind = which(colnames(data)%in%input$UniVar)
dataTmp = data[,ind]
TestNum = is.numeric(dataTmp)
dataTmp = data.frame(x=dataTmp)
namesTmp = names(data)[ind]
gg = NULL
## Numeric data
if(TestNum && !is.null(input$RadioPlotUni))
{
if(input$RadioPlotUni=="hist")
{
gg = ggplot(dataTmp,aes(x=x)) + xlab(namesTmp) + theme_bw()
if(input$HistDens=="freq") gg = gg + geom_histogram(binwidth = input$binwidth,size=input$SizeQQplot-0.5,fill=input$ColorUniplot,alpha=input$TransAlphaUni/100, color="black",aes(y = ..density..))
if(input$HistDens=="counts") gg = gg + geom_histogram(binwidth = input$binwidth,size=input$SizeQQplot-0.5,fill=input$ColorUniplot,alpha=input$TransAlphaUni/100, color="black")
if(input$CheckDens) gg = gg + geom_density(size=input$SizeQQplot-0.5)
if(input$SensGraph=="Hori") gg = gg + coord_flip()
}
if(input$RadioPlotUni=="box")
{
gg = ggplot(dataTmp,aes(1,x)) + geom_boxplot(fill=input$ColorUniplot,alpha=input$TransAlphaUni/100,size=input$SizeQQplot)+xlim(c(0,2))
gg = gg + ylab(namesTmp) + xlab("")+ theme_bw()
if(input$CheckAddPointsBox) gg = gg + geom_jitter()
if(input$SensGraph=="Hori") gg = gg + coord_flip()
}
if(input$RadioPlotUni=="densities")
{
gg = ggplot(dataTmp,aes(x=x)) + theme_bw()
gg = gg + geom_density(fill=input$ColorUniplot,alpha=input$TransAlphaUni/100,size=input$SizeQQplot-0.5) + xlab(namesTmp)
if(input$SensGraph=="Hori") gg = gg + coord_flip()
}
if(input$RadioPlotUni=="qqplot")
{
gg = ggplot(dataTmp, aes(sample = x)) + geom_point(stat = "qq",color = input$ColorUniplot,alpha=input$TransAlphaUni/100,size=input$SizeQQplot)
gg = gg + ylab(namesTmp)+ theme_bw()
}
return(gg)
}
# Quali data
if(!TestNum && !is.null(input$RadioPlotUni))
{
if(input$RadioPlotUni=="BarPlot")
{
gg = ggplot(dataTmp, aes(x)) + xlab(namesTmp)+ theme_bw()
gg = gg+ geom_bar(fill=input$ColorUniplot,alpha=input$TransAlphaUni/100,size=input$SizeQQplot, color="black",width=input$widthBarPlot/100)
if(input$SensGraph=="Hori") gg = gg + coord_flip()
if(input$BarCircular) gg = gg + coord_polar()
}
if(input$RadioPlotUni=="Pie")
{
count = table(dataTmp$x)
dataTmp2 = data.frame(frac = count/sum(count), xUnique = as.factor(names(count)))
dataTmp2 = dataTmp2[order(dataTmp2$frac.Freq), ]
dataTmp2$ymax = cumsum(dataTmp2$frac.Freq)
dataTmp2$ymin = c(0, head(dataTmp2$ymax, n=-1))
dataTmp2$xminPie = 1-input$PieWidth/100
gg = ggplot(dataTmp2, aes(fill=xUnique, ymax=ymax, ymin=ymin, xmax=4, xmin=4*xminPie)) + geom_rect(alpha=input$TransAlphaUni/100) + coord_polar(theta="y")
gg = gg + xlim(c(0, 4)) + scale_fill_discrete(name=namesTmp)+ theme_bw()
}
return(gg)
}
}
### Gerate 2D plots
generateBiPlot<-function(input,rangesBiplot,data)
{
var1 = input$VariableSelectBi1
var2 = input$VariableSelectBi2
ind1 = which(colnames(data)%in%c(var1))
ind2 = which(colnames(data)%in%c(var2))
ind = c(ind1,ind2)
Num = sapply(data[,unique(ind)],is.numeric)
if(length(unique(ind))==2)
{
if(length(which(Num))==2) data2 = data.frame(x=data[,ind1],y=data[,ind2])
if(length(which(Num))==1) data2 = data.frame(x=data[,ind[which(Num)]],y=data[,ind[which(!Num)]])
}
if(length(unique(ind))==1) data2 = data.frame(x=data[,ind],y=data[,ind])
if(!is.null(input$RadioPlotBi))
{
if(input$RadioPlotBi=="Nuage")
{
gg = ggplot(data2,aes(x,y))
gg = gg + geom_point(color=input$ColorBiplot,size=input$SizePoint,alpha=input$TransAlphaBi/100) + theme_bw()
if(!is.null(rangesBiplot$x) && !is.null(rangesBiplot$x)) gg = gg + xlim(rangesBiplot$x) + ylim(rangesBiplot$y)
gg = gg + xlab(var1) + ylab(var2)
if(input$CheckLM) gg = gg + geom_smooth(method='lm')
}
if(input$RadioPlotBi=="densities" )
{
if(length(which(Num))==2)
{
vartmp = c(data[,ind[1]],data[,ind[2]])
y=c(rep(var1,nrow(data)),rep(var2,nrow(data)))
data2 = data.frame(x=vartmp,y=y)
}
gg = ggplot(data2,aes(x=x,fill=y))
gg = gg + xlab("Valeurs")+labs(colour = var2) + scale_fill_discrete(name="Légende")
gg = gg + geom_density(size=input$SizePoint,alpha = input$TransAlphaBi/100) + theme_bw()
if(input$SensGraphBi=="Hori") gg = gg + coord_flip()
}
if(input$RadioPlotBi=="hist" )
{
if(length(which(Num))==2)
{
vartmp = c(data[,ind[1]],data[,ind[2]])
y=c(rep(var1,nrow(data)),rep(var2,nrow(data)))
data2 = data.frame(x=vartmp,y=y)
}
gg = ggplot(data2,aes(x=x,fill=y))
gg = gg + xlab("Valeurs")+labs(colour = var2) + scale_fill_discrete(name="Légende")
gg = gg + geom_histogram(binwidth = input$binwidthBi,size=input$SizePoint-0.5,alpha = input$TransAlphaBi/100,color="black") + theme_bw()
if(input$SensGraphBi=="Hori") gg = gg + coord_flip()
}
if(input$RadioPlotBi=="box" )
{
if(length(which(Num))==2)
{
vartmp = c(data[,ind[1]],data[,ind[2]])
y=c(rep(var1,nrow(data)),rep(var2,nrow(data)))
data2 = data.frame(x=vartmp,y=y)
}
labtmp = unique(data2$y)
gg = ggplot(data2,aes(y,x)) + scale_fill_discrete(name="Légende")
gg = gg+ geom_boxplot(aes(fill=y),alpha=input$TransAlphaBi/100,size=input$SizePoint-0.5) + xlab("")+ theme_bw()
if(input$CheckAddPointsBoxBi) gg = gg + geom_jitter(size=input$SizePoint)
if(input$SensGraphBi=="Hori") gg = gg + coord_flip()
}
return(gg)
}
}
library(shiny)
library(psych)
library(ggplot2)
#library(gdata)
#install_github('rCharts', 'ramnathv')
source("internal.R")
renderDataTable <- DT::renderDataTable
dataTableOutput <- DT::dataTableOutput
shinyServer(function(input, output) {
#####################################################
##
## LOAD FILES
##
#####################################################
dataInputCounts <-reactive({
inFile <- input$fileCounts
if (is.null(inFile)) return(NULL)
## Get the extension
# tmp = strsplit(inFile$name, ".",fixed=T)[[1]]
# ext = tmp[length(tmp)]
#
# ## header
# header = FALSE
# if(input$header==1) header=TRUE
## Read data
# if(ext=="csv") data = read.csv(inFile$datapath,sep=",",header=header)
# if(ext=="xls") data = read.csv(inFile$datapath,sep="\t",header=header)
data = read.csv(inFile$datapath,sep=",",header=TRUE)
## Rownames
rownames(data)=data[,1];data=data[,-1]
return(as.data.frame(data))
})
# ResOutput <-eventReactive(input$RunAnalyse,{
#
# data = dataInput()
#
# })
output$SelectDataVar <- renderUI({
data=dataInputTmp()
selectInput("VariableSelect",p(strong("Choisissez les variables à étudier"),h6(em("Sélection multiple avec CTRL"))),
colnames(data),
selected=colnames(data),multiple=TRUE,size=2,selectize=FALSE)
})
output$SelectVarQuanti <- renderUI({
data=dataInputTmp()
Num = sapply(data,is.numeric)
namesQuanti = colnames(data)[Num]
selectInput("VariableSelectQuanti",h5(strong("Sélectionnez les variables numériques que vous souhaitez transformer en variables qualitatives"),h6(em("Sélection multiple avec CTRL"))),
namesQuanti,
selected=1,multiple=TRUE,size=1,selectize=FALSE)
})
output$QuantiToQuali <- renderUI({
input$GoQuali
names = isolate(input$VariableSelectQuanti)
namesVar = paste(names,collapse = ", ")
if(length(names)>0) HTML(paste("Les variables suivantes seront considérées comme des",'<b>',"variables qualitatives :",'</b>','<br/>',namesVar))
else return(NULL)
})
dataInputType <- reactive({
input$GoQuali
data=dataInputTmp()
names= colnames(data)
if(!is.null(data))
{
ind=which(colnames(data)%in%isolate(input$VariableSelectQuanti))
data[,ind]=as.data.frame(sapply(data[,ind],as.factor))
}
return(data)
})
dataInput <- reactive({
input$RefreshData
data=dataInputType()
names= colnames(data)
rownamesTmp = rownames(data)
if(!is.null(data) && !is.null(isolate(input$VariableSelect)))
{
ind=which(colnames(data)%in%isolate(input$VariableSelect))
data=as.data.frame(data[,ind])
# Get the names of rows and columns
colnames(data) = names[ind]
rownames(data) = rownamesTmp
}
return(as.data.frame(data))
})
# observeEvent(input$RunAnalyse,{
#
# ResOutput()
# })
output$DataBrutes <- renderDataTable(
dataInput(),
options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
pageLength = 10,scrollX=TRUE
))
output$SelectUniVar <- renderUI({
input$RunAnalyse
data = dataInput()
names = colnames(data)
if(!is.null(data)) selectInput("UniVar","Variable à étudier",names)
})
###########################################
##
## Accueil exemples
##
###########################################
###########################################
##
## TABLE DESCRIPTIVES STATS
##
###########################################
TableQuantiOut <- reactive({
input$RefreshStat
data = dataInput()
Num = sapply(data,is.numeric)
dataNum = as.data.frame(data[,Num])
stat = as.data.frame(signif(apply(dataNum,2,DescriptiveStat),2))
stat = stat[as.numeric(isolate(input$IndicQuanti)),]
return(stat)
})
TableQualiOut <- reactive({
input$RefreshStatQuali
data = dataInput()
Num = sapply(data,is.numeric)
dataQuali = data[,!Num]
namesQuali = names(data)[!Num]
DescriptiveStatQuali(as.data.frame(dataQuali),namesQuali,isolate(as.numeric(input$IndicQuali)))
#as.data.frame(tmp[,isolate(as.numeric(input$IndicQuali))])
})
CorTab <- reactive({
data = dataInput()
Num = sapply(data,is.numeric)
dataQuanti = as.data.frame(data[,Num])
corel = corr.test(dataQuanti,method=input$CorelMeth)
return(list(cor=signif(corel$r,2),pval=signif(corel$p,2)))
})
output$TableQuanti <- renderDataTable(
TableQuantiOut(),
options = list(paging=FALSE, searching=FALSE,
pageLength = 12,scrollX=TRUE
))
output$TableQuali <- renderDataTable(
TableQualiOut(),
options = list(paging=FALSE, searching=FALSE,
pageLength = 10,scrollX=TRUE
))
output$CorTable <- renderDataTable(
CorTab()$cor,
options = list(paging=FALSE, searching=FALSE,
pageLength = 10,scrollX=TRUE
))
output$CorTableTest <- renderDataTable(
CorTab()$pval,
options = list(paging=FALSE, searching=FALSE,
pageLength = 10,scrollX=TRUE
))
###########################################
##
## Analyse univarié
##
###########################################
TableOutUni <- reactive({
data = dataInput()
ind = which(colnames(data)%in%input$UniVar)
dataTmp = data[,ind]
namesTmp = names(data)[ind]
if(is.numeric(dataTmp))
{
stat = as.data.frame(signif(DescriptiveStat(dataTmp),2))
names(stat)= namesTmp
}
if(!is.numeric(dataTmp))
{
stat = DescriptiveStatQuali(as.data.frame(dataTmp),namesTmp,seq(1,3))
}
stat=as.data.frame(stat)
return(summary(dataTmp))
})
# output$TableUni <- renderPrint({
# data = dataInput()
# ind = which(colnames(data)%in%input$UniVar)
#
# dataTmp = data[,ind]
# namesTmp = names(data)[ind]
#
# return(summary(dataTmp))
# })
#######################################
##
## Info Box
##
########################################
output$NumberRowBox <- renderInfoBox({
data = dataInput()
nbrow = nrow(data)
infoBox(h5("Lignes"), nbrow, icon = icon("arrows-v"),color = "light-blue",fill=TRUE)
})
output$NumberColBox <- renderInfoBox({
data = dataInput()
nbcol = ncol(data)
infoBox(h5("Colonnes"), nbcol, icon = icon("arrows-h"),color = "light-blue",fill=TRUE)
})
output$NumberQuantiBox <- renderInfoBox({
data = dataInput()
Num = sapply(data,is.numeric)
infoBox(h5("Variables numériques"), length(which(Num)), icon = icon("line-chart"),color = "light-blue",fill=TRUE)
})
output$NumberQualiBox <- renderInfoBox({
data = dataInput()
Num = sapply(data,is.numeric)
infoBox(h5("Variables qualitatives"), length(which(!Num)), icon = icon("pie-chart"),color = "light-blue",fill=TRUE)
})
output$RunOK <- renderInfoBox({
input$RunAnalyse
data = isolate(dataInput())
if(nrow(data)>0)
{
infoBox(h5(""), "L'analyse statistique a été réalisée !", icon = icon("unlock"),color = "light-blue",fill=TRUE)
}
else infoBox(h5(""), "Veuillez charger vos données et appuyer sur Lancer l'analyse", icon = icon("lock"),color = "light-blue",fill=TRUE)
})
output$ResTTestBox <- renderInfoBox({
input$ExecuteTtestCible
data = dataInput()
ind = which(colnames(data)%in%input$UniVar)
dataTmp = data[,ind]
TestNum = is.numeric(dataTmp)
dataTmp = data.frame(x=dataTmp)
namesTmp = names(data)[ind]
## Numeric data
if(TestNum)
{
test = t.test(dataTmp$x,mu=as.numeric((isolate(input$ValCibleTtest))))
pval = signif(test$p.value,3)
if(pval<=as.numeric(isolate(input$alphaTtest))/100) inf = infoBox(h4("Significatif"), paste("p-value :",pval), icon = icon("thumbs-up"),color = "green",fill=TRUE)