Return to union.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / util

Annotation of researchv10no/cmd/sml/src/util/union.sml, revision 1.1.1.1

1.1       root        1: (* 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:            and n = new(32, UnionN) : int intmap
                     19:            fun find x = 
                     20:                 let val z = find(map m x)
                     21:                  in add m (x,z); z
                     22:                 end 
                     23:                 handle UnionM => x
                     24:            fun union (x,y) =
                     25:                let val x' = find x and y' = find y
                     26:                    val xn = map n x'  handle UnionN => 1
                     27:                    and yn = map n y'  handle UnionN => 1
                     28:                 in if x' <> y'
                     29:                    then if fixed(x')
                     30:                         then if fixed(y')
                     31:                              then raise Union
                     32:                              else (add m (y', x'); add n (x',xn+yn); x')
                     33:                         else if fixed(y')
                     34:                              then (add m (x', y'); add n (y',xn+yn); y')
                     35:                              else if xn < yn                         
                     36:                              then (add m (x', y'); add n (y',xn+yn); y')
                     37:                              else (add m (y', x'); add n (x',xn+yn); x')
                     38:                    else x'
                     39:                end
                     40:         in {union=union, find=find}
                     41:        end
                     42:   end
                     43: 
                     44: 
                     45: signature SIBLINGS =
                     46:   sig
                     47:     type 't siblingClass
                     48:     val new : (int -> bool) -> '1t siblingClass
                     49:      (* assoc(i,x) must be called for any element i before 
                     50:         i is used as an argument to union or find or getassoc *)
                     51:   end
                     52: 
                     53: 
                     54: structure Siblings : SIBLINGS =
                     55:   struct
                     56:     type 't siblingClass =
                     57:              {assoc : int * 't -> unit,
                     58:               union : int * int -> int,
                     59:                find : int -> int,
                     60:               getassoc : int -> 't list}
                     61:     fun new(fixed: int -> bool) : '1t siblingClass =
                     62:        let val {union = uni, find = find} = Unionfind.new(fixed)
                     63:            exception UnionA
                     64:            val a = Intmap.new(32, UnionA) : ('1t * int list) Intmap.intmap
                     65:            val add = Intmap.add a
                     66:            val map = Intmap.map a
                     67:            fun assoc (i,x) = 
                     68:                let val (_,l) = map i handle UnionA => (x,nil)
                     69:                 in add (i,(x,l))
                     70:                end
                     71:            fun join(i,j) =
                     72:              let val (x,l) = map j
                     73:               in add (j,(x,i::l)); j
                     74:              end
                     75:            fun union (i,j) = 
                     76:                let val i' = find i and j' = find j
                     77:                 in if i' = j' then i'
                     78:                    else let val k = uni(i',j')
                     79:                          in if k=i' then join(j',k) else join(i',k)
                     80:                         end
                     81:                end
                     82:            fun get(i,l) = 
                     83:               let fun f (a::b) = get(a,f(b)) | f nil = l
                     84:                   val (x,r) = map i
                     85:                in x::f(r)
                     86:               end
                     87:            fun getassoc i = get(find i,nil)
                     88:         in {assoc=assoc, union=union, find=find, getassoc=getassoc}
                     89:        end
                     90:   end (* structure Siblings *)
                     91: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.