#Author: Pierre Ratinaud
-#Copyright (c) 20010 Pierre Ratinaud
+#Copyright (c) 20010-2013 Pierre Ratinaud
#Lisense: GNU/GPL
#fichier genere par IRaMuTeq
-source('%s')
+source('%s', encoding = 'utf8')
typegraph <- %i
what <- %i
x <- %i
tchi.min <- %i
tchi.max <- %i
dirout <- '%s'
+do.svg <- %s
+xminmax <- NULL
+yminmax <- NULL
xlab <- paste('facteur ', x, ' -')
ylab <- paste('facteur ', y, ' -')
if ( what == 0 ) table.in <- afc$colcoord
if ( what == 1 ) table.in <- afc$colcrl
rownames(table.in) <- afc$colnames
+ eff <- afc$colmass
if (typegraph == 0) {
table.in<-table.in[,c(x,y)]
} else {
}
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()
ry <- range(table.in[,2], na.rm = TRUE)
rz <- range(table.in[,3], na.rm = TRUE)
}
+ if (exists('afctable')) {
+ eff <- rowSums(afctable)
+ } else {
+ eff <- afctable$rowmass
+ }
+
if (!is.null(debsup)) {
if ( qui == 0 ) {
table.in <- table.in[1:(debsup-1),]
tablechi <- tablechi[1:(debsup-1),]
- cex.par <- afc$rowmass[1:(debsup-1)]
+ cex.par <- eff[1:(debsup-1)]
}
if ( qui == 1 ) {
table.in <- table.in[debsup:(debet-1),]
tablechi <- tablechi[debsup:(debet-1),]
- #cex.par <- afc$rowmass[debsup:(debet-1)]
+ cex.par <- eff[debsup:(debet-1)]
}
if ( qui == 2 ) {
table.in <- table.in[debet:nrow(table.in),]
tablechi <- tablechi[debet:nrow(tablechi),]
- #cex.par <- afc$rowmass[debet:nrow(tablechi)]
+ cex.par <- eff[debet:nrow(afctable)]
}
}
if (!is.null(debet)) {
table.in <- table.in[1:(debet-1),]
tablechi <- tablechi[1:(debet-1),]
- cex.par <- afc$rowmass[1:(debet-1)]
+ cex.par <- eff[1:(debet-1)]
} else {
- cex.par <- afc$rowmass
+ cex.par <- eff
}
} else {
table.in <- table.in[debet:nrow(table.in),]
tablechi <- tablechi[debet:nrow(tablechi),]
- #cex.par <- afc$rowmass[debet:nrow(tablechi)]
+ cex.par <- eff[debet:nrow(afctable)]
}
}
-# 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)
}
classes <- apply(tablechi, 1, which.max)
maxchi <- apply(tablechi, 1, max)
-
+ infp <- which(is.infinite(maxchi) & maxchi > 0)
+ if (length(infp)) {
+ maxchi[infp] <- NA
+ if (!length(infp) == length(maxchi)) {
+ valmax <- max(maxchi, na.rm = TRUE)
+ } else {
+ valmax <- 8
+ }
+ maxchi[infp] <- valmax + 2
+ }
if (cex.txt) {
#row.keep <- append(row.keep, rn.keep)
#row.keep <- unique(row.keep)
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))
}
}
-#################################################@@
-#from wordcloud
-overlap <- function(x1, y1, sw1, sh1, boxes) {
- use.r.layout <- FALSE
- if(!use.r.layout)
- return(.overlap(x1,y1,sw1,sh1,boxes))
- s <- 0
- if (length(boxes) == 0)
- return(FALSE)
- for (i in c(last,1:length(boxes))) {
- bnds <- boxes[[i]]
- x2 <- bnds[1]
- y2 <- bnds[2]
- sw2 <- bnds[3]
- sh2 <- bnds[4]
- if (x1 < x2)
- overlap <- x1 + sw1 > x2-s
- else
- overlap <- x2 + sw2 > x1-s
-
- if (y1 < y2)
- overlap <- overlap && (y1 + sh1 > y2-s)
- else
- overlap <- overlap && (y2 + sh2 > y1-s)
- if(overlap){
- last <<- i
- return(TRUE)
- }
- }
- FALSE
-}
-
-.overlap <- function(x11,y11,sw11,sh11,boxes1){
- .Call("is_overlap",x11,y11,sw11,sh11,boxes1)
-}
-
-stopoverlap <- function(x, cex.par = NULL) {
-#from wordcloud
- library(wordcloud)
- tails <- "g|j|p|q|y"
- rot.per <- 0
- last <- 1
- thetaStep <- .1
- rStep <- .5
- toplot <- NULL
-
-# plot.new()
- plot(x[,1],x[,2], pch='')
-
- words <- rownames(x)
- if (is.null(cex.par)) {
- size <- rep(0.9, nrow(x))
- } else {
- size <- cex.par
+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)))
}
- #cols <- rainbow(clnb)
- boxes <- list()
- for (i in 1:nrow(x)) {
- rotWord <- runif(1)<rot.per
- r <-0
- theta <- runif(1,0,2*pi)
- x1<- x[i,1]
- y1<- x[i,2]
- wid <- strwidth(words[i],cex=size[i])
- ht <- strheight(words[i],cex=size[i])
- if(grepl(tails,words[i]))
- ht <- ht + ht*.2
- if(rotWord){
- tmp <- ht
- ht <- wid
- wid <- tmp
- }
- isOverlaped <- TRUE
- while(isOverlaped){
- if(!overlap(x1-.5*wid,y1-.5*ht,wid,ht, boxes)) { #&&
- toplot <- rbind(toplot, c(x1, y1, size[i], i))
- #text(x1,y1,words[i],cex=size[i],offset=0,srt=rotWord*90,
- # col=cols[classes[i]])
- boxes[[length(boxes)+1]] <- c(x1-.5*wid,y1-.5*ht,wid,ht)
- isOverlaped <- FALSE
- } else {
- if(r>sqrt(.5)){
- print(paste(words[i], "could not be fit on page. It will not be plotted."))
- isOverlaped <- FALSE
- }
- theta <- theta+thetaStep
- r <- r + rStep*thetaStep/(2*pi)
- x1 <- x[i,1]+r*cos(theta)
- y1 <- x[i,2]+r*sin(theta)
- }
- }
+ 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)))
}
- row.names(toplot) <- words[toplot[,4]]
- return(toplot)
-}
-###############################################################################
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)
if (over) {
- table.in <- stopoverlap(table.in, cex.par=cex.par)
+ 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)
+ 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)
- }
- rnames
- }
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)
+ open3d()
+ text3d(table.in[,1], table.in[,2], table.in[,3], rn, col = colors , cex = cex.par)
par3d(cex=0.7)
#par3d(windowRect = c(100,100,600,600))
- rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
+ rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = FALSE)
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)) {
} 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])
}
projects / iramuteq / blobdiff