Initial commit

internal.R

+
+
+
+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)
+    
+  }
+  
+}
+
+

server.R

+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)