Revision 12acd76ec1d613505e4bb20b3012e8d8507a310a authored by Lars Kotthoff on 16 May 2018, 20:38:09 UTC, committed by cran-robot on 16 May 2018, 20:38:09 UTC
1 parent 970c4e6
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 ...