X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fafc_graph.R;h=017b782a58ef568c74e023c01aea39c0817f8582;hp=17f065e8c6779c26af37372a15ae868ac0f24cfe;hb=9bde3d55d2131f1a33234a43c0de8b200ddb8f9a;hpb=22cd27b2bbe9ab1ffa7ef06fa764b5147ae17dad

diff --git a/Rscripts/afc_graph.R b/Rscripts/afc_graph.R
index 17f065e..017b782 100644
--- a/Rscripts/afc_graph.R
+++ b/Rscripts/afc_graph.R
@@ -16,6 +16,8 @@ do.select.nb <- %s
 select.nb <- %i
 do.select.chi <- %s
 select.chi <- %i
+do.select.chi.classe <- %s
+ptbycluster <- %i
 cex.txt <- %s
 txt.min <- %i
 txt.max <- %i
@@ -29,6 +31,10 @@ tchi <- %s
 tchi.min <- %i
 tchi.max <- %i
 dirout <- '%s'
+#xmin <- xmin
+#xmax <- xmax
+#ymin <- ymin
+#ymax <- ymax
 
 xlab <- paste('facteur ', x, ' -')
 ylab <- paste('facteur ', y, ' -')
@@ -56,10 +62,10 @@ if ( qui == 3 ) {
     }
     classes <- c(1:clnb)
     maxchi <- 1
-    cex.par <- NULL
+    cex.par <- rep(taillecar/10, nrow(table.in))
 } else {
     if ( what == 0 ) table.in <- afc$rowcoord
-    if ( what == 1 ) table.in <- afc$rowcrl*2
+    if ( what == 1 ) table.in <- afc$rowcrl
     rownames(table.in) <- afc$rownames
     tablechi <- chistabletot
     rn.keep <- c()
@@ -105,19 +111,6 @@ if ( qui == 3 ) {
         }
     }
         
-    if (over) {
-        rn <- rownames(table.in)
-        rownames(table.in) <- 1:nrow(table.in)
-        table.in <- unique(table.in)
-        rn.keep <- as.numeric(rownames(table.in))
-        rownames(table.in) <- rn[rn.keep]
-        tablechi <- tablechi[rn.keep,]
-        if (qui==0) {
-            cex.par <- cex.par[rn.keep]
-        } else {
-            cex.par <- NULL
-        }
-    } 
     if (do.select.nb) {
         if (select.nb > nrow(table.in)) select.nb <- nrow(table.in)
         row.keep <- select_point_nb(tablechi, select.nb)
@@ -128,12 +121,21 @@ if ( qui == 3 ) {
         row.keep <- select_point_chi(tablechi, select.chi)
         table.in <- table.in[row.keep,]
         tablechi <- tablechi[row.keep,]
+    } else if (do.select.chi.classe) {
+        row.keep <- select.chi.classe(tablechi, ptbycluster)
+        table.in <- table.in[row.keep,]
+        tablechi <- tablechi[row.keep,]        
     } else {
         row.keep <- 1:nrow(table.in)
     }
     classes <- apply(tablechi, 1, which.max)
     maxchi <- apply(tablechi, 1, max)
-    
+    infp <-  which(is.infinite(maxchi) & maxchi > 0)
+    if (length(infp)) {
+        maxchi[infp] <- NA
+        valmax <- max(maxchi, na.rm = TRUE)
+        maxchi[infp] <- valmax + 2
+    } 
     if (cex.txt) {
         #row.keep <- append(row.keep, rn.keep)
         #row.keep <- unique(row.keep)
@@ -143,15 +145,24 @@ if ( qui == 3 ) {
         cex.par <- maxchi
         cex.par <- norm.vec(cex.par, tchi.min/10, tchi.max/10)
     } else {
-        cex.par <- NULL
+        cex.par <- rep(taillecar/10, nrow(table.in))
     }
 }
 
+
 if (typegraph == 0) {
 
     open_file_graph(fileout, width = width, height = height)
     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)
+    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)
 
 } else {
@@ -184,8 +195,10 @@ if (typegraph == 0) {
         rnames
     }
     library(rgl)
-    rn <- vire.nonascii(rownames(table.in))
+    #rn <- vire.nonascii(rownames(table.in))
+    rn <- rownames(table.in)
     rgl.open()
+    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")
@@ -195,19 +208,21 @@ if (typegraph == 0) {
     text3d(0,ry[2]+1,0, ylab)
     text3d(0,0,rz[2]+1, zlab)
     rain = rainbow(clnb)
-    colors = rain[classes]
-    text3d(table.in[,1], table.in[,2], table.in[,3], rn, col='black')
-    if (tchi) {
+     if (tchi) {
         maxchi <- norm.vec(maxchi, tchi.min/100, tchi.max/100)
     } else if (!is.null(cex.par)) {
         maxchi <- norm.vec(cex.par, txt.min/100, txt.max/100)
     } 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])
     }
-    rgl.spheres(table.in, col = colors, radius = maxchi, alpha = alpha)
+    #if (tchi) {
+    #    rgl.spheres(table.in, col = colors, radius = maxchi, alpha = alpha)
+    #}
 
     if (dofilm) {
         require(tcltk)