1 #Author: Pierre Ratinaud
2 #Copyright (c) 20010-2013 Pierre Ratinaud
6 #fichier genere par IRaMuTeq
7 source('%s', encoding = 'utf8')
21 do.select.chi.classe <- %s
40 xlab <- paste('facteur ', x, ' -')
41 ylab <- paste('facteur ', y, ' -')
42 if (!typegraph == 0) {zlab <- paste('facteur ', z, ' -')}
43 xlab <- paste(xlab,round(afc_table$facteur[x,2],2),sep = ' ')
44 xlab <- paste(xlab,' %%',sep = '')
45 ylab <- paste(ylab,round(afc_table$facteur[y,2],2),sep = ' ')
46 ylab <- paste(ylab,' %%',sep = '')
47 if (!typegraph == 0) {
48 zlab <- paste(zlab,round(afc_table$facteur[z,2],2),sep = ' ')
49 zlab <- paste(zlab,' %%',sep = '')
53 if ( what == 0 ) table.in <- afc$colcoord
54 if ( what == 1 ) table.in <- afc$colcrl
55 rownames(table.in) <- afc$colnames
58 table.in<-table.in[,c(x,y)]
60 table.in<-table.in[,c(x,y,z)]
61 rx <- range(table.in[,1], na.rm = TRUE)
62 ry <- range(table.in[,2], na.rm = TRUE)
63 rz <- range(table.in[,3], na.rm = TRUE)
67 cex.par <- rep(taillecar/10, nrow(table.in))
69 if ( what == 0 ) table.in <- afc$rowcoord
70 if ( what == 1 ) table.in <- afc$rowcrl
71 rownames(table.in) <- afc$rownames
72 tablechi <- chistabletot
75 table.in<-table.in[,c(x,y)]
77 table.in<-table.in[,c(x,y,z)]
78 rx <- range(table.in[,1], na.rm = TRUE)
79 ry <- range(table.in[,2], na.rm = TRUE)
80 rz <- range(table.in[,3], na.rm = TRUE)
82 if (exists('afctable')) {
83 eff <- rowSums(afctable)
88 if (!is.null(debsup)) {
90 table.in <- table.in[1:(debsup-1),]
91 tablechi <- tablechi[1:(debsup-1),]
92 cex.par <- eff[1:(debsup-1)]
95 table.in <- table.in[debsup:(debet-1),]
96 tablechi <- tablechi[debsup:(debet-1),]
97 cex.par <- eff[debsup:(debet-1)]
100 fin <- nrow(table.in)
101 table.in <- table.in[debet:nrow(table.in),]
102 tablechi <- tablechi[debet:nrow(tablechi),]
103 cex.par <- eff[debet:fin]
107 if (is.null(debsup)) {
109 if (!is.null(debet)) {
110 table.in <- table.in[1:(debet-1),]
111 tablechi <- tablechi[1:(debet-1),]
112 cex.par <- eff[1:(debet-1)]
117 fin <- nrow(table.in)
118 table.in <- table.in[debet:nrow(table.in),]
119 tablechi <- tablechi[debet:nrow(tablechi),]
120 cex.par <- eff[debet:fin]
125 if (select.nb > nrow(table.in)) select.nb <- nrow(table.in)
126 row.keep <- select_point_nb(tablechi, select.nb)
127 table.in <- table.in[row.keep,]
128 tablechi <- tablechi[row.keep,]
129 } else if (do.select.chi) {
130 if (select.chi > max(tablechi)) select.chi <- max(tablechi)
131 row.keep <- select_point_chi(tablechi, select.chi)
132 table.in <- table.in[row.keep,]
133 tablechi <- tablechi[row.keep,]
134 } else if (do.select.chi.classe) {
135 row.keep <- select.chi.classe(tablechi, ptbycluster, active=FALSE)
136 table.in <- table.in[row.keep,]
137 tablechi <- tablechi[row.keep,]
139 row.keep <- 1:nrow(table.in)
141 classes <- apply(tablechi, 1, which.max)
142 maxchi <- apply(tablechi, 1, max)
143 infp <- which(is.infinite(maxchi) & maxchi > 0)
146 if (!length(infp) == length(maxchi)) {
147 valmax <- max(maxchi, na.rm = TRUE)
151 maxchi[infp] <- valmax + 2
154 #row.keep <- append(row.keep, rn.keep)
155 #row.keep <- unique(row.keep)
156 cex.par <- cex.par[row.keep]
157 cex.par <- norm.vec(cex.par, txt.min/10, txt.max/10)
160 cex.par <- norm.vec(cex.par, tchi.min/10, tchi.max/10)
162 cex.par <- rep(taillecar/10, nrow(table.in))
166 if (is.null(xminmax)) {
167 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)))
169 if (is.null(yminmax)) {
170 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)))
173 if (typegraph == 0 || typegraph == 2) {
175 open_file_graph(fileout, width = width, height = height, svg = do.svg)
176 parcex <- taillecar/10
179 table.in <- table.in[order(cex.par, decreasing = TRUE),]
180 classes <- classes[order(cex.par, decreasing = TRUE)]
181 cex.par <- cex.par[order(cex.par, decreasing = TRUE)]
182 table.out <- stopoverlap(table.in, cex.par=cex.par, xlim = xminmax, ylim = yminmax)
183 table.in <- table.out$toplot
184 notplot <- table.out$notplot
185 if (! is.null(notplot)) {
186 write.csv2(notplot, file = paste(fileout,'_notplotted.csv', sep=''))
188 classes <- classes[table.in[,4]]
189 cex.par <- cex.par[table.in[,4]]
191 if (typegraph == 0) {
192 make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax)
196 nodes.attr <- make.afc.attributes(rownames(table.in), afc_table, afctable, clnb)
198 tokeep <- rownames(chistabletot) %%in%% rownames(table.in)
199 chis <- chistabletot[tokeep,]
200 chis<-chis[rownames(table.in),]
201 nodes.attr$chiclasse <- chis
205 afctogexf(fileout, table.in, classes, clnb, cex.par, nodes.attr = nodes.attr)
209 if (typegraph == 4) {
213 g <- make_empty_graph()
214 vertex <- rownames(table.in)
215 g <- add.vertices(g, length(vertex), attr=list(weight=cex.par, names=vertex, color=col))
216 minx <- min(table.in[,1])
217 maxx <- max(table.in[,1])
218 miny <- min(table.in[,2])
219 maxy <- max(table.in[,2])
220 minz <- min(table.in[,3])
221 maxz <- max(table.in[,3])
222 table.in <- rbind(table.in, c(minx, 0, 0))
223 rminx <- nrow(table.in)
224 table.in <- rbind(table.in, c(maxx, 0, 0))
225 rmaxx <- nrow(table.in)
226 table.in <- rbind(table.in, c(0, miny, 0))
227 rminy <- nrow(table.in)
228 table.in <- rbind(table.in, c(0, maxy, 0))
229 rmaxy <- nrow(table.in)
230 table.in <- rbind(table.in, c(0, 0, minz))
231 rminz <- nrow(table.in)
232 table.in <- rbind(table.in, c(0, 0, maxz))
233 rmaxz <- nrow(table.in)
234 g <- add.vertices(g, 6, attr=list(weight=c(0.1,0.1,0.1,0.1,0.1,0.1), names=c(rminx,rmaxx,rminy,rmaxy,rminz,rmaxz), color=c('white','white','white','white','white','white')))
235 g <- g + edge(rminx, rmaxx, weight=0.1) + edge(rminy, rmaxy, weight=0.1) + edge(rminz, rmaxz, weight=0.1)
236 table.in <- layout.norm(table.in, -5,5,-5,5,-5,5)
237 graph.to.file2(g, table.in, nodesfile=nodesfile, edgesfile=edgesfile)
240 rn <- vire.nonascii(rownames(table.in))
242 colors = rain[classes]
243 #rn <- rownames(table.in)
246 #rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
248 par3d('userMatrix' = matrix(c(1,0,0,0, 0,1,0,0,0,0,1,0,0,0,0,1), ncol=4, nrow = 4))
250 #par3d(windowRect = c(100,100,600,600))
251 rgl.lines(c(rx), c(0, 0), c(0, 0), col = "#000000")
252 rgl.lines(c(0,0),c(ry),c(0,0),col = "#000000")
253 rgl.lines(c(0,0),c(0,0),c(rz),col = "#000000")
254 text3d(rx[2]+1,0,0, xlab)
255 text3d(0,ry[2]+1,0, ylab)
256 text3d(0,0,rz[2]+1, zlab)
257 splt <- split(seq_along(table.in[,1]), ceiling(seq_along(table.in[,1])/100))
258 #colsplt <- split(seq_along(colors), ceiling(seq_along(colors)/100))
259 #cexsplt <- split(seq_along(cex.par), ceiling(seq_along(cex.par)/100))
261 rgl.texts(table.in[i,1], table.in[i,2], table.in[i,3], rn[i], col = colors[i] , cex = cex.par[i])
263 #rgl.texts(table.in[,1], table.in[,2], table.in[,3], rn, col = colors , cex = cex.par)
266 maxchi <- norm.vec(maxchi, tchi.min/100, tchi.max/100)
267 } else if (!is.null(cex.par)) {
268 maxchi <- norm.vec(cex.par, txt.min/100, txt.max/100)
275 # text3d(rx[2],(ry[2]+(0.2*i)),0,paste('classe',i),col=rain[i])
278 rgl.spheres(table.in, col = colors, radius = maxchi, alpha = alpha)
280 par3d(skipRedraw=FALSE)
284 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
286 movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = dirout)
287 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Fini !",icon="info",type="ok")
290 if (typegraph == 1) {
292 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
294 writeWebGL(dir = fileout, width = width, height= height)