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     ! 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.