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.best.first.R
best.first.search <- function(attributes, eval.fun, max.backtracks = 5) {
if(length(attributes) == 0)
stop("Attributes not specified")
eval.fun = match.fun(eval.fun)
attach_children <- function(states, best) {
parent_state = states$attrs[best$idx,]
children = create.children(parent_state, "forward", omit.func = function(...) {
length(find.subset(states$attrs, ...)) > 0
})
children_len = ifelse(is.null(children), 0, dim(children)[1])
if(children_len > 0) {
states$attrs = rbind(states$attrs, children)
states$open = c(states$open, rep(TRUE, children_len))
states$results = c(states$results, rep(NA, children_len))
}
return(states)
}
states = list(
attrs = diag(length(attributes)),
open = rep(TRUE, length(attributes)),
results = rep(NA, length(attributes))
)
colnames(states$attrs) = attributes
best = list(
result = -Inf,
idx = NULL
)
repeat {
# calculate merit for every open and not evaluated subset of attributes
rows_to_eval = states$open & is.na(states$results)
if(any(rows_to_eval)) {
states$results[rows_to_eval] =
apply(states$attrs[rows_to_eval,, drop=FALSE], 1, function(vec) {
attrs = attributes[as.logical(vec)]
return(eval.fun(attrs))
})
}
#find best
new_best = find.best(states$results, states$open)
#check if better
if(is.null(new_best$result))
break()
states$open[new_best$idx] = FALSE
if(new_best$result > best$result) {
best = new_best
states = attach_children(states, best)
} else {
if(max.backtracks > 0) {
max.backtracks = max.backtracks - 1
} else
break
}
}
return(attributes[as.logical(states$attrs[best$idx, ])])
}
Computing file changes ...