X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fafc_graph.R;h=bda5ce77ee0dea428626311029df38d8a3b5b9de;hp=64e05d6a929dd4063e9ffd2d536fb92877235053;hb=4f2dc8e6823ac5886f758a6ad3f1ae6acb01916c;hpb=3d64c267454b7f21a33b58af45459d1f66d43241

diff --git a/Rscripts/afc_graph.R b/Rscripts/afc_graph.R
index 64e05d6..bda5ce7 100644
--- a/Rscripts/afc_graph.R
+++ b/Rscripts/afc_graph.R
@@ -1,10 +1,10 @@
 #Author: Pierre Ratinaud
 #Copyright (c) 20010-2013 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
 
 
 #fichier genere par IRaMuTeq
-source('%s')
+source('%s', encoding = 'utf8')
 typegraph <- %i
 what <- %i
 x <- %i
@@ -80,7 +80,7 @@ if ( qui == 3 ) {
     if (exists('afctable')) {
         eff <- rowSums(afctable)
     } else {
-        eff <- afctable$rowmass
+        eff <- afc$rowmass
     }
 
     if (!is.null(debsup)) {
@@ -95,9 +95,10 @@ if ( qui == 3 ) {
            cex.par <- eff[debsup:(debet-1)]
         }
         if ( qui == 2 ) {
+           fin <- nrow(table.in)
            table.in <- table.in[debet:nrow(table.in),] 
            tablechi <- tablechi[debet:nrow(tablechi),]
-           cex.par <- eff[debet:nrow(afctable)]
+           cex.par <- eff[debet:fin]
         }
     }
     
@@ -111,9 +112,10 @@ if ( qui == 3 ) {
                 cex.par <- eff
             }
         } else {
+            fin <- nrow(table.in)
             table.in <- table.in[debet:nrow(table.in),]
             tablechi <- tablechi[debet:nrow(tablechi),]
-            cex.par <- eff[debet:nrow(afctable)]
+            cex.par <- eff[debet:fin]
         }
     }
         
@@ -128,7 +130,7 @@ if ( qui == 3 ) {
         table.in <- table.in[row.keep,]
         tablechi <- tablechi[row.keep,]
     } else if (do.select.chi.classe) {
-        row.keep <- select.chi.classe(tablechi, ptbycluster)
+        row.keep <- select.chi.classe(tablechi, ptbycluster, active=FALSE)
         table.in <- table.in[row.keep,]
         tablechi <- tablechi[row.keep,]        
     } else {
@@ -166,64 +168,61 @@ if (is.null(xminmax)) {
         yminmax <- c(min(table.in[,2], na.rm = TRUE) + ((max(cex.par)/10) * min(table.in[,2], na.rm = TRUE)), max(table.in[,2], na.rm = TRUE) + ((max(cex.par)/10) * max(table.in[,2], na.rm = TRUE)))
     }
 
-if (typegraph == 0) {
+if (typegraph == 0 || typegraph == 2) {
 
     open_file_graph(fileout, width = width, height = height, svg = do.svg)
     parcex <- taillecar/10
     par(cex = parcex)
     if (over) {
-    table.in <- table.in[order(cex.par, decreasing = TRUE),]
-    classes <- classes[order(cex.par, decreasing = TRUE)]
-    cex.par <- cex.par[order(cex.par, decreasing = TRUE)]
-    table.in <- stopoverlap(table.in, cex.par=cex.par, xlim = xminmax, ylim = yminmax)
-    classes <- classes[table.in[,4]]
-    cex.par <- cex.par[table.in[,4]]
+        table.in <- table.in[order(cex.par, decreasing = TRUE),]
+        classes <- classes[order(cex.par, decreasing = TRUE)]
+        cex.par <- cex.par[order(cex.par, decreasing = TRUE)]
+        table.out <- stopoverlap(table.in, cex.par=cex.par, xlim = xminmax, ylim = yminmax)
+        table.in <- table.out$toplot
+        notplot <- table.out$notplot
+        if (! is.null(notplot)) {
+            write.csv2(notplot, file = paste(fileout,'_notplotted.csv', sep=''))
+        }    
+        classes <- classes[table.in[,4]]
+        cex.par <- cex.par[table.in[,4]]
     }
-    make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax)
-
-} else {
-
-    vire.nonascii <- function(rnames) {
-        print('vire non ascii')
-        couple <- list(c('é','e'),
-                    c('è','e'),
-                    c('ê','e'),
-                    c('ë','e'),
-                    c('î','i'),
-                    c('ï','i'),
-                    c('ì','i'),
-                    c('à','a'),
-                    c('â','a'),
-                    c('ä','a'),
-                    c('á','a'),
-                    c('ù','u'),
-                    c('û','u'),
-                    c('ü','u'),
-                    c('ç','c'),
-                    c('ò','o'),
-                    c('ô','o'),
-                    c('ö','o'),
-                    c('ñ','n')
-                    )
-        for (c in couple) {
-            rnames<-gsub(c[1],c[2], rnames)
+    if (typegraph == 0) {
+        make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax)
+    } else {
+        dev.off()
+        require(rgexf)
+        nodes.attr <- make.afc.attributes(rownames(table.in), afc_table, afctable, clnb)
+        if (qui != 3) {
+            tokeep <- rownames(chistabletot) %%in%% rownames(table.in)
+            chis <- chistabletot[tokeep,]
+            chis<-chis[rownames(table.in),]
+            nodes.attr$chiclasse <- chis
+        } else {
+            chis <- NULL
         }
-        rnames
+        afctogexf(fileout, table.in, classes, clnb, cex.par, nodes.attr = nodes.attr)
     }
+
+} else {
     library(rgl)
-    #rn <- vire.nonascii(rownames(table.in))
-    rn <- rownames(table.in)
-    rgl.open()
+    rn <- vire.nonascii(rownames(table.in))
+    rain = rainbow(clnb)
+    colors = rain[classes]
+    #rn <- rownames(table.in)
+    #rgl.open()
+    
+    text3d(table.in[,1], table.in[,2], table.in[,3], rn, col = colors , cex = cex.par)
+    rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
+    par3d('userMatrix' = matrix(c(1,0,0,0, 0,1,0,0,0,0,1,0,0,0,0,1), ncol=4, nrow = 4))
     par3d(cex=0.7)
     #par3d(windowRect = c(100,100,600,600))
-    rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
     rgl.lines(c(rx), c(0, 0), c(0, 0), col = "#000000")
     rgl.lines(c(0,0),c(ry),c(0,0),col = "#000000")
     rgl.lines(c(0,0),c(0,0),c(rz),col = "#000000")
     text3d(rx[2]+1,0,0, xlab)
     text3d(0,ry[2]+1,0, ylab)
     text3d(0,0,rz[2]+1, zlab)
-    rain = rainbow(clnb)
+    
      if (tchi) {
         maxchi <- norm.vec(maxchi, tchi.min/100, tchi.max/100)
     } else if (!is.null(cex.par)) {
@@ -231,8 +230,8 @@ if (typegraph == 0) {
     } else {
         maxchi <- 0.1
     }
-    colors = rain[classes]
-    text3d(table.in[,1], table.in[,2], table.in[,3], rn, col= colors , cex = cex.par)
+    
+    
     for (i in 1:clnb) {
         text3d(rx[2],(ry[2]+(0.2*i)),0,paste('classe',i),col=rain[i])
     }
@@ -248,7 +247,11 @@ if (typegraph == 0) {
         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Fini !",icon="info",type="ok")
     }
 
-    require(tcltk)
-    ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
+    if (typegraph == 1) {
+        require(tcltk)
+        ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
+    } else {
+        writeWebGL(dir = fileout, width = width, height= height)
+    }
     rgl.close()
 }