3.
ALGORITMOS GENÉTICOS: CÓDIGO EN R
3.1.
PROGRAMA EN R: ALGORITMOS GENÈTICOS
simulaciones<-1000
tasas.t<-array(NA,dim=c(simulaciones,2))
for (im in 1:simulaciones){
library(MASS)
muestral<-mvrnorm(n=20,rep(l,2),matrix(c(l,0.3,0.3,1),2,2))
muestra2<-mvrnorm(n=20,rep(2,2),matrix(c(1,O.1,O.1,1),2,2))
población.simulada<-rbind((cbind(muestral,c(0))),(cbind(muestra2,c(1))))
muestralK-mvrnorm(n=20,rep(1,2),matrix(c(l,0.3,0.3,1),2,2))
muestra22<-mvrnorm(n=20,rep(2,2),matrix(c(l,0.1,0.1,1),2,2))
población.simuladal<-rbind((cbind(muestral1,c(0))),(cbind(muestra22,c(l))))
tamaño.p<-30
variables<-2
iteraciones<-30
Ngen<-11
cromosomas<-array(sample(c(0,1),(Ngen*variables)*(tamano.p),replace=T),
dim=c(tamano.p,(variables*Ngen)))
transforma.binario.a.decimal<-function(Ngen){
y<-length(Ngen)
pot<-2?seq((y - 1), 0)
tem p < -sum(Ngen *
pot)
}
generacion.de.w<-function(matriz,variables){
n<-ncol (matriz)
m<-nrow (matriz)
z<-variables-1
tamano<-(n/variables)-1
matriz.w<-array(NA,dim=c(m,variables))
for(j in 1:m){
for(i in 0:z){
x<-i*(tamano+l)+2
y<-(tamano+1)*(i+1)
w<-(tamano+1)*i+1
if(matriz[j,w]==0
matriz.w[j,(i+1)]<-(transforma.binario.a.decimal(matriz[j,x:y]))*(-1)
}
else{
matriz.w[j,(i+1)]<-transforma.binario.a.decimal(matriz[j,x:y])
}
}
}
matriz.w
matriz.w1<-apply (matriz,w,2,abs)
matriz.w2<-apply(matriz,w1,1,max)
matriz.w3<-matriz.w/matriz.w2
}
generacion.de.z<-function(matriz.x,vector.w){
tempK-apply (vector,w,1,as.vector)
matriz. x %* %temp1
operacion<-function(obj,y){
temp<-obj-y
temp1<-apply(temp,2,sum)
}
Operacion1<-function(obj,y){
temp<-abs(obj-y)
temp1<-apply(temp,2,sum)
}
indice<-function(z1 ,z2){
n<-ncol(z1)
resultado<-array(0,dim=c(nrow(zl),n))
resultado1<-array(0,dim=c(nrow(z1),n))
for(i in l:n){
if (i==i) {resultado[,i]<-apply(as.matrix(z1[,i]),1,
operacion,as.matrix(z2[,i]))
resultado1[,i]<-apply(as.matrix(z1[,i]),1,operacion1,as.matrix(z2[,i]))}}
resultado<-resultado*(-1)
resultado<-apply(resultado,2,sum)
resultado1<-apply(resultado1,2,sum)
resultadofinal<-(resultado/resultado1)
}
SortMat<-function(Mat,Sort){
m<-do.call(’order’,as.data.frame(Mat[,Sort]))
Mat[m,]
}
—–Genera un par de hijos por la pareja—–
generar.hijos.de.pareja<-function(padremadre){
n1-length(padremadre)
n<-n1/2
padre<-padremadre[1:n]
madre<-padremadre[(n+1):n1]
k<-sample(1:(n-1),1)
hijo1<-c(padre[1:k],madre[(k+1):n])
hijo2<-c(madre[1:k],padre[(k+1):n])
result<-c(hijo1,hijo2)
—–Funcion de selección—–
seleccion<-function(población.ordenada){
n<-nrow(población.ordenada)
nmedio<-n %/ %2
npar<-(nmedio %/ %2)*2
padres<-poblacion.ordenada[seq(1,npar,by=2),]
madres<-poblacion.ordenada[seq(2,npar,by=2),]
hijos<-apply(cbind(padres,madres),1,generar.hijos.de.pareja)
hijos<-matrix(hijos,ncol=ncol(poblacion.ordenada),byrow=T)
nueva.poblacion<-rbind(padres,madres,hijos)
nueva.poblacion
}
—–Función mutación—–
mutaciones<-function(Población,porcentaje=0.05){
n<-nrow(Poblacion)
n1<-ceiling(n*porcentaje)
k1<-sample(2:n,n1,replace=F)
k2<-sample(1:ncol(Poblacion),n1,replace=T)
Poblacion[k1,k2]<-((Poblacion[kl,k2]+l) % % 2)
Poblacion
}
discriminacion<-function(matriz,numero,corte){
punto.de.corte<-quantile(matriz[,numero],probs = corte)
n<-nrow(matriz)
temp<-array(NA,dim=c(n,1))
for(i in 1:n){
if(matriz[i,numero]<=punto.de.corte){
temp[i,1]<-1
}
else{
temp[i,l]<-0
}
}
matriz<-cbind(matriz,temp)
}
discriminacion1<-function(matriz,numero,corte){
punto.de.corte<-quantile(matriz[,numero],probs = 1-corte)
n<-nrow(matriz)
temp<-array(NA,dim=c(n,1))
f
or(i in 1 :n){
if (matriz [i , numero]<=punto.de.corte){
temp[i,l]<-0
}
else{
temp[i,1]<-1
}
}
matriz<-cbind (matriz, temp)
}
—–iteraciones—–
uno<-generacion.de.w(cromosomas,variables)
z1<-generacion.de.z(muestra1,uno)
z2<-generacion.de.z(muestra2,uno)
dos<-cbind(cromosomas,indice(z1,z2))
poblacion<-SortMat(dos,(Ngen*variables)+l)
for(ic in 1 : iteraciones) {
hijos<-seleccion(poblacion[,1:(Ngen*variables)])
generacion<-mutaciones(hijos [,1:(Ngen*variables)],porcentaje=0.05)
uno1-generacion.de.w(generacion,variables)
z1<-generacion.de.z(muestra1,uno1)
z2<-generacion.de.z(muestra2,uno1)
dos1<-cbind(generacion,indice(z1,z2))
poblacion<-SortMat(dos1,(Ngen*variables)+1)
}
cromosomas<-poblacion[,l:(Ngen*variables)]
uno<-generacion.de.w(cromosomas,variables)
w.elegido<-as.matrix(uno[1,])
sco.resultados<-generacion.de.z(poblacion.simulada[,1:2],w.elegido)
población.total<-cbind(poblacion.simulada1,sco.resultados)
población.total<-SortMat(población.total,4)
resul<-discriminacion(poblacion.total,4, nrow(muestra2)
/(nrow(muestral)+nrow(muestra2)))
resul-resul[,-4]
—–DISCRIMINACION
LOGISTICA—–
x1<-poblacion.simulada[,1]
x2<-poblacion.simulada[,2]
y<-poblacion. simulada[,3]
simulacion<-data.frame(x1,x2,y)
datos<-glm(y ˜ x1+x2,family=binomial)
predicho<-array(predict(datos),dim=c(nrow(simulacion),1))
logistica<-cbind(población.simuladal,predicho)
logistica<-SortMat(logística,4)
salida<-diseriminacionKlogística,4,nrow(muestra2)
/(nrow(muestral)+nrow(muestra2)))
salida<-salida[,-4]
—–TASA
DE
CLASIFICACIÓN
ERRONEA—–
matriz.
clasificacion<-function(matriz,res.final){
a<-ifelse(matriz==0&res.final==0,1,0)
b<-ifelse(matriz==l&res.final==l,1,0)
c<-ifelse(matriz==0&res.final==1,1,0)
d<-ifelse(matriz==lres.final==0,1,0)
final<-cbind(a,b,c,d)
e<-apply(final,2,sum)
}
nda<-matriz.clasificacion( resul [,3] ,resul[,4] )
logistica<-matriz.clasificacion( salida[,3],salida [, 4] )
t
asa.de.error.nda<- (nda [3] +nda [4] ) /sum (nda)
tasa.de.error.logistica<-(logistica[3]+logistica[4] ) /sum (logística)
tasa.erronea<-cbind (tasa.de.error.nda,tasa.de.error.logistica)
tasas .t [im,] <-tasa. erronea
}
tasas.t
sum(tasas.t[,1])
sum(tasas.t[,2])
Mister Wong
Portal para Investigadores y Profesionales
