# # (gH)   -_-  sparccQgraph.r  ;  TimeStamp (unix) : 05 Juin 2015 vers 18:40

sparccQgraph <- function(fcor="",fpva,pmin,ctra,fgrps="",fpng="") {

# essai chargement de la librairie

loadlib <- try( library(qgraph) )
if (class(loadlib)=="try-error") {
  errmsg <- paste(" impossible de charger la librairie qgraph. STOP.\n\n",sep="")
  cat(errmsg)
  system("echo   impossible de charger la librairie qgraph. > sparcc_graph.err")
  stop()
} # fin si

options(width=500)

mcor  <- read.table(fcor)
mpva  <- read.table(fpva)

nblc  <- nrow(mcor)
if (nblc<11) {
  cat("corrélations originales\n")
  print(mcor)
} else {
  cat("-- extrait des corrélations originales ")
  cat("\n")
  print(mcor[(1:10),(1:10)])
} # fin si

nblv  <- nrow(mpva)
if (nblv<11) {
  cat("pvalues originales\n")
  print(mpva)
} else {
  cat("-- extrait des p-values")
  cat("\n")
  print(mpva[(1:10),(1:10)])
} # fin si

# vérification des dimensions

dcor <- dim(mcor)
dpva <- dim(mpva)

if (!identical(dcor,dpva)) {
  cat("dimensions de ",fcor," et ",fpva," incompatibles. STOP\n")
  stop()
} # fin si

cat(" dimension ",dcor," pour ",fcor," et ",fpva,"\n")

# filtrage selon corrélation minimale

flt         <- (mpva < pmin)
corp        <- mcor
corp[ flt ] <- 0
sumflt      <- sum(flt)

if (sumflt==0) {
  cat("aucune corrélation dont la pvalue est inférieure à ",pmin," à remplacer par 0.\n")
} else {
  cat(sum(flt)," corrélations dont la pvalue est inférieure à ",pmin," remplacées par 0.\n")
} ; # finsi

# on met 0 sur la diagonale

nbl <- nrow(corp)

for (idc in (1:nbl)) {
  corp[ idc,idc ] <- 0
} # fin pour

# on retire les lignes et les colonnes de total nul

rowSum <- apply(X=corp,M=1,F=sum)
nbl0   <- sum(rowSum==0)

if (nbl0==0) {

   cat(" aucune ligne de total nul à supprimer.\n")

} else {

   cat(nbl0," lignes de total nul àsupprimer àsavoir\n")
   ligAoter <- which(rowSum==0)
   print(ligAoter)

   colSum <- apply(X=corp,M=2,F=sum)
   nbc0   <- sum(colSum==0)
   cat(nbc0," colonnes de total nul à supprimer à savoir\n")
   colAoter <- which(colSum==0)
   print(colAoter)

   corp <- corp[ -ligAoter,  ]
   corp <- corp[ , -colAoter ]

} # fin si

cat("rowSums\n")
print(cbind(rowSum))


if (!fgrps=="") { # gestion des groupes

   grps <<- read.table(fgrps,header=TRUE)

   if (nbl0>0) {

      cat("grps Avant (extrait)")
      cat("\n")
      print(grps[1:10,])

   } # fin si
   if (nbl0>0) {    grps <- grps[ -ligAoter,  ] }

   grps$Class <- factor(grps$Class)
   cat("grps Après (extrait)")
   cat("\n")
   print(grps[1:10,])

} # fin si

cat("--extrait des corrélations filtrées et réduites (diag=0)")
cat("\n")
print(corp[(1:10),(1:10)])

# on remet 1 sur la diagonale

nbl <- nrow(corp)

for (idc in (1:nbl)) {
  corp[ idc,idc ] <- 1
} # fin pour

nbl <- nrow(corp)
cat("--extrait des corrélations filtrées (diag=1)")
cat("\n")
print(corp[(1:10),(1:10)])

# tracé

graphik <- nchar(fpng)>0

if (fgrps=="") { # pas de classes, un tracé simple
 if (graphik) { png(filename=fpng,width=1400,height=1400) }
 if (sum(corp>ctra)<=nbl) {
   qgraph(input=corp)
 } else {
   qgraph(input=corp,minimum=ctra)
 } # fin si
 if (graphik) { dev.off() }

} else {

if (graphik) { png(filename=fpng,width=1400,height=1400) }
# par(ask=TRUE)
qgraph(input=corp,
       minimum=ctra,
       main ="",
       cut=ctra,
       vsize=2,
       vTrans=150,
       borders=FALSE,
       layout="spring",
       labels=FALSE,
       negCol="dodgerblue",
       posCol="darkorange3",
       legend=TRUE,
       border=FALSE,
       groups=grps$Class,
       color=c("deepskyblue4","rosybrown","darkorchid4","chartreuse4","darkgoldenrod2","gray48","firebrick3","black", "darkorange3")
) # fin de qgraph

if (graphik) { dev.off() }

} ; # finsi fichier des classes présents

cat(" vous pouvez utiliser le graphique ",fpng,"\n")

cat("-- fin normale de script sparcc_graph.r\n\n")

# qgraph(corp, graph = "glasso", sampleSize = nrow(corp), tuning = 0, layout = "spring", title = "", details = FALSE)

} # fin de fonction sparccQgraph