Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/util/union.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/MiscUtil/util/union.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 418 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/MiscUtil/util/union.sml

1 : monnier 245 (* Copyright 1989 by AT&T Bell Laboratories *)
2 :     signature UNIONFIND =
3 :     sig
4 :     exception Union
5 :     val new : (int -> bool) ->
6 :     {union: int * int -> int,
7 :     find : int -> int}
8 :     end
9 :    
10 :    
11 :     structure Unionfind : UNIONFIND =
12 :     struct
13 :     exception Union
14 :     fun new (fixed) =
15 :     let open Intmap (* locally rebinding new, of course! *)
16 :     exception UnionM and UnionN
17 :     val m = new(32, UnionM) : int intmap
18 :     fun find x =
19 :     let val z = find(map m x)
20 :     in add m (x,z); z
21 :     end
22 :     handle UnionM => x
23 :     fun union (x,y) =
24 :     let val x' = find x and y' = find y
25 :     in if x' <> y'
26 :     then if fixed(x')
27 :     then if fixed(y')
28 :     then raise Union
29 :     else (add m (y', x'); x')
30 :     else if fixed(y')
31 :     then (add m (x', y'); y')
32 :     else if y' < x'
33 :     then (add m (x', y'); y')
34 :     else (add m (y', x'); x')
35 :     else x'
36 :     end
37 :     in {union=union, find=find}
38 :     end
39 :     end
40 :    
41 :    
42 :     signature SIBLINGS =
43 :     sig
44 :     type 't siblingClass
45 :     val new : (int -> bool) -> '1t siblingClass
46 :     (* assoc(i,x) must be called for any element i before
47 :     i is used as an argument to union or find or getassoc *)
48 :     end
49 :    
50 :    
51 :     structure Siblings : SIBLINGS =
52 :     struct
53 :     type 't siblingClass =
54 :     {assoc : int * 't -> unit,
55 :     union : int * int -> int,
56 :     find : int -> int,
57 :     getassoc : int -> 't list}
58 :     fun new(fixed: int -> bool) : '1t siblingClass =
59 :     let val {union = uni, find = find} = Unionfind.new(fixed)
60 :     exception UnionA
61 :     val a = Intmap.new(32, UnionA) : ('1t * int list) Intmap.intmap
62 :     val add = Intmap.add a
63 :     val map = Intmap.map a
64 :     fun assoc (i,x) =
65 :     let val (_,l) = map i handle UnionA => (x,nil)
66 :     in add (i,(x,l))
67 :     end
68 :     fun join(i,j) =
69 :     let val (x,l) = map j
70 :     in add (j,(x,i::l)); j
71 :     end
72 :     fun union (i,j) =
73 :     let val i' = find i and j' = find j
74 :     in if i' = j' then i'
75 :     else let val k = uni(i',j')
76 :     in if k=i' then join(j',k) else join(i',k)
77 :     end
78 :     end
79 :     fun get(i,l) =
80 :     let fun f (a::b) = get(a,f(b)) | f nil = l
81 :     val (x,r) = map i
82 :     in x::f(r)
83 :     end
84 :     fun getassoc i = get(find i,nil)
85 :     in {assoc=assoc, union=union, find=find, getassoc=getassoc}
86 :     end
87 :     end (* structure Siblings *)
88 :    
89 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0