#Removemos todos los objetos de la memoria#
rm(list=ls(all=TRUE))
         biplot<-"Biplot"
         errorTxt<-"errorTxt"
         centroides  <-"Centroides"
         coeficientes<-"Coeficientes"
         datosOut    <-"Datos Out"
         histograma  <-"Histograma"
         resultadoTxt<-"Resultado"
         frecuencias <-"Frecuencias"
        sedimentacion <-"Sedimentacion"


#MINIDALENIUS#
MINI.DALENIUS<-function(datos=x,estrato=2)
{
      x<-sort(datos);
      L<-estrato;
      nclass<-min(L*10,length(x));
     
          cla <- x[1] + (x[length(x)] - x[1]) * ((0:nclass)/nclass)
          cla[nclass + 1] <- cla[nclass + 1] + 1
          factor.c <- vector(length = length(x))
          for (i in 1:nclass) 
          {
              factor.c[x >= cla[i] & x < cla[i + 1]] <- i
          }
          freq.c <- rep(0, nclass)
          pres.c <- tapply(x, factor.c, length)
          freq.c[as.numeric(names(pres.c))] <- as.vector(pres.c)
          csfreq.c <- cumsum(sqrt(freq.c))
          but <- csfreq.c[nclass]/L
          nclass.temp <- vector(length = 2^(L - 1) - 1)
          csfreqh.temp <- rep(0, 2^(L - 1))
          nclassh <- ssfreqh <- matrix(0, L, 2^(L - 1))
          sous <- 0
          k <- 1
          
          for (i in 1:(L - 1))
          {
              k1 <- k
              for (j in 1:length(sous)) 
              {
                  a <- csfreq.c - sous[j]
                  b <- a[a > 0 & a < but]
                  nclass.temp[k] <- length(b)
                  k <- k + 1
              }
              
              nclassh[i,] <- rep(c(t(cbind(nclass.temp[k1:(k-1)],nclass.temp[k1:(k-1)]+1))),each=(2^(L-2))/(k-k1))
              cumnclass <- colSums(nclassh[1:i, , drop = FALSE])
              cumss <- csfreqh.temp
              csfreqh.temp[cumnclass != 0] <- csfreq.c[cumnclass]
              csfreqh.temp[cumnclass == 0] <- 0
              ssfreqh[i, ] <- csfreqh.temp - cumss
              pos <- seq(1, 2^(L - 1), (2^(L - 2))/(k - k1))
              sous <- colSums(ssfreqh)[pos]
          }
       
          nclassh[L, ] <- nclass - cumnclass
          ssfreqh[L, ] <- csfreq.c[nclass]-sous
          out <- apply(nclassh <= 0, 2, any)
          very<-(ssfreqh[, !out] - but)
#segundo filtro#
if(is.matrix(very)==TRUE)
{
          nrgr <- order(colSums((ssfreqh[, !out] - but)^2))[1]
          bhfull <- cla[cumsum(c(1, nclassh[, !out][, nrgr]))]
          
       IC<-matrix(rep(0,2*L),ncol=2)
       for(j in 1:L)
       { 
       IC[j,1]<-bhfull[j];   IC[j,2]<-bhfull[j+1];
       }
       
       factor.c <- vector(length = length(x))
       for (i in 1:L) 
          {
              factor.c[x >= bhfull[i] & x < bhfull[i + 1]] <- i
          }
     
      if(length(table(factor.c))==L)
      { temp<-"SI";  return(temp)   }
      else 
       {temp<-"NO";return(temp)}
}
#TERMINA EL SEGUNDO FILTRO#
else 
{
  temp<-"NO";
  return(temp)
}
#TERMINA LA FUNCIÓN PRINCIPAL#
}
#MINI.DALENIUS(ind,9);

#-----------------------------------------------------------------------------#

princomp.colli<- function(x, cor=FALSE, scores=TRUE,
  subset=rep(TRUE, nrow(as.matrix(x))))
{
 # it is tempting to add  use="all.obs" which could be passed to cov or
 # cor but then the calculation of N is complicated.
 z<- as.matrix(x)[subset,, drop=F]
 N <- nrow(z)
 if(cor) cv <- get("cor",envir=.GlobalEnv)(z)
 else    cv <- cov(z)

#(svd can be used but gives different signs for some vectors)
 edc <- eigen(cv)
 cn <- paste("Comp.", 1:ncol(cv), sep="")
 names(edc$values) <- cn
 dimnames(edc$vectors) <- list(dimnames(x)[[2]], cn)
 scr<- NULL
 #------------------------------------------------------------------------------#
 cuenta<-0;
for(i in 1:nrow(edc$vectors))
{ 
    if (edc$vectors[i]<0) {cuenta<-cuenta+1}
}

if (cuenta==nrow(edc$vectors))
{
     vectors<-(edc$vectors)*(-1)
}
else 
{
vectors<-edc$vectors
}
#-------------------------------------------------------------------------------# 
 
 if (cor)
   {sdev <- sqrt(edc$values)
    sc <- (apply(z,2,var)*(N-1)/N)^0.5
    if (scores)
        scr<-(scale(z,center=T,scale=T) %*% vectors)*sqrt(N/(N-1))
   }
 else
   {    
   sdev <- sqrt(edc$values*(N-1)/N)
    sc <- rep(1, ncol(z))
    if (scores)
        scr<- (scale(z,center=T,scale=F) %*%vectors)
   }
 names(sc) <- dimnames(x)[[2]]

edc <-list(sdev=sdev, loadings=vectors,center=apply(z,2,mean), scale=sc, n.obs=N, scores=scr)
# The Splus function also return list elements factor.sdev, correlations
# and coef, but these are not documented in the help. coef seems to equal
# load. The Splus function also return list elements call and terms which
# are not supported here.
 class(edc) <- "princomp"
 edc
}

print.princomp <- function(x)
{
 cat("Standard deviations:\n")
 print(x$sdev)
 cat(length(x$scale), " variables and ", x$n.obs, "observations.\n")
 cat("Scale:\n")
 print(x$scale)
 invisible(x)
}

#princomp.colli(x,cor=TRUE,scores=TRUE);

library(sp)
library(lattice)
#Esta función revisa si todas las variables en el análsis estan altamente correlacionadas#
cor.func<-function(x)
{
   x.cor<-cor(x)
   dim.col<-ncol(x.cor)
   cal.acum<-0;
   for(i in 1:dim.col)
   {
      for(j in 1:dim.col)
        {
            if(j!=i)
              {
                 if(x.cor[i,j]>=0.9)
                  {
                    cal.acum<-cal.acum+1
                  }
              }
        }
   }
 if(cal.acum==(dim.col*dim.col-dim.col)) { corre<-1}
 else {corre<-0}
 return(corre)
 }
 
#Funcion nueva para colinialidad #
revisa.cor<-function(tipo,x)
{
  if (tipo=="Cor")
     {
      y<-as.matrix(log(det(cor(x))))
     }
  
  if (tipo=="Cov")
     {
     y<-as.matrix(log(det(cov(x))))
     } 
  
  return(y)
}

#Grafica de centroides#
plot.centroides<-function(datosx)
{
datosx.ncol<-ncol(datosx);
conteo<-table(datosx[,datosx.ncol])
clust.name<-as.matrix(as.numeric(rownames(as.matrix(conteo))))
estrato<-nrow(clust.name)
Centroides<-matrix(rep(NA,estrato*(datosx.ncol-1)),ncol=(datosx.ncol-1))
for (i in 1:estrato)
{
  datosx.parte<-datosx[datosx[,datosx.ncol]==clust.name[i],]
  Centroides[i,]<-colMeans(datosx.parte[,-datosx.ncol])
}
xnames<-colnames(datosx)
colnames(Centroides)<-as.matrix(xnames)[-datosx.ncol,]

direcentroides<-paste(centroides,".pdf",sep="")
direcentroidesjpg<-paste(centroides,".jpg",sep="")
pdf(file=direcentroides)
    matplot(Centroides,lty=1,type="b",pch=19,col=1:datosx.ncol,bg=10,main = "Centroides por variable",xlab="Estrato",ylab="Valores de los centroides",xaxt="n")
    axis(1,clust.name)
    leg.txt<-as.matrix(xnames)[-datosx.ncol,];
    legend("topright", leg.txt, lty=1,pch =19, col= c(1:(datosx.ncol-1)),cex=1)
dev.off()
 
 jpeg(filename=direcentroidesjpg,width = 500, height = 500,quality = 75,units = "px",bg = "white")
    matplot(Centroides,lty=1,type="b",pch=19,col=1:datosx.ncol,bg=10,main = "Centroides por variable",xlab="Estrato",ylab="Valores de los centroides",xaxt="n")
    axis(1,clust.name)
    leg.txt<-as.matrix(xnames)[-datosx.ncol,];
    legend("topright", leg.txt, lty=1,pch =19, col= c(1:(datosx.ncol-1)),cex=1)
 dev.off()

}

#Salidas cuando no tenemos resultados#
noobs<-function()
{
#library(maptools)
#set.seed(123)
  x = c(0,0,0,0,0,5)
  y = c(10,9,8,7,6,0)

  w = c("LOS RESULTADOS NO SE GENERARON PORQUE EL NÚMERO DE",
        "VARIABLES SUPERA EL NÚMERO DE OBSERVACIONES, O BIEN,",
        "TODAS LAS VARIABLES ESTAN ALTAMENTE CORRELACIONADAS.",
        "SE SUGIERE INCLUIR MENOS VARIABLES EN EL MODELO",
        "O CAMBIAR AL MENOS UNA VARIABLE.",
        ""
       )

      direcodos<-paste(sedimentacion,".pdf",sep="")
      #Grafica de codos#
            pdf(file=direcodos);
            par(ann = FALSE, xpd = NA, mar = rep(2, 4))
            plot(x, y, type = "n", axes = FALSE)
            pointLabel(x, y, w, cex=c(rep(1,4),1))
            dev.off()
      #grafica de cargas#
      direcargas<-paste(coeficientes,".pdf",sep="")
            pdf(file=direcargas)
            par(ann = FALSE, xpd = NA, mar = rep(2, 4))
            plot(x, y, type = "n", axes = FALSE)
            pointLabel(x, y, w, cex=c(rep(1,4),1))
            dev.off()
      #Bibplot#
      direbibplot<-paste(biplot,".pdf",sep="")
          pdf(file=direbibplot)
          par(ann = FALSE, xpd = NA, mar = rep(2, 4))
          plot(x, y, type = "n", axes = FALSE)
          pointLabel(x, y, w, cex=c(rep(1,4),1))
          dev.off()
      #Histograma#
      direhist<-paste(histograma,".pdf",sep="")
          pdf(file=direhist)
          par(ann = FALSE, xpd = NA, mar = rep(2, 4))
          plot(x, y, type = "n", axes = FALSE)
          pointLabel(x, y, w, cex=c(rep(1,4),1))
          dev.off()
      direcentroides<-paste(centroides,".pdf",sep="")
             pdf(file=direcentroides)
             par(ann = FALSE, xpd = NA, mar = rep(2, 4))
             plot(x, y, type = "n", axes = FALSE)
             pointLabel(x, y, w, cex=c(rep(1,4),1))
             dev.off()

}

#noobs(direout);

#Agregando formato de negritas a las cargas#
 carga.negra<-function(loads)
 {  loads<-round(loads,digits=3)
   for(i in 1:ncol(as.matrix(loads)))
      {
        parte<-loads[,i]
        if (i==1)
          { carga.ini<-as.matrix(rep(1,nrow(as.matrix(parte))))
            for(j in 1:nrow(as.matrix(parte)))

                   carga.ini[j,]<-paste("<strong>",parte[j],"</strong>")

            carga<-cbind(carga.ini)
          }
        else {carga<-cbind(carga,parte)}
  }
carga<-data.frame(carga); 
names<-c(colnames(loads));  
nombres<-c(colnames(loads));  
#nombres[1]<-paste("<H3> <strong>",names[1],"<H3></strong>");
colnames(carga)<-nombres
#print(carga)

dat<-as.matrix(carga)
colna<-as.matrix(colnames(dat)); rowna<-as.matrix(rownames(dat))
 cat("<center> <table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
  for(i in 1:(nrow(colna)+1))
  { if(i==1) {cat("<tr style='background-color:#CBE2E6'> <td> <strong> &nbsp;&nbsp; Variable &nbsp;&nbsp;</strong></td>")}
    else {cat("<td><strong>&nbsp;&nbsp;",colna[(i-1)],"&nbsp;&nbsp;</strong></td>")}
  }
 cat("\n"); 
 dat<-cbind(rowna,dat)
 fila<-nrow(dat);colum<-ncol(dat);

  for(i in 1:fila)
  {
    for(j in 1:colum)
    {   if(j==1 & i==1){cat("<tr><td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}
         else if(j==1 & i>1){cat("<tr> <td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}    
        else if(j==colum){cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}
    }


  }
cat("</table></center>","\n")
cat("<br><br>")



}

#Resumen corto#

formulas<-function(x)
{  
  vn<-colnames(x);
  fmla <- paste("~ ", paste(vn, collapse= "+"))
 
  return(fmla); 
 }


 modelo<-function(fmla,tipo)
 { if (tipo=="Cor") 
      {cat("<strong>Modelo:</strong><br>","\n"); cat("princomp(formula=",fmla,",data=datos,cor=TRUE,scores=T)<br>","\n");cat("\n") }
  if (tipo=="Cov") {cat("Modelo:<br>","\n");cat("princomp(formula=",fmla,",data=datos,cor=False,scores=T <br><br>)","\n");cat("\n") }
 }
 
resumen<-function(modelos)
{ 
  #cat("Modelo:","\n"); print(modelos$call);cat("\n");

cat("<br><strong>Desviación estándar: </strong>","\n");
meanh<-as.matrix(names(modelos$sdev));
meanh<-paste("<strong>",meanh,"</strong>",sep="")
dati<-cbind(meanh,round(modelos$sdev,digits=3))
dat<-t(dati)

 fila<-nrow(dat);colum<-ncol(dat);
  cat("<center><table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n") 
  
  for(i in 1:fila)
  {
    for(j in 1:colum)
    {   if(j==1 & i==1 ){cat("<tr style='background-color:#CBE2E6'><td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp</td>")}
        else if(j==1 & i>1){cat("<tr><td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}
    }
  }
  cat("</table> </center>","\n")

  #print(modelos$sdev); cat("<br>","\n");
 nuvar<-nrow(as.matrix(modelos$sdev))
  cat("<br><br><strong>Selección de Indicadores:</strong> <br>",modelos$n.obs,"observaciones y ",nuvar," variables. <br>","\n")


}

#Estratificación por daleniuos#
  #funcion para construir el resumen de dalenius;
 dalenius<-function(datos,cum)
 {
  bh<-as.matrix(cum$bh); n<-nrow(bh); limite.inf<-matrix(rep(0,n+1));
  limite.sup<-matrix(rep(0,n))
  contador<-n+1;
   for (i in 1:contador)
    {
        if (i==1)
        {
          limite.inf[i]<-min(datos);
          limite.sup[i]<-bh[i]
        }
        else if (i==contador)
        {
          limite.inf[contador]<-bh[i-1];
          limite.sup[contador]<-max(datos)
        }
        else
        {
            limite.inf[i,]<-bh[(i-1),]
            limite.sup[i,]<-bh[i,]
        }

    }
    limites<-round(cbind(limite.inf,limite.sup),digits=3)
    
    colnames(limites)<-c("Limite_inf","Limite_sup")
 cat("<p><br> <center> <table  width= '100%'; style='height:20px; border-style:solid; background-color:#4F86A4; font:20px;'>","\n") 
cat("<tr><td> <font color='white'><center>Estratificación por el método de Dalenius-Hodges considerando la primera componente principal</center></font> </td></tr></table></center><p><br>","\n") 
    
 cat("<br />","\n")
  cat("<br /> <strong>Intervalos para cada uno de los estratos generados a partir de la primera","\n")
  cat(" componente principal: </strong> <br />","\n")
  cat("<br />","\n")
  fila<-nrow(limites);colum<-ncol(limites);
  cat("<center><table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
  cat("<tr style='background-color:#CBE2E6'><td><strong>&nbsp;&nbsp;Limite inferior&nbsp;&nbsp;</strong></td><td><strong>&nbsp;&nbsp;Limite superior &nbsp;&nbsp;</strong></td>","\n")
  for(i in 1:fila)
  {
    for(j in 1:colum)
    {   if(j==1){cat("<tr><td>&nbsp;&nbsp;",limites[i,j],"&nbsp;&nbsp;</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",limites[i,j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",limites[i,j],"&nbsp;&nbsp;</td>")}
    }
  }
  cat("</table> </center>","\n")
  
  cat("<br />","\n");cat("<br />","\n")
  cat("<br /> <strong>Valor Promedio de la primera componente en cada estrato:</strong><br />                                   ","\n")
  cat("<br />","\n");
 
 meanh<-round(as.matrix(cum$meanh),digits=3)
 colum<-nrow(meanh)
  cat("<center><table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
 for(j in 1:colum) 
{    estra<-paste("Estrato.",1:nrow(meanh),sep="")
  if(j==1){cat("<tr style='background-color:#CBE2E6' ><td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>")}
       
}

 for(j in 1:colum) 
{          
  if(j==1){cat("<tr><td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>")}
}
 cat("</table></center>","\n")
  
  cat("<br />","\n");
  
  cat("<br /><strong>Valor de la varianza de la primera componente en cada estrato:</strong><br />","\n")
  cat("<br />","\n")
  
meanh<-round(as.matrix(cum$varh),digits=3)
colum<-nrow(meanh)
  cat("<center><table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
 for(j in 1:colum) 
{  estra<-paste("Estrato.",1:nrow(meanh),sep="")
  if(j==1){cat("<tr style='background-color:#CBE2E6' ><td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",estra[j],"&nbsp;&nbsp;</td>")}
}

 for(j in 1:colum) 
{
  if(j==1){cat("<tr><td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>")}
        else if(j==colum){cat("<td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>","\n")}
        else  {cat("<td>&nbsp;&nbsp;",meanh[j],"&nbsp;&nbsp;</td>")}
}

 cat("</table></center>","\n") 
   
  cat("<br />","\n");
  cat("<br /><strong>Desviación estándar de la primera componente estratificada:</strong><br />             ","\n")
  cat("<br />","\n")
  cat("<table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
 cat("<tr><td>",round(cum$stderr,digits=3),"<td>")
   cat("</table>","\n") 
  cat("<br />","\n")
  #cat("   Coeficiente de variación  de la primera componente                      ","\n")
  #cat("\n")
  #print(cum$CV)  
}

#FUNCIONES NECESARIAS PARA LAS PRUEBAS DE KMO Y BARTTLE'S#
estandar<-function(dato)
{
ncols<-ncol(dato)
nfilas<-nrow(dato)
est=matrix(rep(0,ncols*nfilas),ncol=ncols,nrow=nfilas)
for(i in 1:ncols)

  {

  est[,i]=(dato[,i]-mean(dato[,i]))/(sd(dato[,i]))

  }
nombres<-colnames(dato)
colnames(est)<-nombres  
return(est)
}
#KMO Kaiser-Meyer-Olkin Measure of Sampling Adequacy 
kmo<-function(datos)
{ 

  library(MASS) 
 
  X<-cor(as.matrix(datos)) 
  iX<-ginv(X) 
  S2<-diag(diag((iX^(-1)))) 
  AIS<-S2%*%iX%*%S2                      # anti-image covariance matrix
  IS<-X+AIS-2*S2                         # image covariance matrix
  Dai<-sqrt(diag(diag(AIS)))
  IR<-ginv(Dai)%*%IS%*%ginv(Dai)         # image correlation matrix
  AIR<-ginv(Dai)%*%AIS%*%ginv(Dai)       # anti-image correlation matrix
  a<-apply((AIR-diag(diag(AIR)))^2,2,sum)
  AA<-sum(a) 
  b<-apply((X-diag(nrow(X)))^2,2,sum)
  BB<-sum(b)  
  MSA<-b/(b+a)                           # indiv. measures of sampling adequacy
  AIR<-AIR-diag(nrow(AIR))+diag(MSA)     # Examine the anti-image of the
                                         # correlation matrix. That is the
                                         # negative of the partial correlations,
                                         # partialling out all other variables.

  kmo<-BB/(AA+BB)                         # overall KMO statistic

  # Reporting the conclusion 
    if (kmo>=0.00 && kmo<0.50)
    { 
      test<-'La prueba KMO obtiene un grado de varianza inaceptable.'
    } 
    else if (kmo >= 0.50 && kmo < 0.60)
    { 
      test <- 'La prueba KMO obtiene un grado de varianza inaceptable' 
    }
    else if (kmo >= 0.60 && kmo < 0.70)
    { 
      test <- 'La prueba KMO obtiene un grado de varianza regular' 
    }
    else if (kmo >= 0.70 && kmo < 0.80)
    { 
      test <- 'La prueba KMO obtiene un grado de varianza aceptable' 
    }
    else if (kmo >= 0.80 && kmo < 0.90)
    { 
      test <- 'La prueba KMO obtiene un grado de varianza excelente' 
    }
    else 
    {
    test <- 'La prueba KMO obtiene un grado de varianza perfecta.'     
    }
    cat("<HR width='80%' />","\n");cat("<br/>","\n");
    

cat("<p><br> <center> <table  width= '100%'; style='height:20px; border-style:solid; background-color:#4F86A4; font:20px;'>","\n") 
cat("<tr><td> <font color='white'><center>Prueba Kaiser-Meyer-Olkin</center></font> </td></tr></table></center><p><br>","\n") 
    
    cat("<strong>Valor de la prueba:",kmo ,"</strong><br>");
    cat("&nbsp; Nota: Es deseable que este valor sea cercano a 1. </br> </dv>","\n")
};


Bartlett.sphericity.test <- function(x)
{
method <- " Prueba de esfericidad de Bartlett's"
data.name <- deparse(substitute(x))
x <- subset(x, complete.cases(x)) # Omit missing values
n <- nrow(x)
p <- ncol(x)
chisq <- (1-n+(2*p+5)/6)*log(det(cor(x)))
df <- p*(p-1)/2
p.value <- pchisq(chisq, df, lower.tail=FALSE)
names(chisq) <- "X-squared"
names(df) <- "df"
return(structure(list(statistic=chisq, parameter=df, p.value=p.value,
method=method, data.name=data.name), class="htest"))
}

#Damos de alta las librerias necesarias
library(foreign)
library(stratification)
#library(xlsReadWrite)
#library(relimp) 
#library(gWidgets)
 
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
Analisis_componentes<-function(diredata,direout,tipo,numout,numgraf,estrato)
#Analisis_componentes<-function(rs,tipo,numout,numgraf,estrato)
{
#setwd(direout)
#Importamos descriptores#
  DIRE.DECRIP<-paste(direout,"DescriptoresSel.dbf",sep="")
  DESCRIP<-as.matrix(read.dbf(file=DIRE.DECRIP));
  #DESCRIP<-as.matrix(rsDescriptores);
  descripcion<-function()
  {cat("<br><strong>Descriptores para cada variable seleccionada: <br></strong>", "\n \n");
   for(i in 1:nrow(DESCRIP))
    {  temp<-DESCRIP[i]
       cat("<br>",temp,"\n");
      
    }
  cat("<br><br><br>","\n");  
  # print(DESCRIP);cat("\n");  
  }
  
      #IMPORTAMOS LA BASE DE DATOS EN FORMATO CSV
      #-------------------------------------------------------------------------#
        #Eliminamos los valos NA, este valor es creado desde delphi#
         #origen<-as.matrix(read.dbf(file=diredata));
         origen<-read.dbf(file=diredata);
		     #origen<-rs;
         for (i in 1:ncol(origen))
            {
               origen<-origen[origen[,i]!="NA",]
               origen<-origen[origen[,i]!=-88,]
               origen<-origen[origen[,i]!=-77,]
               origen<-origen[origen[,i]!=-99,] 
               origen<-origen[origen[,i]!=-66,] 
            }
        origen<-data.frame(origen)
        #origen<-origen[,1:8]
     #-----------------------------------------------------------------------#
        ncolumnas<-ncol(origen) #numero de columnas
        nfilas<-nrow(origen)  #numero de filas
        namecol<-colnames(origen)#nombres de las columnas originales#
        #Obtenemos el nivel de los desgloses #
        nname<-length(namecol) 
        vname<-as.matrix(rep(NA,nname),ncol=1,nrow=nname)
        for (i in 1:nname)
        {temp<-namecol[i]
           if (temp=="ent"){vname[i]<-1}
          else if (temp=="ent"){vname[i]<-1}
          else if (temp=="CVEGEO"){vname[i]<-1}     
          else if (temp=="OID"){vname[i]<-1}
          else if (temp=="clavegeo"){vname[i]<-1}
          else if (temp=="mun"){vname[i]<-1}
          else if (temp=="loc"){vname[i]<-1}
          else if (temp=="ageb"){vname[i]<-1}
          else {vname[i]<-0} 
        }
        retro<-sum(vname)
      
        nume<-origen[,(retro+1):ncolumnas]
        for (i in 1:(ncolumnas-retro))
        {  parte<-as.numeric(as.matrix(nume[,i]))
          if (i==1){ numericas<-cbind(parte) }
          else { numericas<-cbind(numericas,parte) } 
        }
        nombres<-c(colnames(nume))
        colnames(numericas)<-nombres
         datos<-cbind(origen[,c(1:retro)],data.frame(numericas))
          ncols<-ncol(datos) #numero de columnas
          nfilas<-nrow(datos)  #numero de filas
          colnames(datos)<-namecol
        #obtenemos la base de datos numericos#
          x<-datos[,c((retro+1):ncols)]
          xncol<-ncol(x);xnrow<-nrow(x);
#Agregamos nuevo codigo 27/03/2012#
cuenta<-0;
constante<-0;
for(i in 1:ncol(x))
{
if( length(table(x[,i]))>estrato ){cuenta<-cuenta+1}
if( length(table(x[,i]))==1 ){constante<-1}
}
#criterio:almenos una variable es constante#
if (constante==0)
{
if(ncol(x)==cuenta)
{  
  #---------------------------------------------------#
  #Revisión de la correlación de los datos#
  val.cor<-revisa.cor("Cor",x);
  correlacion<-cor.func(x)
  
  if (val.cor=="NaN" | correlacion==1 ){calif<-0}
  else if (val.cor!="NaN" & correlacion==0 ){calif<-1}
  #segunda condición#
  if (calif==1)
  { 
  #tercera condición #     
    if(xncol<=xnrow)
    {
          #Obtenemos el desglose
            desglose<-datos[,c(1:retro)]
          #Analisis de componentes principales#  
  
             #Formula#
             fmla<-formulas(x);
             fmlas<-as.formula(fmla)
             
        if (tipo=="Cor")
          {
            comprin<-princomp.colli(x,cor=TRUE,scores=TRUE); xvar<-cor(x);
          }
          if (tipo=="Cov")
          {
             #datos estandarizados
              #y<-as.matrix(x)
              #z<-estandar(y)
              comprin<-princomp.colli(x,cor=FALSE,scores=TRUE);xvar<-var(x);
              
          }
  
  
        #espectral<-eigen(xvar);
        eigenvalue<-comprin$sdev^2
        value<-matrix(rep(NA,length(eigenvalue)),ncol=1,nrow=length(eigenvalue))
        acumula<-matrix(rep(NA,length(eigenvalue)),ncol=1,nrow=length(eigenvalue))
        suma<-sum(eigenvalue)
        for (i in 1:length(eigenvalue))
        {
         value[i,1]<-(eigenvalue[i]/suma)*100;
         acumula[i,1]<-sum(value[1:i,1]);
        }
    #Matriz de eigenvalores y Porcentaje de varianzas
     resultado<-cbind(eigenvalue,value,acumula)
     colnames(resultado)=c("Valores característicos","Porcentaje de la varianza explicada","Porcentaje de la varianza explicada acumulada ")
     resultado
     #Matriz de componentes principales#
      #cargas#
          loads<-comprin$loadings
          for(i in 1:ncol(as.matrix(loads))) 
          {
          parte<-loads[,i]
          if (i==1) {carga<-cbind(parte)}
          else {carga<-cbind(carga,parte)}
          }
          nombres<-c(colnames(loads));
          colnames(carga)<-nombres
         componente<-carga
      #ESTRATIFICANDO EL INDICADOR POR DALENIUS-HODGES#
      minimo<-min((as.numeric(as.matrix(x)%*%as.matrix(componente[,1]))))
      if (minimo>=0) {minimo<-0}
      
        ind<-(as.numeric(as.matrix(x)%*%as.matrix(componente[,1])))-minimo;
        
        correla<-MINI.DALENIUS(ind,estrato);      
   # Agregamos la condición de bandera blanca para correrla#
   #cuarta condición#
   if(correla=="SI")
   {      
        nclase=min(estrato*10,length(ind));
        #-------------------------------------------------------------------------#
        if (nclase<=30){nclase<-30}
        
        ind<-as.numeric(as.matrix(ind))
        error<-try(cum<-strata.cumrootf(ind,nclass=nclase,CV=0.01,Ls=estrato,alloc=c(0.5,0,0.5)),silent=TRUE)
        list.error<-unlist(strsplit(as.character(error), " ", fixed = TRUE))
        true.error<-list.error[1]
  
        if (true.error=="Error" | true.error=="c(0,") 
          { 
          dir.error<-paste(errorTxt,".html",sep="")
          sink(dir.error) #redirige la salida al fichero salida.txt
          cat("<br>Error:Este error ocurre porque se incluyo una variable que tiene una varianza","\n")
          cat("aproximadamente cero, o bien, no se pueden generar todos los estratos deseados.","\n")
          cat("Se recomienda reducir el numero de estratos. </br>","\n");cat("</br>","\n");
               
          cat("<br>El error que regresa la consola de R es:</br>","</br>","\n")
          cat("<br>")
          print(error);
          cat("</br>")
          sink()
          }
  
        else 
         {
            cum<-strata.cumrootf(ind,nclass=nclase,CV=0.01,Ls=estrato,alloc=c(0.5,0,0.5))
         #------------------------------------------------------------------------#
             resucum<-summary(cum);
             
        #PRUEBA DE HIPOTESIS# 
        #kmt<-kmo(x)
        
        bartlett<-Bartlett.sphericity.test(x)
        
         
         #---------------INICIALIZAMOS LAS SALIDAS AL OUTPUT--------------------------#   
         titulo<-function()
          {
  cat("<div style='font:14px, Arial;'>","\n")  
  cat("<p><br> <center> <table  width= '100%'; style='height:20px; border-style:solid; background-color:#4F86A4; font:20px;'>","\n") 
  cat("<tr><td> <font color='white'><center>*** AVISO IMPORTANTE ***</center></font> </td></tr></table></center><p><br>","\n") 
                  
           cat("Antes de utilizar los resultados de la estratificación multivariada, se sugiere","\n");
           cat("analizar detalladamente los resultados del modelo.</br>","\n");cat("<br>","\n");
      
           cat("El INEGI no se hace responsable del uso, aplicación e interpretación de los re");
           cat("sultados obtenidos en el análisis.</br>","\n");cat("</br>","\n");      
  
  cat("<p><br> <center> <table  width= '100%'; style='height:20px; border-style:solid; background-color:#4F86A4; font:20px;'>","\n") 
  cat("<tr><td> <font color='white'><center>*** ESTRATIFICACIÓN MULTIVARIADA ***</center></font> </td></tr></table></center><p><br>","\n") 
                  
           cat("Resultados del análisis de componentes principales usado para la estratificación","\n")
           cat("con el método Dalenius-Hodges. (Ésta estratificación considera únicamente la ","\n");
           cat("primera componente principal)</br>","\n");cat("\n");
           
           cat("\n");
  
  cat("<p><br> <center> <table  width= '100%'; style='height:20px; border-style:solid; background-color:#4F86A4; font:20px;'>","\n") 
  cat("<tr><td> <font color='white'><center>Análisis de componentes principales</center></font> </td></tr></table></center><p><br>","\n") 
           
          
          }
          propo<-function()
          {  cat("\n"); 
           cat("<br><strong> Porcentaje de la varianza explicada por la primera componente principal<br>")
              print(round(resultado[1,2],digits=3));cat("</strong><br>");
           cat("&nbsp Nota: Es deseable que este valor sea próximo al 100%.","\n");cat("<br><br>","\n")
             
          }  
              direresultado<-paste(resultadoTxt,".html",sep="")
            #resumen corto #
             Standard_deviations<-t(as.matrix(comprin$sdev))
             
            if(numout==4)
            {
            sink(direresultado) #redirige la salida al fichero salida.txt
             
             titulo();cat("\n");propo();cat("\n")
             modelo(fmla,tipo); resumen(comprin);cat("\n") ;descripcion(); 
             cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
              cat("\n");cat("\n");cat("\n")
             kmo(x);cat("\n");cat("\n")
            # print(bartlett);cat("\n");cat("\n")
             sink() #redirige a la salida por defecto (pantalla)
             }
             
             #Importancia de los componentes#
             tstd<-t(Standard_deviations)
             importancia<-cbind(eigenvalue,tstd,value,acumula)
             colnames(importancia)=c("Valores característicos","Desviación estándar","Porcentaje de la varianza explicada",
             "Porcentaje de la varianza explicada acumulada ")
  dat<-t(as.matrix(importancia))
  
  importance<-function(dat)
  {
  dat<-round(dat,digits=3) 
  colna<-as.matrix(colnames(dat))
  rowna<-as.matrix(rownames(dat))
  
    cat("<strong><br>Importancia de las componentes principales: <br><br></strong>  ","\n")
   cat("<center><table border='1'  style='border-style:solid; background-color:#F0F0F0; font-size:14px' >","\n")
    for(i in 1:(nrow(colna)+1))
    { if(i==1) {cat("<tr style='background-color:#CBE2E6'><td><strong>&nbsp;&nbsp;","Descriptor","&nbsp;&nbsp;</strong></td>")}
      else {cat("<td><strong>&nbsp;&nbsp;",colna[(i-1)],"&nbsp;&nbsp;</strong></td>")}
    }
   cat("\n"); 
   dat<-cbind(rowna,dat)
   fila<-nrow(dat);colum<-ncol(dat);
  
    for(i in 1:fila)
    {
      for(j in 1:colum)
      {   if(j==1){cat("<tr><td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}
          else if(j==colum){cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>","\n")}
          else  {cat("<td>&nbsp;&nbsp;",dat[i,j],"&nbsp;&nbsp;</td>")}
      }
  
  
    }
  cat("</table></center>","\n")
  cat("<br><br>")
  }
    
            
            if(numout==6)
            {
              sink(direresultado) #redirige la salida al fichero salida.txt
              b<-(" Importancia de las componentes principales")
              titulo();cat("\n");propo();cat("\n"); 
              cat("\n") ;descripcion();
                          
  importance(dat); 
              
              cat("\n"); cat("\n");
              dalenius(ind,cum) 
               cat("\n");cat("\n");cat("\n")
              kmo(x);cat("\n");cat("\n")
             # print(bartlett);cat("\n");cat("\n") 
              sink() #redirige a la salida por defecto (pantalla)
             }
            
            if(numout==7)
            {
              sink(direresultado) #redirige la salida al fichero salida.txt
              b<-("Vectores de coeficientes<br>")
             titulo();cat("\n");propo();cat("\n");
             cat("\n") ;descripcion();
             cat(b,"\n");cat("\n")
             carga.negra(loads);; #guarda la salida en "salida.txt"
             cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
             cat("\n");cat("\n");cat("\n")
             kmo(x);cat("\n");cat("\n") 
            # print(bartlett);cat("\n");cat("\n") 
             sink() #redirige a la salida por defecto (pantalla)
             }
             #RESUMEN IMPORTANCIA Y CARGAS#
             if(numout==1)
            { newl<-'                                                                     '
              sink(direresultado) #redirige la salida al fichero salida.txt
             
              titulo();cat("\n");propo(); modelo(fmla,tipo); resumen(comprin);cat("\n") ;descripcion(); #guarda la salida en "salida.txt"
              cat("\n");cat("\n");
              b<-("Importancia de las componentes principales")
  importance(dat);
              cat("\n")
              cat("\n")
              cat("\n")
              CARGAS<-("<strong>Vectores de coeficientes para las componentes:</strong><br> <br>")
              cat(CARGAS,"\n");cat("\n");
              carga.negra(loads);; #guarda la salida en "salida.txt"
             cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
              cat("\n");cat("\n");cat("\n")
             kmo(x);cat("\n");cat("\n") 
            # print(bartlett);cat("\n");cat("\n") 
              sink() #redirige a la salida por defecto (pantalla)
            }
             if(numout==2)
            { newl<-'                                                                     '
              sink(direresultado) #redirige la salida al fichero salida.txt
              titulo();cat("\n");propo();cat("\n");  modelo(fmla,tipo); resumen(comprin);
              #guarda la salida en "salida.txt"
              cat("\n") ;descripcion();
              
              cat("\n");cat("\n");
              b<-("<strong>Importancia de las componentes principales</strong>")
  importance(dat);
              cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
              cat("\n");cat("\n");cat("\n")
              kmo(x);cat("\n");cat("\n") 
            # print(bartlett);cat("\n");cat("\n") 
              sink() #redirige a la salida por defecto (pantalla)
            }
            
            if(numout==3)
            { newl<-'                                                                     '
              sink(direresultado)#redirige la salida al fichero salida.txt
              
              titulo();cat("\n");propo();cat("\n");    modelo(fmla,tipo); resumen(comprin);
              cat("\n") ;descripcion(); #guarda la salida en "salida.txt"
              cat("\n");cat("\n");cat("\n");
              CARGAS<-("Vectores de coeficientes para las componentes:<br> <br>");
              cat(CARGAS,"\n");cat("\n");
              carga.negra(loads);; #guarda la salida en "salida.txt"
             cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
              cat("\n");cat("\n");cat("\n")
             kmo(x);cat("\n");cat("\n") 
            # print(bartlett);cat("\n");cat("\n") 
              sink() #redirige a la salida por defecto (pantalla)
            }
             if(numout==5)
            { newl<-'                                                                     '
              sink(direresultado) #redirige la salida al fichero salida.txt
                  
              titulo();cat("\n");propo();cat("\n");
              cat("\n") ;descripcion();
              b<-("Importancia de las componentes principales")
  importance(dat);
              cat("\n");cat("\n"); cat("\n");
              CARGAS<-("Vectores de coeficientes para las componentes:<br> <br>")
              cat(CARGAS,"\n");cat("\n");
              carga.negra(loads); #guarda la salida en "salida.txt"
             cat("\n"); cat("\n");cat("\n");
             dalenius(ind,cum)
             kmo(x);cat("\n");cat("\n")
            # print(bartlett);cat("\n");cat("\n")
              sink() #redirige a la salida por defecto (pantalla)
            }
            
            #-----------------------------INICIAMOS CON LAS GRAFICAS -----------------------#
            direcodospdf<-paste(sedimentacion,".pdf",sep="")
            direcodosjpj<-paste(sedimentacion,".jpg",sep="")
             #Grafica de codos#    
            codos<-function()
            {
            pdf(file=direcodospdf)
            plot(resultado[,1], pch=19,cex=2,type="o",main="Gráfica de sedimentación",ylab="Varianzas",xlab="Número de Componente",xaxt="n")
            axis(1,1:nc)
            dev.off()
            
            jpeg(filename=direcodosjpj,width = 500, height = 500,quality = 75,units = "px",bg = "white")
            plot(resultado[,1], pch=19,cex=2,type="o",main="Gráfica de sedimentación",ylab="Varianzas",xlab="Número de Componente",xaxt="n")
            axis(1,1:nc)
            dev.off()
            }
            #grafica de cargas#    
            direcargas<-paste(coeficientes,".pdf",sep="")   
            cargas<-function()
            {
            pdf(file=direcargas)
              par(mfrow=c(3,1))    
              for (i in 1:ncol(x))
                {
                  barplot(carga[,i],space=0.5 ,col=c('blue','blue','blue','blue'),xla="Variables",yla="valor",main=paste("Componente",i))
                  abline(h=0)
                  abline(v=0)
                }
              
                 par(mfrow=c(1,1)) 
                 dev.off()         
            }
             
              #Bibplot#
            direbibplot<-paste(biplot,".pdf",sep="")
            direbibplotjpg<-paste(biplot,".jpg",sep="")
            
            bibplot<-function()
            {    pdf(file=direbibplot)       
                     biplot(comprin, main="Biplot", cex.main=1, xlabs=filas)
                     #text(prin1,prin2,labels=filas,adj=c(0,1),cex=1)
                     abline(h=0,lty=4)
                     abline(v=0,lty=4)
                 dev.off()
                 
            jpeg(filename=direbibplotjpg,width = 500, height = 500,quality = 75,units = "px",bg = "white")
                  biplot(comprin, main="Biplot", cex.main=1, xlabs=filas)
                 #text(prin1,prin2,labels=filas,adj=c(0,1),cex=1)
                 abline(h=0,lty=4)
                 abline(v=0,lty=4)
            dev.off()     
                 
                      
            }     
                    #cex.main pone los tamaños de letras para los titulos
                    
            #Histograma#
            direhist<-paste(histograma,".pdf",sep="")
            direhistjpg<-paste(histograma,".jpg",sep="")
            histograma<-function()
            {    pdf(file=direhist)
                 plot(cum$stratumID,xlab="Estratos",ylab="Conteos",main="Histograma:\n Estratificación por el método de Dalenius-Hodges");
                 dev.off() 
                 
            jpeg(filename=direhistjpg,width = 500, height = 500,quality = 75,units = "px",bg = "white")
                 plot(cum$stratumID,xlab="Estratos",ylab="Conteos",main="Histograma:\n Estratificación por el método de Dalenius-Hodges");
            dev.off()    
                     
            }     
            
            nc<-nrow(as.matrix(resultado[,1]))
            #Gráfica de las componentes 
                #Procedimiento para crear y guardar la grafica en un directorio
                  #Grafica de los eigenvalores.
                  filas<-as.matrix(datos[,1])
                  prin1<-componente[,1] ;prin2<-componente[,2]
              
              if (numgraf==4){codos();histograma() }
              
              if (numgraf==7){bibplot();histograma()}
             
              if (numgraf==6){cargas();histograma() }
             
              if (numgraf==1){codos(); cargas();bibplot();histograma();}
              
              if (numgraf==2){codos();cargas();           histograma()}
               
              if (numgraf==3){codos()          ;bibplot();histograma();}
             
              if (numgraf==5){        ;cargas();bibplot();histograma();} 
            
               
                   
          #construccion de los datos de salida#
          direoutdata<-paste(datosOut,".dbf",sep="")#direccion de de salida data
          clusterdata<-as.matrix(cum$stratumID);
          datofinal<-cbind(origen,clusterdata)
          write.dbf(datofinal, file=direoutdata,factor2char=TRUE,max_nchar=254)          
         #write.table(datofinal, file=direoutdata, append = FALSE, quote = TRUE, sep = ",",
         #      eol = "\n", na = "NA", dec = ".", row.names =FALSE,
         #       col.names = TRUE, qmethod = c("escape", "double"),
         #      fileEncoding = "")
                
          datosx<-cbind(x,clusterdata);
          
          #Gráfica  de centroides#
          plot.centroides(datosx);
          
      #------------------------------------------------------------------------------#
      #pares<-pairs(x,main="Andersons Iris Data 3 species",pch=21,bg=c(colors())[unclass(datos$MUN)])
            tabla<-table(cum$stratumID)
            freq<-t(as.matrix(tabla))
            freq.rownames<-as.matrix(colnames(freq))
            tabla<-cbind(freq.rownames,t(freq))
            frecuencias<-paste(frecuencias,".html",sep="");
            nro.row<-nrow(tabla);
            n.col<-ncol(tabla)
            sink(frecuencias)
            for(i in 1:nro.row)
            { 
             cat(tabla[i,1],";");cat(tabla[i,2],"\n");
            }
            sink()
   }
  #return(ind)
  }
  #termina la cuarta condición#
  else 
  {
  direresultado<-paste(resultadoTxt,".html",sep="");
    sink(direresultado);
    
      cat("<p>","\n")
      cat(" Los datos no permiten generar este número de estratos. Intente con un número menor.</p>","\n")
   sink()#cerramos el texto#
  }
  #termina la tercera condición#
  }
    
    else 
    { direresultado<-paste(resultadoTxt,".html",sep="");
    sink(direresultado);
    
  cat("<p>LOS RESULTADOS NO SE GENERARON PORQUE EL NÚMERO DE VARIABLES SUPERA EL","\n")
  cat("NÚMERO DE OBSERVACIONES, O BIEN, TODAS LAS VARIABLES ESTAN ALTAMENTE","\n")
  cat("CORRELACIONADAS. SE SUGIERE INCLUIR MENOS VARIABLES EN EL MODELO O ","\n")
  cat("CAMBIAR AL MENOS UNA VARIABLE. </p>","\n")
  
    
    sink()#cerramos el texto#
    #noobs();
    }
  }
  #termina la segunda condición #
  else 
    { direresultado<-paste(resultadoTxt,".html",sep="");
    sink(direresultado);
    
  cat("<p>LOS RESULTADOS NO SE GENERARON PORQUE EL NÚMERO DE VARIABLES SUPERA EL","\n")
  cat("NÚMERO DE OBSERVACIONES, O BIEN, TODAS LAS VARIABLES ESTAN ALTAMENTE","\n")
  cat("CORRELACIONADAS. SE SUGIERE INCLUIR MENOS VARIABLES EN EL MODELO O ","\n")
  cat("CAMBIAR AL MENOS UNA VARIABLE.</p>","\n")
  
      sink()#Cerramos el texto#
     # noobs()
    }    
}
#termina la primera condición#
else 
{
direresultado<-paste(resultadoTxt,".html",sep="");
sink(direresultado);
cat("<p>","\n")
cat("Los datos no permiten generar este número de estratos. Intente con un número menor.</p>","\n")
sink()#Cerramos el texto#

}
}
#termina criterio:almenos una variable es constante#
else 
{
direresultado<-paste(resultadoTxt,".html",sep="");
sink(direresultado);
cat("<p>","\n")
cat("El indicador es constante para esta selección, por lo que no se pueden conformar estratos.</p>","\n")
sink()#Cerramos el texto#

}

}    
#Analisis_componentes("E:/componentes R oscar duran/multiStrat.dbf","E:/componentes R oscar duran/resultado/","Cor",1,1,6);