bag.crossover <- function (parent1, parent2) {
#Created with inspiration from http://algorytmy-genetyczne.eprace.edu.pl/664,Implementacja.html ,
# which I think has some errors corrected bellow.
if(length(parent1)!=length(parent2))
stop("Parents have different lengths")
parentLength <- length(parent1)
crossLength <- sample(1:parentLength,1,replace=T)#lenght of crossing segment
ibeg <- sample(1:(parentLength-crossLength+1),1,replace=T)#index of begining of crossing segment
iend <- (ibeg+crossLength-1) #index of end
SegmentParent <- matrix(data=c(parent1[ibeg:iend], parent2[ibeg:iend]), byrow = T,nrow=2, ncol=crossLength)#crossing
#segment for both parents
child <-c()
child[ibeg:iend] <-SegmentParent[1,]
for(locus in 1:parentLength){
soughtAllele <-parent2[locus]
saPosParent1 <- which( SegmentParent[1,] == soughtAllele) #soughtAllele position in parent 1
saPosParent2 <- which( SegmentParent[2,] == soughtAllele) #soughtAllele position in parent 2
if (length(saPosParent1)) {#Number occurred yet in crossing segment
next
}
else if (length(saPosParent2) ){#Occured in skipped segment
newSoughtAllele <- soughtAllele
while (length(saPosParent2)){
newLocus <- saPosParent2[1]
newSoughtAllele <- SegmentParent[1,newLocus]
saPosParent2 <- which( SegmentParent[2,] == newSoughtAllele)
if(!length(saPosParent2)){
break
}
}
saPosParent2 <- which( parent2 == newSoughtAllele)
newLocus <- saPosParent2[1]
child[newLocus] <- soughtAllele
}
else{#Doesnt occured in crossing segments. Let it stay, where it is now
child[locus] <- soughtAllele
}
}#for
return (child)
}
Raw can be downloaded from http://pastebin.com/7FMfrzfp
Thursday, January 10, 2013
PMX Crossover (Krzyżowanie PMX )
My implementation of PMX crossover written in R.
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment