--- /dev/null
+public class FibHeap {
+
+ public int degree;
+ public TaggedTree ttree;
+ public Vector forest;
+
+ public FibHeap() {
+ this.degree = 0;
+ this.ttree = null;
+ this.forest = null;
+ }
+
+ public FibHeap(int degree,
+ TaggedTree ttree,
+ Vector forest) {
+ this.degree = degree;
+ this.ttree = ttree;
+ this.forest = forest;
+ }
+
+ public boolean isEmpty() {
+ return this.degree == 0;
+ }
+
+ public int minFH() {
+ return this.ttree.tree.root;
+ }
+
+ public FibHeap insertFH(int x) {
+ TaggedTree tt = new TaggedTree(0, new Tree(x, null));
+ FibHeap fh = new FibHeap(1, tt, null);
+
+ return this.meldFH(fh);
+ }
+
+ public FibHeap meldFH(FibHeap fh) {
+ if(this.isEmpty()) {
+ return fh;
+ } else {
+ int root1 = fh.ttree.tree.root;
+ int root2 = this.ttree.tree.root;
+ TaggedTree root = null;
+ Vector forest = fh.forest;
+ if(forest == null) {
+ forest = new Vector();
+ }
+ if(root1 <= root2) {
+ root = fh.ttree;
+ forest.insertElementAt(this.ttree, 0);
+ } else {
+ root = this.ttree;
+ forest.insertElementAt(fh.ttree, 0);
+ }
+ if(this.forest != null) {
+ for(int i = 0; i < this.forest.size(); i++) {
+ forest.addElement(this.forest.elementAt(i));
+ }
+ }
+ return new FibHeap(fh.degree+this.degree, root, forest);
+ }
+ }
+
+ private void insert(Vector a,
+ TaggedTree tt) {
+ int index = tt.degree;
+ if(a.elementAt(index) == null) {
+ a.setElementAt(tt.tree, index);
+ } else {
+ Tree at = (Tree)a.elementAt(index);
+ a.setElementAt(null, index);
+ // link these two tree
+ Tree it = tt.tree.link(at);
+ TaggedTree itt = new TaggedTree(index+1, it);
+ insert(a, itt);
+ }
+ }
+
+ private FibHeap getMin_t(Vector a,
+ int mini,
+ Tree mint,
+ Vector b,
+ int i,
+ int d) {
+ if(i >= d) {
+ return new FibHeap(this.degree-1, new TaggedTree(mini, mint), b);
+ } else {
+ Tree at = (Tree)a.elementAt(i);
+ if(at == null) {
+ return getMin_t(a, mini, mint, b, i+1, d);
+ } else {
+ if(mint.root <= at.root) {
+ b.insertElementAt(new TaggedTree(i, at), 0);
+ return getMin_t(a, mini, mint, b, i+1, d);
+ } else {
+ b.insertElementAt(new TaggedTree(mini, mint), 0);
+ return getMin_t(a, i, at, b, i+1, d);
+ }
+ }
+ }
+ }
+
+ private int locallog(int n) {
+ if(n == 1) {
+ return 0;
+ } else {
+ return 1 + locallog(n/2);
+ }
+ }
+
+ public FibHeap deleteMinFH() {
+ if(this.isEmpty()) {
+ // error here
+ System.exit(0xa0);
+ }
+ if(this.degree == 1) {
+ return new FibHeap();
+ }
+ // newArray (0,d) Zero >>= \a -> applyToAll (ins a) f
+ // Allocate an array indexed by degrees.
+ int d = locallog(this.degree - 1);
+ Vector a = new Vector(d+1);
+ for(int i = 0; i < d+1; i++) {
+ a.addElement(null);
+ }
+ // Insert every tree into this array. If, when inserting a tree of
+ // degree k, there already exists a tree of degree k, link the
+ // two trees and reinsert the new larger tree.
+ for(int i = 0; i < this.forest.size(); i++) {
+ TaggedTree tt = (TaggedTree)this.forest.elementAt(i);
+ insert(a, tt);
+ }
+ // sequence (map (ins a) (getChildren tt))
+ Vector vec = this.ttree.getChildren();
+ for(int i = 0; i < vec.size(); i++) {
+ TaggedTree tt = (TaggedTree)vec.elementAt(i);
+ insert(a, tt);
+ }
+ // getMin a >>= \ (tt,f) -> return (FH (n-1) tt f))
+ Tree test = (Tree)a.elementAt(d);
+ if(test == null) {
+ // error here
+ System.exit(0xa1);
+ } else {
+ return getMin_t(a, d, test, new Vector(), 0, d);
+ }
+ }
+
+ private Vector combine(int index,
+ Vector ts,
+ Vector next,
+ Vector rest) {
+ if(ts.size() == 0) {
+ return startup(index+1, next, rest);
+ } else if (ts.size() == 1) {
+ Vector vec = startup(index+1, next, rest);
+ vec.insertElementAt(new TaggedTree(index, (Tree)ts.elementAt(0)), 0);
+ return vec;
+ } else {
+ Tree t1 = (Tree)ts.elementAt(0);
+ Tree t2 = (Tree)ts.elementAt(1);
+ next.insertElementAt(t1.link(t2), 0);
+ Vector nts = new Vector();
+ for(int i = 2; i < ts.size(); i++) {
+ nts.addElement(ts.elementAt(i));
+ }
+ return combine(index, nts, next, rest);
+ }
+ }
+
+ private Vector startup(int index,
+ Vector ts,
+ Vector rest) {
+ if(ts.size() == 0) {
+ if(rest.size() == 0) {
+ return new Vector();
+ } else {
+ Vector tts = (Vector)rest.elementAt(0);
+ Vector nrest = new Vector();
+ for(int i = 1; i < rest.size(); i++) {
+ nrest.addElement(rest.elementAt(i));
+ }
+ return startup(index+1, tts, nrest);
+ }
+ } else {
+ if(rest.size() == 0) {
+ return combine(index, ts, new Vector(), new Vector());
+ } else {
+ Vector tts = (Vector)rest.elementAt(0);
+ Vector nrest = new Vector();
+ for(int i = 1; i < rest.size(); i++) {
+ nrest.addElement(rest.elementAt(i));
+ }
+ return combine(index, ts, tts, nrest);
+ }
+ }
+ }
+
+ private FibHeap chooseMin(FibHeap fh,
+ TaggedTree tt) {
+ FibHeap rfh = null;
+ if(fh.ttree.tree.root <= tt.tree.root) {
+ fh.forest.insertElementAt(tt, 0);
+ rfh = new FibHeap(this.degree-1, fh.ttree, fh.forest);
+ } else {
+ fh.forest.insertElementAt(fh.ttree, 0);
+ rfh = new FibHeap(this.degree-1, tt, fh.forest);
+ }
+ return rfh;
+ }
+
+ public FibHeap deleteMinFH_t() {
+ if(this.isEmpty()) {
+ // error here
+ System.exit(0xa2);
+ }
+ if(this.degree == 1) {
+ return new FibHeap();
+ }
+ // The second version of deleteMin uses accumArray to group trees of like
+ // size. It then performs the linking and all remaining steps purely
+ // functionally.
+ int d = locallog(this.degree - 1);
+ // arrange a 2 dimentional array to group the trees
+ Vector a = new Vector(d+1);
+ for(int i = 0; i < d+1; i++) {
+ a.addElement(new Vector());
+ }
+ for(int i = 0; i < this.forest.size(); i++) {
+ TaggedTree tt = (TaggedTree)this.forest.elementAt(i);
+ int de = tt.degree;
+ ((Vector)a.elementAt(de)).addElement(tt.tree);
+ }
+ // sequence (map (ins a) (getChildren tt))
+ Vector vec = this.ttree.getChildren();
+ for(int i = 0; i < vec.size(); i++) {
+ TaggedTree tt = (TaggedTree)vec.elementAt(i);
+ int de = tt.degree;
+ ((Vector)a.elementAt(de)).addElement(tt.tree);
+ }
+ Vector ts = (Vector)a.elementAt(0);
+ Vector na = new Vector();
+ for(int i = 1; i < a.size(); i++) {
+ na.addElement(a.elementAt(i));
+ }
+ Vector vvec = startup(0, ts, na);
+
+ // getMin()
+ TaggedTree rtt = (TaggedTree)vvec.elementAt(0);
+ FibHeap rfh = new FibHeap(this.degree-1, rtt, new Vector());
+ Vector nvvec = new Vector();
+ for(int i = 1; i < vvec.size(); i++) {
+ nvvec.addElement(vvec.elementAt(i));
+ }
+ vvec = nvvec;
+ while(vvec.size() != 0) {
+ rfh = chooseMin(rfh, (TaggedTree)vvec.elementAt(0));
+ Vector tvvec = new Vector();
+ for(int i = 1; i < vvec.size(); i++) {
+ tvvec.addElement(vvec.elementAt(i));
+ }
+ vvec = tvvec;
+ }
+ return rfh;
+ }
+}
\ No newline at end of file
--- /dev/null
+/** Bamboo Version
+ * Ported by: Jin Zhou 07/15/10
+ *
+ * This is ported from the NoBench, originally written in Haskell
+ * **/
+
+task t1(StartupObject s{initialstate}) {
+ //System.printString("task t1\n");
+
+ int threadnum = 62;
+ for(int i = 0; i < threadnum; ++i) {
+ TestRunner tr = new TestRunner(){run};
+ }
+
+ taskexit(s{!initialstate});
+}
+
+task t2(TestRunner tr{run}) {
+ //System.printString("task t2\n");
+ tr.run();
+ taskexit(tr{!run});
+}
\ No newline at end of file
--- /dev/null
+include ../../header.mk
+
+TEST = fibheaps
+TITLE = Fibonacci heaps by Okasaki
+TEST_ARGS = 200000
+HUGS_EXTRA_OPTS=-98
+GHC_EXTRA_OPTS=-funbox-strict-fields
+GHC_ASM_EXTRA_OPTS=-funbox-strict-fields
+GHC_OLD_EXTRA_OPTS=-funbox-strict-fields
+
+include ../../footer.mk
--- /dev/null
+// the fibheap class
+public class TestRunner {
+
+ flag run;
+
+ public TestRunner() {}
+
+ public void run() {
+ // generate test data
+ int iter = 600; //200;
+ int seed = 1967;
+ //Vector testdata = new Vector(iter);
+ FibHeap fh = new FibHeap();
+ FibHeap fh_t = new FibHeap();
+ for(int i = 0; i < iter; i++) {
+ int rand = (77 * seed + 1) % 1024;
+ //testdata.addElement(new Integer(rand));
+ seed++;
+ fh = fh.insertFH(rand);
+ fh_t = fh_t.insertFH(rand);
+ }
+ // makeFH from the test data
+ /*FibHeap fh = new FibHeap();
+ for(int i = testdata.size(); i > 0; i++) {
+ fh = fh.insertFH((Integer)(testdata.elementAt(i-1)).intValue());
+ }
+ FibHeap fh_t = new FibHeap();
+ for(int i = testdata.size(); i > 0; i++) {
+ fh_t = fh_t.insertFH((Integer)(testdata.elementAt(i-1)).intValue());
+ }*/
+
+ int[] rfh = new int[iter];
+ int[] rfh_t = new int[iter];
+
+ int i = 0;
+ while(!fh.isEmpty()) {
+ rfh[i] = fh.minFH();
+ fh = fh.deleteMinFH();
+ i++;
+ }
+ int j = 0;
+ while(!fh_t.isEmpty()) {
+ rfh_t[j] = fh_t.minFH();
+ fh_t = fh_t.deleteMinFH_t();
+ j++;
+ }
+
+ if(i != j) {
+ // error!
+ System.exit(0xaa);
+ } else {
+ for(i = 0; i < j; i++) {
+ if(rfh[i] != rfh_t[i]) {
+ // error!
+ System.exit(0xbb);
+ }
+ }
+ }
+ }
+}
\ No newline at end of file
--- /dev/null
+// the bionomial class
+public class Tree {
+ public int root;
+ public Vector v_trees;
+
+ public Tree() {
+ this.root = 0;
+ this.v_trees = null;
+ }
+
+ public Tree(int root,
+ Vector trees) {
+ this.root = root;
+ this.v_trees = trees;
+ }
+
+ public Tree link(Tree t) {
+ int root = 0;
+ Tree tmp = null;
+ Vector tmp_v = null;
+ if(this.root <= t.root) {
+ root = this.root;
+ tmp = t;
+ tmp_v = this.v_trees;
+ } else {
+ root = t.root;
+ tmp = this;
+ tmp_v = t.v_trees;
+ }
+ Tree nt = new Tree(root, tmp_v);
+ if(nt.v_trees == null) {
+ nt.v_trees = new Vector();
+ }
+ nt.v_trees.insertElementAt(tmp, 0);
+ return nt;
+ }
+}
+
+public class TaggedTree {
+ public int degree;
+ public Tree tree;
+
+ public TaggedTree() {
+ this.degree = 0;
+ this.tree = null;
+ }
+
+ public TaggedTree(int degree,
+ Tree tree) {
+ this.degree = degree;
+ this.tree = tree;
+ }
+
+ public Vector getChildren() {
+ Vector rst = new Vector();
+ Vector v = tree.v_trees;
+ int d = this.degree-1;
+ if(v != null) {
+ for(int i = 0; i < v.size(); i++) {
+ rst.addElement(new TaggedTree(d, (Tree)v.elementAt(i)));
+ d--;
+ }
+ }
+ return rst;
+ }
+}
\ No newline at end of file
--- /dev/null
+{-
+Date: Tue, 04 Jul 1995 13:10:58 -0400
+From: Chris_Okasaki@LOCH.MESS.CS.CMU.EDU
+To: simonpj@dcs.gla.ac.uk
+Subject: Fibonacci Heaps
+
+As I promised at the Haskell Workshop, here is a sample program
+using encapsulated state. I've translated this from SML, but
+in doing so, I noticed that in fact accumArray is all the
+encapsulated state you really need for this application. In SML,
+we are forced to use mutable arrays because we don't have such
+fancy monolithic array "primitives" as accumArray.
+
+I've written and tested this as a literate Gofer script because I've
+never been able to get GHC to run under Mach. :-(
+
+Let me know if you have any problems...
+
+Chris
+
+
+- ----------------------------------------------------------------------
+
+FIBONACCI HEAPS
+
+Fibonacci heaps are a priority queue data structure supporting the
+following operations:
+ O(1) Insert
+ O(1) FindMin
+ O(1) Meld
+ O(log n) DeleteMin
+
+(In an imperative settting, Fibonacci heaps also support
+ O(1) DecreaseKey (of an indicated element)
+ O(log n) Delete (an indicated element)
+but these operations are problematic in a functional setting.)
+
+There is one catch: for the DeleteMin operation, the bounds are
+amortized instead of worst-case. This means that the bounds are
+only guaranteed if you use the data structure in a single-threaded manner.
+Otherwise, you can take longer than expected by repeatedly going back
+and operating on an "expensive" version of the data structure.
+
+(Note: I am currently working on a paper with another student describing
+a functional priority queue achieving the above bounds in the worst-case
+instead of amortized. This data structure may be freely used in a
+non-single-threaded manner with no ill effects.)
+
+To understand the implementation of Fibonacci heaps, it is helpful to
+first understand binomial queues. See, for example, David King's
+"Functional Binomial Queues" from the last Glasgow workshop.
+-}
+
+import Data.Array
+import System.IO
+import System
+
+import Control.Monad.ST
+import Data.Array.ST
+
+
+{-
+Like binomial queues, Fibonacci heaps are based on heap-ordered
+binomial trees.
+-}
+
+data Tree a = Node !a [Tree a]
+
+{-
+The degree of a binomial tree is equal to its number of children.
+Every binomial tree of degree k has binomial trees of degrees
+k-1...0 as children, in that order. It is easy to show that
+a binomial tree of degree k has size 2^k.
+
+
+The fundamental operation on binomial trees is linking, which compares
+the roots of two binomial trees and makes the larger a child of the
+smaller (thus bumping its degree by one). It is essential that this
+only be called on binomial trees of equal degree.
+-}
+
+link (a @ (Node x as)) (b @ (Node y bs)) =
+ if x <= y then Node x (b:as) else Node y (a:bs)
+
+-- It will also be useful to extract the minimum element from a tree.
+
+root (Node x _) = x
+
+-- We will frequently need to tag trees with their degrees.
+
+type TaggedTree a = (Int,Tree a)
+
+degree (k, t) = k
+tree (k, t) = t
+
+-- Given a tagged tree, extract and tag its children.
+
+getChildren (n, Node x ts) = zipWith (,) [n-1,n-2 .. ] ts
+
+-- Extract the minimum element from a tagged tree.
+
+root' = root . tree
+
+{-
+ --------------------
+
+We also need a type for bags supporting constant time union. The simple
+representation given here is sufficient since we will always process bags
+as a whole. Note that for this application it is not necessary to
+filter out occurences of EmptyBag. Also, for this application order
+is irrelevant.
+-}
+
+data Bag a = EmptyBag | ConsBag a (Bag a) | UnionBags (Bag a) (Bag a)
+
+bagToList b = flatten b []
+ where flatten EmptyBag xs = xs
+ flatten (ConsBag x b) xs = flatten b (x:xs)
+ flatten (UnionBags b1 b2) xs = flatten b1 (flatten b2 xs)
+
+applyToAll :: (a -> ST s ()) -> Bag a -> ST s ()
+applyToAll f EmptyBag = return ()
+applyToAll f (ConsBag x b) = f x >> applyToAll f b
+applyToAll f (UnionBags b1 b2) = applyToAll f b1 >> applyToAll f b2
+
+
+-- Miscellaneous stuff.
+
+log2 1 = 0
+log2 n = 1 + log2 (n `div` 2)
+
+data MyMaybe a = Zero | One !a
+
+{-
+ --------------------
+
+Since binomial trees only come in certain, fixed sizes, we need some
+way to represent priority queues of other sizes. We will do this
+with a forest of trees summing to the correct size.
+-}
+
+type Forest a = Bag (TaggedTree a)
+
+{-
+In binomial queues, this forest must be maintained in strictly increasing
+order of degree. For Fibonacci heaps, we adopt a more relaxed attitude:
+degrees may be repeated and order does not matter.
+
+To be able to find the minimum element quickly, we keep the tree with the
+minimum root outside of the bag. In addition, at the top level of each heap,
+we store the total size of the heap.
+-}
+
+data FibHeap a = EmptyFH | FH !Int (TaggedTree a) (Forest a)
+
+
+-- Now, the following operations are trivial.
+
+emptyFH = EmptyFH
+
+isEmptyFH EmptyFH = True
+isEmptyFH (FH _ _ _) = False
+
+singleFH x = FH 1 (0, Node x []) EmptyBag
+
+insertFH x xs = meldFH (singleFH x) xs
+
+minFH EmptyFH = error "minFH EmptyFH"
+minFH (FH n tt f) = root' tt
+
+
+{-
+ --------------------
+
+Meld achieves its efficiency by simply unioning the two forests.
+-}
+
+meldFH EmptyFH xs = xs
+meldFH xs EmptyFH = xs
+meldFH (FH n1 tt1 f1) (FH n2 tt2 f2) =
+ if root' tt1 <= root' tt2 then
+ FH (n1+n2) tt1 (ConsBag tt2 (UnionBags f1 f2))
+ else
+ FH (n1+n2) tt2 (ConsBag tt1 (UnionBags f1 f2))
+
+{-
+Finally, the only hard operation is deleteMin. After throwing away the
+minimum element, it repeatedly links trees of equal degree until
+no such pairs are left. The most efficient way to do this is with
+an array. I give two implementations, one using monadic arrays,
+the other using accumArray.
+
+In the first implementation, there are three steps.
+ 1. Allocate an array indexed by degrees.
+ 2. Insert every tree into this array. If, when inserting a tree of
+ degree k, there already exists a tree of degree k, link the
+ two trees and reinsert the new larger tree.
+ 3. Transfer the trees into a bag, keeping track of the minimum tree.
+-}
+
+deleteMinFH EmptyFH = error "deleteMinFH EmptyFH"
+deleteMinFH (FH 1 tt f) = EmptyFH
+deleteMinFH (FH n tt f) =
+ let
+ d = log2 (n-1) -- maximum possible degree
+
+ ins :: Ord a => STArray s Int (MyMaybe (Tree a)) -> (Int,Tree a) -> ST s ()
+ ins a (i, t) =
+ readArray a i >>= \e ->
+ case e of
+ Zero -> writeArray a i (One t)
+ One t2 -> writeArray a i Zero >>
+ ins a (i+1, link t t2)
+
+{-
+Note that after inserting all the trees, the array contains trees
+in the same pattern as the bits of n-1. Since we know that the
+highest order bit of n-1 is one, we know that there is a tree in
+the highest slot of the array.
+-}
+
+ getMin a =
+ readArray a d >>= \e ->
+ case e of
+ Zero -> error "must be One" -- since array is filled as bits of n-1
+ One t -> getMin' a d t EmptyBag 0
+ getMin' a mini mint b i =
+ if i >= d then
+ return ((mini, mint),b)
+ else
+ readArray a i >>= \e ->
+ case e of
+ Zero -> getMin' a mini mint b (i+1)
+ One t -> if root mint <= root t then
+ getMin' a mini mint (ConsBag (i, t) b) (i+1)
+ else
+ getMin' a i t (ConsBag (mini, mint) b) (i+1)
+
+ in
+ runST (newArray (0,d) Zero >>= \a ->
+ applyToAll (ins a) f >>
+ sequence (map (ins a) (getChildren tt)) >>
+ getMin a >>= \ (tt,f) ->
+ return (FH (n-1) tt f))
+
+{-
+The second version of deleteMin uses accumArray to group trees of like
+size. It then performs the linking and all remaining steps purely
+functionally.
+-}
+
+deleteMinFH' EmptyFH = error "deleteMinFH EmptyFH"
+deleteMinFH' (FH 1 tt f) = EmptyFH
+deleteMinFH' (FH n tt f) =
+ let
+ d = log2 (n-1) -- maximum possible degree
+
+ a = accumArray (flip (:)) [] (0,d) (getChildren tt ++ bagToList f)
+
+ doLinks (ts:rest) = startup 0 ts rest
+ where startup i [] [] = []
+ startup i [] (ts:rest) = startup (i+1) ts rest
+ startup i ts [] = combine i ts [] []
+ startup i ts (next:rest) = combine i ts next rest
+
+ combine i [] next rest = startup (i+1) next rest
+ combine i [t] next rest = (i, t) : startup (i+1) next rest
+ combine i (t1:t2:ts) next rest =
+ combine i ts (link t1 t2 : next) rest
+
+ getMin (tt:rest) = foldl chooseMin (tt,EmptyBag) rest
+ where chooseMin (tt1,b) tt2 =
+ if root' tt1 <= root' tt2 then
+ (tt1,ConsBag tt2 b)
+ else
+ (tt2,ConsBag tt1 b)
+
+ (new_tt,new_f) = getMin (doLinks (elems a))
+ in
+ FH (n-1) new_tt new_f
+
+
+-- Testing...
+
+fibToList :: (Ord a) => FibHeap a -> [a]
+fibToList xs = if isEmptyFH xs then []
+ else minFH xs : fibToList (deleteMinFH xs)
+
+fibToList' :: (Ord a) => FibHeap a -> [a]
+fibToList' xs = if isEmptyFH xs then []
+ else minFH xs : fibToList' (deleteMinFH' xs)
+
+makeFH :: (Ord a) => [a] -> FibHeap a
+makeFH xs = foldr insertFH emptyFH xs
+
+fibSort :: (Ord a) => [a] -> [a]
+fibSort = fibToList . makeFH
+
+fibSort' :: (Ord a) => [a] -> [a]
+fibSort' = fibToList' . makeFH
+
+randoms :: Int -> [Int]
+randoms n = take n (iterate (\seed-> (77*seed+1) `rem` 1024) 1967)
+
+test n = fibSort (randoms n) == fibSort' (randoms n)
+
+--partain
+main = getArgs >>= \ [n] -> putStrLn (show (test (read n)))
BAMBOO_DEBUGPRINT_REG(((int *)(tptr))[0]);
#endif
if(ptr == NULL) {
- BAMBOO_EXIT(0x106);
+ BAMBOO_EXIT(0xb106);
}
if(((int *)(ptr))[6] == COMPACTED) {
int type = ((int *)(ptr))[0];
projects / IRC.git / commitdiff