PurelyFunctionalDataStructuresInFSharp is an open source project powered by Assembla

Assembla offers free public and private SVN/Git repositories and project hosting with bug/issue tracking and collaboration tools.

purelyfunctionaldatastructuresinfsharp

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
´╗┐namespace PurelyFunctionalDataStructures

#light

type Heap<'a> =
| E
| T of int * 'a * Heap<'a> * Heap<'a>

module LeftistHeap =
    exception EmptyException

    let empty = E

    let rank h =
        match h with
        | E -> 0
        | T(r, _,_,_) -> r

    let makeT x a b =
        if rank a >= rank b then
            T(rank b + 1, x, a, b)
        else
            T(rank a + 1, x, b, a)

    let isEmpty h =
        if h = E then
            true
        else
            false

    let rec merge l r =
        match l,r with
        | l,E -> l
        | E,r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            if lx <= rx then
                makeT lx la (merge lb rh)
            else
                makeT rx ra (merge lh rb)

    let insert x h =
        merge (T(1,x,E,E)) h

    let findMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> x

    let deleteMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> merge a b

    let rec eq l r =
        let res = match l,r with
                    | E,E -> true
                    | E,T(_,_,_,_) -> false
                    | T(_,_,_,_),E -> false
                    | T(lrank, lval, lchildLeft, lchildRight) as left, (T(rrank, rval, rchildLeft, rchildRight) as right) ->
                        lrank = rrank && lval = rval && (eq lchildLeft rchildLeft) && (eq lchildRight rchildRight)
        if not res then
            printfn "left: %A\nright: %A" l r

        res

    let count h =
        let rec count' h acc cont =
            match h with
            | E -> cont (acc)
            | T(_,_,left,right) ->
                let f = (fun lc -> count' right lc cont)
                count' left (acc+1) f

        count' h 0 (fun (x: int) -> x)

    // Excercise 3.2
    let rec insert3_2 x h =
        match h with
        | E -> T(1, x, E, E)
        | T(_, value, left, right) ->
            if (x <= value) then
                makeT x E h
            else
                makeT value left (insert3_2 x right)

    // Excercise 3.3
    let fromList l =
        let singletons = List.map (fun v -> T(1,v,E,E)) l

        let rec reMerge l acc =
            match l with
            | [] -> E, acc
            | h::[] -> h, acc
            | h1::h2::t ->
                let acc = acc + 1
                let rest = reMerge t acc
                (merge (merge h1 h2) (fst(rest))), snd(rest)

        let result = reMerge singletons 0
        printfn "Merge count %d" (snd(result))

        fst(result)

module WeightBiasedLeftistHeap =
    exception EmptyException

    let size h =
        let rec count' h acc cont =
            match h with
            | E -> cont (acc)
            | T(_,_,left,right) ->
                let f = (fun lc -> count' right lc cont)
                count' left (acc+1) f

        count' h 0 (fun (x: int) -> x)

    let weight h =
        match h with
        | E -> 0
        | T(w, _,_,_) -> w

    let makeT x a b =
        let weightA = weight a
        let weightB = weight b
        if weightA >= weightB then
            T(weightA + weightB + 1, x, a, b)
        else
            T(weightA + weightB + 1, x, b, a)

    let isEmpty h =
        if h = E then
            true
        else
            false

    // excercise 3.4
//    let rec merge3_4 l r =
//        match l,r with
//        | l,E -> l
//        | E,r -> r
//        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
//            if lx <= rx then
//                let right = merge3_4 lb rh
//                let weightA = weight la
//                let weightB = weight right
//
//                if weightA >= weightB then
//                    T(weightA + weightB + 1, lx, la, right)
//                else
//                    T(weightA + weightB + 1, lx, right, la)
//            else
//                let right = merge3_4 lh rb
//                let weightA = weight ra
//                let weightB = weight right
//
//                makeT rx ra (merge lh rb)

    // excercise 3.4
    // this doesn't work, I couldn't figure out how to do this in a single pass
    let merge3_4 l r =
        let rec merge' l r value leftChild  =
            match l,r with
            | l,E -> makeT value leftChild l
            | E,r -> makeT value leftChild r
            | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
                if lx <= rx then
                    merge' lb rh lx la   //(fun h -> makeT(lx, la, h))
                else
                    merge' lh rb rx ra   //(fun h -> makeT(rx, ra, h))

        match l, r with
        | l, E -> l
        | E, r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            let lf = fun h -> makeT(lx, la, h)
            if lx <= rx then
                merge' lb rh lx la // (fun h -> makeT(lx, la, h))
            else
                merge' lh rb rx ra // (fun h -> makeT(rx, ra, h))

    let rec merge l r =
        match l,r with
        | l,E -> l
        | E,r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            if lx <= rx then
                makeT lx la (merge lb rh)
            else
                makeT rx ra (merge lh rb)

    let insert x h =
        merge (T(1,x,E,E)) h

    let insert3_4 x h =
        merge3_4 (T(1,x,E,E)) h

    let findMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> x

    let deleteMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> merge a b

    let rec eq l r =
        let res = match l,r with
                    | E,E -> true
                    | E,T(_,_,_,_) -> false
                    | T(_,_,_,_),E -> false
                    | T(lweight, lval, lchildLeft, lchildRight) as left, (T(rweight, rval, rchildLeft, rchildRight) as right) ->
                        lweight = rweight && lval = rval && (eq lchildLeft rchildLeft) && (eq lchildRight rchildRight)
        if not res then
            printfn "left: %A\nright: %A" l r

        res
Ajax-loader Loading, please wait...