Skip to content

Commit 57beeef

Browse files
krauthaufenkrauthaufen
committed
* updated AList.SkipReader
* improved `AList.sub` and `AList.skip` tests * added DB-join sketch to Scratch * added VSCode test-task
1 parent 93d3dd3 commit 57beeef

7 files changed

Lines changed: 618 additions & 234 deletions

File tree

‎.vscode/tasks.json‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,26 @@
2020
"reveal": "always"
2121
},
2222
"problemMatcher": "$msCompile"
23+
},
24+
{
25+
"label": "test",
26+
"command": "dotnet",
27+
"type": "shell",
28+
"args": [
29+
"test",
30+
"-l",
31+
"\"console;verbosity=normal\"",
32+
"--no-build",
33+
"--nologo"
34+
],
35+
"group": {
36+
"kind": "build",
37+
"isDefault": false
38+
},
39+
"presentation": {
40+
"reveal": "always"
41+
},
42+
"problemMatcher": "$msCompile"
2343
}
2444
]
2545
}

‎src/Demo/Scratch/LookupAll.fs‎

Lines changed: 311 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,311 @@
1+
module LookupAll
2+
open FSharp.Data.Adaptive
3+
4+
// a sketch for n-ary lookups in `amap` which might be useful for database-like scenarios
5+
// where you're often confronted with a *linking-table* of some kind.
6+
7+
// links : asist<(<ai>, <bi>)>:
8+
// (0, 1)
9+
// (0, 2)
10+
11+
// a : amap< <ai>, ainfo>
12+
// | 0 | ... a0info ... |
13+
// ...
14+
15+
// b : amap< <ai>, ainfo>
16+
// | 0 | ... a0info ... |
17+
// ...
18+
19+
// (links, a) ||> AList.lookupAll (fun (ai,_) -> ai) (fun (_ai, bi))
20+
21+
22+
module AList =
23+
open FSharp.Data.Traceable
24+
type LookupReader<'a, 'b, 'c, 'd>(key : 'a -> 'b, mapping : 'a -> 'b -> voption<'c> -> voption<'d>, values : alist<'a>, table : amap<'b, 'c>) =
25+
inherit AbstractReader<IndexList<'d>, IndexListDelta<'d>>(IndexList.trace)
26+
27+
let vReader = values.GetReader()
28+
let tReader = table.GetReader()
29+
30+
let mutable indexCache : HashMap<Index, 'a * 'b> = HashMap.empty
31+
let mutable affected : HashMap<'b, Set<Index>> = HashMap.empty
32+
33+
override x.Compute(token : AdaptiveToken) : IndexListDelta<'d> =
34+
let oldState = x.State
35+
let vops = vReader.GetChanges token
36+
let tops = tReader.GetChanges token
37+
38+
let mutable delta =
39+
vops |> IndexListDelta.choose (fun index op ->
40+
match op with
41+
| Set value ->
42+
match HashMap.tryFind index indexCache with
43+
| Some (_, ok) ->
44+
affected <-
45+
affected |> HashMap.alter ok (fun old ->
46+
match old with
47+
| Some old ->
48+
let res = Set.remove index old
49+
if res.IsEmpty then None
50+
else Some res
51+
| None ->
52+
None
53+
)
54+
| None ->
55+
()
56+
57+
let k = key value
58+
indexCache <- HashMap.add index (value, k) indexCache
59+
affected <- affected |> HashMap.alter k (function Some set -> Some (Set.add index set) | None -> Some (Set.singleton index))
60+
let tv = HashMap.tryFindV k tReader.State
61+
match mapping value k tv with
62+
| ValueSome result ->
63+
Some (Set result)
64+
| ValueNone ->
65+
match IndexList.tryGet index oldState with
66+
| Some _ -> Some Remove
67+
| None -> None
68+
| Remove ->
69+
match HashMap.tryRemove index indexCache with
70+
| Some ((_value, k), rest) ->
71+
indexCache <- rest
72+
affected <-
73+
affected |> HashMap.alter k (fun old ->
74+
match old with
75+
| Some old ->
76+
let res = Set.remove index old
77+
if res.IsEmpty then None
78+
else Some res
79+
| None ->
80+
None
81+
)
82+
Some Remove
83+
84+
| None ->
85+
None
86+
)
87+
88+
89+
for key, op in tops do
90+
match HashMap.tryFind key affected with
91+
| Some indices ->
92+
match op with
93+
| Remove ->
94+
for index in indices do
95+
match IndexList.tryGet index vReader.State with
96+
| Some value ->
97+
match mapping value key ValueNone with
98+
| ValueSome res ->
99+
delta <- delta |> IndexListDelta.add index (Set res)
100+
| ValueNone ->
101+
match IndexList.tryGet index oldState with
102+
| Some _ -> delta <- delta |> IndexListDelta.add index Remove
103+
| None -> ()
104+
| None ->
105+
match IndexList.tryGet index oldState with
106+
| Some _ -> delta <- delta |> IndexListDelta.add index Remove
107+
| None -> ()
108+
109+
110+
| Set newTableValue ->
111+
for index in indices do
112+
match IndexList.tryGet index vReader.State with
113+
| Some value ->
114+
match mapping value key (ValueSome newTableValue) with
115+
| ValueSome res ->
116+
delta <- delta |> IndexListDelta.add index (Set res)
117+
| ValueNone ->
118+
match IndexList.tryGet index oldState with
119+
| Some _ -> delta <- delta |> IndexListDelta.add index Remove
120+
| None -> ()
121+
| None ->
122+
match IndexList.tryGet index oldState with
123+
| Some _ -> delta <- delta |> IndexListDelta.add index Remove
124+
| None -> ()
125+
| None ->
126+
() // OK
127+
128+
129+
delta
130+
131+
let lookupAll (key : 'a -> 'b) (mapping : 'a -> 'b -> voption<'c> -> voption<'d>) (values : alist<'a>) (table : amap<'b, 'c>) : alist<'d> =
132+
AList.ofReader <| fun () ->
133+
LookupReader(key, mapping, values, table)
134+
135+
let lookupAll2 (ka : 'a -> 'ka) (kb : 'a -> 'kb) (values : alist<'a>) (tableA : amap<'ka, 'va>) (tableB : amap<'kb, 'vb>) : alist<'a * 'va * 'vb> =
136+
let withA =
137+
(values, tableA) ||> lookupAll ka (fun a _ka va ->
138+
match va with
139+
| ValueSome va ->
140+
ValueSome (a, va)
141+
| ValueNone ->
142+
ValueNone
143+
)
144+
let withB =
145+
(withA, tableB) ||> lookupAll (fun (a, _) -> kb a) (fun (a, va) _kb vb ->
146+
match vb with
147+
| ValueSome vb ->
148+
ValueSome (a, va, vb)
149+
| ValueNone ->
150+
ValueNone
151+
)
152+
withB
153+
154+
type Person =
155+
{
156+
Name : string
157+
Surname : string
158+
}
159+
160+
type Country =
161+
{
162+
Name : string
163+
Population : int
164+
}
165+
166+
open System
167+
168+
let example() =
169+
// a very typical person-table
170+
let persons =
171+
cmap [
172+
0, { Name = "John"; Surname = "Smith" }
173+
1, { Name = "Alicia"; Surname = "Suarez" }
174+
2, { Name = "Johanna"; Surname = "Maier" }
175+
]
176+
177+
// and a table for countries with population
178+
let countries =
179+
cmap [ // thanks to github-copilot ;)
180+
0, { Name = "Germany"; Population = 81726000 }
181+
1, { Name = "France"; Population = 65447374 }
182+
2, { Name = "United Kingdom"; Population = 6449600 }
183+
3, { Name = "United States"; Population = 327167434 }
184+
4, { Name = "China"; Population = 1344130000 }
185+
5, { Name = "India"; Population = 1344130000 }
186+
6, { Name = "Brazil"; Population = 209469000 }
187+
7, { Name = "Russia"; Population = 143989000 }
188+
8, { Name = "Canada"; Population = 35151728 }
189+
9, { Name = "Australia"; Population = 25475400 }
190+
10, { Name = "Mexico"; Population = 112336538 }
191+
11, { Name = "Argentina"; Population = 43590400 }
192+
]
193+
194+
// a table containing visit per person to each country with a date
195+
let visited =
196+
clist [
197+
0, 0, DateTime(2018, 7, 3)
198+
0, 2, DateTime(2019, 6, 3)
199+
1, 5, DateTime(2018, 7, 2)
200+
2, 9, DateTime(2020, 3, 4)
201+
]
202+
203+
// who visited which country when?
204+
let result =
205+
(visited, persons, countries)
206+
|||> AList.lookupAll2
207+
(fun (personId,_,_) -> personId) // use the personId as key for persons
208+
(fun (_,countryId,_) -> countryId) // use the countryId as key for persons
209+
210+
// finally throw away the ids and just keep the relevant data
211+
|> AList.map (fun ((_,_,date), va, vb) -> va, vb, date)
212+
213+
let reader = result.GetReader()
214+
215+
let datestr (d : DateTime) = sprintf "%04d-%02d-%02d" d.Year d.Month d.Day
216+
217+
let print() =
218+
let oldState = reader.State
219+
let changes = reader.GetChanges AdaptiveToken.Top
220+
221+
for index, op in changes do
222+
match op with
223+
| Set (person, country, date) ->
224+
match IndexList.tryGet index oldState with
225+
| Some(op, oc, od) ->
226+
printfn " changed %s %s's visit to %s on %s" op.Name op.Surname oc.Name (datestr od)
227+
printfn " => %s %s visited %s on %s" person.Name person.Surname country.Name (datestr date)
228+
| None ->
229+
printfn " %s %s added a visit to %s on %s" person.Name person.Surname country.Name (datestr date)
230+
| Remove ->
231+
match IndexList.tryGet index oldState with
232+
| Some(person, country, date) ->
233+
printfn " deleted %s %s's visit to %s on %s" person.Name person.Surname country.Name (datestr date)
234+
| None ->
235+
()
236+
237+
printfn "initial"
238+
print()
239+
240+
transact (fun () -> visited.Append (2,11, DateTime(2022, 1, 1)) |> ignore)
241+
printfn "links.Append (2,11,2022-01-01)"
242+
print()
243+
244+
transact (fun () -> persons.[2] <- { Name = "Johanna"; Surname = "Huber" })
245+
printfn "Johanna Maier -> Johanna Huber"
246+
print()
247+
248+
printfn "final"
249+
for (person, country, date) in reader.State do
250+
printfn " %s %s visited %s on %s" person.Name person.Surname country.Name (datestr date)
251+
252+
253+
let run() =
254+
let l = clist [1;2;3;4;1;2;5]
255+
256+
let table =
257+
cmap [
258+
1L, "one"
259+
2L, "two"
260+
3L, "three"
261+
4L, "four"
262+
]
263+
264+
let test =
265+
(l, table) ||> AList.lookupAll int64 (fun (a : int) (b : int64) (c : voption<string>) ->
266+
match c with
267+
| ValueSome c -> ValueSome (a, c)
268+
| ValueNone -> ValueNone
269+
)
270+
271+
let reader = test.GetReader()
272+
273+
274+
let print() =
275+
reader.GetChanges AdaptiveToken.Top |> ignore
276+
reader.State |> IndexList.toList |> printfn " %0A"
277+
278+
printfn "initial"
279+
print()
280+
281+
printfn "remove(3)"
282+
transact (fun () -> table.Remove 3L |> ignore)
283+
print()
284+
285+
printfn "five"
286+
transact (fun () -> table.[5L] <- "five")
287+
print()
288+
289+
printfn "insert(0)"
290+
transact(fun () -> l.InsertAt(0, 0) |> ignore)
291+
print()
292+
293+
printfn "three"
294+
transact (fun () -> table.[3L] <- "three")
295+
print()
296+
297+
printfn "zero"
298+
transact (fun () -> table.[0L] <- "zero")
299+
print()
300+
301+
printfn "append(0)"
302+
transact(fun () -> l.Append(0) |> ignore)
303+
print()
304+
305+
printfn "zero -> null"
306+
transact (fun () -> table.[0L] <- "null")
307+
print()
308+
309+
310+
311+
//Observable.run()

0 commit comments

Comments
 (0)