AFC

[iramuteq] / Rscripts / Rgraph.R

diff --git a/Rscripts/Rgraph.R b/Rscripts/Rgraph.R
index 85f1ff8..1caf440 100644 (file)
--- a/Rscripts/Rgraph.R
+++ b/Rscripts/Rgraph.R
@@ -183,6 +183,15 @@ select_point_chi <- function(tablechi, chi_limit) {
        row_keep
 }
 
        row_keep
 }
 

+select.chi.classe <- function(tablechi, nb) {
+    rowkeep <- NULL
+    for (i in 1:ncol(tablechi)) {
+        rowkeep <- append(rowkeep,order(tablechi[,i], decreasing = TRUE)[1:nb])
+    }
+    rowkeep <- unique(rowkeep)
+    rowkeep
+}
+

 #from summary.ca
 summary.ca.dm <- function(object, scree = TRUE, ...){
   obj <- object
 #from summary.ca
 summary.ca.dm <- function(object, scree = TRUE, ...){
   obj <- object


@@ -296,7 +305,7 @@ create_afc_table <- function(x) {
        res
 }
 
        res
 }
 

-make_afc_graph <- function(toplot,classes,clnb, xlab, ylab, cex.txt = NULL, leg = FALSE, cmd = FALSE) {
+make_afc_graph <- function(toplot, classes, clnb, xlab, ylab, cex.txt = NULL, leg = FALSE, cmd = FALSE, black = FALSE) {

        rain <- rainbow(clnb)
     compt <- 1
     tochange <- NULL
        rain <- rainbow(clnb)
     compt <- 1
     tochange <- NULL


@@ -316,16 +325,15 @@ make_afc_graph <- function(toplot,classes,clnb, xlab, ylab, cex.txt = NULL, leg
         }
     }
        cl.color <- rain[classes]
         }
     }
        cl.color <- rain[classes]

+    if (black) {
+        cl.color <- 'black'
+    }

        plot(toplot[,1],toplot[,2], pch='', xlab = xlab, ylab = ylab)
        plot(toplot[,1],toplot[,2], pch='', xlab = xlab, ylab = ylab)

-       abline(h=0,v=0, lty = 'dashed')
-    #print('ATTENTION Rgraph.R : utilisation de maptools !')
-    #library(maptools)
+       abline(h=0, v=0, lty = 'dashed')

        if (is.null(cex.txt))
        if (is.null(cex.txt))

-        #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
-               text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
+               text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, offset=0)

        else 
        else 

-               #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
-        text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
+        text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt, offset=0)

 
     if (!cmd) {    
            dev.off()
 
     if (!cmd) {    
            dev.off()


@@ -509,8 +517,9 @@ make.simi.afc <- function(x,chitable,lim=0, alpha = 0.1, movie = NULL) {
     cc<-mc[cc]
     #mass<-(rowSums(x)/max(rowSums(x))) * 5
     maxchi<-norm.vec(maxchi, 0.03, 0.3)
     cc<-mc[cc]
     #mass<-(rowSums(x)/max(rowSums(x))) * 5
     maxchi<-norm.vec(maxchi, 0.03, 0.3)

-    rglplot(g1,vertex.label = vire.nonascii(rownames(x)),vertex.label.color='black',vertex.color=cc,vertex.size = 0.1, layout=lo, rescale=FALSE)
-    rgl.spheres(lo, col = cc, radius = maxchi, alpha = alpha)
+    rglplot(g1,vertex.label = vire.nonascii(rownames(x)),vertex.label.color= cc,vertex.label.cex = maxchi, vertex.size = 0.1, layout=lo, rescale=FALSE)
+    text3d(lo[,1], lo[,2],lo[,3], rownames(x), cex=maxchi, col=cc)
+    #rgl.spheres(lo, col = cc, radius = maxchi, alpha = alpha)

     rgl.bg(color = c('white','black'))
     if (!is.null(movie)) {
         require(tcltk)
     rgl.bg(color = c('white','black'))
     if (!is.null(movie)) {
         require(tcltk)