6 posts tagged “functional programming”

In my previous post, I whined about how it didn't seem to me that a pure-functional union-find data structure should be so hard to make as computationally efficient as the well-known imperative algorithms.  After some wonkulation on the subject, I convinced myself that— yes, bunky, it's true— functional purity really does cost extra, and sometimes it costs enough that it's worth sacrificing purity for efficiency.

• FIND returns the representative element of the set, and I'd rather the code allowed for the representative of the equivalence class to be of a type different than the set elements. This is because I'm planning to use the data structure in a constraint solver for type inference.

• Their code requires the elements to be integers suitable for indexing persistent arrays.  This is unacceptable for me.  I want an algorithm suitable for any totally ordered set of elements.

module type T = sig

    type k and +'a q and +'a t

    

    val nil: 'a t

    val start: k -> 'a -> 'a t

    val find: k -> 'a t -> 'a q option

    val extract: 'a q -> 'a

    val disjoint: 'a t -> 'a t -> 'a t

    val union: 'a q -> 'a q -> 'a t

end

module Create(K: Cf_ordered.Total_T) : (T with type k = K.t) = struct

    module U = Cf_rbtree.Set(K)

    module H = Cf_sbheap.PQueue(Cf_ordered.Int_order)

    

    type k = K.t

    

    type 'a q = Q of U.t * int * 'a * 'a t

    and 'a t = T of int * (k -> 'a q option)

    

    let void_ _ = None

    let nil = T (0, void_)

    

    let start k v =

        let q = Some (Q (U.singleton k, 1, v, nil)) in

        let f k' = if K.compare k k' <> 0 then None else q in

        T (1, f)

    

    let find k (T (_, f)) = f k

    let extract (Q (_, _, v, _)) = v

    

    type 'a compressor = {

        mutable z: int;

        mutable h: 'a q H.t;

        mutable u: U.t;

        mutable f: k -> 'a q option;

    }

    

    let compress_ =

        let rec loop c k h =

            if U.member k c.u then

                None

            else

                match H.pop h with

                | Some (hd, tl) ->

                    let _, q = hd in

                    let Q (u, _, _, _) = q in

                    if U.member k u then Some q else loop c k tl

                | None ->

                    if c.z = 0 then

                        None

                    else

                        match c.f k with

                        | None ->

                            c.u <- U.put k c.u;

                            None

                        | Some q as q1 ->

                            let Q (_, n, _, _) = q in

                            c.h <- H.put (n, q) c.h;

                            let z = c.z - n in

                            assert (z >= 0);

                            c.z <- z;

                            if z == 0 then begin

                                c.f <- void_;

                                c.u <- U.nil

                            end;

                            q1

        in

        fun c k ->

            loop c k c.h

    

    let disjoint a b =

        if a == b then

            a

        else begin

            let T (na, fa) = a and T (nb, fb) = b in

            let n = na + nb in

            let f =

                if n > 1 then begin

                    let f1, f2 = if na > nb then fa, fb else fb, fa in

                    fun k -> match f1 k with Some _ as q -> q | None -> f2 k

                end

                else if n > 0 then begin

                    if na > 0 then fa else fb

                end

                else

                    void_

            in

            let c = { z = n; h = H.nil; u = U.nil; f = f } in

            T (na + nb, compress_ c)

        end

    

    let union a b =

        let Q (ua, na, v, ta) = a and Q (ub, nb, _, tb) = b in

        if ta == tb && ua == ub then

            ta

        else begin

            let qn = na + nb in

            let T (n, f) as t = disjoint ta tb in

            let z = n - qn in

            assert (z >= 0);

            let rec q = Q (U.union ua ub, qn, v, t)

            and c = lazy { z = n; h = H.put (n, q) H.nil; u = U.nil; f = f } in

            let c = Lazy.force c in

            T (n, compress_ c)

        end

end

...is apparently not terribly efficient.  This makes me sad.  The problem doesn't seem like it should be as hard as it appears to be.  This makes me more sad.

ZOMG.  I just found this paper written by David Teller in 2004.  It's freaking awesome.

Hee!

The Koan of Static Type Safety

A disciple of another sect invited Markus Mottl to the beach. As he is driving his car along, he tells Markus: "Dynamic Typing makes me more productive! I can write my program faster if I do not have to worry about the compiler complaining about types". Since it is a long trip, the disciple of Dynamic Typing decides to make a stop for petrol. He enters the station to pay for the fuel and purchase a slurpee, while Markus attends to the refueling. Markus notes that the petrol pump is in use, so he starts pumping diesel fuel into the disciple's car. The disciple cries out, "Hey! What are you doing, this is a petrol car!". Markus replies, "Well, I wanted to get to the beach faster".

Thanks to Didier Rémy and Benoît Montagu, I now have a solution to my type system problem.

Just a brief note to go on the record.  I note that the widespread deployment of pseudo-symmetric multiprocessing hardware in personal computers is giving software developers new reasons to put more energy into crawling up the concurrent programming learning curve.  Sadly, it seems that a lot of the sooper-hip cool kids are glomming onto the latest craze in the world of haute couture for coders, i.e. The Actor Model.