Algoritmos para Crossover - Simulacion 1

Paula Cazali

14000060

generate_cities <- function(cities =5){
  pos_x <- sample(1:100, size = cities , replace=TRUE) 
  pos_y <- sample(1:100, size = cities , replace=TRUE)
  out <- data.frame(city = 1:cities, pos_x, pos_y )
  return(out)
}

distance_route <- function(route,distance){
  sum_distance<-0
  for(i in 1:length(route[-1])){
    out <- distance[ route[i], route[i+1]  ]
    sum_distance <- sum_distance + out
  }
  return(sum_distance)
}

sample_route <- function(...,cities = 5){
  c(1,sample(2:cities),1) %>% return()
}

select_mating_parents <- function(...,pop_size, roullete, population){
  sum_fit_p <-
    sample(1:sum(roullete$rank), size = 1 )
  pindex <-
    roullete %>% 
    filter(cumsum_rank < sum_fit_p) %>%
    nrow()
  p1 <- roullete[pindex + 1,] %>% pull(parent)
  sum_fit_p <-
    sample(1:sum(roullete$rank),size = 1 )
  pindex <-
    roullete %>% 
    filter(cumsum_rank < sum_fit_p) %>%
    nrow()
  p2 <- roullete[pindex + 1,] %>% pull(parent)
  return(population[c(p1,p2)])
}

Position Based Crossover

position_based_crossover <- function(parents, n = 3){
  p1 <- parents[[1]]
  p2 <- parents[[2]]
  length_parent <- length(p1)
  p1 <- p1[2:(length_parent-1)]
  p2 <- p2[2:(length_parent-1)]
  index <- sample(1:(length_parent-2), size = n, replace = FALSE)
  print(index)
  child1 <- p1
  fill_values <- setdiff(p2, p1[index])
  child1[-index] <- fill_values
  return(c(1, child1, 1)) 
}

Probando el position_based_crossover

prueba1 <- list(c(1,2:9,1), c(1,5,4,6,3,9,2,7,8,1))
position_based_crossover(prueba1,4)

[1] 1 7 8 6
 [1] 1 2 5 4 6 3 7 8 9 1

Order Crossover

order_crossover <- function(parents, n = 3){
  p1 <- parents[[1]]
  p2 <- parents[[2]]
  length_parent <- length(p1)
  p1 <- p1[2:(length_parent-1)]
  p2 <- p2[2:(length_parent-1)]
  subs <- sample(1:(length_parent-2), size = 1, replace = FALSE)
  if((subs+(n-1)) > (length_parent-2)){
    index <- c(subs:(length_parent-2))
  }else {
    index <- c(subs:(subs+(n-1)))  
  }
  print(index)
  child1 <- p1
  fill_values <- setdiff(p2, p1[index])
  child1[-index] <- fill_values
  return(c(1, child1, 1)) 
}

Probando el order_crossover

prueba2 <- list(c(1,2:9,1), c(1,5,4,6,3,9,2,7,8,1))
order_crossover(prueba2,4)

[1] 5 6 7 8
 [1] 1 5 4 3 2 6 7 8 9 1

Order Based Crossover

order_based_crossover <- function(parents, n = 3){
  p1 <- parents[[1]]
  p2 <- parents[[2]]
  length_parent <- length(p1)
  p1 <- p1[2:(length_parent-1)]
  p2 <- p2[2:(length_parent-1)]
  index1 <- sample(1:(length_parent-2), size = n, replace = FALSE)
  child <- p2
  dif <- setdiff(child, p1[index1])
  index2 <- match(dif, child)
  child[-index2] <- p1[index1]
  return(c(1, child, 1)) 
}

Probando el order_based_crossover

prueba3 <- list(c(1,2:9,1), c(1,5,4,6,3,9,2,7,8,1))
order_based_crossover(prueba3,4)

 [1] 1 3 5 6 8 9 2 7 4 1

Cycle Crosscover CX

cycle_crossover <- function(parents){
  p1 <- parents[[1]]
  p2 <- parents[[2]]
  length_parent <- length(p1)
  p1 <- p1[2:(length_parent-1)]
  p2 <- p2[2:(length_parent-1)]
  child <- p1
  primer_sample <- sample(p1, size = 1, replace = FALSE)
  sample_actual <- 0
  proto_child <- c(primer_sample)
  sample_index <- match(primer_sample, p1)
  index <- c(sample_index)
  while (primer_sample != sample_actual) {
    sample_actual <- p2[sample_index]
    proto_child <- c(proto_child, sample_actual)
    sample_index <- match(sample_actual, p1)  #devuelve el indice del padre1
    index <- c(index, sample_index)
  }
  proto_child <- proto_child[-length(proto_child)]
  index <- index[-length(index)]
  child[index] <- proto_child
  child[-index] <-  setdiff(p2,proto_child)
  return(c(1, child, 1)) 
}

Probando el cycle_crossover

padre1 <- c(1,2:9,1)
padre2 <- c(1,7,6,8,2,9,5,4,3,1)
prueba4 <- list(padre1,padre2)
cycle_crossover(prueba4)

 [1] 1 2 6 8 5 9 7 4 3 1