1. Selección de funciones de prueba

Función de Rosenbrock:

\[f(x_1,x_2)=100 \cdot (x_2-x_1^2)^2+(1-x_1)^2), \ x_i \in [-2.048,2.048], \ i=\{1,2\} \\ Alcanza \ su \ valor \ mínimo \ en \ x_1=1 \ y \ x_2=1\]

#### Implementación de la función Rosenbrock
rosenbrock <- function(xx, a=1, b=100){
  y <- 0
  for (i in 1:(length(xx)-1)) {
    y <- y + (b*(xx[i]^2 - xx[i+a])^2 + (xx[i] - 1)^2)
  }
  return(y)
}

Función de Rastrigin’s:

\[f(x_1,x_2)=20+\sum_{i=1}^{2}{x_i^2-10 \cdot \cos(2 \pi \cdot x_i)}, \ x_i \in [-5.12,5.12], \ i=\{1,2\} \\ Alcanza \ su \ valor \ mínimo \ en \ x_1=0 \ y \ x_2=0\]

#### Implementación de la función Rastrigin’s
rastrigin <- function(xx){
  y <- 0
  for (i in 1:length(xx)) {
    y <- y + (xx[i]^2 - 10*cos(2*pi*xx[i]) + 10)
  }
  return(y)  
}

2. Optimización de las funciones en dos y tres dimensiones usando un método de descenso por gradiente

Gradiente función de Rosenbrock:

#### Gradiente de la función de Rosenbrock
derivada1 <- function(xx){
  f1 <- 100*2*(xx[1]^2 - xx[2])*2*xx[1] + 2*(xx[1]-1)
  return(f1)
}

derivada2 <- function(xx){
  f1 <- -100*2*(xx[1]^2 - xx[2])
  return(f1)
}



gradiente_rosenbrock <- function(xx){
  y <- vector()
  if (length(xx) == 2) {
    x1 <- derivada1(xx)
    x2 <- derivada2(xx)
    y <- c(x1, x2)
  }else{
    for (i in 1:(length(xx))) {
      if (i == 1) {
        x1 <- derivada1(xx[c(i, i+1)])
        y <- append(y, x1)
      }else if(i > 1 & i < length(xx)){
        x <- derivada2(xx[c(i-1,i)]) + derivada1(xx[c(i,i+1)])
        y <- append(y, x)
      }else{
        x <- derivada2(xx[c(i-1,i)])
        y <- append(y, x)
      }
    }
  }
  return(y)
}

Gradiente función de Rastrigin’s:

#### Gradiente de la función Rastrigin’s
gradiente_rastrigin <- function(xx){
  y <- vector()
  for (i in 1:length(xx)) {
    e <- 2*xx[i] - 10*sin(2*pi*xx[i])*2*pi
    y <- append(y, e)
  }
  return(y)
}

Función gradiente

\[ x_1 := x_1 - \eta \cdot \frac{\delta} {\delta x_1} f(x_1,x_2) \\ x_2 := x_2 - \eta \cdot \frac{\delta} {\delta x_2} f(x_1,x_2)\]

optimizador_gradiente <- function(x0,eta,grad,max_eval=100,eps=0.00001){
  xx <- x0
  x <- array(xx)
  for (i in 2:max_eval){
    xx <- xx -eta*grad(xx)
    x <- rbind(x, xx)
    if (abs(x[i]-x[i-1])<eps){
      break
    }
  }
  return(x)
}

3. Optimice las funciones en dos y tres dimensiones usando: algoritmos evolutivos, optimización de partículas y evolución diferencial

Optimización algoritmos evolutivos

library(GA)

rosenbrock_inv <- function(x){
  y <- rosenbrock(x)
  return(-y)
}

rastrigin_inv <- function(x){
  y <- rastrigin(x)
  return(-y)
}

optimizador_ga <- function (func,lower,upper,dimentions){
  oopt <- ga(type="real-valued",fitness = func,lower=rep(lower,dimentions),upper = rep(upper,dimentions))
  return(oopt@population)
}

Optimización de particulas

library(pso)

optimizador_pso <- function (func,lower,upper,dimentions,iter){
  
  oopt <- psoptim(par=rep(NA,dimentions),fn=func,lower=rep(lower,dimentions),
                  upper=rep(upper,dimentions),control=list(trace.stats=TRUE,trace=1,maxit=100))
  
  return(t(oopt$stats$x[[iter]]))
  
}

Optimización por evolución diferencial

library(DEoptim)

optimizador_ev <- function (func,lower,upper,dimentions){
  
  oopt <- DEoptim(fn=func,lower=rep(lower,dimentions),upper=rep(upper,dimentions))
  
  return(oopt$member$pop)
  
}

Organizar las salidas

data_names <- function (nvar){
  names <- vector()
  for (i in 1:nvar){names <- append(names, paste('x', i, sep = ''))}
  names <- append(names, c("fx", "metodo"))
  return(names)
}

store_data <- function (sol,func,method){
  
  dat <- data.frame()
  
  # info
  a <- 1
  for (i in 1:nrow(sol)){
    irow<- append(sol[i,], c(func(sol[i,]),method))
    dat <- rbind(dat, irow)
  }
  colnames(dat) <- data_names(ncol(sol))
  return(dat)
  
}

data_optim <- function(n, eta, func,func_inv,grad, lower, upper, iter=sample(10,1)){
  
  df_grad <- store_data(optimizador_gradiente(runif(n,lower,upper),eta,grad),func,"Gradiente")
  df_ga <- store_data(optimizador_ga(func_inv,lower,upper,n),rastrigin,"Algoritmo Genético")
  df_pso <- store_data(optimizador_pso(func,lower,upper,n,iter),func,"Optimización de párticulas")
  df_ev <- store_data(optimizador_ev(func,lower,upper,n),func,"Evolución diferencial")
  
  df <- rbind(df_grad,df_ga,df_pso,df_ev)
  for (col in colnames(df)){
    if (col != "metodo"){df[col] <- apply(X = df[col], MARGIN = 1, FUN = as.numeric)}
  }
  
  return(df)
  
}

4. Represente con un gif animado o un video el proceso de optimización de descenso por gradiente y el proceso usando el método heurístico

library(snakecase)

contour_data <- function(func,n,m,lower,upper){
  
  Z <- expand.grid(c(rep(list(seq(lower,upper,length.out=m)), n)))
  Z[n+1] <- matrix(func(Z),ncol=m ,nrow = m)
  data <- data.frame(Z)
  colnames(data) <- c(data_names(n)[0:n+1])
  
  return(data)
}


plot_contour <- function (d,ct,m,method,case){
  Z <- matrix(ct$fx,ncol=m,nrow = m)
  for(i in 1:length(d$fx)){
    path = paste('images/',case,'/',to_snake_case(method), '_',i,'.png', sep = '')
    png(path)

    contour(seq(lower,upper,length.out=m),seq(lower,upper,length.out=m),Z)
    lines(d[c('x1','x2')][1:i,],type="p",pch=2,col="red",lwd=3)
    title(method, sub=paste(' iter: ', i))
    
    # Cerramos el dispositivo
    dev.off()

  }
}

plot_contours <- function(df,ct,n,m,case){
  for (method in unique(df$metodo)){
    d <- subset(df,metodo == method)
    plot_contour(d,ct,m,method,case)
  }
}

Solución

#### Función de Rosenbrock:

m <- 100
n <- 2
lower <- -2.048
upper <- 2.048
eta <- 0.0001

df <- data_optim(n, eta, rosenbrock, rosenbrock_inv,gradiente_rosenbrock,lower, upper,10)
ct <- contour_data(rosenbrock,n,m,lower,upper)
plot_contours(df,ct,n,m,'ros')
2D

3D
n <- 3
df <- data_optim(n, eta, rosenbrock, rosenbrock_inv,gradiente_rastrigin,lower, upper,10)
plot_contours(df,ct,n,m,'ros3d')

Función Rastrigin’s:

2D
m <- 100
n <- 2
lower <- -5.12
upper <- 5.12
eta <- 0.08

df <- data_optim(n, eta, rastrigin, rastrigin_inv,gradiente_rastrigin, lower, upper,10)
ct <- contour_data(rastrigin,n,m,lower,upper)
plot_contours(df,ct,n,m,'rast')

3D
n <- 3
df <- data_optim(n, eta, rastrigin, rastrigin_inv,gradiente_rastrigin, lower, upper,10)
plot_contours(df,ct,n,m,'rast3d')

Conclusiones