1
1
namespace FSharpPlus.Data
2
2
3
+ open System
3
4
open System.Collections .Generic
4
5
open System.ComponentModel
6
+ open FSharp.Core .CompilerServices
5
7
open FSharpPlus
6
8
7
9
// DList from FSharpx.Collections
8
10
//This implementation adds an additional parameter to allow O(1) retrieval of the list length.
9
11
10
-
11
12
type DListData < 'T > =
12
13
| Nil
13
14
| Unit of 'T
14
15
| Join of DListData < 'T > * DListData < 'T >
15
16
16
-
17
17
/// DList is an ordered linear structure implementing the List signature (head, tail, cons),
18
18
/// end-insertion (add), and O(1) append. Ordering is by insertion history.
19
19
/// DList is an implementation of [John Hughes' append list](http://dl.acm.org/citation.cfm?id=8475).
@@ -25,11 +25,11 @@ type DList<'T> (length: int, data: DListData<'T>) =
25
25
26
26
static member ofSeq ( s : seq < 'T >) =
27
27
DList ( Seq.fold ( fun ( i , state ) x ->
28
- ( i+ 1 ,
28
+ ( i + 1 ,
29
29
match state with
30
- | Nil -> Unit x
31
- | Unit _ -> Join ( state, Unit x)
32
- | Join(_,_) -> Join ( state, Unit x))) ( 0 , Nil) s)
30
+ | Nil -> Unit x
31
+ | Unit _ -> Join ( state, Unit x)
32
+ | Join(_, _) -> Join ( state, Unit x))) ( 0 , Nil) s)
33
33
34
34
override this.GetHashCode () =
35
35
match hashCode with
@@ -42,34 +42,23 @@ type DList<'T> (length: int, data: DListData<'T>) =
42
42
| Some hash -> hash
43
43
44
44
override this.Equals other =
45
- #if FABLE_ COMPILER
46
- let y = other :?> DList< 'T>
47
- if this.Length <> y.Length then false
48
- else
49
- if hash this <> hash y then false
50
- else Seq.forall2 Unchecked.equals this y
51
- #else
52
45
match other with
53
- | :? DList< 'T> as y ->
54
- if this.Length <> y.Length then false
55
- else
56
- if this.GetHashCode () <> y.GetHashCode () then false
57
- else Seq.forall2 Unchecked.equals this y
46
+ | :? DList< 'T> as y -> ( this :> IEquatable< DList< 'T>>) .Equals y
58
47
| _ -> false
59
- #endif
60
48
61
49
/// O(1). Returns the count of elememts.
62
50
member _.Length = length
63
51
64
- // O(n ). FoldBack walks the DList using constant stack space. Implementation is from Norman Ramsey.
52
+ // O(2n ). FoldBack walks the DList using constant stack space. Implementation is from Norman Ramsey.
65
53
// Called a "fold" in the article processes the linear representation from right to left
66
54
// and so is more appropriately implemented under the foldBack signature
67
55
// See http://stackoverflow.com/questions/5324623/functional-o1-append-and-on-iteration-from-first-element-list-data-structure/5334068#5334068
68
- static member foldBack ( f : 'T -> 'State -> 'State ) ( l : DList < 'T >) ( state : 'State ) =
56
+ static member foldBack ( f : 'T -> 'State -> 'State ) ( l : DList < 'T >) ( state : 'State ) =
57
+ let f = OptimizedClosures.FSharpFunc<_, _, _>. Adapt f
69
58
let rec walk lefts l xs =
70
59
match l with
71
60
| Nil -> finish lefts xs
72
- | Unit x -> finish lefts <| f x xs
61
+ | Unit x -> finish lefts <| f.Invoke ( x , xs)
73
62
| Join ( x, y) -> walk ( x:: lefts) y xs
74
63
and finish lefts xs =
75
64
match lefts with
@@ -78,37 +67,35 @@ type DList<'T> (length: int, data: DListData<'T>) =
78
67
walk [] l.dc state
79
68
80
69
// making only a small adjustment to Ramsey's algorithm we get a left to right fold
81
- static member fold ( f : 'State -> 'T -> 'State ) ( state : 'State ) ( l : DList < 'T >) =
82
- let f = OptimizedClosures.FSharpFunc<_,_, _>. Adapt f
70
+ static member fold ( f : 'State -> 'T -> 'State ) ( state : 'State ) ( l : DList < 'T >) =
71
+ let f = OptimizedClosures.FSharpFunc<_, _, _>. Adapt f
83
72
let rec walk rights l xs =
84
73
match l with
85
- | Nil -> finish rights xs
86
- | Unit x -> finish rights <| f.Invoke ( xs, x)
87
- | Join( x, y) -> walk ( y:: rights) x xs
74
+ | Nil -> finish rights xs
75
+ | Unit x -> finish rights <| f.Invoke ( xs, x)
76
+ | Join ( x, y) -> walk ( y:: rights) x xs
88
77
and finish rights xs =
89
78
match rights with
90
79
| [] -> xs
91
80
| t:: ts -> walk ts t xs
92
81
walk [] l.dc state
93
82
94
- static member private tryFindi ( f : ( int -> 'T -> bool )) ( l : DList < 'T >) =
95
- let f = OptimizedClosures.FSharpFunc<_,_, _>. Adapt f
83
+ static member private tryFindi ( f : ( int -> 'T -> bool )) ( l : DList < 'T >) =
84
+ let f = OptimizedClosures.FSharpFunc<_, _, _>. Adapt f
96
85
let rec walk rights l i =
97
86
match l with
98
- | Nil -> finish rights i
99
- | Unit x ->
100
- if f.Invoke ( i, x) then
101
- Some x
102
- else
103
- finish rights ( i+ 1 )
104
- | Join( x, y) -> walk ( y:: rights) x i
87
+ | Nil -> finish rights i
88
+ | Unit x ->
89
+ if f.Invoke ( i, x) then Some x
90
+ else finish rights ( i + 1 )
91
+ | Join ( x, y) -> walk ( y:: rights) x i
105
92
and finish rights xs =
106
93
match rights with
107
94
| [] -> None
108
95
| t:: ts -> walk ts t xs
109
96
walk [] l.dc 0
110
97
static member private findi ( f : ( int -> 'T -> bool )) ( l : DList < 'T >) =
111
- match DList.tryFindi f l with | Some v -> v | None -> raise ( System.Collections.Generic. KeyNotFoundException ())
98
+ match DList.tryFindi f l with Some v -> v | None -> raise ( KeyNotFoundException ())
112
99
113
100
static member append ( left , right ) =
114
101
match left, right with
@@ -161,59 +148,59 @@ type DList<'T> (length: int, data: DListData<'T>) =
161
148
member this.TryTail =
162
149
let rec step ( xs : DListData < 'T >) ( acc : DListData < 'T >) =
163
150
match xs with
164
- | Nil -> acc | Unit _ -> acc
165
- | Join ( x, y) -> step x ( DList< 'T>. append ( y, acc))
151
+ | Nil | Unit _ -> acc
152
+ | Join ( x, y) -> step x ( DList< 'T>. append ( y, acc))
166
153
if this.IsEmpty then None
167
154
else Some ( DList ( length - 1 , step data Nil))
168
155
169
156
/// O(log n). Returns the first element and tail.
170
- member this.Uncons = ( DList< 'T>. head data, this.Tail)
157
+ member this.Uncons = DList< 'T>. head data, this.Tail
171
158
172
159
/// O(log n). Returns option first element and tail.
173
160
member this.TryUncons =
174
161
match DList< 'T>. tryHead data with
175
162
| Some x -> Some ( x, this.Tail)
176
163
| None -> None
177
164
178
- member s.Item with get ( index : int ) =
179
- let withIndex i _ = ( i = index)
180
- if index < 0 || index >= s.Length then raise ( System.IndexOutOfRangeException ())
181
- DList.findi withIndex s
165
+ member s.Item
166
+ with get ( index : int ) =
167
+ let withIndex i _ = ( i = index)
168
+ if index < 0 || index >= s.Length then raise ( IndexOutOfRangeException ())
169
+ DList.findi withIndex s
182
170
183
171
member _.toSeq () =
184
172
//adaptation of right-hand side of Norman Ramsey's "fold"
185
173
let rec walk rights l = seq {
186
174
match l with
187
175
| Nil ->
188
176
match rights with
189
- | [] -> ()
177
+ | [] -> ()
190
178
| t:: ts -> yield ! walk ts t
191
179
| Unit x ->
192
180
yield x
193
181
match rights with
194
182
| [] -> ()
195
183
| t:: ts -> yield ! walk ts t
196
- | Join ( x, y) -> yield ! walk ( y:: rights) x}
197
-
184
+ | Join ( x, y) -> yield ! walk ( y:: rights) x }
198
185
( walk [] data) .GetEnumerator ()
199
186
200
- interface IEnumerable < 'T > with
201
- member s.GetEnumerator ( ) = s.toSeq ()
202
-
203
- interface IReadOnlyCollection < 'T > with
204
- member s.Count = s.Length
187
+ interface IEquatable < DList < 'T > > with
188
+ member this.Equals ( y : DList < 'T > ) =
189
+ if this.Length <> y.Length then false
190
+ elif this.GetHashCode () <> y.GetHashCode () then false
191
+ else Seq.forall2 Unchecked.equals this y
205
192
206
193
interface IReadOnlyList< 'T> with
207
194
member s.Item with get index = s.Item index
208
-
209
- interface System.Collections.IEnumerable with
210
- override s.GetEnumerator () = ( s.toSeq () :> System.Collections.IEnumerator)
195
+ member s.Count = s.Length
196
+ member s.GetEnumerator () = s.toSeq ()
197
+ member s.GetEnumerator () = s.toSeq () :> System.Collections.IEnumerator
211
198
212
199
213
- [<CompilationRepresentation ( CompilationRepresentationFlags.ModuleSuffix ) >]
200
+ [<RequireQualifiedAccess >]
214
201
module DList =
215
202
/// O(1). Returns a new DList of two lists.
216
- let append left right = DList< 'T>. appendLists( left, right)
203
+ let append left right = DList< 'T>. appendLists ( left, right)
217
204
218
205
/// O(1). Returns a new DList with the element added to the beginning.
219
206
let cons hd ( l : DList < 'T >) =
@@ -225,8 +212,7 @@ module DList =
225
212
[<GeneralizableValue>]
226
213
let empty < 'T > : DList < 'T > = DList( 0 , Nil)
227
214
228
- /// O(n). Fold walks the DList using constant stack space. Implementation is from Norman Ramsey.
229
- /// See http://stackoverflow.com/questions/5324623/functional-o1-append-and-on-iteration-from-first-element-list-data-structure/5334068#5334068
215
+ /// Fold walks the DList using constant stack space.
230
216
let foldBack ( f : 'T -> 'State -> 'State ) ( l : DList < 'T >) ( state : 'State ) = DList< 'T>. foldBack f l state
231
217
232
218
let fold ( f : 'State -> 'T -> 'State ) ( state : 'State ) ( l : DList < 'T >) = DList< 'T>. fold f state l
@@ -261,18 +247,64 @@ module DList =
261
247
/// O(log n). Returns option first element and tail.
262
248
let inline tryUncons ( l : DList < 'T >) = l.TryUncons
263
249
264
- /// O(n). Returns a DList of the seq.
250
+ /// Returns a DList of the seq.
265
251
let ofSeq s = DList< 'T>. ofSeq s
266
252
267
- /// O(n). Returns a list of the DList elements.
268
- let inline toList l = foldBack List.cons l []
269
-
270
- /// O(n). Returns a seq of the DList elements.
253
+ /// Iterates over each element of the list.
254
+ let iter action ( source : DList < 'T >) =
255
+ let rec walk rights = function
256
+ | Nil ->
257
+ match rights with
258
+ | [] -> ()
259
+ | t:: ts -> walk ts t
260
+ | Unit x ->
261
+ action x
262
+ match rights with
263
+ | [] -> ()
264
+ | t:: ts -> walk ts t
265
+ | Join ( x, y) -> walk ( y:: rights) x
266
+ walk [] source.dc
267
+
268
+ /// Returns a list of the DList elements.
269
+ let toList ( source : DList < 'T >) =
270
+ #if FABLE_ COMPILER
271
+ DList< 'T>. foldBack List.cons source []
272
+ #else
273
+ let mutable coll = new ListCollector<_> ()
274
+ iter ( fun x -> coll.Add x) source
275
+ coll.Close ()
276
+ #endif
277
+
278
+ /// Returns an array of the DList elements.
279
+ let toArray ( source : DList < 'T >) =
280
+ #if FABLE_ COMPILER
281
+ source :> seq< 'T> |> Seq.toArray
282
+ #else
283
+ let mutable coll = new ArrayCollector<_> ()
284
+ iter ( fun x -> coll.Add x) source
285
+ coll.Close ()
286
+ #endif
287
+
288
+ /// Returns a seq of the DList elements.
271
289
let inline toSeq ( l : DList < 'T >) = l :> seq< 'T>
272
290
291
+ let pairwise ( source : DList < 'T >) =
292
+ let (| Cons | Nil |) ( l : DList < 'T >) = match l.TryUncons with Some ( a, b) -> Cons ( a, b) | None -> Nil
293
+ let rec pairWiseDListData cons lastvalue = function
294
+ | Nil -> cons
295
+ | Cons ( x, Nil) -> Join ( cons, Unit ( lastvalue, x))
296
+ | Cons ( x, rest) -> pairWiseDListData ( Join ( cons, Unit ( lastvalue, x))) x rest
297
+ let dlistData =
298
+ match source with
299
+ | Nil | Cons (_, Nil) -> Nil
300
+ | Cons ( x, ( Cons ( y, rest))) -> pairWiseDListData ( Unit ( x, y)) y rest
301
+ match source.Length with
302
+ | 0 -> DList ( 0 , Nil)
303
+ | _ -> DList ( source.Length - 1 , dlistData)
304
+
273
305
// additions to fit F#+ :
274
306
let inline map f ( x : DList < _ >) = DList.foldBack ( cons << f ) x empty
275
- let concat x = DList.fold append empty x
307
+ let concat x = DList.fold append empty x
276
308
let inline ap f x = concat <| map ( fun y -> map ((|>) y) f) x
277
309
let inline bind m k = DList.foldBack ( append << k) empty m
278
310
@@ -283,13 +315,13 @@ type DList<'T> with
283
315
static member (<|>) ( x : DList < _ >, y : DList < _ >) = DList.append x y
284
316
285
317
[<EditorBrowsable( EditorBrowsableState.Never) >]
286
- static member ToSeq x = DList.toSeq x
318
+ static member ToSeq x = DList.toSeq x
287
319
288
320
[<EditorBrowsable( EditorBrowsableState.Never) >]
289
321
static member ToList x = DList.toList x
290
322
291
323
[<EditorBrowsable( EditorBrowsableState.Never) >]
292
- static member OfSeq x = DList.ofSeq x
324
+ static member OfSeq x = DList.ofSeq x
293
325
294
326
[<EditorBrowsable( EditorBrowsableState.Never) >]
295
327
static member Fold ( x , f , z ) = DList.fold f x z
@@ -301,4 +333,4 @@ type DList<'T> with
301
333
static member Map ( x , f ) = DList.map f x
302
334
303
335
static member (<*>) ( f , x ) = DList.ap f x
304
- static member (>>= ) ( x, f) = DList.bind x f
336
+ static member (>>= ) ( x, f) = DList.bind x f
0 commit comments