-
Notifications
You must be signed in to change notification settings - Fork 1
/
Monoid.fs
168 lines (132 loc) · 5 KB
/
Monoid.fs
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
namespace Yaaf.FSharp.Functional
/// Semigroup (set with associative binary operation)
type ISemigroup<'T> =
/// <summary>
/// Associative operation
/// </summary>
abstract Combine : 'T * 'T -> 'T
/// Monoid (associative binary operation with identity)
[<AbstractClass>]
type Monoid<'T>() as m =
/// <summary>
/// Identity
/// </summary>
abstract Zero : unit -> 'T
/// Associative operation
abstract Combine : 'T * 'T -> 'T
/// Fold a list using this monoid
abstract Concat : 'T seq -> 'T
default x.Concat a = x.For(a, id)
abstract For: 'T seq * ('T -> 'T) -> 'T
default x.For(sequence, body) =
let combine a b = x.Combine(a, body b)
Seq.fold combine (x.Zero()) sequence
member x.Yield a = a
member x.Delay f = f()
interface ISemigroup<'T> with
member x.Combine(a,b) = m.Combine(a,b)
module Semigroup =
let min<'T when 'T : comparison> =
{ new ISemigroup<'T> with
member x.Combine(a,b) = min a b }
let max<'T when 'T : comparison> =
{ new ISemigroup<'T> with
member x.Combine(a,b) = max a b }
module Monoid =
open System
/// The dual of a monoid, obtained by swapping the arguments of 'Combine'.
let dual (m: _ Monoid) =
{ new Monoid<_>() with
override this.Zero() = m.Zero()
override this.Combine(a,b) = m.Combine(b,a) }
let tuple2 (a: _ Monoid) (b: _ Monoid) =
{ new Monoid<_ * _>() with
override this.Zero() = a.Zero(), b.Zero()
override this.Combine((a1,b1), (a2,b2)) = a.Combine(a1, a2), b.Combine(b1, b2) }
let tuple3 (a: 'T Monoid) (b: 'b Monoid) (c: 'c Monoid) =
{ new Monoid<_ * _ * _>() with
override this.Zero() = a.Zero(), b.Zero(), c.Zero()
override this.Combine((a1,b1,c1), (a2,b2,c2)) =
a.Combine(a1, a2), b.Combine(b1, b2), c.Combine(c1, c2) }
/// Monoid (a,0,+)
let inline sum() =
{ new Monoid<_>() with
override this.Zero() = LanguagePrimitives.GenericZero
override this.Combine(a,b) = a + b }
/// Monoid (a,1,*)
let inline product() =
{ new Monoid<_>() with
override this.Zero() = LanguagePrimitives.GenericOne
override this.Combine(a,b) = a * b }
/// Monoid (int,0,+)
let sumInt : Monoid<int> = sum()
/// Monoid (int,1,*)
let productInt : Monoid<int> = product()
let minInt =
{ new Monoid<_>() with
override this.Zero() = Int32.MaxValue
override this.Combine(a,b) = min a b }
let maxInt =
{ new Monoid<_>() with
override this.Zero() = Int32.MinValue
override this.Combine(a,b) = max a b }
let string =
{ new Monoid<string>() with
override this.Zero() = ""
override this.Combine(a,b) = a + b }
let all =
{ new Monoid<bool>() with
override this.Zero() = true
override this.Combine(a,b) = a && b }
let any =
{ new Monoid<bool>() with
override this.Zero() = false
override this.Combine(a,b) = a || b }
let unit =
// can't write this as a direct Monoid object expression due to this F# bug http://stackoverflow.com/questions/4485445/f-interface-inheritance-failure-due-to-unit
let inline create zero combine =
{ new Monoid<_>() with
override this.Zero() = zero
override this.Combine(a,b) = combine a b }
create () (fun _ _ -> ())
[<GeneralizableValue>]
let endo<'T> =
{ new Monoid<'T -> 'T>() with
override this.Zero() = id
override this.Combine(f,g) = f << g }
//namespace Yaaf.FSharp.Collections
//
// open System
// open System.Linq
// open System.Collections
// open System.Collections.Generic
// open System.Runtime.CompilerServices
// open Yaaf.FSharp.Functional
module Seq =
let foldMap (monoid: _ Monoid) f =
Seq.fold (fun s e -> monoid.Combine(s, f e)) (monoid.Zero())
module List =
/// List monoid
let monoid<'T> =
{ new Monoid<'T list>() with
override this.Zero() = []
override this.Combine(a,b) = a @ b }
module Set =
let monoid<'T when 'T : comparison> =
{ new Monoid<Set<'T>>() with
override this.Zero() = Set.empty
override this.Combine(a,b) = Set.union a b }
open Yaaf.FSharp.Collections
module Map =
let monoid<'key, 'value when 'key : comparison> =
{ new Monoid<Map<'key, 'value>>() with
override this.Zero() = Map.empty
override this.Combine(a,b) =
Map.union a b
}
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module ByteString =
let monoid =
{ new Monoid<_>() with
override x.Zero() = ByteString.empty
override x.Combine(a,b) = ByteString.append a b }