Translated elim_order()
This commit is contained in:
Waldir Leoncio
parent
aff5b3de15
commit
c69c0639ae
1 changed files with 61 additions and 65 deletions
126
R/elim_order.R
126
R/elim_order.R
|
|
@ -1,71 +1,67 @@
|
|||
elim_order <- function(G, node_sizes) {
|
||||
stop("needs translation")
|
||||
# function order = elim_order(G, node_sizes)
|
||||
# % BEST_FIRST_ELIM_ORDER Greedily search for an optimal elimination order.
|
||||
# % order = best_first_elim_order(moral_graph, node_sizes)
|
||||
# %
|
||||
# % Find an order in which to eliminate nodes from the graph in such a way as to try and minimize the
|
||||
# % weight of the resulting triangulated graph. The weight of a graph is the sum of the weights of each
|
||||
# % of its cliques; the weight of a clique is the product of the weights of each of its members; the
|
||||
# % weight of a node is the number of values it can take on.
|
||||
# %
|
||||
# % Since this is an NP-hard problem, we use the following greedy heuristic:
|
||||
# % at each step, eliminate that node which will result in the addition of the least
|
||||
# % number of fill-in edges, breaking ties by choosing the node that induces the lighest clique.
|
||||
# % For details, see
|
||||
# % - Kjaerulff, "Triangulation of graphs -- algorithms giving small total state space",
|
||||
# % Univ. Aalborg tech report, 1990 (www.cs.auc.dk/~uk)
|
||||
# % - C. Huang and A. Darwiche, "Inference in Belief Networks: A procedural guide",
|
||||
# % Intl. J. Approx. Reasoning, 11, 1994
|
||||
# %
|
||||
# BEST_FIRST_ELIM_ORDER Greedily search for an optimal elimination order.
|
||||
# order <- best_first_elim_order(moral_graph, node_sizes)
|
||||
# Find an order in which to eliminate nodes from the graph in such a way as to try and minimize the
|
||||
# weight of the resulting triangulated graph. The weight of a graph is the sum of the weights of each
|
||||
# of its cliques the weight of a clique is the product of the weights of each of its members the
|
||||
# weight of a node is the number of values it can take on.
|
||||
# Since this is an NP - hard problem, we use the following greedy heuristic:
|
||||
# at each step, eliminate that node which will result in the addition of the least
|
||||
# number of fill - in edges, breaking ties by choosing the node that induces the lighest clique.
|
||||
# For details, see
|
||||
# - Kjaerulff, "Triangulation of graphs - - algorithms giving small total state space",
|
||||
# Univ. Aalborg tech report, 1990 (www.cs.auc.dk/!uk)
|
||||
# - C. Huang and A. Darwiche, "Inference in Belief Networks: A procedural guide",
|
||||
# Intl. J. Approx. Reasoning, 11, 1994
|
||||
|
||||
# % Warning: This code is pretty old and could probably be made faster.
|
||||
# Warning: This code is pretty old and could probably be made faster.
|
||||
|
||||
# n = length(G);
|
||||
# %if nargin < 3, stage = { 1:n }; end % no constraints
|
||||
n <- length(G)
|
||||
# if (nargin < 3, stage = { 1:n } end# no constraints) {
|
||||
|
||||
# % For long DBNs, it may be useful to eliminate all the nodes in slice t before slice t+1.
|
||||
# % This will ensure that the jtree has a repeating structure (at least away from both edges).
|
||||
# % This is why we have stages.
|
||||
# % See the discussion of splicing jtrees on p68 of
|
||||
# % Geoff Zweig's PhD thesis, Dept. Comp. Sci., UC Berkeley, 1998.
|
||||
# % This constraint can increase the clique size significantly.
|
||||
# For long DBNs, it may be useful to eliminate all the nodes in slice t before slice t + 1.
|
||||
# This will ensure that the jtree has a repeating structure (at least away from both edges).
|
||||
# This is why we have stages.
|
||||
# See the discussion of splicing jtrees on p68 of
|
||||
# Geoff Zweig's PhD thesis, Dept. Comp. Sci., UC Berkeley, 1998.
|
||||
# This constraint can increase the clique size significantly.
|
||||
|
||||
# MG = G; % copy the original graph
|
||||
# uneliminated = ones(1,n);
|
||||
# order = zeros(1,n);
|
||||
# %t = 1; % Counts which time slice we are on
|
||||
# for i=1:n
|
||||
# U = find(uneliminated);
|
||||
# %valid = myintersect(U, stage{t});
|
||||
# valid = U;
|
||||
# % Choose the best node from the set of valid candidates
|
||||
# min_fill = zeros(1,length(valid));
|
||||
# min_weight = zeros(1,length(valid));
|
||||
# for j=1:length(valid)
|
||||
# k = valid(j);
|
||||
# nbrs = myintersect(neighbors(G, k), U);
|
||||
# l = length(nbrs);
|
||||
# M = MG(nbrs,nbrs);
|
||||
# min_fill(j) = l^2 - sum(M(:)); % num. added edges
|
||||
# min_weight(j) = prod(node_sizes([k nbrs])); % weight of clique
|
||||
# end
|
||||
# lightest_nbrs = find(min_weight==min(min_weight));
|
||||
# % break ties using min-fill heuristic
|
||||
# best_nbr_ndx = argmin(min_fill(lightest_nbrs));
|
||||
# j = lightest_nbrs(best_nbr_ndx); % we will eliminate the j'th element of valid
|
||||
# %j1s = find(score1==min(score1));
|
||||
# %j = j1s(argmin(score2(j1s)));
|
||||
# k = valid(j);
|
||||
# uneliminated(k) = 0;
|
||||
# order(i) = k;
|
||||
# ns = myintersect(neighbors(G, k), U);
|
||||
# if ~isempty(ns)
|
||||
# G(ns,ns) = 1;
|
||||
# G = setdiag(G,0);
|
||||
# end
|
||||
# %if ~any(logical(uneliminated(stage{t}))) % are we allowed to the next slice?
|
||||
# % t = t + 1;
|
||||
# %end
|
||||
# end
|
||||
MG <- G# copy the original graph
|
||||
uneliminated <- ones(1, n)
|
||||
order <- zeros(1, n)
|
||||
# t <- 1 # Counts which time slice we are on
|
||||
for (i in 1:n) {
|
||||
U <- find(uneliminated)
|
||||
# valid <- myintersect(U, stage{t})
|
||||
valid <- U
|
||||
# Choose the best node from the set of valid candidates
|
||||
min_fill <- zeros(1, length(valid))
|
||||
min_weight <- zeros(1, length(valid))
|
||||
for (j in 1:length(valid)) {
|
||||
k <- valid(j)
|
||||
nbrs <- myintersect(neighbors(G, k), U)
|
||||
l <- length(nbrs)
|
||||
M <- MG[nbrs, nbrs]
|
||||
min_fill[j] <- l^2 - sum(M)# num. added edges
|
||||
min_weight[j] <- prod(node_sizes[k, nbrs])# weight of clique
|
||||
}
|
||||
lightest_nbrs <- find(min_weight == min(min_weight))
|
||||
# break ties using min - fill heuristic
|
||||
best_nbr_ndx <- argmin(min_fill[lightest_nbrs])
|
||||
j <- lightest_nbrs[best_nbr_ndx] # we will eliminate the j'th element of valid
|
||||
# j1s <- find(score1 == min(score1))
|
||||
# j <- j1s(argmin(score2(j1s)))
|
||||
k <- valid(j)
|
||||
uneliminated[k] <- 0
|
||||
order[i] <- k
|
||||
ns <- myintersect(neighbors(G, k), U)
|
||||
if (!is.null(ns)) {
|
||||
G[ns, ns] <- 1
|
||||
G <- setdiag(G, 0)
|
||||
}
|
||||
# if (!any(as.logical(uneliminated(stage{t})))# are we allowed to the next slice?) {
|
||||
# t <- t + 1
|
||||
# }
|
||||
}
|
||||
return(order)
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue