API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 19th, 2019
117
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.25 KB | None | 0 0
raw download clone embed print report
  1. require(GA)
  2. require(globalOptTests)
  3. #### Wykorzystywane funkcje: Bohachevsky2, GoldPrice, Branin
  4. function_name = "Bohachevsky2"
  5.  
  6. #### Liczba serii
  7. series_amount = c(1,2,3,4)
  8.  
  9. #### Liczba iteracji dla usredniania wynikow
  10. for_avg_iterations = 15
  11.  
  12. #### Rozmiar populacji
  13. population_size = c(5, 25, 50, 100, 125, 150, 175, 200)
  14. population_size_default = 50
  15.  
  16. #### Liczba generacji
  17. generation_size = c(5, 25, 50, 100, 125, 150, 175, 200)
  18. generation_size_default = 100
  19.  
  20. #### Selekcja elitarna
  21. elitism_range = seq(0, 1, by = 0.05)
  22. elitism_default = 0.05
  23.  
  24. #### Prawdopodobienstwo krzyzowania
  25. pcrossover_range = seq(0, 1, by = 0.1)
  26. pcrossover_default = c(0,1,0,1)
  27.  
  28. #### Prawdopodobienstwo mutacji
  29. pmutation_range = seq(0, 1, by = 0.1)
  30. pmutation_default =c(0,0,1,1)
  31.  
  32. #### Funkcja zwracajaca przedzial zmiennych
  33. get_bounds <- function(p.n) {
  34. return(seq(getDefaultBounds(function_name)$lower[p.n], getDefaultBounds(function_name)$upper[p.n],length.out = 100))
  35. }
  36.  
  37. #### Funkcja zwracajaca wartość funkcji z globalOptTests
  38. fun <- function(x1, x2) {
  39. # Oblicz wartość funkcji o zadanej nazwie
  40. result <- goTest(c(x1, x2), function_name, TRUE)
  41. return(result)
  42. }
  43.  
  44. get_max_value_from_series <- function(result_values_in_series) {
  45. max_range_val<-0
  46. for(result_vector_idx in series_amount){
  47. for(val in result_values_in_series[result_vector_idx,1]){
  48. max_vector_val = max(val)
  49. if(max_vector_val>max_range_val){
  50. max_range_val = max_vector_val
  51. }
  52. }
  53. }
  54. return (max_range_val+max_range_val*4/10)
  55. }
  56. #### Obliczenie zakresu zmiennych
  57. x1_range <- get_bounds(1)
  58. x2_range <- get_bounds(2)
  59.  
  60. #### Oblicz wartosci funkcji do wykresu
  61. f <- outer(x1_range, x2_range, Vectorize(fun))
  62.  
  63. #### Narysuj wykres 3D
  64. persp3D(x1_range, x2_range, f, theta = -45, phi = 25,
  65. nlevel = 36, shade = 0.33,
  66. color.palette = jet.colors,
  67. xlab = "x1",
  68. ylab = "x2",
  69. zlab = "f(x1, x2)")
  70.  
  71. #### Przebieg algorytmu dla wartości domyślnych
  72. generic_alghoritm <- ga(type = "real-valued",
  73. fitness = function(x) - fun(x[1], x[2]),
  74. min = c(getDefaultBounds(function_name)$lower[1],
  75. getDefaultBounds(function_name)$lower[2]),
  76. max = c(getDefaultBounds(function_name)$upper[1],
  77. getDefaultBounds(function_name)$upper[2]),
  78. popSize = population_size_default, maxiter = generation_size_default,
  79. pmutation = pmutation_default, pcrossover = pcrossover_default,
  80. elitism = elitism_default)
  81.  
  82. #### Podsumowanie i wykres
  83. summary(generic_alghoritm)
  84. plot(generic_alghoritm)
  85. # Wykres konturowy
  86. filled.contour(x1_range, x2_range, f, color.palette = jet.colors,
  87. plot.axes = {
  88. axis(1); axis(2);
  89. points(generic_alghoritm@solution[,1], generic_alghoritm@solution[,2],
  90. pch = 3, cex = 2, col = "white", lwd = 2)
  91. }
  92. )
  93.  
  94. #### Funkcja usredniajaca wyniki zadana ilosc razy
  95. avg <- function(p.popSize, p.maxiter, p.pmutation,
  96. p.pcrossover, p.elitism) {
  97. # Suma rozwiazan
  98. solution = 0
  99. result.generic_alghoritm <- NULL
  100. for (i in seq(1, for_avg_iterations, by = 1)) {
  101. result.generic_alghoritm <- ga(type = "real-valued",
  102. fitness = function(x)
  103. -fun(x[1], x[2]),
  104. min = c(getDefaultBounds(function_name)$lower[1],
  105. getDefaultBounds(function_name)$lower[2]),
  106. max = c(getDefaultBounds(function_name)$upper[1],
  107. getDefaultBounds(function_name)$upper[2]),
  108. popSize = p.popSize,
  109. maxiter = p.maxiter,
  110. pmutation = p.pmutation,
  111. pcrossover = p.pcrossover,
  112. elitism = p.elitism)
  113. solution = solution + fun(result.generic_alghoritm@solution[,1],
  114. result.generic_alghoritm@solution[,2])
  115. }
  116.  
  117. #### Zwroc usrednione rozwiazanie
  118. return(solution / for_avg_iterations)
  119. }
  120.  
  121. #### Badanie GA przy zmiennej populacji
  122. results.popSize.series <- as.list(numeric(4*1))
  123. dim(results.popSize.series) <- c(4,1)
  124. for(s in series_amount){
  125. results.popSize <- NULL
  126. for (j in population_size) {
  127. results.popSize <- c(results.popSize,
  128. avg(j, generation_size_default, pmutation_default[s],
  129. pcrossover_default[s], elitism_default))
  130. }
  131. results.popSize.series[[s,1]] <- results.popSize
  132. }
  133.  
  134.  
  135.  
  136. #### Rysunek dla badanie GA przy zmiennej populacji
  137. a = data.frame(x = population_size, f = results.popSize.series[[1,1]])
  138. plot(a, ylim = c(getGlobalOpt(function_name), get_max_value_from_series(results.popSize.series)),
  139. yaxs="r", xaxs="r", type="o", col="blue",
  140. main="Wykres wartości funkcji dla zmieniającego się rozmiaru populacji",
  141. xlab="Rozmiar populacji", ylab="Wartość funkcji")
  142. abline(getGlobalOpt(function_name), 0, col = "green")
  143. lines(population_size, results.popSize.series[[2,1]], col = "red")
  144. points(population_size, results.popSize.series[[2,1]], col = "red")
  145. lines(population_size, results.popSize.series[[3,1]], col = "grey")
  146. points(population_size, results.popSize.series[[3,1]], col = "grey")
  147. lines(population_size, results.popSize.series[[4,1]], col = "steelblue")
  148. points(population_size, results.popSize.series[[4,1]], col = "steelblue")
  149. legend( x="topleft",
  150. legend=c("S1: krz=0, mut=0","S2: krz=1, mut=0","S3: krz=0, mut=1","S4: krz=1, mut=1"),
  151. col=c("red","green","grey","steelblue"), lwd=1, lty=1,
  152. pch=c(NA,NA) )
  153.  
  154. #### Testy liczby generacji
  155. results.maxiter.series <- as.list(numeric(4*1))
  156. dim(results.maxiter.series) <- c(4,1)
  157. for(s in series_amount){
  158. results.maxiter <- NULL
  159. for (j in generation_size) {
  160. results.maxiter <- c(results.maxiter,
  161. avg(population_size_default, j, pmutation_default[s],
  162. pcrossover_default[s], elitism_default))
  163. }
  164. results.maxiter.series[[s,1]] <- results.maxiter
  165. }
  166.  
  167.  
  168.  
  169. #### Wykres dla paramatru: liczba generacji
  170. b = data.frame(x = generation_size, f = results.maxIter.series[[1,1]])
  171. plot(b, ylim = c(getGlobalOpt(function_name), get_max_value_from_series(results.maxIter.series)),
  172. yaxs="r", xaxs="r", type="o", col="blue",
  173. main="Wykres wartości funkcji dla zmieniającej się liczby generacji",
  174. xlab="Liczba generacji", ylab="Wartość funkcji")
  175. abline(getGlobalOpt(function_name), 0, col = "green")
  176. lines(generation_size, results.maxIter.series[[2,1]], col = "red")
  177. points(generation_size, results.maxIter.series[[2,1]], col = "red")
  178. lines(generation_size, results.maxIter.series[[3,1]], col = "grey")
  179. points(generation_size, results.maxIter.series[[3,1]], col = "grey")
  180. lines(generation_size, results.maxIter.series[[4,1]], col = "steelblue")
  181. points(generation_size, results.maxIter.series[[4,1]], col = "steelblue")
  182. legend( x="topleft",
  183. legend=c("S1: krz=0, mut=0","S2: krz=1, mut=0","S3: krz=0, mut=1","S4: krz=1, mut=1"),
  184. col=c("red","green","grey","steelblue"), lwd=1, lty=1,
  185. pch=c(NA,NA))
  186.  
  187. #### Testy prawd. mutacji
  188. results.pmutation.series <- as.list(numeric(4*1))
  189. dim(results.pmutation.series) <- c(4,1)
  190. for(s in series_amount){
  191. results.pmutation <- NULL
  192. for (j in pmutation_range) {
  193. results.pmutation <- c(results.pmutation,
  194. avg(population_size_default, generation_size_default, j,
  195. pcrossover_default[s], elitism_default))
  196. }
  197. results.pmutation.series[[s,1]] <- results.pmutation
  198. }
  199. #### Wykres dla paramatru: prawd. mutacji
  200. c = data.frame(x = pmutation_range, f = results.pmutation.series[[1,1]])
  201. plot(c, ylim = c(getGlobalOpt(function_name), get_max_value_from_series(results.pmutation.series)),
  202. yaxs="r", xaxs="r", type="o", col="blue",
  203. main="Wykres wartości funkcji dla zmieniającego się prawd. mutacji",
  204. xlab="Prawd. mutacji", ylab="Wartość funkcji")
  205. abline(getGlobalOpt(function_name), 0, col = "green")
  206. lines(pmutation_range, results.pmutation.series[[2,1]], col = "red")
  207. points(pmutation_range, results.pmutation.series[[2,1]], col = "red")
  208. lines(pmutation_range, results.pmutation.series[[3,1]], col = "grey")
  209. points(pmutation_range, results.pmutation.series[[3,1]], col = "grey")
  210. lines(pmutation_range, results.pmutation.series[[4,1]], col = "steelblue")
  211. points(pmutation_range, results.pmutation.series[[4,1]], col = "steelblue")
  212. legend( x="topleft",
  213. legend=c("S1: krz=0, mut=0","S2: krz=1, mut=0","S3: krz=0, mut=1","S4: krz=1, mut=1"),
  214. col=c("red","green","grey","steelblue"), lwd=1, lty=1,
  215. pch=c(NA,NA) )
  216.  
  217. #### Testy prawd. krzyzowania
  218. results.pcrossover.series <- as.list(numeric(4*1))
  219. dim(results.pcrossover.series) <- c(4,1)
  220. for(s in series_amount){
  221. results.pcrossover <- NULL
  222. for (j in pcrossover_range) {
  223. results.pcrossover <- c(results.pcrossover,
  224. avg(population_size_default, generation_size_default, pmutation_default[s],
  225. j, elitism_default))
  226. }
  227. results.pcrossover.series[[s,1]] <- results.pcrossover
  228. }
  229. #### Wykres dla paramatru: prawd. krzyzowania
  230. d = data.frame(x = pcrossover_range, f = results.pcrossover.series[[1,1]])
  231. plot(d, ylim = c(getGlobalOpt(function_name), get_max_value_from_series(results.pcrossover.series)),
  232. yaxs="r", xaxs="r", type="o", col="blue",
  233. main="Wykres wartości funkcji dla zmieniającego się prawd. krzyżowania",
  234. xlab="Prawd. krzyżowania", ylab="Wartość funkcji")
  235. abline(getGlobalOpt(function_name), 0, col = "green")
  236. lines(pcrossover_range, results.pcrossover.series[[2,1]], col = "red")
  237. points(pcrossover_range, results.pcrossover.series[[2,1]], col = "red")
  238. lines(pcrossover_range, results.pcrossover.series[[3,1]], col = "gray")
  239. points(pcrossover_range, results.pcrossover.series[[3,1]], col = "gray")
  240. lines(pcrossover_range, results.pcrossover.series[[4,1]], col = "steelblue")
  241. points(pcrossover_range, results.pcrossover.series[[4,1]], col = "steelblue")
  242. legend( x="topleft",
  243. legend=c("S1: krz=0, mut=0","S2: krz=1, mut=0","S3: krz=0, mut=1","S4: krz=1, mut=1"),
  244. col=c("red","green","grey","steelblue"), lwd=1, lty=1,
  245. pch=c(NA,NA) )
  246.  
  247. #### Testy selekcji elitarnej
  248. results.elitism.series <- as.list(numeric(4*1))
  249. dim(results.elitism.series) <- c(4,1)
  250. for(s in series_amount){
  251. results.elitism <- NULL
  252. for (j in elitism_range) {
  253. results.elitism <- c(results.elitism,
  254. avg(population_size_default, generation_size_default, pmutation_default[s],
  255. pcrossover_default[s], j))
  256. }
  257. results.elitism.series[[s,1]] <- results.elitism
  258. }
  259.  
  260. #### Wykres dla paramatru: selekcja elitarna
  261. e = data.frame(x = elitism_range, f = results.elitism.series[[1,1]])
  262. plot(e, ylim = c(getGlobalOpt(function_name), get_max_value_from_series(results.elitism.series)),
  263. yaxs="r", xaxs="r", type="o", col="blue",
  264. main="Wykres wartości funkcji dla zmieniającej się selekcji elitarnej",
  265. xlab="Elityzm", ylab="Wartość funkcji")
  266. abline(getGlobalOpt(function_name), 0, col = "green")
  267. lines(elitism_range, results.elitism.series[[2,1]], col = "red")
  268. points(elitism_range, results.elitism.series[[2,1]], col = "red")
  269. lines(elitism_range, results.elitism.series[[3,1]], col = "grey")
  270. points(elitism_range, results.elitism.series[[3,1]], col = "grey")
  271. lines(elitism_range, results.elitism.series[[4,1]], col = "steelblue")
  272. points(elitism_range, results.elitism.series[[4,1]], col = "steelblue")
  273. legend( x="topleft",
  274. legend=c("S1: krz=0, mut=0","S2: krz=1, mut=0","S3: krz=0, mut=1","S4: krz=1, mut=1"),
  275. col=c("red","green","grey","steelblue"), lwd=1, lty=1,
  276. pch=c(NA,NA))
  277.  
  278.  
  279.  
  280. #### Testy selekcji elitarnej dla zmiennego prawdopodobienstwa mutacji i krzyzowania
  281. temp <- NULL
  282. for (j in pmutation_range) {
  283. for (k in pcrossover_range) {
  284. temp <- c(temp, avg(population_size_default, generation_size_default, j, k, 0))
  285. }
  286. }
  287. results.mutation.crossing <- matrix(temp, nrow = length(pcrossover_range), ncol = length(pmutation_range))
  288.  
  289. filled.contour(pmutation_range, pmutation_range, results.mutation.crossing, color.palette = jet.colors,
  290. plot.title = title(main = "Wykres cieplny dla zmiennych \nprawdopodobieństw mutacji i krzyżowania",
  291. xlab = "prawdopodobieństwo krzyżowania", ylab = "prawdopodobieństwo mutacji"))
  292.  
  293.  
  294. #### Testy selekcji elitarnej dla zmiennego prawdopodobienstwa mutacji i krzyzowania
  295. temp <- NULL
  296. for (j in population_size) {
  297. for (k in generation_size) {
  298. temp <- c(temp, avg(j, k, 0.1, 0.1, 0))
  299. }
  300. }
  301. results.mutation.crossing2 <- matrix(temp, nrow = length(generation_size), ncol = length(population_size))
  302.  
  303. filled.contour(generation_size, population_size, results.mutation.crossing2, color.palette = jet.colors,
  304. plot.title = title(main = "Wykres cieplny dla zmiennych \nwielkosci populacji i ilosci generacji",
  305. xlab = "ilosc generacji", ylab = "wielkosc populacji"))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!