","\n")
cat("
","\n")
cat("| *** AVISO IMPORTANTE *** |
","\n")
cat("Antes de utilizar los resultados de la estratificación multivariada, se sugie");
cat("re analizar detalladamente los resultados del modelo.","\n");cat("\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. ","\n");cat("\n");
cat("
","\n")
cat("| *** ESTRATIFICACIÓN MULTIVARIADA *** |
","\n")
cat("Se presentan los resultados de la estratificación multivariada por el método de","\n");
cat("k-medias. Adicionalmente, se muestran los resultados de un análisis de componentes","\n");
cat("principales como un auxiliar para la evaluación del comportamiento de las","\n");
cat("variables utilizadas para la estratificación.","\n");cat("\n");
cat("\n");
cat("
","\n")
cat("| Análisis de componentes principales |
","\n")
}
propo<-function()
{
#Importamos descriptores#
DIRE.DECRIP<-paste("DescriptoresSel.dbf",sep="")
DESCRIP<-as.matrix(read.dbf(file=DIRE.DECRIP));
#DESCRIP<-as.matrix(rsDescriptores);
descripcion<-function()
{cat("
Descriptores para cada variable seleccionada:
", "\n \n");
for(i in 1:nrow(DESCRIP))
{ temp<-DESCRIP[i]
cat("
",temp,"\n");
}
cat("
","\n");
# print(DESCRIP);cat("\n");
}
#cat("\n"); cat("$Porcentaje de la varianza explicada por la primera componente principal","\n")
#print(resultado[1,2]);
#cat(" Nota: Es deseable que este valor sea lo más próximo al 100%.","\n");cat("\n")
#cat("$","\n");
cat("\n")
#Costruimos el modelo#
{ cat("Modelo:
","\n"); cat("princomp(formula=",fmla,",data=datos,cor=TRUE,scores=T)
","\n");cat("\n") }
# cat("Desviación estándar","\n");print(comprin$sdev); cat("\n");
cat("
Desviación estándar: ","\n");
meanh<-as.matrix(names(comprin$sdev));
dati<-cbind(meanh,round(comprin$sdev,digits=3))
dat<-t(dati)
fila<-nrow(dat);colum<-ncol(dat);
cat("
","\n")
for(i in 1:fila)
{
for(j in 1:colum)
{ if(j==1 & i==1 ){cat("| ",dat[i,j]," | ")}
else if(j==1 & i>1){cat("
| ",dat[i,j]," | ")}
else if(j==colum){cat(" ",dat[i,j]," | ","\n")}
else {cat(" ",dat[i,j]," | ")}
}
}
cat("
","\n")
cat("
")
nuvar<-nrow(as.matrix(comprin$sdev))
cat("
Selección de Indicadores: ",comprin$n.obs,"observaciones y ",nuvar," variables.
","\n")
descripcion();
cat("\n");cat("\n");cat("\n");
dat<-t(as.matrix(importancia))
importance<-function(dat)
{
dat<-round(dat,digits=3)
colna<-as.matrix(colnames(dat))
rowna<-as.matrix(rownames(dat))
cat("
Importancia de las componentes principales:
","\n")
cat("
","\n")
for(i in 1:(nrow(colna)+1))
{ if(i==1) {cat("| ","Descriptor"," | ")}
else {cat(" ",colna[(i-1)]," | ")}
}
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("
| ",dat[i,j]," | ")}
else if(j==colum){cat(" ",dat[i,j]," | ","\n")}
else {cat(" ",dat[i,j]," | ")}
}
}
cat("
","\n")
cat("
")
}
importance(dat);
cat("\n"); cat("\n"); cat("\n");
}
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 = 900, height = 900)
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()
}
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
filas<-rownames(xvar)
prin1<-componente[,1] ;prin2<-componente[,2]
diredendrograma<-paste(dendrograma,".pdf",sep="")
diredendrogramajpg<-paste(dendrograma,".jpg",sep="")
dendrograma<-function()
{
pdf(file=diredendrograma)
hc <- hclust(dist(x), "average")
plot(hc, main="Dendograma \n Método: distancia media entre estratos",xlab="Observaciones",ylab="Distancia",labels=as.matrix(datos[,1]))
dev.off()
jpeg(filename=diredendrogramajpg,width = 900, height = 900)
hc <- hclust(dist(x), "average")
plot(hc, main="Dendograma \n Método: distancia media entre estratos",xlab="Observaciones",ylab="Distancia",labels=as.matrix(datos[,1]))
dev.off()
}
#-------------------------------------------------------------------------------#
if(nrow(x)<=100)
{
#combinaciones de salidas para graficos#
filas<-as.matrix(datos[,1])
if (combinagraf==1) { bibplot();dendrograma();}
if (combinagraf==2) { dendrograma();}
if (combinagraf==3) { bibplot(); }
}
else if(nrow(x)>100)
{
#combinaciones de salidas para graficos#
filas<-as.matrix(datos[,1])
if (combinagraf==1) { bibplot()}
if (combinagraf==2) { }
if (combinagraf==3) { bibplot(); }
}
#-------------------------------------------------------------------------------#
#Exportamos la salida completa #
direresultado<-paste(resultadoTxt,".html",sep="")
if (outtx==1)
{ sink(direresultado) #redirige la salida al fichero salida.txt
titulo();propo();
cat("
","\n")
cat("| Estratificación por el método de k-medias |
","\n")
resumen(kmedias)
sink() #redirige a la salida por defecto (pantalla)
}
if (outtx==2)
{ sink(direresultado) #redirige la salida al fichero salida.txt
titulo();propo();
cat("
","\n")
cat("| Estratificación por el método de k-medias |
","\n")
corta(kmedias);
sink() #redirige a la salida por defecto (pantalla)
}
if (outtx==3)
{ sink(direresultado) #redirige la salida al fichero salida.txt
titulo();propo();
cat("
","\n")
cat("| Estratificación por el método de k-medias |
","\n")
completa(kmedias);
sink() #redirige a la salida por defecto (pantalla)
}
#Histograma para los clusters#
direplot<-paste(histograma,".pdf",sep="")
pdf(file=direplot)
barplot(table(kmedias$cluster),xlab="Estratos",ylab="Conteos",main="Histograma:\n Estratificación por el método de k-medias",
col=c("darkgreen","dimgray","darkblue","midnightblue"));
abline(h=0,lty=1)
#abline(v=0,lty=1)
dev.off()
direplotjpg<-paste(histograma,".jpg",sep="")
jpeg(filename=direplotjpg,width = 900, height = 900)
barplot(table(kmedias$cluster),xlab="Estratos",ylab="Conteos",main="Histograma:\n Estratificación por el método de k-medias",
col=c("darkgreen","dimgray","darkblue","midnightblue"));
abline(h=0,lty=1)
dev.off()
#Exportamos la base ya con sus estratos#
direoutdata<-paste(datosKmeans,".dbf",sep="")#direccion de de salida data
clusterdata<-as.matrix(kmedias$cluster);
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);
#--------------------------------------#
tabla<-table(clusterdata)
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(kmedias)
}
else
{ direresultado<-paste(resultadoTxt,".html",sep="");
sink(direresultado);
cat("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.","\n")
sink()
#noobs();
}
}
else
{ direresultado<-paste(resultadoTxt,".html",sep="");
sink(direresultado);
cat("
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.","\n")
sink()#Cerramos el texto#
#noobs();
}
#}#termina filtro por frecuencia#
#else
#{
#direresultado<-paste(resultadoTxt,".html",sep="");
#sink(direresultado);
#cat("
","\n")
#cat(" El número de estratos que se desea conformar no es factible. Reducir el número de estratos.
","\n")
#sink()#Cerramos el texto#
#}
}#termina criterio:almenos una variable es constante#
else
{
direresultado<-paste(resultadoTxt,".html",sep="");
sink(direresultado);
cat("
","\n")
cat("El indicador es constante para esta selección, por lo que no se pueden conformar estratos.
","\n")
sink()#Cerramos el texto#
}
}
#(diredata ,direout ,combinagraf ,itermax,estrato ,outtx)
#kmedias("E:/componentes R oscar duran/multiStrat.dbf","E:/componentes R oscar duran/resultado/", 1 ,6 ,6 ,3 );
criterio<-function(diredata ,direout,combinagraf,itermax,estrato,outtx)
{
crite<-warnings();#convergencia#
diremen<-paste("Prueba.txt",sep="");
sink(diremen); #redirige la salida al fichero salida.txt
print(crite);
cat("\n");cat("\n");cat("\n");
citation()
sink();
}
#criterio("E:/componentes R Aron/multiStrat.dbf","E:/componentes R Aron/resultado/", 1 ,6 ,6 ,3 );
#quit("yes") #cerrar R#