Revision a6a4107a08051dfddc3c733102d002fd8617ab9e authored by Lars Kotthoff on 25 October 2014, 00:00:00 UTC, committed by Gabor Csardi on 25 October 2014, 00:00:00 UTC
1 parent c389439
search.hill.climbing.R
hill.climbing.search <- function(attributes, eval.fun) {
if(length(attributes) == 0)
stop("Attributes not specified")
eval.fun = match.fun(eval.fun)
best = list(
result = -Inf,
attrs = rep(0, length(attributes))
)
while(sum(best$attrs) == 0)
best$attrs = sample(c(0,1), length(attributes), replace = TRUE)
best$result = eval.fun(attributes[as.logical(best$attrs)])
evaluated_states = list(
attrs = matrix(best$attrs, nrow = 1, ncol = length(attributes), byrow = TRUE),
results = best$result
)
eval_state <- function(state, evaluated_states) {
idx = find.subset(evaluated_states$attrs, state)
if(length(idx) == 0) { # needs to be evaluated
return(list(
to_be_saved = TRUE,
result = eval.fun(attributes[as.logical(state)])
))
} else if(length(idx) == 1) { # already evaluated
return(list(
to_be_saved = FALSE,
result = evaluated_states$results[idx]
))
} else {
stop("Internal error")
}
}
# main loop
repeat {
# find neighbours
children = create.children(best$attrs, direction = "both")
if(is.null(children))
break()
# evaluate and find the best of them
children_evaluated = apply(children, 1, function(vec) {
eval_state(vec, evaluated_states)
})
children_results = sapply(children_evaluated, function(x) x$result)
children_to_be_saved = sapply(children_evaluated, function(x) x$to_be_saved)
# save children at evaluated_states
evaluated_states$attrs = rbind(evaluated_states$attrs, children[children_to_be_saved,, drop = FALSE])
evaluated_states$results = c(evaluated_states$results, children_results[children_to_be_saved])
local_best = find.best(children_results)
# compare to the best so far
if(local_best$result > best$result) {
best$result = local_best$result
best$attrs = children[local_best$idx,]
} else {
break()
}
}
return(attributes[as.logical(best$attrs)])
}
Computing file changes ...