R/multibiplot.R

Defines functions multibiplot

Documented in multibiplot

multibiplot <- function(x, ni)
{
        transforma <- function(tipo, matriz)
        {    
                if (tipo=="Subtract the global mean"){                        
                        Xstd <- as.matrix(matriz)
                        media <- mean(Xstd)
                        Xstd <- Xstd-media                
                }#end if (tipo=="Subtract the global mean")
                
                if (tipo=="Column centering"){
                        Xstd <- as.matrix(matriz)
                        Xstd <-apply(matriz, 2, function(x){x-mean(as.matrix(x))})
                }#end if (tipo=="Column centering")
                
                if (tipo=="Standardize columns"){        
                        Xstd <- as.matrix(matriz)
                        Xstd <-apply(matriz, 2, function(x){(x-mean(as.matrix(x)))/sqrt(var(as.matrix(x)))})
                }#end if (tipo=="Standardize columns")
                
                if (tipo=="Row centering"){        	
                        Xstd <- as.matrix(matriz)
                        Xstd <-apply(matriz, 1, function(x){x-mean(as.matrix(x))})
                        Xstd <- t(Xstd)
                }#end if (tipo=="Row centering")
                
                if (tipo=="Standardize rows"){
                        Xstd <- as.matrix(matriz)
                        Xstd <-apply(matriz, 1, function(x){(x-mean(as.matrix(x)))/sqrt(var(as.matrix(x)))})
                        Xstd <- t(Xstd)
                }#end if (tipo=="Standardize rows")
                
                if (tipo=="Double centering"){
                        Xstd <- as.matrix(matriz)
                        mediac <- colMeans(Xstd)
                        mediaf <- rowMeans(Xstd)
                        globalm <- mean(Xstd)
                        
                        mediafm <- array(unlist(rep(rowMeans(Xstd), dim(Xstd)[2])), dim=dim(Xstd))
                        mediacm <- t(array(unlist(rep(colMeans(Xstd), dim(Xstd)[1])), dim=c(dim(Xstd)[2],dim(Xstd)[1])))
                        Xstd <- Xstd - mediafm - mediacm +globalm
                        
                }#end if (tipo=="Double centering")
                
                if (tipo=="Raw data"){
                        Xstd <- as.matrix(matriz)
                }#end if (tipo=="Raw data")
                
                rownames(Xstd) <- rownames(matriz)
                return(Xstd)        
                
        }# end transforma 
        
        
        multibiplotint<-function(matrices, nejes, tipo, filas)
        {
                if (filas==1)
                {
                        dimensiones<-mapply(function(x){dim(x)[1]}, matrices) 
                }else{
                        dimensiones<-mapply(function(x){dim(x)[2]}, matrices)
                }
                
                matrices<-lapply(matrices, function(x){array(unlist(x), dim=dim(x))})
                estand<-function(matriz, desvia)
                {
                        matrizst<-apply(matriz, 1, function(x,y){x/y}, desvia)
                        return(t(matrizst))
                }#end function
                
                
                normalizar<-function(matriz)
                {
                        covar <- cov(matriz)
                        vvpropios <- eigen(covar)
                        matriz <- matriz/vvpropios$values[1]
                        return(matriz)
                }#end function
                
                
                
                if (filas == 1){
                        
                        ###############################################################################                		
                        ####	We center the matrices
                        ###############################################################################
                        
                        matricesst <- lapply(matrices, function(x){transforma(x,tipo="Column centering")})
                        
                        ###############################################################################				
                        ####	We standardize the matrices
                        ###############################################################################
                        
                        desvt<-sqrt(diag(var(do.call(rbind,matrices))))
                        
                        matricesstt <- lapply(matricesst, function(x){estand(x,desvt)})
                        #matricesstt <- mapply(transforma, matrices, tipo="Standardize columns")
                        
                        ###############################################################################        			
                        ####	We normalize the matrices
                        ###############################################################################
                        
                        matricesnor <- lapply(matricesstt, normalizar)
                        Xpon<<-do.call(rbind,matricesnor)
                        
                } else{
                        
                        matricesnor <- lapply(matrices,normalizar)
                        
                        Xpon<<-do.call(cbind,matricesnor)
                        
                }#end if (filas == 1)
                
                ##############################################################################
                #####        	Coordinates
                ##############################################################################
                ejes<<-c()
                for (i in 1:nejes)
                {
                        ejes<<-c(ejes, paste("Axis",i))
                }#end for (i in 1:nejes)
                
                descom<<-La.svd(Xpon,nu=nejes,nv=nejes)
                bonajuste<<-0
                
                if (tipo == "RMP"){
                        coindividuos<<-descom$u%*%diag(descom$d[1:nejes])
                        covariables<<-t(descom$v)				
                        
                        ##############################################################################
                        #####		Contributions, goodness of fit and qualities of representation
                        ##############################################################################
                        
                        suma2valprop<<-sum((descom$d[1:nejes])^2)
                        sumaRvalprop<<-sum((descom$d)^2)
                        inercia<<-(descom$d[1:nejes])^2/sumaRvalprop
                        cuminer<<-cumsum(inercia)
                        bonajuste<<-(suma2valprop/sumaRvalprop)*100
                        calcol<<-nejes/length(descom$d)*100
                        calfilas<<-(suma2valprop/sumaRvalprop)*100
                }#end if (tipo == "RMP")
                
                if (tipo == "CMP"){
                        
                        coindividuos<<-descom$u
                        covariables<<-t(descom$v)%*%diag(descom$d[1:nejes])				
                        
                        ##############################################################################
                        #####		Contributions, goodness of fit and qualities of representation
                        ##############################################################################
                        
                        suma2valprop<<-sum((descom$d[1:nejes])^2)
                        sumaRvalprop<<-sum((descom$d)^2)
                        inercia<<-(descom$d[1:nejes])^2/sumaRvalprop
                        cuminer<<-cumsum(inercia)
                        bonajuste<<-(suma2valprop/sumaRvalprop)*100
                        calfilas<<-nejes/length(inerciatot)*100
                        calcol<<-(suma2valprop/sumaRvalprop)*100
                }#end if (tipo == "CMP")
                
                
                if (tipo=="RCMP")
                {
                        coindividuos<<-descom$u%*%diag(descom$d[1:nejes])
                        covariables<<-t(descom$v)%*%diag(descom$d[1:nejes])
                        
                        ##############################################################################
                        #####		Contributions, goodness of fit and qualities of representation
                        ##############################################################################
                        
                        suma2valprop<<-sum((descom$d[1:nejes])^2)
                        sumaRvalprop<<-sum((descom$d)^2)
                        inercia<<-(descom$d[1:nejes])^2/sumaRvalprop
                        cuminer<<-cumsum(inercia)
                        calcol<<-(suma2valprop/sumaRvalprop)*100
                        calfilas<<-(suma2valprop/sumaRvalprop)*100
                }#end if (tipo=="RCMP")
                
                coindividuosnam<-as.data.frame(coindividuos)
                #rownames(coindividuosnam)<-textindividuos
                colnames(coindividuosnam)<-ejes
                covariablesnam<-as.data.frame(covariables)
                #rownames(covariablesnam)<-textvariables
                colnames(covariablesnam)<-ejes
                
                coindivcuad<-coindividuos^2
                CRTi<-rowSums(coindivcuad)
                CRTi<-(CRTi*1000)/suma2valprop
                CRTi<-as.data.frame(CRTi)
                #rownames(CRTi)<-textindividuos
                
                covarcuad<-covariables^2
                CRTj<-rowSums(covarcuad)
                CRTj<-(CRTj*1000)/suma2valprop
                CRTj<-as.data.frame(CRTj)
                #rownames(CRTj)<-textvariables
                
                
                CREiFq<-array(dim=dim(coindividuos))
                CREjFq<-array(dim=dim(covariables))
                
                CRFqEi<-coindivcuad
                sumaindi<-rowSums(coindivcuad)
                
                CRFqEj<-covarcuad
                sumavar<-rowSums(covarcuad)
                
                for(i in 1:nejes)
                {
                        CREiFq[,i]<-((coindivcuad)[,i]*1000)/((descom$d[i])^2)
                        CREjFq[,i]<-((covarcuad)[,i]*1000)/((descom$d[i])^2)
                        CRFqEi[,i]<-((coindivcuad)[,i]*1000)/(sumaindi)
                        CRFqEj[,i]<-((covarcuad)[,i]*1000)/(sumavar)
                }#end for(i in 1:nejes)
                
                CREiFq<-as.data.frame(CREiFq)
                #rownames(CREiFq)<-textindividuos
                colnames(CREiFq)<-ejes
                
                CREjFq<-as.data.frame(CREjFq)
                #rownames(CREjFq)<-textvariables
                colnames(CREjFq)<-ejes
                
                CRFqEi<-as.data.frame(CRFqEi)
                #rownames(CRFqEi)<-textindividuos
                colnames(CRFqEi)<-ejes
                
                CRFqEj<-as.data.frame(CRFqEj)
                #rownames(CRFqEj)<-textvariables
                colnames(CRFqEj)<-ejes
                
                
                
                if (filas==1){
                        
                        partir<-function(x, start, end)
                        {
                                mat<-x[start:end,]
                                return(mat)
                        }
                        
                        rango<-as.list(dimensiones)
                        final<-cumsum(dimensiones)
                        princi<-as.list(final-dimensiones+1)
                        numerod<-length(dimensiones)
                        listcoindividuos<-rep(list(coindivcuad), numerod)
                        coorpart<-mapply(partir,listcoindividuos, princi, as.list(final), SIMPLIFY=FALSE)
                        
                        CRTt<-mapply(function(x){sum(x)/suma2valprop}, coorpart)
                        CRGtFq<-t(mapply(function(x,lambda){colSums(x)/lambda}, coorpart, rep(list(descom$d[1:nejes]^2),numerod))) 
                        CRFqGt<-t(mapply(function(x){colSums(x)/sum(x)}, coorpart)) 
                        
                }else{
                        
                        partir<-function(x, start, end)
                        {
                                mat<-x[start:end,]
                                return(mat)
                        }
                        
                        rango<-as.list(dimensiones)
                        final<-cumsum(dimensiones)
                        princi<-as.list(final-dimensiones+1)
                        numerod<-length(dimensiones)
                        listcovariables<-rep(list(covarcuad), numerod)
                        coorpart<-mapply(partir,listcovariables, princi, as.list(final), SIMPLIFY=FALSE)
                        
                        CRTt<-mapply(function(x){sum(x)/suma2valprop}, coorpart)
                        CRGtFq<-t(mapply(function(x,lambda){colSums(x)/lambda}, coorpart, rep(list(descom$d[1:nejes]^2),numerod))) 
                        CRFqGt<-t(mapply(function(x){colSums(x)/sum(x)}, coorpart))
                }#end if (filas==1)
                
                CRTt<-(CRTt*1000)
                CRTt<-as.data.frame(CRTt)
                CRGtFq<-CRGtFq*1000
                CRFqGt<-CRFqGt*1000
                colnames(CRGtFq)<-ejes
                colnames(CRFqGt)<-ejes
                
                resultados<- list(ejes=ejes,descom=descom, coindividuos=coindividuos, covariables=covariables, suma2valprop=suma2valprop,
                                  inercia=inercia, cuminer=cuminer, bonajuste=bonajuste, calcol=calcol, calfilas=calfilas, 
                                  coindividuosnam=coindividuosnam, covariablesnam=covariablesnam, CRTi=CRTi, CRTj=CRTj,
                                  CREiFq=CREiFq, CREjFq=CREjFq, CRFqEi=CRFqEi, CRFqEj=CRFqEj, CRTt=CRTt, CRGtFq=CRGtFq, CRFqGt=CRFqGt, valpro=descom$d)
                return(resultados)
        }#end multibiplotint
        
        
        remuestreojack<-function(cadajack,indices)
        {
                indicessep<-t(array(unlist(strsplit(unlist(indices), split="[.]")), dim=c(2,length(unlist(indices)))))
                tablas<-unique(indicessep[,1])
                tablas<-as.list(as.numeric(tablas))
                remuestra<-mapply(function(t){cadajack[[t]][as.numeric(indicessep[which(indicessep[,1]==t),2]),]},tablas, SIMPLIFY=FALSE)
                return(remuestra)
        }#end remuestreojack
        
        remuestreojackcol<-function(cadajack,indices)
        {
                remuestra<-mapply(function(x,y){x[indices,]},cadajack, SIMPLIFY=FALSE)
                return(remuestra)
        }#end remuestreojackcol
        
        resample_boot<-function(X)
        {
                dimen<-length(X)
                indicestabla<-sample(1:dimen, dimen, replace=TRUE)
                Xinter<- X[indicestabla]
                muestra<-function(x)
                {
                        indices <- sample(1:dim(x)[1], replace = T)
                        rem<-x[indices,]
                        return(list(rem,indices))
                }
                Xr <- lapply(Xinter, muestra)
                Xres<-lapply(Xr, function(x){x[[1]]})
                indices<-lapply(Xr, function(x){x[[2]]})
                indicestot<-mapply(function(x,y){paste(x,y, sep=".")}, indicestabla, indices, SIMPLIFY=FALSE)
                return(list(Xres, indicestot, indicestabla))
        }# end resample_boot<-function(X)
        
        
        resample_bootcol<-function(X)
        {
                dimen<-length(X)
                indicestabla<-1:dimen
                indicestot<-sample(1:dim(X[[1]])[1],dim(X[[1]])[1], replace=TRUE)
                
                Xres<-mapply(function(x){x[indicestot,]}, X, SIMPLIFY=FALSE)
                #indicestot<-rep(list(indices), dimen)
                return(list(Xres, indicestot, indicestabla))
        }# end resample_bootcol<-function(X)
        
        cal.ic <- function (muestra, liminf, limsup, valorobs, muestrajack, niter)
        {
                c.mean <- mean (muestra)
                se <- sd(muestra)
                sesgo <- c.mean - valorobs
                t.ic <- se * (-qt(liminf,(length(muestra)-1)))
                ic.t <- c(c.mean - t.ic, c.mean + t.ic)
                ic.p <- quantile (muestra,c(liminf, limsup), na.rm=TRUE)
                z0 <- qnorm(length(muestra[which(muestra<valorobs)])/as.numeric(niter))
                dent <- mean(muestrajack)- muestrajack
                acc <- sum(dent * dent * dent)/(6 * (sum(dent * dent))^1.5)
                alpha1 <- qnorm(liminf)
                alpha2 <- qnorm(limsup)
                zalpha1 <- pnorm(z0 + (z0 + alpha1)/(1 - acc * (z0 + alpha1)))
                zalpha2 <- pnorm(z0 + (z0 + alpha2)/(1 - acc * (z0 + alpha2)))
                ic.bca <- quantile (muestra,c(zalpha1, zalpha2), na.rm=TRUE)
                return(c(c.mean, se,sesgo,ic.t, ic.p, ic.bca))
        }#end cal.ic <- function (muestra, liminf, limsup, valorobs)
        
        
        if(missing(ni))
        {
                msg<-("ERROR: this function requires two arguments")
                tkmessageBox(message=msg)
                stop(" this function requires two arguments")
        }#end if(missing(ni))
        
        if(sum(ni)!=dim(x)[1] & sum(ni)!=dim(x)[2])
        {
                msg<-("ERROR: dimensions do not match")
                tkmessageBox(message=msg)
                stop(" dimensions do not match")
        }#end  if(sum(ni)!=dim(x)[1] & sum(ni)!=dim(x)[2])
        
        #############################################################################
        #########	libraries
        #############################################################################
        
#         require(tcltk)
#         library(tkrplot)
#         library(tcltk2)
#         library(rgl)
#         library(shapes)
#         library(cluster)
#         library(dendroextras)
#         library(Matrix)
#         tclRequire("BWidget")
#         
        mientorno <- new.env()
        
        symbols <- c("*",".", "o","O","0","+","-","|","%","#")
        tipo<-"RCMP" 
        filas<-1
        nejes<-3  
        dim1<-1
        dim2<-2
        dim3<-3
        NameVal<-NULL
        rbVal<-NULL
        hescale <- "1.5"
        vescale <- "1.5"
        indicei<-NULL
        Namei<-NULL
        Cexi<-1
        NameCexi<-NULL
        colori<-NULL
        simChoicei<-NULL
        Namei<-NULL
        colores<-c()  
        indicev<-NULL
        Namev<-NULL
        NameValv<-NULL
        Cexv<-1
        NameCexv<-NULL  
        colorv<-NULL   
        tipobi<-"Classical Biplot"
        anteriorx <- NULL
        anteriory <- NULL
        xCoords <- NULL
        yCoords <- NULL
        zCoords <- NULL
        datos <- NULL
        textos <- NULL
        indexClosest <- NULL
        indexLabeled <- NULL                           
        indexLabeledaux <- NULL
        parPlotSize <- NULL
        usrCoords <- NULL
        tChoice <- "Raw data"
        img <- NULL
        imgbar <- NULL
        descom<-NULL
        inerciatot<-NULL
        msginertia<-NULL
        nejes<-NULL
        cbVal<-NULL
        X<-NULL
        Xpon<-NULL
        colvariables<-NULL
        colindividuos<-NULL
        textvariables<-NULL
        textindividuos<-NULL
        cexvariables<-NULL
        cexindividuos<-NULL
        simvariables<-NULL
        simindividuos<-NULL
        Choicei<-NULL
        Choicev<-NULL
        sumaRvalprop<-NULL
        suma2valprop<-NULL
        inercia<-NULL
        cuminer<-NULL
        bonajuste<-NULL
        ejes<-NULL
        coindividuos<-NULL
        covariables<-NULL
        coindividuosnam<-NULL
        covariablesnam<-NULL
        CRTi<-NULL
        CRTj<-NULL
        CRTt<-NULL
        CREiFq<-NULL
        CREjFq<-NULL
        CRGtFq<-NULL
        CRFqEi<-NULL
        CRFqEj<-NULL
        CRFqGt<-NULL
        
        calcol<-NULL
        calfilas<-NULL
        labelsVec<-NULL
        sizesVec<-NULL
        centro<-NULL
        simbolos<-NULL
        simChoice<-NULL
        proj<-"normal"
        clb <- "normal"
        Choiceproj<- 0
        colvariablesp <- c()
        tit_graph <- "Graph"
        nclust <-"3"
        niterclust <- "10"
        nstart <- "1"
        dim1ant<-1
        dim2ant<-2
        Limix1 <-tclVar("0")
        Limix2 <-tclVar("0")
        Limiy1 <-tclVar("0")
        Limiy2 <-tclVar("0")
        pertb <- NULL
        pert <- NULL
        dcolor <- NULL
        hc <- NULL
        pertcentr <- NULL
        distchoos <- NULL
        linkchoos <- NULL
        algorchoos <- NULL
        pamx <- NULL
        entry.limix1 <- NULL
        entry.limix2 <- NULL
        entry.limiy1 <- NULL
        entry.limiy2 <- NULL
        niter <- 1000
        alphaic <- 95
        cbonajusteVal <- NULL
        ccalfilasVal <- NULL
        ccalcolVal <- NULL
        ccrtiVal <- NULL
        ccrtjVal <- NULL
        ccrttVal <- NULL
        ccreifqVal <- NULL
        ccrejfqVal <- NULL
        ccrgtfqVal <- NULL
        ccrfqeiVal <- NULL
        ccrfqejVal <- NULL
        ccrfqgtVal <- NULL
        ceigenVal <- NULL
        cpdfVal <- NULL
        cepsVal <- NULL
        ccaVal <- NULL
        
        
        colorescoor <- c("skyblue","red","green","blue","yellow","pink","orange", "navyblue",
                         "violet", "brown", "grey", "navyblue", "darkgreen", "papayawhip", "paleturquoise", "purple",
                         "seagreen", "azure", "coral", "springgreen", "steelblue", "plum", "orchid", 
                         "lemonchiffon", "lavender", "honeydew", "gold", "deeppink", "darksalmon", "darkmagenta")
        
        #############################################################################
        ### Informative window
        #############################################################################
        
        winfor<-tktoplevel()
        tkwm.title(winfor,"MultibiplotGUI")
        fontHeading <- tkfont.create(family="times",size=24,weight="bold",slant="italic")
        fontFixedWidth <- tkfont.create(family="courier",size=12)
        tkgrid(tklabel(winfor, text="    "))
        tkgrid(tklabel(winfor,text="MULTIBIPLOT:",font=fontHeading, foreground = "blue"))
        tkgrid(tklabel(winfor, text="    "))
        
        rb1 <- tkradiobutton(winfor)
        rb2 <- tkradiobutton(winfor)
        rbValue <- tclVar("Some sets of individuals which have been observed in a single set of variables")
        tkconfigure(rb1,variable=rbValue,value="Some sets of individuals which have been observed in a single set of variables")
        tkconfigure(rb2,variable=rbValue,value="Some sets of variables observed on a single set of individuals")
        tkgrid(tklabel(winfor,text="Some sets of individuals which have been observed in a single set of variables"),rb1)
        tkgrid(tklabel(winfor,text="Some sets of variables observed on a single set of individuals"),rb2)
        tkgrid(tklabel(winfor, text="    "))
        OnOKinf <- function()
        {
                #############################################################################
                #########	Window to enter the number of matrices to analyze
                #############################################################################
                rbVal <<- as.character(tclvalue(rbValue))
                tipobi<-rbVal
                tkdestroy(winfor)
                if(tipobi=="Some sets of individuals which have been observed in a single set of variables")
                {
                        filas<<-1 
                }else{
                        filas<<-0
                }
                NameVal<<-length(ni)	
                
                #############################################################################
                #########	We create vectors with the names of the matrices and of the  
                #########	eigen values
                #############################################################################
                
                niac <- cumsum(ni)
                matrices<-vector("list",NameVal)
                matricesname<-vector("list",NameVal)
                
                
                
                ###############################################################################				
                ####	If the selected option is Some sets of individuals observed in a single 
                ####	 set of variables
                ###############################################################################
                X <<- array(data=unlist(x), dim=dim(x))
                
                
                
                
                if (filas == 1){
                        for (z in 1:NameVal)
                        {
                                if(z==1)
                                {
                                        matrices[[z]]<-X[1:niac[1],]   
                                        matricesname[[z]]<-x[1:niac[1],]   
                                }else{
                                        matrices[[z]]<-X[(niac[z-1]+1):niac[z],]   
                                        matricesname[[z]]<-x[(niac[z-1]+1):niac[z],]   
                                }    
                        }#end for (z in 1:NameVal)
                        
                } else{
                        for (z in 1:NameVal)
                        {
                                if(z==1)
                                {
                                        matrices[[z]]<-X[,1:niac[1]]   
                                }else{
                                        matrices[[z]]<-X[,(niac[z-1]+1):niac[z]]   
                                }    
                        }#end for (z in 1:NameVal)
                }#end if (filas == 1)
                
                ##############################################################################
                ####	We create vectors of the colors
                ##############################################################################
                
                colvariables<<-rep("blue",times = dim(x)[2])		
                colindividuos<<-rep("green",times = dim(x)[1])
                textvariables<<-colnames(x)
                textindividuos<<-rownames(x)
                
                
                ##############################################################################
                ####	We create vectors of the character size
                ##############################################################################
                
                cexvariables<<-rep(1,times = dim(x)[2])		
                cexindividuos<<-rep(1,times = dim(x)[1])
                
                ##############################################################################
                ####	We create vectors of the symbols
                ##############################################################################
                
                simvariables<<-rep(" ",times = dim(x)[2])		
                simindividuos<<-rep("+",times = dim(x)[1])
                
                ##############################################################################
                #####	Window to change labels and colors and select the biplot 
                ##############################################################################
                
                tt<-tktoplevel()
                tkwm.title(tt,"Options")
                
                #####Dropdown menu#############################
                
                topMenutt <- tkmenu(tt)
                tkconfigure(tt,menu=topMenutt)
                fileMenutt <- tkmenu(topMenutt,tearoff=FALSE)
                fileMenutrans <- tkmenu(topMenutt, tearoff=FALSE)
                
                
                tkadd(fileMenutt,"command",label="JK-biplot",command=function() tipo<<-"RMP")
                tkadd(fileMenutt,"command",label="HJ-biplot",command=function() tipo<<-"RCMP")
                
                tkadd(topMenutt,"cascade",label="Biplot",menu=fileMenutt)
                
                #### Frames
                
                framett<-tkframe(tt, relief = "flat", borderwidth = 2, background = "white")
                framett1<-tkframe(framett, relief = "ridge", borderwidth = 2, background = "white")
                framett2<-tkframe(framett, relief = "ridge", borderwidth = 2, background = "white")
                framett3<-tkframe(framett, relief = "ridge", borderwidth = 2)
                
                framet1<-tkframe(framett1, relief = "ridge", borderwidth = 2, background = "white")		
                frametext1<-tkframe(framett1, relief = "flat", borderwidth = 2, background = "white")
                frameok1<-tkframe(framett1, relief = "ridge", borderwidth = 2, background = "white")
                
                framecol1<-tkframe(framett1, relief = "flat", borderwidth = 2, background = "white")
                framecol11<-tkframe(framecol1, relief = "flat", borderwidth = 2, background = "white")
                framecol12<-tkframe(framecol1, relief = "flat", borderwidth = 2, background = "white")
                
                framename1<-tkframe(framett1, relief = "flat", borderwidth = 2, background = "white")
                framename11<-tkframe(framename1, relief = "flat", borderwidth = 2, background = "white")
                framename12<-tkframe(framename1, relief = "flat", borderwidth = 2, background = "white")
                
                framecex1<-tkframe(framett1, relief = "flat", borderwidth = 2, background = "white")
                framecex11<-tkframe(framecex1, relief = "flat", borderwidth = 2, background = "white")
                framecex12<-tkframe(framecex1, relief = "flat", borderwidth = 2, background = "white")
                
                frames1<-tkframe(framett1, relief = "flat", borderwidth = 2, background = "white")   
                frames11<-tkframe(frames1, relief = "flat", borderwidth = 2, background = "white")
                frames12<-tkframe(frames1, relief = "flat", borderwidth = 2, background = "white")
                
                framet2<-tkframe(framett2, relief = "ridge", borderwidth = 2, background = "white")
                frametext2<-tkframe(framett2, relief = "flat", borderwidth = 2, background = "white")
                frameok2<-tkframe(framett2, relief = "ridge", borderwidth = 2, background = "white")
                
                framecol2<-tkframe(framett2, relief = "flat", borderwidth = 2, background = "white")
                framecol21<-tkframe(framecol2, relief = "flat", borderwidth = 2, background = "white")
                framecol22<-tkframe(framecol2, relief = "flat", borderwidth = 2, background = "white")
                
                framename2<-tkframe(framett2, relief = "flat", borderwidth = 2, background = "white")
                framename21<-tkframe(framename2, relief = "flat", borderwidth = 2, background = "white")
                framename22<-tkframe(framename2, relief = "flat", borderwidth = 2, background = "white")
                
                framecex2<-tkframe(framett2, relief = "flat", borderwidth = 2, background = "white")
                framecex21<-tkframe(framecex2, relief = "flat", borderwidth = 2, background = "white")
                framecex22<-tkframe(framecex2, relief = "flat", borderwidth = 2, background = "white")
                
                framet3<-tkframe(framett3, relief = "flat", borderwidth = 2)#, background = "white")
                frametext3<-tkframe(framett3, relief = "flat", borderwidth = 2)#, background = "white")
                frameok3<-tkframe(framett3, relief = "flat", borderwidth = 2)#, background = "white")
                framett3auxgs<-tkframe(framett3, relief = "ridge", borderwidth = 2)#, background = "white")
                framehvtitle<-tkframe(framett3auxgs, relief = "flat", borderwidth = 2)#, background = "white")
                framehv<-tkframe(framett3auxgs, relief = "flat", borderwidth = 2)#, background = "white")
                framehvnames<-tkframe(framehv, relief = "flat", borderwidth = 2)#, background = "white")
                framehnames<-tkframe(framehvnames, relief = "flat", borderwidth = 2)#, background = "white")
                framevnames<-tkframe(framehvnames, relief = "flat", borderwidth = 2)#, background = "white")
                
                framehvtext<-tkframe(framehv, relief = "flat", borderwidth = 2)#, background = "white")
                framehtext<-tkframe(framehvtext, relief = "flat", borderwidth = 2)#, background = "white")
                framevtext<-tkframe(framehvtext, relief = "flat", borderwidth = 2)#, background = "white")
                
                frames2<-tkframe(framett2, relief = "flat", borderwidth = 2, background = "white")
                framegraphic<-tkframe(tt, relief = "flat", borderwidth = 2, background = "white")
                
                ##### Checkbox to show the axes or not #######
                
                cb <- tkcheckbutton(frames2)
                cbValue <- tclVar("0")
                tkconfigure(cb,variable=cbValue)
                
                ##############################################################################
                ##### 	List of individuals
                ##############################################################################
                
                indicei<-NULL
                Namei<-NULL
                NameVali<-NULL
                Cexi<-1
                NameCexi<-NULL
                scri <- tkscrollbar(framet1, repeatinterval=5, command=function(...)tkyview(tli,...))
                tli<-tklistbox(framet1,height=6,width=42,selectmode="multiple",yscrollcommand=function(...)tkset(scri,...),background="white")
                tkpack(tklabel(frametext1,text="Individuals"),side="left",expand = "TRUE",fill="both")
                
                for (i in 1:(dim(x)[1]))
                {
                        tkinsert(tli,"end",textindividuos[i])
                }#end for (i in 1:(dim(x)[1]))
                
                tkselection.set(tli,0) #  Indexing starts at zero.
                
                OnOKi <- function()
                {
                        Choicei <<- textindividuos[as.numeric(tkcurselection(tli))+1]
                        
                        ##### Color of the selected variable  #############
                        
                        indicei<<-as.numeric(tkcurselection(tli))+1
                        colori <- colindividuos[indicei[1]]
                        tkconfigure(canvasi,bg=colori)
                        
                        ##### Text of the selected variable  #############
                        
                        Namei <<- tclVar(textindividuos[indicei[1]])
                        tkconfigure(entry.Namei,textvariable=Namei)
                        
                        ##### Size of the selected variable  #############
                        
                        Cexi <<- tclVar(cexindividuos[indicei[1]])
                        tkconfigure(entry.Cexi,textvariable=Cexi)
                }#end OnOKi <- function()
                
                OK.buti <-tkbutton(frameok1,text="    OK    ",command=OnOKi)
                
                tkpack(tli,scri,expand = "TRUE", side="left", fill = "both")
                tkpack.configure(scri,side="left")
                tkpack(OK.buti,expand = "TRUE", side="left", fill = "both")
                
                
                #######Color#######################################
                
                indicei<-as.numeric(tkcurselection(tli))+1
                colori <- colindividuos[indicei[1]]
                canvasi <- tkcanvas(framecol11,width="57",height="20",bg=colori)
                
                ChangeColori <- function()
                {
                        colori <<- tclvalue(tcl("tk_chooseColor",initialcolor=colindividuos[indicei[1]],title="Choose a color"))
                        
                        if (nchar(colori)>0)
                        {
                                tkconfigure(canvasi,bg=colori)
                                colindividuos[indicei]<<-colori
                        }#end if (nchar(colori)>0)
                }#end ChangeColori <- function()
                
                ChangeColor.buttoni<- tkbutton(framecol12,text="Change Color",command=ChangeColori,width=4)
                tkpack(canvasi,ChangeColor.buttoni,expand = "TRUE", side="left", fill = "both")
                
                
                
                ######Labels   ###################################
                
                Namei <- textindividuos[indicei[1]]
                entry.Namei <-tkentry(framename11,width=10,textvariable=Namei)
                
                OnOKli <- function()
                {
                        NameVali <<- tclvalue(Namei)
                        textindividuos[indicei]<<-NameVali
                        
                        #####Values of listbox###############################
                        
                        for (i in 1:dim(x)[1])
                        {
                                tkdelete(tli,0)
                        }#end for (i in 1:dim(x)[1])
                        
                        for (i in 1:(dim(x)[1]))
                        {
                                tkinsert(tli,"end",textindividuos[i])
                        }#end for (i in 1:(dim(x)[1]))
                }#end OnOKli <- function()
                
                OK.butli <-tkbutton(framename12,text=" Change label",command=OnOKli,width=4)
                tkbind(entry.Namei, "<Return>",OnOKli)
                tkpack(entry.Namei,OK.butli,expand = "TRUE", side="left", fill = "both")
                
                ###### Sizes   ###################################
                
                Cexi <- cexindividuos[indicei[1]]
                entry.Cexi <-tkentry(framecex11,width=10,textvariable=Cexi)
                
                OnOKci <- function()
                {
                        NameCexi <<- tclvalue(Cexi)
                        cexindividuos[indicei]<<-NameCexi
                }#end OnOKci <- function()
                
                OK.butci <-tkbutton(framecex12,text=" Change size",command=OnOKci,width=4)
                tkbind(entry.Cexi, "<Return>",OnOKci)
                tkpack(entry.Cexi,OK.butci,expand = "TRUE", side="left", fill = "both")
                
                
                ######Symbols  ###################################
                
                comboBoxi <- tkwidget(frames11,"ComboBox",editable=FALSE,values=symbols, width=7)
                
                chang.symi <- function()
                {
                        simChoicei <<- symbols[as.numeric(tclvalue(tcl(comboBoxi,"getvalue")))+1]
                        simindividuos[indicei]<<-simChoicei
                }#end chang.symi <- function()
                
                Change.symboli <-tkbutton(frames12,text="   Change symbol   ",command=chang.symi,width=4, height=1)
                tkpack(comboBoxi,Change.symboli,side="left",expand="TRUE", fill="both")
                
                ##### List of variables ###########################
                
                indicev<-NULL
                Namev<-NULL
                NameValv<-NULL
                Cexv<-1
                NameCexv<-NULL
                
                scrv <- tkscrollbar(framet2, repeatinterval=5, command=function(...)tkyview(tlv,...))
                tlv<-tklistbox(framet2,height=6,width=42,selectmode="multiple",yscrollcommand=function(...)tkset(scrv,...),background="white")
                tkpack(tklabel(frametext2,text="Variables"),side="left",expand = "TRUE",fill="both")
                
                for (i in 1:dim(x)[2])
                {
                        tkinsert(tlv,"end",textvariables[i])
                }#end for (i in 1:dim(x)[2])
                
                tkselection.set(tlv,0) #  Indexing starts at zero.
                
                OnOKv <- function()
                {
                        Choicev <<- textvariables[as.numeric(tkcurselection(tlv))+1]
                        
                        ##### Color of the selected variable  #############
                        
                        indicev<<-as.numeric(tkcurselection(tlv))+1
                        colorv <- colvariables[indicev[1]]
                        tkconfigure(canvasv,bg=colorv)
                        
                        
                        ##### Text of the selected variable  #############
                        
                        Namev <<- tclVar(textvariables[indicev[1]])
                        tkconfigure(entry.Namev,textvariable=Namev)
                        
                        ##### Size of the selected variable  #############
                        
                        Cexv <<- tclVar(cexvariables[indicev[1]])
                        tkconfigure(entry.Cexv,textvariable=Cexv)    
                }#end OnOKv <- function()
                
                OK.butv <-tkbutton(frameok2,text="    OK    ",command=OnOKv)
                tkpack(OK.butv,expand = "TRUE", side="left", fill = "both")
                
                
                tkpack(tlv,scrv,expand = "TRUE", side="left", fill = "both")
                tkpack.configure(scrv,side="left")
                
                tkpack(OK.butv,expand = "TRUE", side="left", fill = "both")
                tkfocus(tt)
                
                
                #######Color#######################################
                
                indicev<-as.numeric(tkcurselection(tlv))+1
                colorv <- colvariables[indicev[1]]
                canvasv <- tkcanvas(framecol21,width="57",height="20",bg=colorv)
                
                ChangeColorv <- function()
                {
                        colorv <<- tclvalue(tcl("tk_chooseColor",initialcolor=colvariables[indicev[1]],title="Choose a color"))
                        
                        if (nchar(colorv)>0)
                        {
                                tkconfigure(canvasv,bg=colorv)
                                colvariables[indicev]<<-colorv
                        }#end if (nchar(colorv)>0)
                }#end ChangeColorv <- function()
                
                ChangeColor.buttonv<- tkbutton(framecol22,text="Change Color",command=ChangeColorv,width=4)
                tkpack(canvasv,ChangeColor.buttonv,expand = "TRUE", side="left", fill = "both")
                
                ######Labels  ###################################
                
                Namev <- textvariables[indicev[1]]
                entry.Namev <-tkentry(framename21,width=10, textvariable=Namev)
                
                OnOKlv <- function()
                {
                        NameValv <<- tclvalue(Namev)
                        textvariables[indicev]<<-NameValv
                        
                        #####Values of listbox###############################
                        
                        for (i in 1:(dim(x)[2]))
                        {
                                tkdelete(tlv,0)
                        }#end for (i in 1:(dim(x)[2]))
                        
                        for (i in 1:(dim(x)[2]))
                        {
                                tkinsert(tlv,"end",textvariables[i])
                        }#end for (i in 1:(dim(x)[2]))
                }#end OnOKlv <- function()
                
                OK.butlv <-tkbutton(framename22,text=" Change label",command=OnOKlv,width=4)
                tkbind(entry.Namev, "<Return>",OnOKlv)
                tkpack(entry.Namev,OK.butlv,expand = "TRUE", side="left", fill = "both")
                
                
                ###### Sizes  ###################################
                
                Cexv <- cexvariables[indicev[1]]
                entry.Cexv <-tkentry(framecex21,width=10, textvariable=Cexv)
                
                OnOKcv <- function()
                {
                        NameCexv <<- tclvalue(Cexv)
                        cexvariables[indicev]<<-NameCexv
                }#end OnOKcv <- function()
                
                OK.butcv <-tkbutton(framecex22,text=" Change size",command=OnOKcv,width=4)
                tkbind(entry.Cexv, "<Return>",OnOKcv)
                tkpack(entry.Cexv,OK.butcv,expand = "TRUE", side="left", fill = "both")
                
                Graphics <- function()
                {
                        barvp<-tktoplevel()
                        tkdestroy(tt)
                        tkwm.title(barvp,"Eigenvalues")
                        hescale <<- tclvalue(entryvalueh)
                        vescale <<- tclvalue(entryvaluev)
                        
                        plotbar<-function()
                        {
                                descom<<-multibiplotint(matrices, rankMatrix(x)[1], tipo, filas)$descom
                                sumaRvalprop<<-sum((descom$d)^2)
                                inerciatot<<-(descom$d[1:length(descom$d)])^2/sumaRvalprop
                                barplot(descom$d, col="blue", xlab="", ylab="", names.arg=round(inerciatot, digits=2))
                        }#end plotbar<-function()
                        
                        imgbar <<- tkrplot(barvp,fun=plotbar,hscale=as.numeric(hescale),vscale=as.numeric(vescale))
                        msginertia<-"Proportion of inertia explained by each axis:"
                        for (i in 1:length(descom$d))
                        {
                                msginertia<-paste(msginertia, "\n",i, "\t", round(inerciatot[i]*100, digits=2), "%")
                        }#end for (i in 1:length(descom$d))
                        
                        tk2tip(imgbar, msginertia)
                        
                        Onaxis <- function()
                        {
                                nejes <<- tclvalue(numaxis)
                                nejes<<-as.numeric(nejes)
                                if (nejes > length(descom$d))
                                {
                                        msg <- paste("The maximum number of dimensions is ",length(descom$d))
                                        tkmessageBox(message=msg)
                                }else{
                                        tkdestroy(barvp)
                                        nejes <<- as.integer(nejes)
                                        
                                        resultados<- multibiplotint(matrices, nejes, tipo, filas)
                                        ejes<<-resultados$ejes
                                        descom<<-resultados$descom
                                        coindividuos<<-resultados$coindividuos
                                        covariables<<-resultados$covariables
                                        suma2valprop<<-resultados$suma2valprop
                                        inercia<<-resultados$inercia
                                        cuminer<<-resultados$cuminer
                                        bonajuste<<-resultados$bonajuste
                                        calcol<<-resultados$calcol
                                        calfilas<<-resultados$calfilas
                                        coindividuosnam<<-resultados$coindividuosnam
                                        covariablesnam<<- resultados$covariablesnam
                                        CRTi<<-resultados$CRTi
                                        CRTj<<-resultados$CRTj
                                        CRTt<<-resultados$CRTt
                                        CREiFq<<-resultados$CREiFq
                                        CREjFq<<-resultados$CREjFq
                                        CRGtFq<<-resultados$CRGtFq
                                        CRFqEi<<-resultados$CRFqEi
                                        CRFqEj<<-resultados$CRFqEj
                                        CRFqGt<<-resultados$CRFqGt
                                        
                                        
                                        rownames(coindividuosnam)<<-textindividuos
                                        rownames(covariablesnam)<<-textvariables
                                        rownames(CRTi)<<-textindividuos
                                        rownames(CRTj)<<-textvariables
                                        rownames(CREiFq)<<-textindividuos
                                        rownames(CREjFq)<<-textvariables
                                        rownames(CRFqEi)<<-textindividuos
                                        rownames(CRFqEj)<<-textvariables
                                        
                                        
                                        cat("File saved in:    ",file="Results.txt")
                                        cat(getwd(),file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")		
                                        cat("CONTRIBUTIONS:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        
                                        if (tipo != "RCMP"){
                                                cat("\n",file="temp.txt")        				
                                                file.append("Results.txt","temp.txt")	
                                                cat("Goodnes of Fit:  ",file="temp.txt")					
                                                file.append("Results.txt","temp.txt")					
                                                cat(round(bonajuste, digits=2),file="temp.txt")
                                                file.append("Results.txt","temp.txt")
                                                cat(" %",file="temp.txt")					
                                                file.append("Results.txt","temp.txt")	
                                        }#end if (tipo != "RCMP")
                                        
                                        cat("\n",file="temp.txt")        				
                                        file.append("Results.txt","temp.txt")	
                                        cat("Quality of approximation for rows:  ",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        cat(round(calfilas, digits=2),file="temp.txt")
                                        file.append("Results.txt","temp.txt")
                                        cat(" %",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Quality of approximation for columns:  ",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        cat(round(calcol, digits=2),file="temp.txt")
                                        file.append("Results.txt","temp.txt")
                                        cat(" %",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution to total variability of the row element i:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRTi, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution to total variability of the column element j:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRTj, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")        				
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the set t to total variability: \n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRTt, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")        				
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the row element i to the factor q-th:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CREiFq, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the column element j to the factor q-th:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CREjFq, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")        				
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the set t to the factor q: \n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRGtFq, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the factor q-th to row element i:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRFqEi, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the factor q-th to column element j:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRFqEj, digits=2),file="temp.txt", sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Relative contribution of the factor q-th to the set t: \n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(CRFqGt, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        
                                        
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Individual coordinates:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(coindividuosnam, digits=2),file="temp.txt",sep="\t",dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Variables coordinates:\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(covariablesnam, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")	
                                        cat("Eigen values: \n",file="temp.txt")					
                                        file.append("Results.txt","temp.txt")					
                                        write.table(round(descom$d, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        cat("\n",file="temp.txt")
                                        file.append("Results.txt","temp.txt")
                                        cat("Proportion of inertia explained by each axis: \n",file="temp.txt")
                                        file.append("Results.txt","temp.txt")
                                        write.table(round(inercia, digits=2), file="temp.txt", sep="\t", dec=",")
                                        file.append("Results.txt","temp.txt")
                                        
                                        file.show("Results.txt")
                                        file.remove("temp.txt")
                                        
                                        
                                        datos<-rbind(coindividuos,covariables)
                                        textos<-datos
                                        limix <- round(c(min(datos[,dim1],0), max(datos[,dim1],0)), digits=2)
                                        limiy <- round(c(min(datos[,dim2],0), max(datos[,dim2],0)), digits=2)
                                        
                                        centro<-c(0,0)
                                        
                                        xCoords<-textos[,dim1]
                                        yCoords<-textos[,dim2]
                                        labelsVec <- c()
                                        sizesVec <- c()
                                        colores<-c()
                                        simbolos<-c()
                                        
                                        colores<-c(colindividuos, colvariables)
                                        labelsVec<-c(textindividuos, textvariables)
                                        sizesVec<-c(cexindividuos, cexvariables)
                                        simbolos<-c(simindividuos, simvariables)
                                        
                                        
                                        indexLabeled<-c(1:length(xCoords))
                                        indexLabeledaux<-c()
                                        labeledPoints <- list()
                                        cbVal <<- as.character(tclvalue(cbValue))
                                        wgr <- tktoplevel()
                                        tkwm.title(wgr,"Graph")
                                        
                                        
                                        normalLine <- function(variableele, colorele, coordenadas, colorcoor) 
                                        { 
                                                A <- variableele
                                                B <- centro
                                                
                                                slopeAB <- (B[[2]] - A[[2]])/(B[[1]] - A[[1]]) 
                                                slopeNorm <- -1/slopeAB 
                                                a <- A[[2]] - slopeAB * A[[1]]
                                                
                                                b<-c()
                                                xintersect<-c()
                                                yintersect<-c()
                                                
                                                for(i in 1:dim(coordenadas)[1])
                                                {
                                                        b[i] <- coordenadas[i,2] - slopeNorm * coordenadas[i,1] 
                                                        
                                                        xintersect[i] <- (b[i] - a)/(slopeAB - slopeNorm) 
                                                        yintersect[i] <- b[i] + slopeNorm * xintersect[i] 
                                                        
                                                }#end for (i in 1:dim(coordenadas)[1])
                                                
                                                abline(a =a,b=slopeAB, col=colorele, lwd=3)
                                                
                                                for(i in 1:dim(coordenadas)[1])
                                                        segments(xintersect[i], yintersect[i], coordenadas[i,1], coordenadas[i,2],lty=2, col=colorcoor[i]) 
                                        } #end normalLine
                                        
                                        plotFunctiond <- function(screen=TRUE)
                                        {
                                                tclvalue(Limix1) <- limix[1]
                                                tclvalue(Limix2) <- limix[2]
                                                tclvalue(Limiy1) <- limiy[1]
                                                tclvalue(Limiy2) <- limiy[2]
                                                labelsVec <- c()
                                                sizesVec <- c()
                                                colores<-c()
                                                simbolos<-c()
                                                
                                                colores<-c(colindividuos, colvariables)
                                                labelsVec<-c(textindividuos, textvariables)
                                                sizesVec<-c(cexindividuos, cexvariables)
                                                simbolos<-c(simindividuos, simvariables)
                                                
                                                xCoords<<-textos[,dim1]
                                                yCoords<<-textos[,dim2]
                                                params <- par(bg="white")
                                                
                                                plot(datos[,c(dim1,dim2)],main= tit_graph,type="n",xlab=paste("Axis", dim1, ":", round(inerciatot[dim1]*100, digits=2),"%"),ylab=paste("Axis", dim2, ":", round(inerciatot[dim2]*100,digits=2),"%"), asp=1/1, xlim = limix * 1.05, ylim = limiy * 1.05)
                                                
                                                if(proj=="normal")
                                                {
                                                        if(clb=="normal")
                                                        {
                                                                points(coindividuos[,dim1],coindividuos[,dim2],pch=simbolos[1:length(simindividuos)],col=colores[1:length(colindividuos)])    
                                                                if (length(indexLabeled)>0)
                                                                        for (i in (1:length(indexLabeled)))
                                                                        {
                                                                                indexClosest <- indexLabeled[i]
                                                                                text(xCoords[indexClosest],yCoords[indexClosest], labels=labelsVec[indexClosest], col= colores[indexClosest],cex=as.numeric(sizesVec)[indexClosest])
                                                                        }#end for (i in (1:length(indexLabeled)))
                                                                
                                                        }else{
                                                                
                                                                for(i in 1:as.numeric(nclust))
                                                                {
                                                                        clusteri <-coindividuos[which(pertb==i),c(dim1,dim2), drop=FALSE]
                                                                        clusteri <- t(t(clusteri))
                                                                        hpts <- chull(clusteri)
                                                                        hpts <- c(hpts, hpts[1])
                                                                        if(length(hpts)>2)
                                                                        {
                                                                                lines(clusteri[hpts,], col=unique(pertb)[i]+1)                                                                                
                                                                        }
                                                                }
                                                                points(coindividuos[,dim1],coindividuos[,dim2],pch=simbolos[1:length(simindividuos)],col=pertb+1)    
                                                                colorescl<-c(pertb+1, colvariables)
                                                                if (length(indexLabeled)>0)
                                                                        for (i in (1:length(indexLabeled)))
                                                                        {
                                                                                indexClosest <- indexLabeled[i]
                                                                                text(xCoords[indexClosest],yCoords[indexClosest], labels=labelsVec[indexClosest], col= colorescl[indexClosest],cex=as.numeric(sizesVec)[indexClosest])
                                                                        }#end for (i in (1:length(indexLabeled)))
                                                                
                                                                if(clb=="km")
                                                                {
                                                                        points(hc$centers[unique(pertcentr),c(dim1,dim2)], pch=8, col=unique(pertb)+1)
                                                                }
                                                                
                                                                
                                                        }
                                                        
                                                        
                                                        arrows(centro[1],centro[2],covariables[,dim1],covariables[,dim2],col=colores[1+length(colindividuos):length(colores)],#lty="dotted",
                                                               length=0.10, lwd=0.08)
                                                        points(centro[1],centro[2],pch=18,col="black")
                                                        
                                                        if (cbVal=="1"){
                                                                abline(h=centro[2],v=centro[1],lty="dotted")
                                                        }#end if (cbVal=="1")
                                                        
                                                        
                                                        
                                                }else{
                                                        colvariablesp <- rep("grey",dim(x)[2])
                                                        colvariablesp[Choiceproj] <-colvariables[Choiceproj]
                                                        coloresp<-c(colindividuos, colvariablesp)
                                                        points(coindividuos[,dim1],coindividuos[,dim2],pch=simbolos[1:length(simindividuos)],col=colores[1:length(colindividuos)])
                                                        
                                                        if (length(indexLabeled)>0)
                                                                for (i in (1:length(indexLabeled)))
                                                                {
                                                                        indexClosest <- indexLabeled[i]
                                                                        text(xCoords[indexClosest],yCoords[indexClosest], labels=labelsVec[indexClosest], col= coloresp[indexClosest],cex=as.numeric(sizesVec)[indexClosest])
                                                                }#end for (i in (1:length(indexLabeled)))
                                                        
                                                        normalLine(covariables[Choiceproj,c(dim1,dim2)], colvariablesp[Choiceproj], coindividuos[,c(dim1,dim2)], colindividuos)
                                                        
                                                }
                                                
                                                parPlotSize <<- par("plt")
                                                usrCoords   <<- par("usr")
                                                par(params)
                                        }# end plotFunctiond
                                        
                                        
                                        
                                        #############################################################################
                                        ### Functions to save the graph
                                        #############################################################################
                                        SaveFileJPG <- function() {
                                                FileName <- tclvalue(tkgetSaveFile(filetypes = "{{Jpeg files} {.jpg .jpeg}} {{All files} *}"))
                                                if (nchar(FileName)) {
                                                        nn <- nchar(FileName)
                                                        if (nn < 5 || substr(FileName, nn - 3, nn) != ".jpg") 
                                                                FileName <- paste(FileName, ".jpg", sep = "")
                                                        jpeg(FileName, width = 8, height = 8, units = "in", restoreConsole = FALSE, res = 96, quality = 50)
                                                        plotFunctiond(screen = FALSE)
                                                        dev.off()
                                                }#end if (nchar(FileName))
                                        }#end SaveFileJPG <- function()
                                        
                                        SaveFilePDF <- function() {
                                                FileName <- tclvalue(tkgetSaveFile(filetypes = "{{PDF files} {.pdf}} {{All files} *}"))
                                                if (nchar(FileName)) {
                                                        nn <- nchar(FileName)
                                                        if (nn < 5 || substr(FileName, nn - 3, nn) != ".pdf") 
                                                                FileName <- paste(FileName, ".pdf", sep = "")
                                                        pdf(FileName, width = 7, height = 7)
                                                        plotFunctiond(screen = FALSE)
                                                        dev.off()
                                                }#end if (nchar(FileName))
                                        }#end SaveFilePDF <- function()
                                        
                                        SaveFileBmp <- function() {
                                                FileName <- tclvalue(tkgetSaveFile(filetypes = "{{Bitmap files} {.bmp}} {{All files} *}"))
                                                if (nchar(FileName)) {
                                                        nn <- nchar(FileName)
                                                        if (nn < 5 || substr(FileName, nn - 3, nn) != ".bmp") 
                                                                FileName <- paste(FileName, ".bmp", sep = "")
                                                        bmp(FileName, width = 8, height = 8, units = "in", restoreConsole = FALSE, res = 96)
                                                        plotFunctiond(screen = FALSE)
                                                        dev.off()
                                                }#end if (nchar(FileName))
                                        }#end SaveFileBmp <- function()
                                        
                                        SaveFilePng <- function() {
                                                FileName <- tclvalue(tkgetSaveFile(filetypes = "{{Png files} {.png}} {{All files} *}"))
                                                if (nchar(FileName)) {
                                                        nn <- nchar(FileName)
                                                        if (nn < 5 || substr(FileName, nn - 3, nn) != ".png") 
                                                                FileName <- paste(FileName, ".png", sep = "")
                                                        png(FileName, width = 8, height = 8, units = "in", restoreConsole = FALSE, res = 96)
                                                        plotFunctiond(screen = FALSE)
                                                        dev.off()
                                                }#end if (nchar(FileName))
                                        }#end SaveFilePng <- function()
                                        
                                        SaveFileeps <- function() {
                                                FileName <- tclvalue(tkgetSaveFile(filetypes = "{{Eps files} {.eps}} {{All files} *}"))
                                                if (nchar(FileName)) {
                                                        nn <- nchar(FileName)
                                                        if (nn < 5 || substr(FileName, nn - 3, nn) != ".eps") 
                                                                FileName <- paste(FileName, ".eps", sep = "")
                                                        postscript(FileName, width = 8, height = 8)
                                                        plotFunctiond(screen = FALSE)
                                                        dev.off()
                                                }#end if (nchar(FileName))
                                        }#end SaveFilePng <- function()
                                        
                                        projections <- function(project)
                                        {                			
                                                proj<<-project
                                                if(proj=="normal")
                                                {
                                                        tkrreplot(img)
                                                        return()
                                                }#end if(proj=="normal")
                                                if(proj=="v") 
                                                {
                                                        wproj <- tktoplevel()
                                                        tkwm.title(wproj, "Select variable")
                                                        
                                                        scrproj <- tkscrollbar(wproj, repeatinterval=5, command=function(...)tkyview(tlproj,...))
                                                        tlproj<-tklistbox(wproj,height=6,width=42,yscrollcommand=function(...)tkset(scrproj,...),background="white")
                                                        
                                                        for (i in 1:dim(x)[2])
                                                        {
                                                                tkinsert(tlproj,"end",textvariables[i])
                                                        }#end for (i in 1:Numbercuant)
                                                        
                                                        tkselection.set(tlproj,0) #  Indexing starts at zero.
                                                        
                                                        OnOKproj <- function()
                                                        {
                                                                Choiceproj <<- as.numeric(tkcurselection(tlproj))+1
                                                                tkdestroy(wproj)
                                                                tkrreplot(img)
                                                        }#end OnOKproj <- function()
                                                        
                                                        OK.butp <- tkbutton(wproj, text = "   OK   ", command = OnOKproj)
                                                        tkpack(tlproj,scrproj,expand = "TRUE", side="left", fill = "both")
                                                        tkpack.configure(scrproj,side="left")
                                                        tkpack(OK.butp,expand = "TRUE", side="left", fill = "both")
                                                        tkfocus(wproj)
                                                        tkwait.window(wproj)
                                                }#end if       
                                        }#end projections <-function()
                                        
                                        clusterbip <- function(cl)
                                        {
                                                clb<<-cl
                                                if(clb=="h")
                                                {
                                                        wclust <- tktoplevel()
                                                        tkwm.title(wclust, "Hierarchical clustering")
                                                        
                                                        framehier<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                        framehier1<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                        framehier2<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                        framehier3<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                        
                                                        linkm <- c("ward.D","ward.D2","single","complete","average","mcquitty","median","centroid")
                                                        distancias <- c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")
                                                        
                                                        comboBoxdist <- tkwidget(framehier2,"ComboBox",editable=FALSE,values=distancias,width=10, text= distancias[1])
                                                        comboBoxlink <- tkwidget(framehier2,"ComboBox",editable=FALSE,values=linkm,width=10, text= linkm[1])
                                                        
                                                        
                                                        OnOKclust <- function()
                                                        {
                                                                distchoos<<-distancias[as.numeric(tclvalue(tcl(comboBoxdist,"getvalue")))+1]
                                                                linkchoos<<-linkm[as.numeric(tclvalue(tcl(comboBoxlink,"getvalue")))+1]
                                                                nclust <<- tclvalue(n_clust)
                                                                hc<<-hclust(dist(coindividuosnam, method=distchoos), method=linkchoos)
                                                                pertb<<-cutree(hc, k=nclust)
                                                                pert<<-pertb
                                                                for(i in 1:nclust)
                                                                {
                                                                        pert[which(pertb==i)]<<-unique(pertb[hc$order])[i]
                                                                }
                                                                dcolor<<-colour_clusters(hc, nclust, col=unique(pert)+1)
                                                                plot(dcolor)
                                                                tkdestroy(wclust)
                                                                tkrreplot(img)
                                                        }#end OnOKclust <- function()
                                                        
                                                        
                                                        n_clust<-tclVar(nclust)
                                                        entry.clust <-tkentry(framehier2, width="50",textvariable=n_clust, bg="white")
                                                        tkbind(entry.clust, "<Return>",OnOKclust)
                                                        
                                                        OK.butc <- tkbutton(framehier3, text = "   OK   ", command = OnOKclust)
                                                        
                                                        tkpack(tklabel(framehier1,text="Number of cluster:    "),
                                                               tklabel(framehier1,text="Distance:     "),
                                                               tklabel(framehier1,text="Link method:   "), expand = "TRUE", side="top", fill = "both")
                                                        
                                                        tkpack(OK.butc, expand = "TRUE", side="left", fill = "both")
                                                        tkpack(entry.clust, comboBoxdist, comboBoxlink, expand = "TRUE", side="top", fill = "both")
                                                        
                                                        #tkpack(framehier21, framehier22, framehier23, side="top", expand="TRUE", fill="both")
                                                        tkpack(framehier1, framehier2, side="left", expand="TRUE", fill="both")
                                                        tkpack(framehier, framehier3, side="top", expand="TRUE", fill="both")
                                                        
                                                        tkfocus(wclust)
                                                        tkwait.window(wclust)
                                                        
                                                }else{
                                                        if(clb=="km")
                                                        {
                                                                wclust <- tktoplevel()
                                                                tkwm.title(wclust, "K-means")
                                                                
                                                                framehier<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                framehier1<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                framehier2<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                framehier3<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                
                                                                algoritmo <- c("Hartigan-Wong", "Lloyd", "Forgy", "MacQueen")
                                                                
                                                                comboBoxalg <- tkwidget(framehier2,"ComboBox",editable=FALSE,values=algoritmo,width=10, text= algoritmo[1])
                                                                
                                                                
                                                                OnOKclust <- function()
                                                                {
                                                                        algorchoos<<-algoritmo[as.numeric(tclvalue(tcl(comboBoxalg,"getvalue")))+1]
                                                                        nclust <<- tclvalue(n_clust)
                                                                        niterclust <<- tclvalue(n_iter)
                                                                        nstart <<- tclvalue(n_start)
                                                                        
                                                                        
                                                                        hc<<-kmeans(coindividuosnam, centers=nclust, iter.max=niterclust, nstart=nstart)
                                                                        pertb<<-hc$cluster
                                                                        pertcentr<<-pertb
                                                                        pert<<-pertb
                                                                        for(i in 1:length(unique(pertb)))
                                                                        {
                                                                                pert[which(pertb==unique(pertb)[i])]<<-i
                                                                        }
                                                                        pertb<<-pert
                                                                        tkdestroy(wclust)
                                                                        tkrreplot(img)
                                                                }#end OnOKclust <- function()
                                                                
                                                                
                                                                n_clust<-tclVar(nclust)
                                                                entry.clust <-tkentry(framehier2, width="50",textvariable=n_clust, bg="white")
                                                                tkbind(entry.clust, "<Return>",OnOKclust)
                                                                
                                                                n_iter<-tclVar(niterclust)
                                                                entry.iterclus <-tkentry(framehier2, width="50",textvariable=n_iter, bg="white")
                                                                tkbind(entry.iterclus, "<Return>",OnOKclust)
                                                                
                                                                n_start<-tclVar(nstart)
                                                                entry.start <-tkentry(framehier2, width="50",textvariable=n_start, bg="white")
                                                                tkbind(entry.start, "<Return>",OnOKclust)
                                                                
                                                                OK.butc <- tkbutton(framehier3, text = "   OK   ", command = OnOKclust)
                                                                
                                                                tkpack(tklabel(framehier1,text="Algorithm:    "),
                                                                       tklabel(framehier1,text="Number of cluster:    "),
                                                                       tklabel(framehier1,text="Iterations:     "),
                                                                       tklabel(framehier1,text="Random sets:   "), expand = "TRUE", side="top", fill = "both")
                                                                
                                                                tkpack(OK.butc, expand = "TRUE", side="left", fill = "both")
                                                                tkpack(comboBoxalg, entry.clust, entry.iterclus, entry.start, expand = "TRUE", side="top", fill = "both")
                                                                
                                                                #tkpack(framehier21, framehier22, framehier23, side="top", expand="TRUE", fill="both")
                                                                tkpack(framehier1, framehier2, side="left", expand="TRUE", fill="both")
                                                                tkpack(framehier, framehier3, side="top", expand="TRUE", fill="both")
                                                                
                                                                tkfocus(wclust)
                                                                tkwait.window(wclust)  
                                                        }else{
                                                                if(clb=="kmed")
                                                                {
                                                                        wclust <- tktoplevel()
                                                                        tkwm.title(wclust, "K-medoids")
                                                                        
                                                                        framehier<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                        framehier1<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                        framehier2<-tkframe(framehier, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                        framehier3<-tkframe(wclust, relief = "ridge", borderwidth = 2, background = "whitesmoke", height=40)
                                                                        
                                                                        distancias <- c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")
                                                                        
                                                                        comboBoxdist <- tkwidget(framehier2,"ComboBox",editable=FALSE,values=distancias,width=10, text= distancias[1])
                                                                        
                                                                        
                                                                        OnOKclust <- function()
                                                                        {
                                                                                distchoos<<-distancias[as.numeric(tclvalue(tcl(comboBoxdist,"getvalue")))+1]
                                                                                nclust <<- tclvalue(n_clust)
                                                                                
                                                                                pamx<<-pam(dist(coindividuosnam, method=distchoos), k=nclust, diss=TRUE)
                                                                                pertb<<-pamx$clustering
                                                                                tkdestroy(wclust)
                                                                                tkrreplot(img)
                                                                        }#end OnOKclust <- function()
                                                                        
                                                                        
                                                                        n_clust<-tclVar(nclust)
                                                                        entry.clust <-tkentry(framehier2, width="50",textvariable=n_clust, bg="white")
                                                                        tkbind(entry.clust, "<Return>",OnOKclust)
                                                                        
                                                                        
                                                                        OK.butc <- tkbutton(framehier3, text = "   OK   ", command = OnOKclust)
                                                                        
                                                                        tkpack(tklabel(framehier1,text="Distance:    "),
                                                                               tklabel(framehier1,text="Number of cluster:    "), expand = "TRUE", side="top", fill = "both")
                                                                        
                                                                        tkpack(OK.butc, expand = "TRUE", side="left", fill = "both")
                                                                        tkpack(comboBoxdist, entry.clust, expand = "TRUE", side="top", fill = "both")
                                                                        
                                                                        #tkpack(framehier21, framehier22, framehier23, side="top", expand="TRUE", fill="both")
                                                                        tkpack(framehier1, framehier2, side="left", expand="TRUE", fill="both")
                                                                        tkpack(framehier, framehier3, side="top", expand="TRUE", fill="both")
                                                                        
                                                                        tkfocus(wclust)
                                                                        tkwait.window(wclust)  
                                                                        
                                                                }else{
                                                                        tkrreplot(img)
                                                                        return()
                                                                }
                                                        }
                                                }
                                        }#end clusterbip
                                        
                                        showaxes <- function()
                                        {
                                                if(cbVal=="1")
                                                {
                                                        cbVal<<-"0"
                                                        tkrreplot(img)
                                                }else{
                                                        cbVal<<-"1"
                                                        tkrreplot(img)
                                                }#end if(cbVal=="1")        
                                        }#end showaxes
                                        
                                        changetit <- function()
                                        {
                                                ctwin<-tktoplevel()
                                                tkwm.title(ctwin,"Change title")
                                                OnOKchantit <- function()
                                                {
                                                        tit_graph <<- tclvalue(tit_gr)
                                                        tkrreplot(img)
                                                        tkdestroy(ctwin)
                                                        
                                                }
                                                OK.butchantit<-tkbutton(ctwin,text=" Change ", command=OnOKchantit,  bg= "lightblue", width=20, foreground = "navyblue")
                                                tkbind(OK.butchantit, "<Return>",OnOKchantit)
                                                
                                                tit_gr<-tclVar(tit_graph)
                                                entry.tit <-tkentry(ctwin, width="50",textvariable=tit_gr, bg="white")
                                                tkbind(entry.tit, "<Return>",OnOKchantit)
                                                
                                                
                                                tkpack(tklabel(ctwin,text="New title:    "),entry.tit, expand = "TRUE", side="left", fill = "both")
                                                tkpack(OK.butchantit)
                                                
                                                tkfocus(ctwin)
                                                
                                        }#end changetit
                                        
                                        
                                        g3d<-function()
                                        {
                                                if (nejes>2)
                                                { 
                                                        zCoords<-datos[,dim3]
                                                        bg3d("white")
                                                        aspect3d("iso")
                                                        lims <- par3d("bbox")
                                                        if (cbVal=="1"){
                                                                axes3d()
                                                        }#end if (cbVal=="1")
                                                        
                                                        points3d(xCoords,yCoords,zCoords, color=colores)
                                                        texts3d(xCoords, yCoords, zCoords,labelsVec,color=colores, cex= as.numeric(sizesVec))
                                                        
                                                        for (i in 1:(dim(covariables)[1]))
                                                        {
                                                                linea<-rbind(covariables[i,c(dim1, dim2, dim3)],c(0,0,0))	
                                                                segments3d(linea[,1],linea[,2], linea[,3],color=colvariables[i])
                                                        }#end for (i in 1:(dim(covariables)[1]))
                                                        
                                                        rgl.bringtotop()
                                                }else{
                                                        msg <- "You have selected less than 3 dimensions. 3D-graph not available"
                                                        tkmessageBox(message=msg)
                                                }#end if (nejes>2)
                                                
                                        }#end g3d<-function()
                                        
                                        bootmulti<-function()
                                        {
                                                wboot<-tktoplevel()
                                                tkwm.title(wboot,"Bootstrap")
                                                #### Frames
                                                
                                                framewi<-tkframe(wboot, relief = "flat", borderwidth = 2, background = "white")
                                                framewi1<-tkframe(framewi, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi2<-tkframe(framewi, relief = "ridge", borderwidth = 2, background = "white")
                                                
                                                framewi21<-tkframe(framewi2, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi21i<-tkframe(framewi21, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi21a<-tkframe(framewi21, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi21f<-tkframe(framewi21, relief = "ridge", borderwidth = 2, background = "white")
                                                
                                                framewi21ft<-tkframe(framewi21f, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi21fb<-tkframe(framewi21f, relief = "ridge", borderwidth = 2, background = "white")
                                                
                                                framewi21fl<-tkframe(framewi21fb, relief = "ridge", borderwidth = 2, background = "white")
                                                framewi21fr<-tkframe(framewi21fb, relief = "ridge", borderwidth = 2, background = "white")
                                                
                                                framewi22<-tkframe(framewi2, relief = "flat", borderwidth = 2, background = "white")
                                                framewi22c<-tkframe(framewi22, relief = "flat", borderwidth = 2, background = "white")
                                                framewi22l<-tkframe(framewi22, relief = "flat", borderwidth = 2, background = "white")
                                                
                                                framewi221c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi222c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi223c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi224c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi225c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi226c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi227c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi228c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi229c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2210c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2211c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2212c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2213c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2214c<-tkframe(framewi22c, relief = "flat", borderwidth = 2, background = "white")
                                                
                                                framewi221l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi222l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi223l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi224l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi225l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi226l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")        
                                                framewi227l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi228l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi229l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2210l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2211l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2212l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2213l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewi2214l<-tkframe(framewi22l, relief = "flat", borderwidth = 2, background = "white")
                                                framewigr<-tkframe(wboot, relief = "flat", borderwidth = 2, background = "white")
                                                
                                                fontHeading <- tkfont.create(family="times",size=24,weight="bold",slant="italic")
                                                fontFixedWidth <- tkfont.create(family="courier",size=12)
                                                tkpack(tklabel(framewi1, text="    "), expand = "TRUE", side="left",expand="TRUE", fill = "both")
                                                tkpack(tklabel(framewi1,text="BOOTSTRAP",font=fontHeading, foreground = "blue"), expand = "TRUE", side="left", fill = "both")
                                                tkpack(tklabel(framewi1, text="    "), expand = "TRUE", side="left",expand="TRUE", fill = "both")
                                                
                                                
                                                ######Iterations   ###################################
                                                Niter <- tclVar(niter)
                                                entry.Niter <-tkentry(framewi21i,width=10,textvariable=Niter, bg="white")
                                                tkconfigure(entry.Niter,textvariable=Niter)  		
                                                
                                                tkpack(tklabel(framewi21i, text="Number of resamples"),entry.Niter, expand = "TRUE", side="left", fill = "both")
                                                
                                                ######alpha confidence intervals ###################################
                                                Nalpha <- tclVar(alphaic)
                                                entry.Nalpha <-tkentry(framewi21a,width=10,textvariable=Nalpha, bg="white")
                                                tkconfigure(entry.Nalpha,textvariable=Nalpha)
                                                
                                                tkpack(tklabel(framewi21a, text="Confidence Level     "),entry.Nalpha, expand = "TRUE", side="left", fill = "both")
                                                
                                                
                                                tkpack(framewi21fl, framewi21fr, expand = "TRUE",side="left", fill="both")
                                                tkpack(framewi21ft, framewi21fb, expand = "TRUE",side="top", fill="both")
                                                tkpack(framewi21i, framewi21a, framewi21f, expand = "TRUE",side="top", fill="both")
                                                
                                                
                                                ###### Parameters to estimate   ###################################
                                                tkpack(tklabel(framewi221l, text="Calculate confidence intervals for:"), expand = "TRUE", side="left",expand="TRUE", fill = "both")
                                                tkpack(tklabel(framewi221c, text=" "), expand = "TRUE", side="left",expand="TRUE", fill = "both")
                                                
                                                ##### Checkbox bonajuste  #######
                                                
                                                cbonajuste <- tkcheckbutton(framewi222c)
                                                cbonajusteValue <- tclVar("0")
                                                tkconfigure(cbonajuste,variable=cbonajusteValue)
                                                
                                                ##### Checkbox calfilas  #######
                                                
                                                ccalfilas <- tkcheckbutton(framewi223c)
                                                ccalfilasValue <- tclVar("0")
                                                tkconfigure(ccalfilas,variable=ccalfilasValue)
                                                
                                                ##### Checkbox calcol  #######
                                                
                                                ccalcol <- tkcheckbutton(framewi224c)
                                                ccalcolValue <- tclVar("0")
                                                tkconfigure(ccalcol,variable=ccalcolValue)
                                                
                                                ##### Checkbox CRTi  #######
                                                
                                                ccrti <- tkcheckbutton(framewi225c)
                                                ccrtiValue <- tclVar("0")
                                                tkconfigure(ccrti, variable=ccrtiValue)
                                                
                                                ##### Checkbox CRTj  #######
                                                
                                                ccrtj <- tkcheckbutton(framewi226c)
                                                ccrtjValue <- tclVar("0")
                                                tkconfigure(ccrtj,variable=ccrtjValue)
                                                
                                                ##### Checkbox CRTt #######
                                                
                                                ccrtt <- tkcheckbutton(framewi227c)
                                                ccrttValue <- tclVar("0")
                                                tkconfigure(ccrtt, variable=ccrttValue)
                                                
                                                ##### Checkbox CREiFq #######
                                                
                                                ccreifq <- tkcheckbutton(framewi228c)
                                                ccreifqValue <- tclVar("0")
                                                tkconfigure(ccreifq,variable=ccreifqValue)
                                                
                                                ##### Checkbox CREjFq #######
                                                
                                                ccrejfq <- tkcheckbutton(framewi229c)
                                                ccrejfqValue <- tclVar("0")
                                                tkconfigure(ccrejfq, variable=ccrejfqValue)
                                                
                                                ##### Checkbox CRGtFq #######
                                                
                                                ccrgtfq <- tkcheckbutton(framewi2210c)
                                                ccrgtfqValue <- tclVar("0")
                                                tkconfigure(ccrgtfq, variable=ccrgtfqValue)
                                                
                                                ##### Checkbox CRFqEi #######
                                                
                                                ccrfqei <- tkcheckbutton(framewi2211c)
                                                ccrfqeiValue <- tclVar("0")
                                                tkconfigure(ccrfqei, variable=ccrfqeiValue)
                                                
                                                ##### Checkbox CRFqEj #######
                                                
                                                ccrfqej <- tkcheckbutton(framewi2212c)
                                                ccrfqejValue <- tclVar("0")
                                                tkconfigure(ccrfqej, variable=ccrfqejValue)
                                                
                                                ##### Checkbox CRFqGt #######
                                                
                                                ccrfqgt <- tkcheckbutton(framewi2213c)
                                                ccrfqgtValue <- tclVar("0")
                                                tkconfigure(ccrfqgt, variable=ccrfqgtValue)
                                                
                                                ##### Checkbox Eigenvalues #######
                                                
                                                ceigen <- tkcheckbutton(framewi2214c)
                                                ceigenValue <- tclVar("0")
                                                tkconfigure(ceigen,variable=ceigenValue)
                                                
                                                
                                                tkpack(tklabel(framewi21ft,text="Save files as:"),
                                                       expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                cpdf <- tkradiobutton(framewi21fl)
                                                cpdfb <- tkradiobutton(framewi21fl)
                                                rbpdfValue <- tclVar("Color pdf")
                                                tkconfigure(cpdf,variable=rbpdfValue,value="Color pdf")
                                                tkconfigure(cpdfb,variable=rbpdfValue,value="Black and white pdf")
                                                tkpack(tklabel(framewi21fl,text="Color pdf"),cpdf,
                                                       expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                tkpack(tklabel(framewi21fl,text="Black and white pdf"),cpdfb,
                                                       expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                
                                                
                                                ceps <- tkradiobutton(framewi21fr)
                                                cepsb <- tkradiobutton(framewi21fr)
                                                rbepsValue <- tclVar("Color eps")
                                                tkconfigure(ceps,variable=rbepsValue,value="Color eps")
                                                tkconfigure(cepsb,variable=rbepsValue,value="Black and white eps")
                                                tkpack(tklabel(framewi21fr,text="Color eps"),ceps,
                                                       expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                tkpack(tklabel(framewi21fr,text="Black and white eps"),cepsb,
                                                       expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                
                                                
                                                
                                                tkpack( tklabel(framewi222l, text="-Goodnes of Fit", anchor="nw"), 
                                                        tklabel(framewi223l, text="-Quality of approximation for rows", anchor="nw"), 
                                                        tklabel(framewi224l, text="-Quality of approximation for columns", anchor="nw"),
                                                        tklabel(framewi225l, text="-Relative contribution to total variability of the row element i", anchor="nw"),
                                                        tklabel(framewi226l, text="-Relative contribution to total variability of the column element j", anchor="nw"),
                                                        tklabel(framewi227l, text="-Relative contribution of the set t to total variability", anchor="nw"),
                                                        tklabel(framewi228l, text="-Relative contribution of the row element i to the factor q-th", anchor="nw"),
                                                        tklabel(framewi229l, text="-Relative contribution of the column element j to the factor q-th", anchor="nw"),
                                                        tklabel(framewi2210l, text="-Relative contribution of the set t to the factor q-th", anchor="nw"),
                                                        tklabel(framewi2211l, text="-Relative contribution of the factor q-th to row element i", anchor="nw"),
                                                        tklabel(framewi2212l, text="-Relative contribution of the factor q-th to column element j", anchor="nw"),
                                                        tklabel(framewi2213l, text="-Relative contribution of the factor q-th to the set t", anchor="nw"),
                                                        tklabel(framewi2214l, text="-Eigenvalues", anchor="nw"),
                                                        expand = "FALSE", side="top",expand="TRUE", fill = "both")
                                                
                                                tkpack(cbonajuste, ccalfilas, ccalcol, ccrti,ccrtj,ccrtt,
                                                       ccreifq,ccrejfq, ccrgtfq, ccrfqei, ccrfqej, ccrfqgt,
                                                       ceigen,
                                                       expand = "TRUE",side="top", fill="both")
                                                tkpack(framewi221l,framewi222l,framewi223l,framewi224l,framewi225l,framewi226l,framewi227l,framewi228l,framewi229l,
                                                       framewi2210l,framewi2211l,framewi2212l,
                                                       framewi2213l, framewi2214l, expand = "TRUE",side="top", fill="both")
                                                tkpack(framewi221c,framewi222c,framewi223c,framewi224c,framewi225c,framewi226c,framewi227c,framewi228c,framewi229c,
                                                       framewi2210c,framewi2211c,framewi2212c,
                                                       framewi2213c, framewi2214c, expand = "TRUE",side="top", fill="both")
                                                tkpack(framewi22c, framewi22l, expand = "TRUE",side="left", fill="both")
                                                
                                                OnOKboot<-function()
                                                {
                                                        tkdestroy(wboot) 
                                                        niter <<- tclvalue(Niter)
                                                        alphaic <<- tclvalue(Nalpha)
                                                        cbonajusteVal <<- as.character(tclvalue(cbonajusteValue))
                                                        ccalfilasVal <<- as.character(tclvalue(ccalfilasValue))
                                                        ccalcolVal <<- as.character(tclvalue(ccalcolValue))
                                                        ccrtiVal <<- as.character(tclvalue(ccrtiValue))
                                                        ccrtjVal <<- as.character(tclvalue(ccrtjValue))
                                                        ccrttVal <<- as.character(tclvalue(ccrttValue))
                                                        ccreifqVal <<- as.character(tclvalue(ccreifqValue))
                                                        ccrejfqVal <<- as.character(tclvalue(ccrejfqValue))
                                                        ccrgtfqVal <<- as.character(tclvalue(ccrgtfqValue))
                                                        ccrfqeiVal <<- as.character(tclvalue(ccrfqeiValue))
                                                        ccrfqejVal <<- as.character(tclvalue(ccrfqejValue))
                                                        ccrfqgtVal <<- as.character(tclvalue(ccrfqgtValue))
                                                        ceigenVal <<- as.character(tclvalue(ceigenValue))
                                                        
                                                        cpdfVal <<- as.character(tclvalue(rbpdfValue))
                                                        cepsVal <<- as.character(tclvalue(rbepsValue))
                                                        
                                                        ## muestra bootstrap
                                                        #muestraboot<-remuestreomulti(matrices)
                                                        tablas<-as.list(1:length(matrices))
                                                        indices<-lapply(matrices, function(x){1:dim(x)[1]}) 
                                                        textostotales<-mapply(function(x,y){paste(x,y, sep=".")}, tablas, indices, SIMPLIFY=FALSE)
                                                        textosjack<-unlist(textostotales)
                                                        
                                                        if(filas==1)
                                                        {
                                                                muestrarep<-rep(list(matrices),niter)
                                                                muestrasample<-lapply(muestrarep, resample_boot)
                                                                datosresample<-lapply(muestrasample, function(x)x[[1]])
                                                                textosresample<-lapply(muestrasample, function(x)x[[2]])
                                                                tablasresample<-lapply(muestrasample, function(x)x[[3]])
                                                                bootresult<-mapply(multibiplotint, datosresample, rep(list(nejes),niter), rep(list(tipo),niter), rep(list(filas),niter))
                                                                
                                                                bondadesalm<-bootresult[8,]
                                                                calidadesalm<-bootresult[9,]
                                                                calfilasalm<-bootresult[10,]
                                                                eigenalm<-bootresult[22,]
                                                                crtjalm<-bootresult[14,]
                                                                crejfqalm<-bootresult[16,]
                                                                crfqejalm<-bootresult[18,]
                                                                
                                                                crtiaux<-bootresult[13,]
                                                                indicestab<-sort(unique(unlist(textosresample)))
                                                                tabmat<-cbind(unlist(textosresample), t(array(unlist(strsplit(unlist(textosresample),split="[.]")), dim=c(2,length(unlist(textosresample))))))
                                                                indicestablas<-sort(unique(tabmat[,2]))
                                                                
                                                                crtialm<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(crtiaux))
                                                                
                                                                crttaux<-bootresult[19,]
                                                                crttalm<-lapply(indicestablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(crttaux))
                                                                creifqaux<-bootresult[15,]
                                                                creifqalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        creifqalm[[i]]<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(lapply(creifqaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqeiaux<-bootresult[17,]
                                                                crfqeialm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqeialm[[i]]<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(lapply(crfqeiaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                crgtfqaux<-bootresult[20,]
                                                                crgtfqalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crgtfqalm[[i]]<-lapply(tablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(lapply(crgtfqaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqgtaux<-bootresult[21,]
                                                                crfqgtalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqgtalm[[i]]<-lapply(tablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(lapply(crfqgtaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                
                                                                
                                                                #  jakknife submuestra
                                                                muestratotjack<-lapply(1:length(unlist(textostotales)), function(i){unlist(textostotales)[-i]})
                                                                datosjack<-mapply(remuestreojack, rep(list(matrices), length(muestratotjack)),muestratotjack,SIMPLIFY=FALSE)
                                                                jackresult<-mapply(multibiplotint, datosjack, rep(list(nejes),length(datosjack)), rep(list(tipo),length(datosjack)), rep(list(filas),length(datosjack)))
                                                                
                                                                bondadesjackr<-jackresult[8,]
                                                                calidadesjackr<-jackresult[9,]
                                                                calfilasjackr<-jackresult[10,]
                                                                descomjackr<-jackresult[22,]
                                                                crtjjackr<-jackresult[14,]
                                                                crejfqjackr<-jackresult[16,]
                                                                crfqejjackr<-jackresult[18,]
                                                                
                                                                crtiauxjackr<-jackresult[13,]
                                                                indicestabjackr<-sort(unique(unlist(textosjack)))
                                                                tabmatjackr<-cbind(unlist(textosjack), t(array(unlist(strsplit(unlist(textosjack),split="[.]")), dim=c(2,length(unlist(textosjack))))))
                                                                indicestablasjackr<-sort(unique(tabmatjackr[,2]))
                                                                tablasresamplejackr<-rep(list(tablas), length(datosjack))
                                                                
                                                                crtijackr<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(crtiauxjackr))
                                                                crttauxjackr<-jackresult[19,]
                                                                crttjackr<-lapply(tablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(crttauxjackr))
                                                                creifqauxjackr<-jackresult[15,]
                                                                creifqjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        creifqjackr[[i]]<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(lapply(creifqauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqeiauxjackr<-jackresult[17,]
                                                                crfqeijackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqeijackr[[i]]<-lapply(as.list(textosjack), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(lapply(crfqeiauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                crgtfqauxjackr<-jackresult[20,]
                                                                crgtfqjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crgtfqjackr[[i]]<-lapply(tablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(lapply(crgtfqauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqgtauxjackr<-jackresult[21,]
                                                                crfqgtjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqgtjackr[[i]]<-lapply(tablas, function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(lapply(crfqgtauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                
                                                        }else{
                                                                
                                                                muestrarep<-rep(list(matrices),niter)
                                                                muestrasample<-lapply(muestrarep, resample_bootcol)
                                                                datosresample<-lapply(muestrasample, function(x)x[[1]])
                                                                textosresample<-lapply(muestrasample, function(x)x[[2]])
                                                                tablasresample<-lapply(muestrasample, function(x)x[[3]])
                                                                
                                                                bootresult<-mapply(multibiplotint, datosresample, rep(list(nejes),niter), rep(list(tipo),niter), rep(list(filas),niter))
                                                                
                                                                bondadesalm<-bootresult[8,]
                                                                calidadesalm<-bootresult[9,]
                                                                calfilasalm<-bootresult[10,]
                                                                eigenalm<-bootresult[22,]
                                                                crtjalm<-bootresult[14,]
                                                                crejfqalm<-bootresult[16,]
                                                                crfqejalm<-bootresult[18,]
                                                                
                                                                crtiaux<-bootresult[13,]
                                                                #                                                                 indicestab<-sort(unique(unlist(textosresample)))
                                                                #                                                                 tabmat<-cbind(unlist(textosresample), t(array(unlist(strsplit(unlist(textosresample),split="[.]")), dim=c(2,length(unlist(textosresample))))))
                                                                #                                                                 indicestablas<-sort(unique(tabmat[,2]))
                                                                #                                                                 
                                                                crtialm<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(crtiaux))
                                                                
                                                                crttaux<-bootresult[19,]
                                                                
                                                                crttalm<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(crttaux))
                                                                
                                                                creifqaux<-bootresult[15,]
                                                                creifqalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        creifqalm[[i]]<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(lapply(creifqaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqeiaux<-bootresult[17,]
                                                                crfqeialm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqeialm[[i]]<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(textosresample), unlist(lapply(crfqeiaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                crgtfqaux<-bootresult[20,]
                                                                crgtfqalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crgtfqalm[[i]]<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(lapply(crgtfqaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqgtaux<-bootresult[21,]
                                                                crfqgtalm <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqgtalm[[i]]<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresample), unlist(lapply(crfqgtaux, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                
                                                                
                                                                #  jakknife submuestra
                                                                muestratotjack<-lapply(1:dim(matrices[[1]])[1], function(i){c(1:dim(matrices[[1]])[1])[-i]})
                                                                datosjack<-mapply(remuestreojackcol, rep(list(matrices), length(muestratotjack)),muestratotjack,SIMPLIFY=FALSE)
                                                                jackresult<-mapply(multibiplotint, datosjack, rep(list(nejes),length(datosjack)), rep(list(tipo),length(datosjack)), rep(list(filas),length(datosjack)))
                                                                
                                                                bondadesjackr<-jackresult[8,]
                                                                calidadesjackr<-jackresult[9,]
                                                                calfilasjackr<-jackresult[10,]
                                                                descomjackr<-jackresult[22,]
                                                                crtjjackr<-jackresult[14,]
                                                                crejfqjackr<-jackresult[16,]
                                                                crfqejjackr<-jackresult[18,]
                                                                
                                                                crtiauxjackr<-jackresult[13,]
                                                                #                                                                 indicestabjackr<-sort(unique(unlist(textosjack)))
                                                                #                                                                 tabmatjackr<-cbind(unlist(textosjack), t(array(unlist(strsplit(unlist(textosjack),split="[.]")), dim=c(2,length(unlist(textosjack))))))
                                                                #                                                                 indicestablasjackr<-sort(unique(tabmatjackr[,2]))
                                                                tablasresamplejackr<-rep(list(tablas), length(datosjack))
                                                                
                                                                crtijackr<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(crtiauxjackr))
                                                                crttauxjackr<-jackresult[19,]
                                                                crttjackr<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(crttauxjackr))
                                                                creifqauxjackr<-jackresult[15,]
                                                                creifqjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        creifqjackr[[i]]<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(lapply(creifqauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqeiauxjackr<-jackresult[17,]
                                                                crfqeijackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqeijackr[[i]]<-lapply(as.list(1:dim(matrices[[1]])[1]), function(x, indices, datab) datab[which(indices==x)], unlist(muestratotjack), unlist(lapply(crfqeiauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                crgtfqauxjackr<-jackresult[20,]
                                                                crgtfqjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crgtfqjackr[[i]]<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(lapply(crgtfqauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                crfqgtauxjackr<-jackresult[21,]
                                                                crfqgtjackr <- vector("list",nejes)
                                                                for (i in 1:nejes)
                                                                {
                                                                        crfqgtjackr[[i]]<-lapply(tablasresample[[1]], function(x, indices, datab) datab[which(indices==x)], unlist(tablasresamplejackr), unlist(lapply(crfqgtauxjackr, function(x, ejes) x[,ejes], i)))
                                                                }
                                                                
                                                                
                                                        }
                                                        
                                                        
                                                        ####crear vectores con coordenadas de variables
                                                        coorvarrot<-bootresult[4,]
                                                        coorvarrot<-array(c(unlist(covariables),unlist(coorvarrot)), dim=c(dim(x)[2], nejes, as.numeric(niter)+1))
                                                        
                                                        out.var<-procGPA(coorvarrot, reflect=TRUE, distances=FALSE, pcaoutput=FALSE)
                                                        plot(out.var$rotated[,dim1,], out.var$rotated[,dim2,], type="n", main=paste("Bootstrap Coordinates (Variables)"), xlab=paste("Dimension", dim1), ylab=paste("Dimension", dim2), asp=1/1)
                                                        
                                                        for(i in 1:dim(covariablesnam)[1])
                                                        {
                                                                points(out.var$rotated[i,dim1,],out.var$rotated[i,dim2,], col=colorescoor[i], pch=20)
                                                                
                                                        }
                                                        
                                                        abline(v=0)
                                                        abline(h=0)
                                                        
                                                        
                                                        for(i in 1:dim(covariablesnam)[1])
                                                        {
                                                                hpts <- chull(t(out.var$rotated[i,c(dim1,dim2),]))
                                                                hpts <- c(hpts, hpts[1])
                                                                lines(t(out.var$rotated[i,c(dim1,dim2),hpts]), col=colorescoor[i])
                                                        }
                                                        text(out.var$rotated[,dim1,1], out.var$rotated[,dim2,1], labels=textvariables)
                                                        
                                                        
                                                        
                                                        #########################################################################
                                                        ### Guardar resultados
                                                        #########################################################################
                                                        
                                                        cat("File saved in:    ",file="Resultsbootstrap.txt")
                                                        cat(getwd(),file="temp.txt")					
                                                        file.append("Resultsbootstrap.txt","temp.txt")	
                                                        cat("\n",file="temp.txt")					
                                                        file.append("Resultsbootstrap.txt","temp.txt")
                                                        cat("\n",file="temp.txt")					
                                                        file.append("Resultsbootstrap.txt","temp.txt")		
                                                        
                                                        alphaic <<- tclvalue(Nalpha)
                                                        alphaic <<- as.numeric(alphaic)
                                                        liminf <- (1 - alphaic*0.01) / 2
                                                        limsup <- 1 - (1 - alphaic*0.01) / 2
                                                        
                                                        
                                                        titulo <-c("Obs. Value","Mean","SE","Bias","IC t-boot inf","IC t-boot sup","IC perc inf","IC perc sup","IC BCa inf","IC BCa sup")
                                                        
                                                        
                                                        ### Goodness of fit
                                                        
                                                        if (cbonajusteVal=="1")
                                                        {
                                                                if (tipo != "RCMP"){        	
                                                                        
                                                                        calc.cgf <-c()
                                                                        cgf.mean <-c()
                                                                        se.cgf <-c()
                                                                        sesgo.cgf <-c()
                                                                        ic.t.cgfinf <-c()
                                                                        ic.t.cgfsup <-c()
                                                                        ic.p.cgfinf <-c()
                                                                        ic.p.cgfsup <-c()
                                                                        ic.bca.cgfinf <-c()
                                                                        ic.bca.cgfsup <-c()
                                                                        
                                                                        calc.cgf <-cal.ic(sapply(bondadesalm,function(x) x[1]), liminf, limsup, bonajuste, sapply(bondadesjackr,function(x) x[1]), niter)
                                                                        cgf.mean <- c(cgf.mean, calc.cgf[1])
                                                                        se.cgf <- c(se.cgf,calc.cgf[2])
                                                                        sesgo.cgf <- c(sesgo.cgf,calc.cgf[3])
                                                                        ic.t.cgfinf <- c(ic.t.cgfinf,calc.cgf[4])
                                                                        ic.t.cgfsup <- c(ic.t.cgfsup,calc.cgf[5])
                                                                        ic.p.cgfinf <- c(ic.p.cgfinf,calc.cgf[6])
                                                                        ic.p.cgfsup <- c(ic.p.cgfsup,calc.cgf[7])
                                                                        ic.bca.cgfinf <- c(ic.bca.cgfinf,calc.cgf[8])
                                                                        ic.bca.cgfsup <- c(ic.bca.cgfsup,calc.cgf[9])
                                                                        
                                                                        pdf(paste("Histogram of Goodness of fit", ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(bondadesalm,function(x) x[1]), main="Histogram", xlab="Goodness of fit")
                                                                        
                                                                        if(cpdfVal=="Color pdf")
                                                                        {
                                                                                abline(v=cgf.mean, lwd=2, col="blue")
                                                                                abline(v=bonajuste, lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=cgf.mean, lwd=2)
                                                                                abline(v=bonajuste, lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(bondadesalm,function(x) x[1]))
                                                                        dev.off()
                                                                        
                                                                        
                                                                        postscript(paste("Histogram of Goodness of fit", ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(bondadesalm,function(x) x[1]), main="Histogram", xlab="Goodness of fit")
                                                                        
                                                                        if(cepsVal=="Color eps")
                                                                        {
                                                                                abline(v=cgf.mean, lwd=2, col="blue")
                                                                                abline(v=bonajuste, lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=cgf.mean, lwd=2)
                                                                                abline(v=bonajuste, lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(bondadesalm,function(x) x[1]))
                                                                        dev.off()                                                                               
                                                                        
                                                                        
                                                                        calc.cgf <-array(cbind(bonajuste, cgf.mean, se.cgf, sesgo.cgf, ic.t.cgfinf, ic.t.cgfsup, ic.p.cgfinf, ic.p.cgfsup, ic.bca.cgfinf, ic.bca.cgfsup),
                                                                                         dim=c(1,10))
                                                                        calc.cgf <- as.data.frame(calc.cgf)
                                                                        colnames(calc.cgf) <- titulo
                                                                        rownames(calc.cgf) <-c("Goodnes of Fit")
                                                                        
                                                                        
                                                                        cat("\n",file="temp.txt")					
                                                                        file.append("Resultsbootstrap.txt","temp.txt")	
                                                                        cat("Goodness of fit:  \n",file="temp.txt")					
                                                                        file.append("Resultsbootstrap.txt","temp.txt")					
                                                                        write.table(round(calc.cgf, digits=3),file="temp.txt", sep="\t", dec=",")
                                                                        file.append("Resultsbootstrap.txt","temp.txt")
                                                                }#end if (tipo != "RCMP")
                                                        }#end if (cgfVal=="1")
                                                        
                                                        
                                                        ### Quality of representation rows    
                                                        
                                                        if (ccalfilasVal=="1")
                                                        {
                                                                calc.cci <-c()
                                                                cci.mean <-c()
                                                                se.cci <-c()
                                                                sesgo.cci <-c()
                                                                ic.t.cciinf <-c()
                                                                ic.t.ccisup <-c()
                                                                ic.p.cciinf <-c()
                                                                ic.p.ccisup <-c()
                                                                ic.bca.cciinf <-c()
                                                                ic.bca.ccisup <-c()
                                                                
                                                                calc.cci <-cal.ic(unlist(calfilasalm), liminf, limsup, calfilas, unlist(calfilasjackr), niter)
                                                                cci.mean <- c(cci.mean, calc.cci[1])
                                                                se.cci <- c(se.cci,calc.cci[2])
                                                                sesgo.cci <- c(sesgo.cci,calc.cci[3])
                                                                ic.t.cciinf <- c(ic.t.cciinf,calc.cci[4])
                                                                ic.t.ccisup <- c(ic.t.ccisup,calc.cci[5])
                                                                ic.p.cciinf <- c(ic.p.cciinf,calc.cci[6])
                                                                ic.p.ccisup <- c(ic.p.ccisup,calc.cci[7])
                                                                ic.bca.cciinf <- c(ic.bca.cciinf,calc.cci[8])
                                                                ic.bca.ccisup <- c(ic.bca.ccisup,calc.cci[9])
                                                                
                                                                pdf(paste("Histogram of Quality of Approximation for rows", ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                par(mfrow=c(1,2))
                                                                hist(unlist(calfilasalm), main="Histogram", xlab="Quality of Approximation for rows")
                                                                
                                                                if(cpdfVal=="Color pdf")
                                                                {
                                                                        abline(v=cci.mean, lwd=2, col="blue")
                                                                        abline(v=calfilas, lty =2, lwd=2, col="red")
                                                                }else{
                                                                        abline(v=cci.mean, lwd=2)
                                                                        abline(v=calfilas, lty =2, lwd=2)
                                                                }        
                                                                qqnorm(unlist(calfilasalm))
                                                                dev.off()
                                                                
                                                                
                                                                postscript(paste("Histogram of Quality of Approximation for rows", ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                par(mfrow=c(1,2))
                                                                hist(unlist(calfilasalm), main="Histogram", xlab="Quality of Approximation for rows")
                                                                
                                                                if(cepsVal=="Color eps")
                                                                {
                                                                        abline(v=cci.mean, lwd=2, col="blue")
                                                                        abline(v=calfilas, lty =2, lwd=2, col="red")
                                                                }else{
                                                                        abline(v=cci.mean, lwd=2)
                                                                        abline(v=calfilas, lty =2, lwd=2)
                                                                }        
                                                                qqnorm(unlist(calfilasalm))
                                                                dev.off()                                                                               
                                                                
                                                                
                                                                calc.cci <-array(cbind(calfilas, cci.mean, se.cci, sesgo.cci, ic.t.cciinf, ic.t.ccisup, ic.p.cciinf, ic.p.ccisup, ic.bca.cciinf, ic.bca.ccisup),
                                                                                 dim=c(1,10))
                                                                calc.cci <- as.data.frame(calc.cci)
                                                                colnames(calc.cci) <- titulo
                                                                rownames(calc.cci) <-c("Quality of Approximation for rows")
                                                                
                                                                
                                                                cat("\n",file="temp.txt")        				
                                                                file.append("Resultsbootstrap.txt","temp.txt")	
                                                                cat("Quality of approximation for rows:  \n",file="temp.txt")					
                                                                file.append("Resultsbootstrap.txt","temp.txt")					
                                                                write.table(round(calc.cci, digits=3),file="temp.txt", sep="\t", dec=",")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                        }#end if (ccalfilasVal=="1")
                                                        
                                                        ### Quality of representation     
                                                        
                                                        if (ccalcolVal=="1")
                                                        {
                                                                calc.ccr <-c()
                                                                ccr.mean <-c()
                                                                se.ccr <-c()
                                                                sesgo.ccr <-c()
                                                                ic.t.ccrinf <-c()
                                                                ic.t.ccrsup <-c()
                                                                ic.p.ccrinf <-c()
                                                                ic.p.ccrsup <-c()
                                                                ic.bca.ccrinf <-c()
                                                                ic.bca.ccrsup <-c()
                                                                
                                                                calc.ccr <-cal.ic(sapply(calidadesalm,function(x) x[1]), liminf, limsup, calcol, sapply(calidadesjackr,function(x) x[1]), niter)
                                                                ccr.mean <- c(ccr.mean, calc.ccr[1])
                                                                se.ccr <- c(se.ccr,calc.ccr[2])
                                                                sesgo.ccr <- c(sesgo.ccr,calc.ccr[3])
                                                                ic.t.ccrinf <- c(ic.t.ccrinf,calc.ccr[4])
                                                                ic.t.ccrsup <- c(ic.t.ccrsup,calc.ccr[5])
                                                                ic.p.ccrinf <- c(ic.p.ccrinf,calc.ccr[6])
                                                                ic.p.ccrsup <- c(ic.p.ccrsup,calc.ccr[7])
                                                                ic.bca.ccrinf <- c(ic.bca.ccrinf,calc.ccr[8])
                                                                ic.bca.ccrsup <- c(ic.bca.ccrsup,calc.ccr[9])
                                                                
                                                                pdf(paste("Histogram of Quality of Approximation for columns", ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                par(mfrow=c(1,2))
                                                                hist(sapply(calidadesalm,function(x) x[1]), main="Histogram", xlab="Quality of Approximation for columns")
                                                                
                                                                if(cpdfVal=="Color pdf")
                                                                {
                                                                        abline(v=ccr.mean, lwd=2, col="blue")
                                                                        abline(v=calcol, lty =2, lwd=2, col="red")
                                                                }else{
                                                                        abline(v=ccr.mean, lwd=2)
                                                                        abline(v=calcol, lty =2, lwd=2)
                                                                }        
                                                                qqnorm(sapply(calidadesalm,function(x) x[1]))
                                                                dev.off()
                                                                
                                                                
                                                                postscript(paste("Histogram of Quality of Approximation for columns", ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                par(mfrow=c(1,2))
                                                                hist(sapply(calidadesalm,function(x) x[1]), main="Histogram", xlab="Quality of Approximation for columns")
                                                                
                                                                if(cepsVal=="Color eps")
                                                                {
                                                                        abline(v=ccr.mean, lwd=2, col="blue")
                                                                        abline(v=calcol, lty =2, lwd=2, col="red")
                                                                }else{
                                                                        abline(v=ccr.mean, lwd=2)
                                                                        abline(v=calcol, lty =2, lwd=2)
                                                                }        
                                                                qqnorm(sapply(calidadesalm,function(x) x[1]))
                                                                dev.off()                                                                               
                                                                
                                                                
                                                                calc.ccr <-array(cbind(calcol, ccr.mean, se.ccr, sesgo.ccr, ic.t.ccrinf, ic.t.ccrsup, ic.p.ccrinf, ic.p.ccrsup, ic.bca.ccrinf, ic.bca.ccrsup),
                                                                                 dim=c(1,10))
                                                                calc.ccr <- as.data.frame(calc.ccr)
                                                                colnames(calc.ccr) <- titulo
                                                                rownames(calc.ccr) <-c("Quality of Approximation for columns")
                                                                
                                                                
                                                                cat("\n",file="temp.txt")        				
                                                                file.append("Resultsbootstrap.txt","temp.txt")	
                                                                cat("Quality of approximation for columns:  \n",file="temp.txt")					
                                                                file.append("Resultsbootstrap.txt","temp.txt")					
                                                                write.table(round(calc.ccr, digits=3),file="temp.txt", sep="\t", dec=",")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                        }#end if (ccalcolVal=="1")
                                                        
                                                        
                                                        
                                                        
                                                        ### Relative contribution to total variability
                                                        
                                                        if (ccrtiVal=="1")
                                                        {
                                                                calc.crti <-c()
                                                                crti.mean <-c()
                                                                se.crti <-c()
                                                                sesgo.crti <-c()
                                                                ic.t.crtiinf <-c()
                                                                ic.t.crtisup <-c()
                                                                ic.p.crtiinf <-c()
                                                                ic.p.crtisup <-c()
                                                                ic.bca.crtiinf <-c()
                                                                ic.bca.crtisup <-c()
                                                                
                                                                
                                                                for (i in 1:dim(CRTi)[1])
                                                                {
                                                                        
                                                                        calc.crti <-cal.ic(crtialm[[i]], liminf, limsup, CRTi[i,1], crtijackr[[i]], niter)
                                                                        crti.mean <- c(crti.mean, calc.crti[1])
                                                                        se.crti <- c(se.crti,calc.crti[2])
                                                                        sesgo.crti <- c(sesgo.crti,calc.crti[3])
                                                                        ic.t.crtiinf <- c(ic.t.crtiinf,calc.crti[4])
                                                                        ic.t.crtisup <- c(ic.t.crtisup,calc.crti[5])
                                                                        ic.p.crtiinf <- c(ic.p.crtiinf,calc.crti[6])
                                                                        ic.p.crtisup <- c(ic.p.crtisup,calc.crti[7])
                                                                        ic.bca.crtiinf <- c(ic.bca.crtiinf,calc.crti[8])
                                                                        ic.bca.crtisup <- c(ic.bca.crtisup,calc.crti[9])
                                                                        
                                                                        pdf(paste("Histogram of contribution to total variability of individual", i, ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(crtialm, function(x) x[[i]]), main="Histogram", xlab=paste("CRT of individual", i))
                                                                        
                                                                        if(cpdfVal=="Color pdf")
                                                                        {
                                                                                abline(v=crti.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTi[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crti.mean[i], lwd=2)
                                                                                abline(v=CRTi[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(crtialm, function(x) x[[i]]))
                                                                        dev.off()
                                                                        
                                                                        
                                                                        postscript(paste("Histogram of contribution to total variability of individual", i, ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(crtialm, function(x) x[[i]]), main="Histogram", xlab=paste("CRT of individual", i))
                                                                        
                                                                        if(cepsVal=="Color eps")
                                                                        {
                                                                                abline(v=crti.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTi[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crti.mean[i], lwd=2)
                                                                                abline(v=CRTi[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(crtialm, function(x) x[[i]]))
                                                                        dev.off()                                                                               
                                                                        
                                                                }#end for (i in 1:length(crtialm))
                                                                
                                                                calc.crti <-array(cbind(CRTi[,1],crti.mean, se.crti, sesgo.crti, ic.t.crtiinf, ic.t.crtisup, ic.p.crtiinf, ic.p.crtisup, ic.bca.crtiinf, ic.bca.crtisup),
                                                                                  dim=c(dim(CRTi)[1],10))
                                                                calc.crti <- as.data.frame(calc.crti)
                                                                colnames(calc.crti) <- titulo
                                                                rownames(calc.crti) <- textindividuos
                                                                
                                                                cat("\n",file="temp.txt")        				
                                                                file.append("Resultsbootstrap.txt","temp.txt")	
                                                                cat("Relative contribution to total variability of the row element i:\n",file="temp.txt")					
                                                                file.append("Resultsbootstrap.txt","temp.txt")					
                                                                write.table(round(calc.crti, digits=3),file="temp.txt", sep="\t",dec=",")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                        }#end if (ccrtiVal=="1")
                                                        
                                                        ### Relative contribution to total variability
                                                        
                                                        
                                                        if (ccrtjVal=="1")
                                                        {
                                                                calc.crtj <-c()
                                                                crtj.mean <-c()
                                                                se.crtj <-c()
                                                                sesgo.crtj <-c()
                                                                ic.t.crtjinf <-c()
                                                                ic.t.crtjsup <-c()
                                                                ic.p.crtjinf <-c()
                                                                ic.p.crtjsup <-c()
                                                                ic.bca.crtjinf <-c()
                                                                ic.bca.crtjsup <-c()
                                                                
                                                                for (i in 1:dim(CRTj)[1])
                                                                {
                                                                        calc.crtj <-cal.ic(sapply(crtjalm, function(x) x[i,1]), liminf, limsup, CRTj[i,1], sapply(crtjjackr, function(x) x[i,1]), niter)
                                                                        crtj.mean <- c(crtj.mean, calc.crtj[1])
                                                                        se.crtj <- c(se.crtj,calc.crtj[2])
                                                                        sesgo.crtj <- c(sesgo.crtj,calc.crtj[3])
                                                                        ic.t.crtjinf <- c(ic.t.crtjinf,calc.crtj[4])
                                                                        ic.t.crtjsup <- c(ic.t.crtjsup,calc.crtj[5])
                                                                        ic.p.crtjinf <- c(ic.p.crtjinf,calc.crtj[6])
                                                                        ic.p.crtjsup <- c(ic.p.crtjsup,calc.crtj[7])
                                                                        ic.bca.crtjinf <- c(ic.bca.crtjinf,calc.crtj[8])
                                                                        ic.bca.crtjsup <- c(ic.bca.crtjsup,calc.crtj[9])
                                                                        
                                                                        pdf(paste("Histogram of contribution to total variability of variable", i, ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(crtjalm, function(x) x[i,1]), main="Histogram", xlab=paste("CRT of variable", i))
                                                                        
                                                                        if(cpdfVal=="Color pdf")
                                                                        {
                                                                                abline(v=crtj.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTj[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crtj.mean[i], lwd=2)
                                                                                abline(v=CRTj[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(crtjalm, function(x) x[i,1]))
                                                                        dev.off()
                                                                        
                                                                        
                                                                        postscript(paste("Histogram of contribution to total variability of variable", i, ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(sapply(crtjalm, function(x) x[i,1]), main="Histogram", xlab=paste("CRT of variable", i))
                                                                        
                                                                        if(cepsVal=="Color eps")
                                                                        {
                                                                                abline(v=crtj.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTj[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crtj.mean[i], lwd=2)
                                                                                abline(v=CRTj[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(sapply(crtjalm, function(x) x[i,1]))
                                                                        dev.off()                                                                               
                                                                        
                                                                }#end for (i in 1:length(crtjalm))
                                                                
                                                                calc.crtj <-array(cbind(CRTj[,1],crtj.mean, se.crtj, sesgo.crtj, ic.t.crtjinf, ic.t.crtjsup, ic.p.crtjinf, ic.p.crtjsup, ic.bca.crtjinf, ic.bca.crtjsup),
                                                                                  dim=c(dim(CRTj)[1],10))
                                                                calc.crtj <- as.data.frame(calc.crtj)
                                                                colnames(calc.crtj) <- titulo
                                                                rownames(calc.crtj) <- textvariables
                                                                
                                                                cat("\n",file="temp.txt")                			
                                                                file.append("Resultsbootstrap.txt","temp.txt")	
                                                                cat("Relative contribution to total variability of the column element j:\n",file="temp.txt")					
                                                                file.append("Resultsbootstrap.txt","temp.txt")					
                                                                write.table(round(calc.crtj, digits=3),file="temp.txt", sep="\t",dec=",")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                        }#end if (ccrtjVal=="1")
                                                        
                                                        
                                                        
                                                        ### Relative contribution to total variability of table
                                                        
                                                        if (ccrttVal=="1")
                                                        {
                                                                calc.crtt <-c()
                                                                crtt.mean <-c()
                                                                se.crtt <-c()
                                                                sesgo.crtt <-c()
                                                                ic.t.crttinf <-c()
                                                                ic.t.crttsup <-c()
                                                                ic.p.crttinf <-c()
                                                                ic.p.crttsup <-c()
                                                                ic.bca.crttinf <-c()
                                                                ic.bca.crttsup <-c()
                                                                
                                                                
                                                                for (i in 1:dim(CRTt)[1])
                                                                {
                                                                        
                                                                        calc.crtt <-cal.ic(crttalm[[i]], liminf, limsup, CRTt[i,1], crttjackr[[i]], niter)
                                                                        crtt.mean <- c(crtt.mean, calc.crtt[1])
                                                                        se.crtt <- c(se.crtt,calc.crtt[2])
                                                                        sesgo.crtt <- c(sesgo.crtt,calc.crtt[3])
                                                                        ic.t.crttinf <- c(ic.t.crttinf,calc.crtt[4])
                                                                        ic.t.crttsup <- c(ic.t.crttsup,calc.crtt[5])
                                                                        ic.p.crttinf <- c(ic.p.crttinf,calc.crtt[6])
                                                                        ic.p.crttsup <- c(ic.p.crttsup,calc.crtt[7])
                                                                        ic.bca.crttinf <- c(ic.bca.crttinf,calc.crtt[8])
                                                                        ic.bca.crttsup <- c(ic.bca.crttsup,calc.crtt[9])
                                                                        
                                                                        pdf(paste("Histogram of contribution to total variability of table", i, ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(crttalm[[i]], main="Histogram", xlab=paste("CRT of table", i))
                                                                        if(cpdfVal=="Color pdf")
                                                                        {
                                                                                abline(v=crtt.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTt[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crtt.mean[i], lwd=2)
                                                                                abline(v=CRTt[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(crttalm[[i]])
                                                                        dev.off()
                                                                        
                                                                        
                                                                        postscript(paste("Histogram of contribution to total variability of table", i, ".eps", sep = ""), height = 600, width = 1200, horizontal=FALSE)
                                                                        par(mfrow=c(1,2))
                                                                        hist(crttalm[[i]], main="Histogram", xlab=paste("CRT of table", i))
                                                                        
                                                                        if(cepsVal=="Color eps")
                                                                        {
                                                                                abline(v=crtt.mean[i], lwd=2, col="blue")
                                                                                abline(v=CRTt[i,1], lty =2, lwd=2, col="red")
                                                                        }else{
                                                                                abline(v=crtt.mean[i], lwd=2)
                                                                                abline(v=CRTt[i,1], lty =2, lwd=2)
                                                                        }        
                                                                        qqnorm(crttalm[[i]])
                                                                        dev.off()                                                                               
                                                                        
                                                                }#end for (i in 1:length(crttalm))
                                                                
                                                                calc.crtt <-array(cbind(CRTt[,1],crtt.mean, se.crtt, sesgo.crtt, ic.t.crttinf, ic.t.crttsup, ic.p.crttinf, ic.p.crttsup, ic.bca.crttinf, ic.bca.crttsup),
                                                                                  dim=c(dim(CRTt)[1],10))
                                                                calc.crtt <- as.data.frame(calc.crtt)
                                                                colnames(calc.crtt) <- titulo
                                                                rownames(calc.crtt) <- unlist(tablas)
                                                                
                                                                cat("\n",file="temp.txt")                			
                                                                file.append("Resultsbootstrap.txt","temp.txt")	
                                                                cat("Relative contribution to total variability of the table t:\n",file="temp.txt")					
                                                                file.append("Resultsbootstrap.txt","temp.txt")					
                                                                write.table(round(calc.crtt, digits=3),file="temp.txt", sep="\t",dec=",")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                        }#end if (ccrttVal=="1")
                                                        
                                                        
                                                        ### Relative contribution of element i to factor q
                                                        
                                                        if (ccreifqVal=="1")
                                                        {
                                                                cat("\n",file="temp.txt")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                                cat("Relative contribution of the row element i to the q-th factor:",file="temp.txt")
                                                                file.append("Resultsbootstrap.txt","temp.txt")
                                                                for(i in 1: dim(CREiFq)[1])
                                                                {
                                                                        calc.creifq <-c()
                                                                        creifq.mean <-c()
                                                                        se.creifq <-c()
                                                                        sesgo.creifq <-c()
                                                                        ic.t.creifqinf <-c()
                                                                        ic.t.creifqsup <-c()
                                                                        ic.p.creifqinf <-c()
                                                                        ic.p.creifqsup <-c()
                                                                        ic.bca.creifqinf <-c()
                                                                        ic.bca.creifqsup <-c()
                                                                        
                                                                        for (j in  1:dim(CREiFq)[2])
                                                                        {
                                                                                calc.creifq <-cal.ic(creifqalm[[j]][[i]], liminf, limsup, CREiFq[i,j], creifqjackr[[j]][[i]], niter)
                                                                                creifq.mean <- c(creifq.mean, calc.creifq[1])
                                                                                se.creifq <- c(se.creifq,calc.creifq[2])
                                                                                sesgo.creifq <- c(sesgo.creifq,calc.creifq[3])
                                                                                ic.t.creifqinf <- c(ic.t.creifqinf,calc.creifq[4])
                                                                                ic.t.creifqsup <- c(ic.t.creifqsup,calc.creifq[5])
                                                                                ic.p.creifqinf <- c(ic.p.creifqinf,calc.creifq[6])
                                                                                ic.p.creifqsup <- c(ic.p.creifqsup,calc.creifq[7])
                                                                                ic.bca.creifqinf <- c(ic.bca.creifqinf,calc.creifq[8])
                                                                                ic.bca.creifqsup <- c(ic.bca.creifqsup,calc.creifq[9])
                                                                                
                                                                                
                                                                                pdf(paste("Histogram of CREiFq of ", textindividuos[i]," to axis ", j, ".pdf", sep = ""), height = 7, width = 7, useDingbats=FALSE)
                                                                                par(mfrow=c(1,2))
                                                                                hist(creifqalm[[j]][[i]], main="Histogram", xlab=paste("CREiFq of ", textindividuos[i],"\n to axis ", j))
                                                                                if(cpdfVal=="Color pdf")
                                                                                {
                                                                                        abline(v=creifq.mean[j], lwd=2, col="blue")
                                                                                        abline(v=