init

ue02/a1/a/gradient_ascent.R

@@ -0,0 +1,126 @@
+library(ggplot2)
+library(gganimate)
+library(patchwork)
+
+gradient <- function(f, x, d){
+    return((f(x + d) - f(x - d)) / (2*d))
+}
+
+gradient.ascent.move <- function(f, x, d, mu){
+    return(x + mu * gradient(f, x, d))
+}
+
+func.g <- function(x) x
+func.k <- function(x) sin(x)
+func.h <- function(x) x * sin(x)
+func.l <- function(x) 2 + cos(x) + sin(2*x)
+
+gradient.ascent.iterate <- function(f, x, d, mu, n){
+    if(n == 1) {
+        return(gradient.ascent.move(f, x, d, mu))
+    }
+
+    return(gradient.ascent.niter(f
+                                 ,gradient.descent.move(f, x, d, mu)
+                                 ,d
+                                 ,mu
+                                 ,n-1
+                                ))
+}
+
+gradient.ascent.iterverb <- function(f, x, d, mu, n, xs=numeric()){
+    next_x <- gradient.ascent.move(f, x, d, mu)
+    xs[length(xs)+1] <- next_x
+
+    if(n == 1) {
+        return(xs)
+    }
+
+    return(gradient.ascent.iterverb(f, next_x, d, mu, n-1, xs))
+}
+
+trace.ascent <- function(f, x, d, eta, n, xs) {
+    df_dc = data.frame(x=numeric()
+                       ,y=numeric()
+                       ,i=integer()
+                       ,start_x=character()
+                       ,eta=numeric())
+
+    for(start in x) {
+        for(e in eta) {
+            first_it <- TRUE
+            if(first_it == TRUE) {
+                df_dc <- rbind(df_dc, data.frame(x=c(start)
+                                                 ,y=c(f(start))
+                                                 ,i=c(0)
+                                                 ,start_x=c(as.character(start))
+                                                 ,eta=c(e)
+                                                ))
+                first_it <- FALSE
+            }
+
+            xf <- gradient.ascent.iterverb(f, start, d, e, n)
+    
+            df_dc <- rbind(df_dc, data.frame(x=xf
+                                             ,y=f(xf)
+                                             ,i=1:length(xf)
+                                             ,start_x=rep(as.character(start), length(xf))
+                                             ,eta=e)
+                                            )
+        }
+    }
+
+    return(df_dc)
+}
+
+plot.ascent <- function(f, x, d, eta, n, xs) {
+    df_dc = trace.ascent(f, x, d, eta, n, xs)
+
+    func_str = deparse(substitute(f))
+
+    df_f <- data.frame(x=xs, y=f(xs))
+    p1 <- ggplot(df_f, aes(x=x, y=y)) +
+            geom_line() +
+            geom_point(aes(colour=start_x
+                           ,size=i
+                          )
+                       ,data=df_dc) +
+            labs(size="iteration"
+                 ,alpha="iteration"
+                 ,color="start x"
+                 ,y=sprintf("%s(x)", func_str)) +
+            facet_grid(eta ~ ., labeller=label_both)
+
+    p2 <- ggplot(df_dc, aes(x=i, y=y)) +
+          geom_line(aes(colour=start_x), show.legend=FALSE) +
+          labs(x="iteration"
+               ,y=sprintf("%s(x)", func_str)) +
+                  facet_grid(eta ~ ., labeller=label_both)
+
+    p <- (p1 | p2) + 
+            plot_annotation(title=sprintf("function: %s", func_str)) +
+            plot_layout(guides="collect"
+                        ,widths=10
+                        ,heights=2) 
+
+    return(p)
+}
+
+animate.ascent <- function(f, x, d, eta, n, xs) {
+    df_dc = trace.ascent(f, x, d, eta, n, xs)
+
+    func_str <- deparse(substitute(f))
+
+    df_f <- data.frame(x=xs, y=f(xs))
+
+    p <- ggplot(df_f, aes(x=x, y=y)) +
+            geom_line() +
+            geom_point(aes(colour=start_x), size=2.5, data=df_dc) +
+            labs(color="start x", y=sprintf("%s(x)", func_str)) +
+            facet_grid(eta ~ ., labeller=label_both) +
+            ggtitle(sprintf("function: %s", func_str))
+
+    anim <- p + transition_reveal(i)
+
+    return(anim)
+}

ue02/a1/b/2

@@ -0,0 +1,124 @@
+library(ggplot2)
+
+func.g <- function(x) x
+func.k <- function(x) sin(x)
+func.h <- function(x) x * sin(x)
+func.l <- function(x) 2 + cos(x) + sin(2*x)
+
+
+delta.const <- function(x) {
+    return(function() x)
+}
+
+delta.gaus <- function() {
+    return(rnorm(1))
+}
+
+ea.init_population <- function(range, size, rand_gen) {
+    return(rand_gen(size) * (range[2] - range[1]) + range[1])   
+}    
+
+ea.trace <- function(range, delta, population_size, fit_func, iterations) {
+    population <- ea.init_population(range, population_size, runif)
+    
+    df <- data.frame(i=integer()
+                     ,max=numeric()
+                     ,median=numeric()
+                     ,min=numeric())
+
+    for(i in 1:iterations) {
+        population <- ea.iterate(delta, population, fit_func)
+
+        df[nrow(df) + 1,] <- c(i
+                               ,population[1]
+                               ,population[length(population) %/% 2]
+                               ,population[length(population)]
+                              )
+    }
+
+    df["max_val"] <- fit_func(df$max)
+    df["median_val"] <- fit_func(df$median)
+    df["min_val"] <- fit_func(df$min)
+
+    res <- list(population, df)
+    names(res) <- c("population", "df_tr")
+
+    return(res)
+}
+
+ea.traces <- function(range, deltas, population_size, fit_funcs, iterations) {
+    df <- data.frame(i=integer()
+                     ,max=numeric()
+                     ,median=numeric()
+                     ,min=numeric()
+                     ,delta_func=character()
+                     ,delta=numeric()
+                     ,fit_func=character())
+
+    for(delta_func in names(deltas)) {
+        delta <- deltas[delta_func]
+
+        for(fit_name in names(fit_funcs)) {
+            fit <- fit_funcs[fit_name]
+
+            tmp_df <- ea.trace(range, delta, population_size, fit, iterations)$df_tr
+ 
+            tmp_df["delta_func"] <- delta_func
+            if(delta_func == "delta.gaus") {
+                tmp_df["delta"] <- NA
+            } else {
+                tmp_df["delta"] <- delta()
+            }
+    
+            tmp_df["fit_func"] <- fit_name
+
+            df <- rbind(df, tmp_df)
+        }
+    }
+
+    return(df)
+}
+
+ea.plot <- function(range, delta, population_size, fit_func, iterations) {
+    res <- ea.trace(range, delta, population_size, fit_func, iterations)
+
+    df_vals <- melt(res$df_tr[c("i", "min_val", "median_val", "max_val")], id.vars="i")
+
+    p <- ggplot(data=df_vals, aes(x=i)) +
+            geom_line(aes(y=value, linetype=variable))
+
+    return(p)
+}
+
+ea.run <- function(range, delta, population_size, fit_func, iterations) {
+    population <- ea.init_population(range, population_size, runif)
+
+    for(i in 1:iterations) {
+        population <- ea.iterate(delta, population, fit_func)
+    }
+
+    return(population)
+}
+
+ea.iterate <- function(delta, population, fit_func) {
+    children <- c()
+
+    for(individual in population) {
+        children <- append(children, ea.mutate(individual, delta))
+    }
+
+    population <- append(population, children)
+
+    return(ea.select(population, fit_func))
+}
+
+ea.mutate <- function(individual, delta) {
+    sign <- sample(c(-1,1), 1)
+    
+    return(individual + sign * delta())
+}
+
+ea.select <- function(population, fit_func) {
+    sorted_popul <- population[order(sapply(population, fit_func), decreasing=TRUE)]
+    return(sorted_popul[1 : (length(sorted_popul) %/% 2)])
+}

ue02/a1/b/ea_alg.R

@@ -0,0 +1,125 @@
+library(ggplot2)
+
+func.g <- function(x) x
+func.k <- function(x) sin(x)
+func.h <- function(x) x * sin(x)
+func.l <- function(x) 2 + cos(x) + sin(2*x)
+
+
+delta.const <- function(x) {
+    return(function() x)
+}
+
+delta.gaus <- function() {
+    return(rnorm(1))
+}
+
+ea.init_population <- function(range, size, rand_gen) {
+    return(rand_gen(size) * (range[2] - range[1]) + range[1])   
+}    
+
+ea.trace <- function(range, delta, population_size, fit_func, iterations) {
+    population <- ea.init_population(range, population_size, runif)
+    
+    df <- data.frame(i=integer()
+                     ,max=numeric()
+                     ,median=numeric()
+                     ,min=numeric())
+
+    for(i in 1:iterations) {
+        population <- ea.iterate(delta, population, fit_func)
+
+        df[nrow(df) + 1,] <- c(i
+                               ,population[1]
+                               ,population[length(population) %/% 2]
+                               ,population[length(population)]
+                              )
+    }
+
+    df["max_val"] <- fit_func(df$max)
+    df["median_val"] <- fit_func(df$median)
+    df["min_val"] <- fit_func(df$min)
+
+    res <- list(population, df)
+    names(res) <- c("population", "df_tr")
+
+    return(res)
+}
+
+ea.traces <- function(range, deltas, population_size, fit_funcs, iterations) {
+    df <- data.frame(i=integer()
+                     ,max=numeric()
+                     ,median=numeric()
+                     ,min=numeric()
+                     ,delta_func=character()
+                     ,delta=numeric()
+                     ,fit_func=character())
+
+    for(delta_func in names(deltas)) {
+        delta <- deltas[[delta_func]]
+
+        for(fit_name in names(fit_funcs)) {
+            fit <- fit_funcs[[fit_name]]
+
+            print(delta_func)
+            tmp_df <- ea.trace(range, delta, population_size, fit, iterations)$df_tr
+ 
+            tmp_df["delta_func"] <- delta_func
+            if(delta_func == "delta.gaus") {
+                tmp_df["delta"] <- NA
+            } else {
+                tmp_df["delta"] <- delta()
+            }
+    
+            tmp_df["fit_func"] <- fit_name
+
+            df <- rbind(df, tmp_df)
+        }
+    }
+
+    return(df)
+}
+
+ea.plot <- function(range, delta, population_size, fit_func, iterations) {
+    res <- ea.trace(range, delta, population_size, fit_func, iterations)
+
+    df_vals <- melt(res$df_tr[c("i", "min_val", "median_val", "max_val")], id.vars="i")
+
+    p <- ggplot(data=df_vals, aes(x=i)) +
+            geom_line(aes(y=value, linetype=variable))
+
+    return(p)
+}
+
+ea.run <- function(range, delta, population_size, fit_func, iterations) {
+    population <- ea.init_population(range, population_size, runif)
+
+    for(i in 1:iterations) {
+        population <- ea.iterate(delta, population, fit_func)
+    }
+
+    return(population)
+}
+
+ea.iterate <- function(delta, population, fit_func) {
+    children <- c()
+
+    for(individual in population) {
+        children <- append(children, ea.mutate(individual, delta))
+    }
+
+    population <- append(population, children)
+
+    return(ea.select(population, fit_func))
+}
+
+ea.mutate <- function(individual, delta) {
+    sign <- sample(c(-1,1), 1)
+    
+    return(individual + sign * delta())
+}
+
+ea.select <- function(population, fit_func) {
+    sorted_popul <- population[order(sapply(population, fit_func), decreasing=TRUE)]
+    return(sorted_popul[1 : (length(sorted_popul) %/% 2)])
+}