1 #Author: Pierre Ratinaud
2 #Copyright (c) 20010 Pierre Ratinaud
6 #fichier genere par IRaMuTeq
33 xlab <- paste('facteur ', x, ' -')
34 ylab <- paste('facteur ', y, ' -')
35 if (!typegraph == 0) {zlab <- paste('facteur ', z, ' -')}
36 xlab <- paste(xlab,round(afc_table$facteur[x,2],2),sep = ' ')
37 xlab <- paste(xlab,' %%',sep = '')
38 ylab <- paste(ylab,round(afc_table$facteur[y,2],2),sep = ' ')
39 ylab <- paste(ylab,' %%',sep = '')
40 if (!typegraph == 0) {
41 zlab <- paste(zlab,round(afc_table$facteur[z,2],2),sep = ' ')
42 zlab <- paste(zlab,' %%',sep = '')
46 if ( what == 0 ) table.in <- afc$colcoord
47 if ( what == 1 ) table.in <- afc$colcrl
48 rownames(table.in) <- afc$colnames
50 table.in<-table.in[,c(x,y)]
52 table.in<-table.in[,c(x,y,z)]
53 rx <- range(table.in[,1], na.rm = TRUE)
54 ry <- range(table.in[,2], na.rm = TRUE)
55 rz <- range(table.in[,3], na.rm = TRUE)
61 if ( what == 0 ) table.in <- afc$rowcoord
62 if ( what == 1 ) table.in <- afc$rowcrl*2
63 rownames(table.in) <- afc$rownames
64 tablechi <- chistabletot
67 table.in<-table.in[,c(x,y)]
69 table.in<-table.in[,c(x,y,z)]
70 rx <- range(table.in[,1], na.rm = TRUE)
71 ry <- range(table.in[,2], na.rm = TRUE)
72 rz <- range(table.in[,3], na.rm = TRUE)
74 if (!is.null(debsup)) {
76 table.in <- table.in[1:(debsup-1),]
77 tablechi <- tablechi[1:(debsup-1),]
78 cex.par <- afc$rowmass[1:(debsup-1)]
81 table.in <- table.in[debsup:(debet-1),]
82 tablechi <- tablechi[debsup:(debet-1),]
83 #cex.par <- afc$rowmass[debsup:(debet-1)]
86 table.in <- table.in[debet:nrow(table.in),]
87 tablechi <- tablechi[debet:nrow(tablechi),]
88 #cex.par <- afc$rowmass[debet:nrow(tablechi)]
92 if (is.null(debsup)) {
94 if (!is.null(debet)) {
95 table.in <- table.in[1:(debet-1),]
96 tablechi <- tablechi[1:(debet-1),]
97 cex.par <- afc$rowmass[1:(debet-1)]
99 cex.par <- afc$rowmass
102 table.in <- table.in[debet:nrow(table.in),]
103 tablechi <- tablechi[debet:nrow(tablechi),]
104 #cex.par <- afc$rowmass[debet:nrow(tablechi)]
109 rn <- rownames(table.in)
110 rownames(table.in) <- 1:nrow(table.in)
111 table.in <- unique(table.in)
112 rn.keep <- as.numeric(rownames(table.in))
113 rownames(table.in) <- rn[rn.keep]
114 tablechi <- tablechi[rn.keep,]
116 cex.par <- cex.par[rn.keep]
122 if (select.nb > nrow(table.in)) select.nb <- nrow(table.in)
123 row.keep <- select_point_nb(tablechi, select.nb)
124 table.in <- table.in[row.keep,]
125 tablechi <- tablechi[row.keep,]
126 } else if (do.select.chi) {
127 if (select.chi > max(tablechi)) select.chi <- max(tablechi)
128 row.keep <- select_point_chi(tablechi, select.chi)
129 table.in <- table.in[row.keep,]
130 tablechi <- tablechi[row.keep,]
132 row.keep <- 1:nrow(table.in)
134 classes <- apply(tablechi, 1, which.max)
135 maxchi <- apply(tablechi, 1, max)
138 #row.keep <- append(row.keep, rn.keep)
139 #row.keep <- unique(row.keep)
140 cex.par <- cex.par[row.keep]
141 cex.par <- norm.vec(cex.par, txt.min/10, txt.max/10)
144 cex.par <- norm.vec(cex.par, tchi.min/10, tchi.max/10)
150 if (typegraph == 0) {
152 open_file_graph(fileout, width = width, height = height)
153 parcex <- taillecar/10
155 make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par)
159 vire.nonascii <- function(rnames) {
160 print('vire non ascii')
161 couple <- list(c('é','e'),
182 rnames<-gsub(c[1],c[2], rnames)
187 rn <- vire.nonascii(rownames(table.in))
189 #par3d(windowRect = c(100,100,600,600))
190 rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
191 rgl.lines(c(rx), c(0, 0), c(0, 0), col = "#000000")
192 rgl.lines(c(0,0),c(ry),c(0,0),col = "#000000")
193 rgl.lines(c(0,0),c(0,0),c(rz),col = "#000000")
194 text3d(rx[2]+1,0,0, xlab)
195 text3d(0,ry[2]+1,0, ylab)
196 text3d(0,0,rz[2]+1, zlab)
198 colors = rain[classes]
199 text3d(table.in[,1], table.in[,2], table.in[,3], rn, col='black')
201 maxchi <- norm.vec(maxchi, tchi.min/100, tchi.max/100)
202 } else if (!is.null(cex.par)) {
203 maxchi <- norm.vec(cex.par, txt.min/100, txt.max/100)
208 text3d(rx[2],(ry[2]+(0.2*i)),0,paste('classe',i),col=rain[i])
210 rgl.spheres(table.in, col = colors, radius = maxchi, alpha = alpha)
214 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
216 movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = dirout)
217 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Fini !",icon="info",type="ok")
221 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")