.operators. <- c ("+", "-", "*", "/")
random.elt <- function (lista)
sample (lista, 1) [[1]]
random.form <- function (operators)
{
lista <- list (random.elt (operators))
for (i in 1:2) lista <- c (lista,
{
random.nr <- runif (1)
if (random.nr < .5)
list (random.form (operators))
else if (random.nr < .75)
list (runif (1, 0, 10))
else list ("=input=")
})
lista
}
escribe.lista <- function (lista)
{
force (lista) escribe.sublista <- function (sublista)
{
cat ("(")
for (elemento in sublista)
if (is.list (elemento))
escribe.sublista (elemento)
else cat (elemento, "")
cat ("\b) ")
}
escribe.sublista (lista)
cat ("\b") }
random.form <- function (operators, max.depth = 4)
{
lista <- list (random.elt (operators))
for (i in 1:2) lista <- c (lista,
{
random.nr <- runif (1)
if (max.depth > 0)
if (random.nr < .5)
list (random.form (operators, max.depth-1))
else if (random.nr < .75)
list (runif (1, 0, 10))
else list ("=input=")
else if (random.nr < .5)
list (runif (1, 0, 10))
else list ("=input=")
})
lista
}
run.form.insegura <- function (form, input)
{
if (is.atomic (form))
if (form == "=input=")
input
else form
else
do.call (form[[1]], lapply (form[-1], run.form.insegura, input))
}
run.form <- function (form, input)
{
intento <- try (run.form.insegura (form, input))
if (inherits (intento, "try-error")) NA else intento
}
create.initial.population <- function(operators, size=100)
lapply (1:size, function (i) random.form (operators))
fitness <- function (form, fitness.fn, test.input)
prod (sapply (test.input,
function (input)
{
output <- run.form (form, input)
target <- do.call (fitness.fn, list (input))
difference <- abs (target - output)
fitness.value <- 1 / (1 + difference)
}))
traverse.nodes.example <- function (form)
{
cat ("0 :", form[[1]], "\n")
traverse.nodes <- function (subform, indent = " ")
{
for (node in subform[-1])
{
cat (nchar (indent) / 2, ":", indent, node[[1]], "\n")
if (is.list (node))
traverse.nodes (node, paste0 (indent, " "))
}
}
traverse.nodes (form)
}
traverse.nodes.infijo <- function (form)
{
res <- ""
traverse.nodes <- function (subform)
{
oper.actual <- subform[[1]]
res <<- paste0 (res, "(")
es.el.primero <- TRUE
for (node in subform[-1])
{
if (es.el.primero)
es.el.primero <- FALSE
else
res <<- paste0 (res, oper.actual)
if (is.list (node))
traverse.nodes (node)
else res <<- paste0 (res,
ifelse (node == "=input=",
"x",
node))
}
res <<- paste0 (res, ")")
}
traverse.nodes (form)
res
}
n.nodes <- function (form)
{
nodes <- 1
traverse.nodes <- function (subform)
for (node in subform[-1])
{
nodes <<- nodes + 1
if (is.list (node))
traverse.nodes (node)
}
traverse.nodes (form)
nodes
}
random.node <- function (form)
{
index <- 2 random.node.index <- sample (2:n.nodes(form), 1)
encuentro <- FALSE
traverse.nodes <- function (subform)
for (node in subform[-1])
{
encuentro <<- index == random.node.index
if (encuentro)
return (list (index = index, node = node))
index <<- index + 1
res <- if (is.list (node))
traverse.nodes (node)
if (encuentro) return (res)
}
traverse.nodes (form)
}
replace.node <- function (form, node.index, new.node)
{
index <- 1
traverse.nodes <- function (subform)
{
lista <- subform[1] for (node in subform[-1])
{
index <<- index + 1
if (index == node.index)
lista <- c (lista, list (new.node))
if (index != node.index && !is.list (node))
lista <- c (lista, list (node))
if (index != node.index && is.list (node))
lista <- c (lista, list (traverse.nodes (node)))
}
lista
}
traverse.nodes (form)
}
cross.over <- function (form1, form2, debug = FALSE)
{
rnode1 <- random.node (form1)
rnode2 <- random.node (form2)
if (debug)
{
cat ("form1: ")
escribe.lista (form1)
cat ("\nform2: ")
escribe.lista (form2)
cat ("\nrnode1: ")
escribe.lista (rnode1)
cat ("\nrnode2: ")
escribe.lista (rnode2)
cat ("\n")
}
replace.node (form1, rnode1$index, rnode2$node)
}
mutate <- function (form, operators, debug = FALSE)
{
rform <- random.form (operators)
rnode <- random.node (form)
if (debug)
{
cat ("form: ")
escribe.lista (form)
cat ("\nrform: ")
escribe.lista (rform)
cat ("\nrnode: ")
escribe.lista (rnode)
cat ("\n")
}
replace.node (form, rnode$index, rform)
}
evaluate.population <- function (population, fitness.fn, test.input)
{
result <- list ()
for (form in population)
{
fitness.valor <- fitness (form, fitness.fn, test.input)
if (!is.na (fitness.valor))
result <- c (result, list (list (fitness = fitness.valor,
form = form)))
}
result [order (sapply (result, function (x) x$fitness), decreasing = TRUE)]
}
head <- function (sequence, amount = 1)
{
if (amount <= 0)
NULL
else if (length (sequence) < amount)
sequence
else sequence[1:amount]
}
advance.generation <- function (population, fitness.fn, operators,
test.input, max.population = 100)
{
epop <- evaluate.population (population, fitness.fn, test.input)
cat ("Best fitness of current population:",
epop[[1]]$fitness, "\n")
res <- list()
for (plist in head (epop, max.population))
{
fitness <- plist$fitness
form <- plist$form
res <- c (res, list (form))
if (runif (1) < fitness)
res <- c (res, list (if (runif (1) < .9)
cross.over (form, random.elt(epop)$form)
else mutate (form, operators)))
if (runif (1) < 0.02)
res <- c (res, list (random.form (operators)))
}
res
}
best.form <- function ()
evaluate.population (population, function (r) pi * r^2, list (0, 1, -2)) [[1]]
population <- create.initial.population (.operators., 100)
for (i in 1:500)
{
cat("[",i,"] ")
population <- advance.generation (population,
function(r) pi*r*r,
.operators.,
list(0,1,-2))
}
traverse.nodes.example(best.form()$form)
traverse.nodes.infijo(best.form()$form)