## compute-minimum-feedback-vertex-set-of-digraph.pkg
#
# Compute "minimum feedback vertex set" of a given directed graph:
# For definition and background see:
#
# http://en.wikipedia.org/wiki/Feedback_vertex_set
#
# This algorithm is used in
#
# src/lib/compiler/back/low/main/nextcode/pick-nextcode-fns-for-heaplimit-checks.pkg#
# to select a minimal set of functions at which to insert heapcleaner ("garbage collector")
# heap-limit checks while still guaranteeing that every possible codeloop contains
# at least one such check. This is currently the only use of the algorithm in the codebase.
#
# History:
# Original version by: Andrew Appel (appel@cs.princeton.edu) (is this right?)
# Recent cleanup by: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
# The cleanup involves getting rid of duplicate strongly-connected-component (SCC)
# code using the library module graph_strongly_connected_components_g) and making
# use of integer set- and map-modules (from the same library).
# The use of sorted_list has been eliminated.
#
# Compiled by:
# src/lib/compiler/core.sublibapi Compute_Minimum_Feedback_Vertex_Set_Of_Digraph {
# Input: A directed graph; that is, a list of vertex-numbers,
# each node with a list of out-edges which indicate other vertices.
# Output: A minimum feedback vertex set.
#
# Method: branch and bound
Vertex = Int;
Node = (Vertex, List( Vertex )); # vertex + outgoing edges
Graph = List( Node );
compute_minimum_feedback_vertex_set_of_digraph
:
Graph -> List(Vertex);
};
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package im = int_red_black_map; # int_red_black_map is from src/lib/src/int-red-black-map.pkg package is = int_red_black_set; # int_red_black_set is from src/lib/src/int-red-black-set.pkg package nd
=
package {
Key = Int;
compare = int::compare;
};
package scc = digraph_strongly_connected_components_g( nd ); # digraph_strongly_connected_components_g is from src/lib/src/digraph-strongly-connected-components-g.pkgherein
package compute_minimum_feedback_vertex_set_of_digraph
: Compute_Minimum_Feedback_Vertex_Set_Of_Digraph
{
# NOTE: By setting MAXDEPTH=infinity, this algorithm will produce
# the exact minimum feedback vertex set. With MAXDEPTH<infinity,
# the result will still be a feedback vertex set, but not
# always the minimum set. However, on almost all real programs,
# MAXDEPTH=3 will give perfect and efficiently computed results.
# Increasing MAXDEPTH will not make the algorithm take longer or
# produce better results on "real" programs.
maxdepth = 3;
Vertex = Int;
Node = (Vertex, List( Vertex )); # vertex + outgoing edges
Graph = List( Node );
fun bug s = err::impossible ("Feedback::feedback: " + s);
fun l2s l = is::add_list (is::empty, l);
s2l = is::vals_list;
# Normalize graph by eliminating edges that lead elsewhere:
#
fun normalize g
=
{ vs = l2s (map #1 g);
fun prune (v, e)
=
(v, is::intersection (e, vs));
map prune g;
};
fun scc g # "scc" == "strongly connected component"
=
{ roots = map #1 g;
fun add ((v, e), (sm, fm))
=
(im::set (sm, v, e), im::set (fm, v, s2l e));
my (set_map, follow_map) = fold_forward add (im::empty, im::empty) g;
fun follow v
=
the (im::get (follow_map, v));
# Do the actual scc calculation.
#
# For a sanity check we could
# match the result against (scc::SIMPLE root ! _),
# but we trust the SCC module and "nontrivial"
# (below) will take care of the root node.
#
sccres = scc::topological_order' { roots, follow };
# At this point we have already eliminated
# all trivial (= SIMPLE) components.
fun to_node v
=
( v,
the (im::get (set_map, v))
);
fun nontrivial (scc::SIMPLE _, a) => a;
nontrivial (scc::RECURSIVE l, a) => map to_node l ! a;
end;
ntcomps = fold_backward nontrivial [] sccres;
# Finally, We make each component "self-contained"
# by pruning away all edges that lead out of it:
map normalize ntcomps;
};
fun compute_minimum_feedback_vertex_set_of_digraph graph0
=
{ # Make edges into vertex sets:
#
graph = map (\\ (v, e) = (v, l2s e))
graph0;
# Any node with an edge to itself
# MUST be in the minimum feedback
# vertex set.
# Remove these "selfnodes" first
# to simplify the problem.
#
fun has_self_loop (v, e)
=
is::member (e, v);
my (selfnodes, rest) = list::partition has_self_loop graph;
# The following value is part 1
# of the final result:
#
selfvertices = l2s (map #1 selfnodes);
# With missing nodes, the rest
# needs to be normalized:
#
rest = normalize rest;
# Here is the branch-and-bound algorithm
# that is used for the rest:
#
fun feedb (limit, graph, depth)
=
if (depth <= 0)
#
if (limit >= length graph)
#
THE (l2s (map #1 graph)); # Approximate!
else
# Note: the original algorithm would have continued
# here when depth < 0; but that seems wrong. XXX BUGGO FIXME
#
NULL;
fi;
else
comps = scc graph;
fun g (lim, set, c ! comps)
=>
if (lim <= 0)
#
NULL;
else
case (try (lim, c, depth))
#
THE vs => g ( lim - is::vals_count vs + 1,
is::union (vs, set),
comps
);
NULL => NULL;
esac;
fi;
g (lim, set, [])
=>
THE set;
end;
g (limit - length comps + 1, is::empty, comps);
fi
also
fun try (limit, nodes, depth)
=
f (NULL, int::min (limit, length nodes), [], nodes)
where
fun f (best, lim, left, [])
=>
best;
f (best, lim, left, (node as (x, e)) ! right)
=>
if (not (list::null left) and is::vals_count e == 1)
#
# A node with only one out-edge can't be part of
# a unique minimum feedback vertex set, unless they
# all have one out-edge.
#
f (best, lim, node ! left, right);
else
fun prune (n, es)
=
(n, is::drop (es, x));
reduced = map prune (list::reverse_and_prepend (left, right));
case (feedb (lim - 1, reduced, depth - 1))
#
THE vs
=>
f (THE (is::add (vs, x)),
is::vals_count vs,
node ! left, right);
NULL => f (best, lim, node ! left, right);
esac;
fi;
end;
end;
fun bab g
=
case (feedb (length g, g, maxdepth))
#
THE solution => solution;
NULL => bug "no solution";
esac;
s2l (is::union (selfvertices, bab rest));
};
};
end;