Guest User

Untitled

a guest
Jul 18th, 2018
98
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.87 KB | None | 0 0
  1. target<-utf8ToInt("Hello World")
  2.  
  3. #####Random Mating with Mutation. No selective breeding at all.
  4.  
  5. #The generation array stores each generation (duh)
  6. generation<- array(0,c(100,11,100))
  7. generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
  8. #Two for loops is generally an R no-no, but since the computation is explicitly serial, I wasn't sure how to get around it
  9. #However I was able to put most of the random number generation in the outer loop and use indices to pick and choose which
  10. #ones I wanted.
  11. for (n in 2:100) {
  12. #We randomly select parents from the preceding generation. r.split tells us how the traits will be passed on to
  13. #offspring. sel.mutate picks a single element in the child for mutation
  14. parent.1<- sample(nrow(generation[,,n-1]),nrow(generation[,,n-1])/2,replace=FALSE)
  15. parent.2<- setdiff(1:100,parent.1)
  16. parents<- c(parent.1,parent.2)
  17. r.split<- round(runif(100,min=2,max=10))
  18. sel.mutate<- round(runif(100,min=1,max=11))
  19. #The inner loop operates over the columns of each of n generations. We pair parents from the preceding generation and get
  20. #child traits in one line.
  21. for (j in 1:100) {
  22. generation[j,,n]<- c(generation[parents[j],1:r.split[j],n-1],generation[parents[101-j],(r.split[j]+1):11,n-1])
  23. #The boundaries for mutation are set because we are using integers which represent UTF-8 characters and I want to stick between
  24. #0-255. I'm sure there is a more elegant way to do this.
  25. if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
  26. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
  27. else if (generation[j,sel.mutate[j],n] < 5)
  28. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
  29. else
  30. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
  31. }
  32. }
  33.  
  34. ####Tournament style mating. Sort of.
  35. #Same mutation and chromosome swap as the random mating.
  36. #Actually doesn't converge because we don't pull people out of the pool!
  37. #Will take a little bit of time to run what with the really inefficient/ugly code
  38. generation<- array(0,c(100,11,200))
  39. generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
  40. for (n in 2:200) {
  41. tour.parents<-matrix(0,nrow=50,ncol=2)
  42. past.parent<-numeric(0)
  43. second.pot.parent<- numeric(0)
  44. #This loop chooses parents. We select 2 at random from the pool which has not already been selected.
  45. #If the fitness of one is higher, we choose that as the first parent, then choose the second one in the same fashion
  46. #Repeat 50 times and we have our 50 pairs.
  47. for (j in 1:50) {
  48. pot.parent<-sample(setdiff(1:100,past.parent),2,replace=FALSE)
  49. if (sum(abs(target-generation[pot.parent[1],,n-1])) <= sum(abs(target-generation[pot.parent[2],,n-1]))) {
  50. tour.parents[j,1]<-pot.parent[1]
  51. second.draw<- sample(setdiff(1:100,c(pot.parent[2],past.parent)),1,replace=FALSE)
  52. second.pot.parent<- pot.parent[2]
  53. }
  54. else {
  55. tour.parents[j,1]<-pot.parent[2]
  56. second.draw<- sample(setdiff(1:100,c(pot.parent[1],past.parent)),1,replace=FALSE)
  57. second.pot.parent<- pot.parent[1]
  58. }
  59. if (sum(abs(target-generation[second.pot.parent,,n-1])) <= sum(abs(target-generation[second.draw,,n-1]))) {
  60. tour.parents[j,2]<-second.pot.parent
  61. }
  62. else {
  63. tour.parents[j,2]<-second.draw
  64. }
  65. past.parent<- c(past.parent,tour.parents[j,])
  66. pot.parent<-numeric(0)
  67. second.pot.parent<-numeric(0)
  68. }
  69. #Because we have 50 parents and want 100 members of the next generation, each has two kids, with the opposite chromosome split.
  70. r.split<- round(runif(100,min=2,max=10))
  71. for (j in 1:50) {
  72. generation[j,,n]<- c(generation[tour.parents[j,1],1:r.split[j],n-1],generation[tour.parents[j,2],(r.split[j]+1):11,n-1])
  73. generation[101-j,,n]<- c(generation[tour.parents[j,2],1:r.split[j],n-1],generation[tour.parents[j,1],(r.split[j]+1):11,n-1])
  74. }
  75. #Same mutation as the random mating.
  76. sel.mutate<- round(runif(100,min=1,max=11))
  77. for (j in 1:100) {
  78. if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
  79. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
  80. else if (generation[j,sel.mutate[j],n] < 5)
  81. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
  82. else
  83. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
  84. }
  85. }
  86.  
  87. ###Some removal of the bottom 10% of solutions. Not effective (as the graph shows)
  88. dec.quant<- seq(0, 1, 0.1)
  89. generation<- array(0,c(100,11,500))
  90. generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
  91. for (n in 2:dim(generation)[3]) {
  92. tour.parents<-matrix(0,nrow=50,ncol=2)
  93. past.parent<- rep.parents<- rm.parents <- numeric(0)
  94. second.pot.parent<- numeric(0)
  95. r.split<- round(runif(100,min=2,max=10))
  96. for (j in 1:50) {
  97. pot.parent<-sample(setdiff(1:100,past.parent),2,replace=FALSE)
  98. if (sum(abs(target-generation[pot.parent[1],,n-1])) <= sum(abs(target-generation[pot.parent[2],,n-1]))) {
  99. tour.parents[j,1]<-pot.parent[1]
  100. second.draw<- sample(setdiff(1:100,c(pot.parent[2],past.parent)),1,replace=FALSE)
  101. second.pot.parent<- pot.parent[2]
  102. }
  103. else {
  104. tour.parents[j,1]<-pot.parent[2]
  105. second.draw<- sample(setdiff(1:100,c(pot.parent[1],past.parent)),1,replace=FALSE)
  106. second.pot.parent<- pot.parent[1]
  107. }
  108. if (sum(abs(target-generation[second.pot.parent,,n-1])) <= sum(abs(target-generation[second.draw,,n-1]))) {
  109. tour.parents[j,2]<-second.pot.parent
  110. }
  111. else {
  112. tour.parents[j,2]<-second.draw
  113. }
  114. generation[j,,n]<- c(generation[tour.parents[j,1],1:r.split[j],n-1],generation[tour.parents[j,2],(r.split[j]+1):11,n-1])
  115. generation[101-j,,n]<- c(generation[tour.parents[j,2],1:r.split[j],n-1],generation[tour.parents[j,1],(r.split[j]+1):11,n-1])
  116. past.parent<- c(past.parent,tour.parents[j,])
  117. pot.parent<- second.pot.parent<- numeric(0)
  118. }
  119. sel.mutate<- round(runif(100,min=1,max=11))
  120. for (j in 1:100) {
  121. if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
  122. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
  123. else if (generation[j,sel.mutate[j],n] < 5)
  124. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
  125. else
  126. generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
  127. }
  128. rm.parents<- which (rowSums(abs(target.mat-generation[,,n])) > quantile(rowSums(abs(target.mat-generation[,,n])),probs= dec.quant)[[10]])
  129. rep.parents<- sample(which (rowSums(abs(target.mat-generation[,,n-1])) < quantile(rowSums(abs(target.mat-generation[,,n-1])),probs= dec.quant)[[3]]),size=length(rm.parents))
  130. generation[rm.parents,,n]<- generation[rep.parents,,n-1]
  131. rep.parents<- rm.parents <- numeric(0)
  132. }
  133. ###Plotting the output. this plots the minimum. You could choose the average or whatever.
  134. no.select<-numeric(0)
  135. for (n in 1:dim(generation)[3]) {no.select[n]<- min(rowSums(abs(target-generation[,,n])))}
  136. plot(1:dim(generation)[3],no.select,type="l")
Add Comment
Please, Sign In to add comment