X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fafc_graph.R;h=d067c162a844adaddf39aaf1001c8f16b489b26f;hp=0c47dfa2a832bf76e299d5396d20e442bbd43a73;hb=1fb687c23b19ae4cc88146acf393041356c1df3a;hpb=a503f041dc4947ee21c1d353ddd05ddb13a5e322 diff --git a/Rscripts/afc_graph.R b/Rscripts/afc_graph.R index 0c47dfa..d067c16 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,9 @@ tchi <- %s tchi.min <- %i tchi.max <- %i dirout <- '%s' +do.svg <- %s +xminmax <- NULL +yminmax <- NULL xlab <- paste('facteur ', x, ' -') ylab <- paste('facteur ', y, ' -') @@ -56,10 +61,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 +110,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 +120,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,16 +144,31 @@ 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 (is.null(xminmax)) { + xminmax <- c(min(table.in[,1], na.rm = TRUE) + ((max(cex.par)/10) * min(table.in[,1], na.rm = TRUE)), max(table.in[,1], na.rm = TRUE) + ((max(cex.par)/10) * max(table.in[,1], na.rm = TRUE))) + } + if (is.null(yminmax)) { + 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) { - open_file_graph(fileout, width = width, height = height) + open_file_graph(fileout, width = width, height = height, svg = do.svg) parcex <- taillecar/10 par(cex = parcex) - make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par) + 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]] + } + make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax) } else {