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
}
}
- 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 (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)
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)
}
}
}
+#################################################@@
+#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
+ }
+ #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)
+ }
+ }
+ }
+ row.names(toplot) <- words[toplot[,4]]
+ return(toplot)
+}
+###############################################################################
+
if (typegraph == 0) {
open_file_graph(fileout, width = width, height = height)
parcex <- taillecar/10
par(cex = parcex)
+ if (over) {
+ 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 {
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")
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)