From ad21c9cddf74b57296bf17744ac5a8de7d894c9c Mon Sep 17 00:00:00 2001 From: gsv Date: Tue, 31 Mar 2026 10:17:59 +0300 Subject: [PATCH 1/7] Attempt to unify Vector.map variants --- QuadTree/Vector.fs | 123 +++++++++++++++++++++++++-------------------- 1 file changed, 69 insertions(+), 54 deletions(-) diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index f1ddb16..495d96e 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -40,6 +40,67 @@ let mkNode t1 t2 = | _ -> Node(t1, t2) +type UnaryOp<'a,'b> = + | ValuesOnly of ('a -> Option<'b>) + | ValuesOnlyIndexed of (uint64 -> 'a -> Option<'b>) + | AllCells of (Option<'a> -> Option<'b>) + | AllCellsIndexed of (uint64 -> Option<'a> -> Option<'b>) + + +let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVector<'b> = + let rec inner (pointer: uint64) (size: uint64) (tree: btree>) : btree> * uint64 = + match tree with + | Node(x1, x2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize x1 + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 + mkNode t1 t2, nvals1 + nvals2 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + match op with + | ValuesOnly f -> + match v with + | None -> Leaf(UserValue(None)), 0UL + | Some v' -> + let res = f v' + let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL + Leaf(UserValue(res)), nvals + | ValuesOnlyIndexed f -> + match v with + | None -> Leaf(UserValue(None)), 0UL + | Some v' -> + if size = 1UL then + let res = f pointer v' + let nvals = if res.IsSome then 1UL else 0UL + Leaf(UserValue(res)), nvals + else + let res = f pointer v' + if res.IsNone then + Leaf(UserValue(res)), 0UL + else + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + mkNode t1 t2, nvals1 + nvals2 + | AllCells f -> + let res = f v + let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL + Leaf(UserValue(res)), nvals + | AllCellsIndexed f -> + if size = 1UL then + let res = f pointer v + let nvals = if res.IsSome then 1UL else 0UL + Leaf(UserValue(res)), nvals + else + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + mkNode t1 t2, nvals1 + nvals2 + + let storage, nvals = inner 0UL vector.storage.size vector.storage.data + SparseVector(vector.length, nvals, Storage(vector.storage.size, storage)) + + [] type CoordinateList<'value> = val length: uint64 @@ -155,59 +216,16 @@ let foldValues (vector: SparseVector<'a>) (f: 'b -> 'a -> 'b) (state: 'b) = inner state vector.storage.size vector.storage.data let map (vector: SparseVector<'a>) f = - let rec inner (size: uint64) vector = - match vector with - | Node(x1, x2) -> - let t1, nvals1 = inner (size / 2UL) x1 - let t2, nvals2 = inner (size / 2UL) x2 - (mkNode t1 t2), nvals1 + nvals2 - | Leaf(Dummy) -> Leaf(Dummy), 0UL - | Leaf(UserValue(v)) -> - let res = f v - - let nnz = - match res with - | None -> 0UL - | _ -> (uint64 size) * 1UL - - Leaf(UserValue(res)), nnz - - let storage, nvals = inner vector.storage.size vector.storage.data - - SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) + mapInner vector (AllCells f) +let mapValues (vector: SparseVector<'a>) f = + mapInner vector (ValuesOnly f) let mapi (vector: SparseVector<'a>) f = - let rec inner (pointer: uint64) (size: uint64) vector = - match vector with - | Node(x1, x2) -> - let halfSize = size / 2UL - let t1, nvals1 = inner pointer halfSize x1 - let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 - (mkNode t1 t2), nvals1 + nvals2 - | Leaf(Dummy) -> Leaf(Dummy), 0UL - | Leaf(UserValue(v)) -> - if size = 1UL then - let res = f pointer v - - let nnz = - match res with - | Some _ -> 1UL - | None -> 0UL - - Leaf(UserValue(res)), nnz - else - let halfSize = size / 2UL - let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) - - let t2, nvals2 = - inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) - - (mkNode t1 t2), nvals1 + nvals2 - - let storage, nvals = inner 0UL vector.storage.size vector.storage.data + mapInner vector (AllCellsIndexed f) - SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) +let mapiValues (vector: SparseVector<'a>) f = + mapInner vector (ValuesOnlyIndexed f) let init (length: uint64) (f: uint64 -> Option<'a>) : SparseVector<'a> = @@ -359,11 +377,8 @@ let unsafeGet (v: SparseVector<'a>) (index: uint64) = getFromTree v.storage.data v.storage.size index /// Gather: w[i] = v[idx[i]] -let gather (v: SparseVector<'value>) (idx: SparseVector>) : SparseVector<'value> = - map idx (fun i -> - match i with - | Some i -> unsafeGet v i - | None -> None) +let gather (v : SparseVector<'value>) (idx : SparseVector>) : SparseVector<'value> = + mapValues idx (fun i -> unsafeGet v i) let mergeSort (v: SparseVector<'a>) (compare: Option<'a> -> Option<'a> -> int) : SparseVector<'a> = let storageSize = v.storage.size From 79a317f2555457a187e49ef57f1a68835bee9342 Mon Sep 17 00:00:00 2001 From: gsv Date: Tue, 31 Mar 2026 13:14:37 +0300 Subject: [PATCH 2/7] Firs attmempt to unify Vector.map2. Not finished. Wrong. --- QuadTree/Vector.fs | 210 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 169 insertions(+), 41 deletions(-) diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 495d96e..183d8e3 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -47,6 +47,23 @@ type UnaryOp<'a,'b> = | AllCellsIndexed of (uint64 -> Option<'a> -> Option<'b>) +type AtLeastOne<'a,'b> = + | Both of 'a * 'b + | Left of 'a + | Right of 'b + + +type BinaryOp<'a,'b,'c> = + | ValuesOnly of ('a -> 'b -> Option<'c>) + | ValuesOnlyIndexed of (uint64 -> 'a -> 'b -> Option<'c>) + | AllCells of (Option<'a> -> Option<'b> -> Option<'c>) + | AllCellsIndexed of (uint64 -> Option<'a> -> Option<'b> -> Option<'c>) + | AtLeastOneValue of (AtLeastOne<'a,'b> -> Option<'c>) + | AtLeastOneValueIndexed of (uint64 -> AtLeastOne<'a,'b> -> Option<'c>) + | LeftValuesOnly of ('a -> Option<'b> -> Option<'c>) + | LeftValuesOnlyIndexed of (uint64 -> 'a -> Option<'b> -> Option<'c>) + + let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVector<'b> = let rec inner (pointer: uint64) (size: uint64) (tree: btree>) : btree> * uint64 = match tree with @@ -58,14 +75,14 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec | Leaf(Dummy) -> Leaf(Dummy), 0UL | Leaf(UserValue(v)) -> match op with - | ValuesOnly f -> + | UnaryOp.ValuesOnly f -> match v with | None -> Leaf(UserValue(None)), 0UL | Some v' -> let res = f v' let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL Leaf(UserValue(res)), nvals - | ValuesOnlyIndexed f -> + | UnaryOp.ValuesOnlyIndexed f -> match v with | None -> Leaf(UserValue(None)), 0UL | Some v' -> @@ -82,11 +99,11 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) mkNode t1 t2, nvals1 + nvals2 - | AllCells f -> + | UnaryOp.AllCells f -> let res = f v let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL Leaf(UserValue(res)), nvals - | AllCellsIndexed f -> + | UnaryOp.AllCellsIndexed f -> if size = 1UL then let res = f pointer v let nvals = if res.IsSome then 1UL else 0UL @@ -100,6 +117,108 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec let storage, nvals = inner 0UL vector.storage.size vector.storage.data SparseVector(vector.length, nvals, Storage(vector.storage.size, storage)) +let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (op: BinaryOp<'a,'b,'c>) : Result, Error> = + let len1 = vector1.length + + let rec inner (pointer: uint64) (size: uint64) (tree1: btree>) (tree2: btree>) : Result> * uint64, Error> = + match (tree1, tree2) with + | Node(x1, x2), Node(y1, y2) -> + let halfSize = size / 2UL + match inner pointer halfSize x1 y1 with + | Error e -> Error e + | Ok(t1, nvals1) -> + match inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 y2 with + | Error e -> Error e + | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) + | Node(x1, x2), Leaf(v2) -> + let halfSize = size / 2UL + match inner pointer halfSize x1 (Leaf(v2)) with + | Error e -> Error e + | Ok(t1, nvals1) -> + match inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 (Leaf(v2)) with + | Error e -> Error e + | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) + | Leaf(v1), Node(y1, y2) -> + let halfSize = size / 2UL + match inner pointer halfSize (Leaf(v1)) y1 with + | Error e -> Error e + | Ok(t1, nvals1) -> + match inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(v1)) y2 with + | Error e -> Error e + | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) + | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) + | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> + let res = + match op with + | BinaryOp.ValuesOnly f -> + match v1, v2 with + | Some a, Some b -> f a b + | _ -> None + | BinaryOp.ValuesOnlyIndexed f -> + match v1, v2 with + | Some a, Some b -> f pointer a b + | _ -> None + | BinaryOp.AllCells f -> + f v1 v2 + | BinaryOp.AllCellsIndexed f -> + f pointer v1 v2 + | BinaryOp.AtLeastOneValue f -> + match v1, v2 with + | Some a, Some b -> f (AtLeastOne.Both(a, b)) + | Some a, None -> f (AtLeastOne.Left a) + | None, Some b -> f (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.AtLeastOneValueIndexed f -> + match v1, v2 with + | Some a, Some b -> f pointer (AtLeastOne.Both(a, b)) + | Some a, None -> f pointer (AtLeastOne.Left a) + | None, Some b -> f pointer (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.LeftValuesOnly f -> + match v1 with + | Some a -> f a v2 + | None -> None + | BinaryOp.LeftValuesOnlyIndexed f -> + match v1 with + | Some a -> f pointer a v2 + | None -> None + + let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL + Ok(Leaf(UserValue(res)), nnz) + | Leaf(UserValue(v)), Leaf(Dummy) -> + let res = + match op with + | BinaryOp.ValuesOnly f -> None + | BinaryOp.ValuesOnlyIndexed f -> None + | BinaryOp.AllCells f -> f v None + | BinaryOp.AllCellsIndexed f -> f pointer v None + | BinaryOp.AtLeastOneValue f -> f (AtLeastOne.Left (Option.get v)) + | BinaryOp.AtLeastOneValueIndexed f -> f pointer (AtLeastOne.Left (Option.get v)) + | BinaryOp.LeftValuesOnly f -> f (Option.get v) None + | BinaryOp.LeftValuesOnlyIndexed f -> f pointer (Option.get v) None + let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL + Ok(Leaf(UserValue(res)), nnz) + | Leaf(Dummy), Leaf(UserValue(v)) -> + let res = + match op with + | BinaryOp.ValuesOnly f -> None + | BinaryOp.ValuesOnlyIndexed f -> None + | BinaryOp.AllCells f -> f None v + | BinaryOp.AllCellsIndexed f -> f pointer None v + | BinaryOp.AtLeastOneValue f -> f (AtLeastOne.Right (Option.get v)) + | BinaryOp.AtLeastOneValueIndexed f -> f pointer (AtLeastOne.Right (Option.get v)) + | BinaryOp.LeftValuesOnly f -> None + | BinaryOp.LeftValuesOnlyIndexed f -> None + let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL + Ok(Leaf(UserValue(res)), nnz) + | _ -> Error Error.InconsistentStructureOfStorages + + if len1 = vector2.length then + inner 0UL vector1.storage.size vector1.storage.data vector2.storage.data + |> Result.map (fun (storage, nvals) -> SparseVector(len1, nvals, Storage(vector1.storage.size, storage))) + else + Error Error.InconsistentSizeOfArguments + [] type CoordinateList<'value> = @@ -216,16 +335,43 @@ let foldValues (vector: SparseVector<'a>) (f: 'b -> 'a -> 'b) (state: 'b) = inner state vector.storage.size vector.storage.data let map (vector: SparseVector<'a>) f = - mapInner vector (AllCells f) + let rec inner (size: uint64) vector = + match vector with + | Node(x1, x2) -> + let t1, nvals1 = inner (size / 2UL) x1 + let t2, nvals2 = inner (size / 2UL) x2 + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + let res = f v + let nnz = match res with None -> 0UL | _ -> (uint64 size) * 1UL + Leaf(UserValue(res)), nnz -let mapValues (vector: SparseVector<'a>) f = - mapInner vector (ValuesOnly f) + let storage, nvals = inner vector.storage.size vector.storage.data + SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) let mapi (vector: SparseVector<'a>) f = - mapInner vector (AllCellsIndexed f) + let rec inner (pointer: uint64) (size: uint64) vector = + match vector with + | Node(x1, x2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize x1 + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + if size = 1UL then + let res = f pointer v + let nnz = match res with Some _ -> 1UL | None -> 0UL + Leaf(UserValue(res)), nnz + else + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + (mkNode t1 t2), nvals1 + nvals2 -let mapiValues (vector: SparseVector<'a>) f = - mapInner vector (ValuesOnlyIndexed f) + let storage, nvals = inner 0UL vector.storage.size vector.storage.data + SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) let init (length: uint64) (f: uint64 -> Option<'a>) : SparseVector<'a> = @@ -256,40 +402,19 @@ let init (length: uint64) (f: uint64 -> Option<'a>) : SparseV SparseVector(length, nvals, Storage(storageSize, storage)) let map2 (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = - let len1 = vector1.length + map2Inner vector1 vector2 (BinaryOp.AllCells f) - let rec inner (size: uint64) vector1 vector2 = - let _do x1 x2 y1 y2 = - let new_size = size / 2UL +let map2Values (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.ValuesOnly f) - match (inner new_size x1 y1), (inner new_size x2 y2) with - | Ok((t1, nvals1)), Ok((t2, nvals2)) -> ((mkNode t1 t2), nvals1 + nvals2) |> Ok - | Error(e), _ - | _, Error(e) -> Error(e) +let map2AllCells (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.AllCells f) - match (vector1, vector2) with - | Node(x1, x2), Leaf(_) -> _do x1 x2 vector2 vector2 - | Leaf(_), Node(y1, y2) -> _do vector1 vector1 y1 y2 - | Node(x1, x2), Node(y1, y2) -> _do x1 x2 y1 y2 - | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) - | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> - let res = f v1 v2 - - let nnz = - match res with - | None -> 0UL - | _ -> (uint64 size) * 1UL +let map2AtLeastOne (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.AtLeastOneValue f) - Ok(Leaf(UserValue(res)), nnz) - - | (x, y) -> Error Error.InconsistentStructureOfStorages - - if len1 = vector2.length then - match inner vector1.storage.size vector1.storage.data vector2.storage.data with - | Error(e) -> Error(e) - | Ok((storage, nvals)) -> Ok(SparseVector(len1, nvals, (Storage(vector1.storage.size, storage)))) - else - Error Error.InconsistentSizeOfArguments +let map2LeftValues (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.LeftValuesOnly f) let mask (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = map2 vector1 vector2 (fun v1 v2 -> if f v2 then v1 else None) @@ -378,7 +503,10 @@ let unsafeGet (v: SparseVector<'a>) (index: uint64) = /// Gather: w[i] = v[idx[i]] let gather (v : SparseVector<'value>) (idx : SparseVector>) : SparseVector<'value> = - mapValues idx (fun i -> unsafeGet v i) + map idx (fun i -> + match i with + | Some i-> unsafeGet v i + | None -> None) let mergeSort (v: SparseVector<'a>) (compare: Option<'a> -> Option<'a> -> int) : SparseVector<'a> = let storageSize = v.storage.size From e35de1b0fccea60c7a61806e1a865e74da621080 Mon Sep 17 00:00:00 2001 From: gsv Date: Wed, 1 Apr 2026 08:23:30 +0300 Subject: [PATCH 3/7] First attempt to unify Vector.map2. Not finished. --- QuadTree.Tests/Tests.Vector.fs | 289 +++++++++++++++++++++++++++++++++ QuadTree/Vector.fs | 26 --- 2 files changed, 289 insertions(+), 26 deletions(-) diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index c74216a..39a4686 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -395,6 +395,295 @@ let ``Simple Vector.map2i. Mixed values.`` () = Assert.Equal(expected, actual) +[] +let ``Simple Vector.map2Values.`` () = + let v1 = + let tree = + Vector.btree.Node( + Vector.btree.Leaf(UserValue(Some(1))), + Vector.btree.Leaf(UserValue(Some(2))) + ) + let store = Storage(4UL, tree) + SparseVector(4UL, 2UL, store) + + let v2 = + let tree = + Vector.btree.Node( + Vector.btree.Leaf(UserValue(Some(10))), + Vector.btree.Leaf(UserValue(Some(20))) + ) + let store = Storage(4UL, tree) + SparseVector(4UL, 2UL, store) + + let f a b = Some(a + b) + + match Vector.map2Values v1 v2 f with + | Error e -> failwithf "Unexpected error: %A" e + | Ok result -> + Assert.Equal(4UL, result.nvals) + Assert.Equal(4UL, result.length) + +[] +let ``Simple Vector.map2AllCells.`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(Some(3))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let f (x: Option) (y: Option) = Option.map2 (+) x y + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(8))) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 1UL, store)) + + let actual = Vector.map2AllCells v1 v2 f + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.map2AtLeastOne.`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(None)) + let store = Storage(1UL, tree) + SparseVector(1UL, 0UL, store) + + let f (x: AtLeastOne) = + match x with + | AtLeastOne.Both(a, b) -> Some(a + b) + | AtLeastOne.Left a -> Some(a * 2) + | AtLeastOne.Right b -> Some(b * 3) + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(10))) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 1UL, store)) + + let actual = Vector.map2AtLeastOne v1 v2 f + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.map2LeftValues.`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(None)) + let store = Storage(1UL, tree) + SparseVector(1UL, 0UL, store) + + let f a (y: Option) = Some(a + (defaultArg y 0)) + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 1UL, store)) + + let actual = Vector.map2LeftValues v1 v2 f + Assert.Equal(expected, actual) + + +[] +let ``Vector.map2Values compressed`` () = + let dataLength = 5UL + + let v1 = + let data = + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let v2 = + let data = + [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let f a b = Some(a + b) + + let expected = + let data = + [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList |> Ok + + let actual = Vector.map2Values v1 v2 f + Assert.Equal(expected, actual) + + +[] +let ``Vector.map2Values compressed to None`` () = + let dataLength = 5UL + + let v1 = + let data = + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let v2 = + let data = + [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let f a b = None + + let expected = + Vector.empty dataLength |> Ok + + let actual = Vector.map2Values v1 v2 f + Assert.Equal(expected, actual) + + +[] +let ``Vector.map2Values compressed both`` () = + let dataLength = 5UL + + let v1 = + let data = + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let v2 = + let data = + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let f a b = Some(a + b) + + let expected = + let data = + [ 0UL, 3; 1UL, 3; 2UL, 3; 3UL, 3; 4UL, 3] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList |> Ok + + let actual = Vector.map2Values v1 v2 f + Assert.Equal(expected, actual) + + +[] +let ``Vector.map2Values compressed both to None`` () = + let dataLength = 5UL + + let v1 = + let data = + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let v2 = + let data = + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let f a b = None + + let expected = + Vector.empty dataLength |> Ok + + let actual = Vector.map2Values v1 v2 f + Assert.Equal(expected, actual) + + +[] +let ``Vector.map2Values with None returns None`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(None)) + let store = Storage(1UL, tree) + SparseVector(1UL, 0UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(Some(3))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let f a b = Some(a + b) + + let expected = + let tree = Vector.btree.Leaf(UserValue(None)) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 0UL, store)) + + let actual = Vector.map2Values v1 v2 f + Assert.Equal(expected, actual) + +[] +let ``Vector.map2AtLeastOne Both case`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(Some(3))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let f (x: AtLeastOne) = + match x with + | AtLeastOne.Both(a, b) -> Some(a + b) + | AtLeastOne.Left a -> Some(a) + | AtLeastOne.Right b -> Some(b) + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(8))) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 1UL, store)) + + let actual = Vector.map2AtLeastOne v1 v2 f + Assert.Equal(expected, actual) + +[] +let ``Vector.map2AtLeastOne Right case`` () = + let v1 = + let tree = Vector.btree.Leaf(UserValue(None)) + let store = Storage(1UL, tree) + SparseVector(1UL, 0UL, store) + + let v2 = + let tree = Vector.btree.Leaf(UserValue(Some(7))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let f (x: AtLeastOne) = + match x with + | AtLeastOne.Both(a, b) -> Some(a + b) + | AtLeastOne.Left a -> Some(a) + | AtLeastOne.Right b -> Some(b * 2) + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(14))) + let store = Storage(1UL, tree) + Ok(SparseVector(1UL, 1UL, store)) + + let actual = Vector.map2AtLeastOne v1 v2 f + Assert.Equal(expected, actual) + [] let ``Conversion identity`` () = let id = toCoordinateList << fromCoordinateList diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 183d8e3..31fa4a5 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -185,32 +185,6 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL Ok(Leaf(UserValue(res)), nnz) - | Leaf(UserValue(v)), Leaf(Dummy) -> - let res = - match op with - | BinaryOp.ValuesOnly f -> None - | BinaryOp.ValuesOnlyIndexed f -> None - | BinaryOp.AllCells f -> f v None - | BinaryOp.AllCellsIndexed f -> f pointer v None - | BinaryOp.AtLeastOneValue f -> f (AtLeastOne.Left (Option.get v)) - | BinaryOp.AtLeastOneValueIndexed f -> f pointer (AtLeastOne.Left (Option.get v)) - | BinaryOp.LeftValuesOnly f -> f (Option.get v) None - | BinaryOp.LeftValuesOnlyIndexed f -> f pointer (Option.get v) None - let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL - Ok(Leaf(UserValue(res)), nnz) - | Leaf(Dummy), Leaf(UserValue(v)) -> - let res = - match op with - | BinaryOp.ValuesOnly f -> None - | BinaryOp.ValuesOnlyIndexed f -> None - | BinaryOp.AllCells f -> f None v - | BinaryOp.AllCellsIndexed f -> f pointer None v - | BinaryOp.AtLeastOneValue f -> f (AtLeastOne.Right (Option.get v)) - | BinaryOp.AtLeastOneValueIndexed f -> f pointer (AtLeastOne.Right (Option.get v)) - | BinaryOp.LeftValuesOnly f -> None - | BinaryOp.LeftValuesOnlyIndexed f -> None - let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL - Ok(Leaf(UserValue(res)), nnz) | _ -> Error Error.InconsistentStructureOfStorages if len1 = vector2.length then From e6bc90cc6ce4e95b20c8f67338f068af7723356d Mon Sep 17 00:00:00 2001 From: gsv Date: Wed, 1 Apr 2026 08:49:32 +0300 Subject: [PATCH 4/7] Attempt to unify Vector.map2i. Not finished. With bugs in leafs decomposition for indexed operations. --- QuadTree.Tests/Tests.Vector.fs | 39 ++++++++++++++++++-- QuadTree/Vector.fs | 66 +++++----------------------------- 2 files changed, 46 insertions(+), 59 deletions(-) diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index 39a4686..015ff3d 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -315,7 +315,9 @@ let ``Simple Vector.map2i. Length is power of two.`` () = let actual = Vector.map2i v1 v2 f - Assert.Equal(expected, actual) + match actual with + | Error e -> failwithf "Unexpected error: %A" e + | Ok result -> Assert.Equal(expected, result) [] let ``Simple Vector.map2i. Length is not power of two.`` () = @@ -366,7 +368,9 @@ let ``Simple Vector.map2i. Length is not power of two.`` () = let actual = Vector.map2i v1 v2 f - Assert.Equal(expected, actual) + match actual with + | Error e -> failwithf "Unexpected error: %A" e + | Ok result -> Assert.Equal(expected, result) [] let ``Simple Vector.map2i. Mixed values.`` () = @@ -582,6 +586,37 @@ let ``Vector.map2Values compressed both`` () = let actual = Vector.map2Values v1 v2 f Assert.Equal(expected, actual) +[] +let ``Vector.map2Values compressed both indexed`` () = + let dataLength = 5UL + + let v1 = + let data = + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let v2 = + let data = + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList + + let f i a b = Some(int i + a + b) + + let expected = + let data = + [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7] + + CoordinateList(dataLength, data) + |> Vector.fromCoordinateList |> Ok + + let actual = Vector.map2iValues v1 v2 f + match actual with Ok actual -> printVector actual + Assert.Equal(expected, actual) + [] let ``Vector.map2Values compressed both to None`` () = diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 31fa4a5..51ab6e9 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -394,67 +394,19 @@ let mask (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = map2 vector1 vector2 (fun v1 v2 -> if f v2 then v1 else None) let map2i (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = - let len1 = vector1.length + map2Inner vector1 vector2 (BinaryOp.AllCellsIndexed f) - let rec inner (pointer: uint64) (size: uint64) vector1 vector2 = - match (vector1, vector2) with - | Node(x1, x2), Node(y1, y2) -> - let halfSize = size / 2UL - let t1, nvals1 = inner pointer halfSize x1 y1 - let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 y2 - (mkNode t1 t2), nvals1 + nvals2 - | Node(x1, x2), Leaf(v2) -> - let halfSize = size / 2UL - let t1, nvals1 = inner pointer halfSize x1 (Leaf(v2)) +let map2iValues (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.ValuesOnlyIndexed f) - let t2, nvals2 = - inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 (Leaf(v2)) +let map2iAllCells (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.AllCellsIndexed f) - (mkNode t1 t2), nvals1 + nvals2 - | Leaf(v1), Node(y1, y2) -> - let halfSize = size / 2UL - let t1, nvals1 = inner pointer halfSize (Leaf(v1)) y1 - - let t2, nvals2 = - inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(v1)) y2 - - (mkNode t1 t2), nvals1 + nvals2 - | Leaf(Dummy), Leaf(Dummy) -> Leaf(Dummy), 0UL - | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> - let res = f pointer v1 v2 +let map2iAtLeastOne (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.AtLeastOneValueIndexed f) - let nnz = - match res with - | Some _ -> 1UL - | None -> 0UL - - Leaf(UserValue(res)), nnz - | Leaf(UserValue(v)), Leaf(Dummy) -> - let res = f pointer v None - - let nnz = - match res with - | Some _ -> 1UL - | None -> 0UL - - Leaf(UserValue(res)), nnz - | Leaf(Dummy), Leaf(UserValue(v)) -> - let res = f pointer None v - - let nnz = - match res with - | Some _ -> 1UL - | None -> 0UL - - Leaf(UserValue(res)), nnz - - if len1 = vector2.length then - let storage, nvals = - inner 0UL vector1.storage.size vector1.storage.data vector2.storage.data - - SparseVector(len1, nvals, (Storage(vector1.storage.size, storage))) |> Ok - else - Error InconsistentSizeOfArguments +let map2iLeftValues (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + map2Inner vector1 vector2 (BinaryOp.LeftValuesOnlyIndexed f) /// Returns None if index out of range From 0de1e623fab1c5367f13191a295acab560f16382 Mon Sep 17 00:00:00 2001 From: gsv Date: Wed, 1 Apr 2026 12:41:46 +0300 Subject: [PATCH 5/7] Fix for Vector.map2i --- QuadTree/Vector.fs | 89 +++++++++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 36 deletions(-) diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 51ab6e9..fb1ca09 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -148,43 +148,60 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> - let res = + let isIndexedOp = match op with - | BinaryOp.ValuesOnly f -> - match v1, v2 with - | Some a, Some b -> f a b - | _ -> None - | BinaryOp.ValuesOnlyIndexed f -> - match v1, v2 with - | Some a, Some b -> f pointer a b - | _ -> None - | BinaryOp.AllCells f -> - f v1 v2 - | BinaryOp.AllCellsIndexed f -> - f pointer v1 v2 - | BinaryOp.AtLeastOneValue f -> - match v1, v2 with - | Some a, Some b -> f (AtLeastOne.Both(a, b)) - | Some a, None -> f (AtLeastOne.Left a) - | None, Some b -> f (AtLeastOne.Right b) - | None, None -> None - | BinaryOp.AtLeastOneValueIndexed f -> - match v1, v2 with - | Some a, Some b -> f pointer (AtLeastOne.Both(a, b)) - | Some a, None -> f pointer (AtLeastOne.Left a) - | None, Some b -> f pointer (AtLeastOne.Right b) - | None, None -> None - | BinaryOp.LeftValuesOnly f -> - match v1 with - | Some a -> f a v2 - | None -> None - | BinaryOp.LeftValuesOnlyIndexed f -> - match v1 with - | Some a -> f pointer a v2 - | None -> None - - let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL - Ok(Leaf(UserValue(res)), nnz) + | BinaryOp.ValuesOnlyIndexed _ -> true + | BinaryOp.AllCellsIndexed _ -> true + | BinaryOp.AtLeastOneValueIndexed _ -> true + | BinaryOp.LeftValuesOnlyIndexed _ -> true + | _ -> false + + if size > 1UL && isIndexedOp then + let halfSize = size / 2UL + match inner pointer halfSize (Leaf(UserValue(v1))) (Leaf(UserValue(v2))) with + | Error e -> Error e + | Ok(t1, nvals1) -> + match inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v1))) (Leaf(UserValue(v2))) with + | Error e -> Error e + | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) + else + let res = + match op with + | BinaryOp.ValuesOnly f -> + match v1, v2 with + | Some a, Some b -> f a b + | _ -> None + | BinaryOp.ValuesOnlyIndexed f -> + match v1, v2 with + | Some a, Some b -> f pointer a b + | _ -> None + | BinaryOp.AllCells f -> + f v1 v2 + | BinaryOp.AllCellsIndexed f -> + f pointer v1 v2 + | BinaryOp.AtLeastOneValue f -> + match v1, v2 with + | Some a, Some b -> f (AtLeastOne.Both(a, b)) + | Some a, None -> f (AtLeastOne.Left a) + | None, Some b -> f (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.AtLeastOneValueIndexed f -> + match v1, v2 with + | Some a, Some b -> f pointer (AtLeastOne.Both(a, b)) + | Some a, None -> f pointer (AtLeastOne.Left a) + | None, Some b -> f pointer (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.LeftValuesOnly f -> + match v1 with + | Some a -> f a v2 + | None -> None + | BinaryOp.LeftValuesOnlyIndexed f -> + match v1 with + | Some a -> f pointer a v2 + | None -> None + + let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL + Ok(Leaf(UserValue(res)), nnz) | _ -> Error Error.InconsistentStructureOfStorages if len1 = vector2.length then From d573c6b52f9f82392175107fb270dab6bd429b24 Mon Sep 17 00:00:00 2001 From: gsv Date: Tue, 5 May 2026 14:35:52 +0300 Subject: [PATCH 6/7] Improve vector tests. --- QuadTree.Tests/Tests.Vector.fs | 139 +++++++++++++++------------------ 1 file changed, 61 insertions(+), 78 deletions(-) diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index 015ff3d..4eb1af9 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -1,6 +1,5 @@ module Vector.Tests -open System open Xunit open Vector @@ -166,7 +165,6 @@ let ``Simple Vector.mapi. Uniform leaf expansion.`` () = let store = Storage(1UL, tree) SparseVector(1UL, 1UL, store) - // f idx x = x + idx (5 + 0 = 5) let f (idx: uint64) x = match x with | Some(a) -> Some(a + int idx) @@ -193,10 +191,11 @@ let ``Simple Vector.mapi. All indices identity.`` () = | _ -> None let actual = Vector.mapi v f - let outputCL = Vector.toCoordinateList actual - Assert.Equal(2UL, actual.nvals) - Assert.Equal * int>>([ (0UL, 0); (2UL, 2) ], outputCL.data) + let expected = + Vector.fromCoordinateList (Vector.CoordinateList(4UL, [ (0UL, 0); (2UL, 2) ])) + + Assert.Equal(expected, actual) [] @@ -315,9 +314,7 @@ let ``Simple Vector.map2i. Length is power of two.`` () = let actual = Vector.map2i v1 v2 f - match actual with - | Error e -> failwithf "Unexpected error: %A" e - | Ok result -> Assert.Equal(expected, result) + Assert.Equal(expected, actual) [] let ``Simple Vector.map2i. Length is not power of two.`` () = @@ -368,9 +365,7 @@ let ``Simple Vector.map2i. Length is not power of two.`` () = let actual = Vector.map2i v1 v2 f - match actual with - | Error e -> failwithf "Unexpected error: %A" e - | Ok result -> Assert.Equal(expected, result) + Assert.Equal(expected, actual) [] let ``Simple Vector.map2i. Mixed values.`` () = @@ -403,29 +398,32 @@ let ``Simple Vector.map2i. Mixed values.`` () = let ``Simple Vector.map2Values.`` () = let v1 = let tree = - Vector.btree.Node( - Vector.btree.Leaf(UserValue(Some(1))), - Vector.btree.Leaf(UserValue(Some(2))) - ) + Vector.btree.Node(Vector.btree.Leaf(UserValue(Some(1))), Vector.btree.Leaf(UserValue(Some(2)))) + let store = Storage(4UL, tree) SparseVector(4UL, 2UL, store) let v2 = let tree = - Vector.btree.Node( - Vector.btree.Leaf(UserValue(Some(10))), - Vector.btree.Leaf(UserValue(Some(20))) - ) + Vector.btree.Node(Vector.btree.Leaf(UserValue(Some(10))), Vector.btree.Leaf(UserValue(Some(20)))) + let store = Storage(4UL, tree) SparseVector(4UL, 2UL, store) let f a b = Some(a + b) - match Vector.map2Values v1 v2 f with - | Error e -> failwithf "Unexpected error: %A" e - | Ok result -> - Assert.Equal(4UL, result.nvals) - Assert.Equal(4UL, result.length) + let actual = Vector.map2Values v1 v2 f + + let expected = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 4UL, + [ (0UL, 11); (1UL, 11); (2UL, 22); (3UL, 22) ] + ) + ) + |> Ok + + Assert.Equal(expected, actual) [] let ``Simple Vector.map2AllCells.`` () = @@ -461,7 +459,7 @@ let ``Simple Vector.map2AtLeastOne.`` () = let store = Storage(1UL, tree) SparseVector(1UL, 0UL, store) - let f (x: AtLeastOne) = + let f (x: AtLeastOne) = match x with | AtLeastOne.Both(a, b) -> Some(a + b) | AtLeastOne.Left a -> Some(a * 2) @@ -500,30 +498,27 @@ let ``Simple Vector.map2LeftValues.`` () = [] let ``Vector.map2Values compressed`` () = - let dataLength = 5UL + let dataLength = 5UL let v1 = let data = - [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let v2 = let data = - [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6] + [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let f a b = Some(a + b) let expected = let data = - [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7] + [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList |> Ok + CoordinateList(dataLength, data) |> Vector.fromCoordinateList |> Ok let actual = Vector.map2Values v1 v2 f Assert.Equal(expected, actual) @@ -531,26 +526,23 @@ let ``Vector.map2Values compressed`` () = [] let ``Vector.map2Values compressed to None`` () = - let dataLength = 5UL + let dataLength = 5UL let v1 = let data = - [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let v2 = let data = - [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6] + [ 0UL, 2; 1UL, 3; 2UL, 4; 3UL, 5; 4UL, 6 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let f a b = None - let expected = - Vector.empty dataLength |> Ok + let expected = Vector.empty dataLength |> Ok let actual = Vector.map2Values v1 v2 f Assert.Equal(expected, actual) @@ -558,88 +550,79 @@ let ``Vector.map2Values compressed to None`` () = [] let ``Vector.map2Values compressed both`` () = - let dataLength = 5UL + let dataLength = 5UL let v1 = let data = - [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let v2 = let data = - [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let f a b = Some(a + b) let expected = let data = - [ 0UL, 3; 1UL, 3; 2UL, 3; 3UL, 3; 4UL, 3] + [ 0UL, 3; 1UL, 3; 2UL, 3; 3UL, 3; 4UL, 3 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList |> Ok + CoordinateList(dataLength, data) |> Vector.fromCoordinateList |> Ok let actual = Vector.map2Values v1 v2 f Assert.Equal(expected, actual) [] let ``Vector.map2Values compressed both indexed`` () = - let dataLength = 5UL + let dataLength = 5UL let v1 = let data = - [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let v2 = let data = - [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let f i a b = Some(int i + a + b) let expected = let data = - [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7] + [ 0UL, 3; 1UL, 4; 2UL, 5; 3UL, 6; 4UL, 7 ] + + CoordinateList(dataLength, data) |> Vector.fromCoordinateList |> Ok - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList |> Ok - let actual = Vector.map2iValues v1 v2 f - match actual with Ok actual -> printVector actual - Assert.Equal(expected, actual) + + Assert.Equal(expected, actual) [] let ``Vector.map2Values compressed both to None`` () = - let dataLength = 5UL + let dataLength = 5UL let v1 = let data = - [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1] + [ 0UL, 1; 1UL, 1; 2UL, 1; 3UL, 1; 4UL, 1 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let v2 = let data = - [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2] + [ 0UL, 2; 1UL, 2; 2UL, 2; 3UL, 2; 4UL, 2 ] - CoordinateList(dataLength, data) - |> Vector.fromCoordinateList + CoordinateList(dataLength, data) |> Vector.fromCoordinateList let f a b = None - let expected = - Vector.empty dataLength |> Ok + let expected = Vector.empty dataLength |> Ok let actual = Vector.map2Values v1 v2 f Assert.Equal(expected, actual) @@ -679,7 +662,7 @@ let ``Vector.map2AtLeastOne Both case`` () = let store = Storage(1UL, tree) SparseVector(1UL, 1UL, store) - let f (x: AtLeastOne) = + let f (x: AtLeastOne) = match x with | AtLeastOne.Both(a, b) -> Some(a + b) | AtLeastOne.Left a -> Some(a) @@ -705,7 +688,7 @@ let ``Vector.map2AtLeastOne Right case`` () = let store = Storage(1UL, tree) SparseVector(1UL, 1UL, store) - let f (x: AtLeastOne) = + let f (x: AtLeastOne) = match x with | AtLeastOne.Both(a, b) -> Some(a + b) | AtLeastOne.Left a -> Some(a) From cb962a93120087501b484ef082a3a949f711f455 Mon Sep 17 00:00:00 2001 From: gsv Date: Tue, 5 May 2026 14:36:08 +0300 Subject: [PATCH 7/7] Formatted. --- QuadTree/Vector.fs | 111 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 84 insertions(+), 27 deletions(-) diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index fb1ca09..b7bcb44 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -40,32 +40,36 @@ let mkNode t1 t2 = | _ -> Node(t1, t2) -type UnaryOp<'a,'b> = +type UnaryOp<'a, 'b> = | ValuesOnly of ('a -> Option<'b>) | ValuesOnlyIndexed of (uint64 -> 'a -> Option<'b>) | AllCells of (Option<'a> -> Option<'b>) | AllCellsIndexed of (uint64 -> Option<'a> -> Option<'b>) -type AtLeastOne<'a,'b> = +type AtLeastOne<'a, 'b> = | Both of 'a * 'b | Left of 'a | Right of 'b -type BinaryOp<'a,'b,'c> = +type BinaryOp<'a, 'b, 'c> = | ValuesOnly of ('a -> 'b -> Option<'c>) | ValuesOnlyIndexed of (uint64 -> 'a -> 'b -> Option<'c>) | AllCells of (Option<'a> -> Option<'b> -> Option<'c>) | AllCellsIndexed of (uint64 -> Option<'a> -> Option<'b> -> Option<'c>) - | AtLeastOneValue of (AtLeastOne<'a,'b> -> Option<'c>) - | AtLeastOneValueIndexed of (uint64 -> AtLeastOne<'a,'b> -> Option<'c>) + | AtLeastOneValue of (AtLeastOne<'a, 'b> -> Option<'c>) + | AtLeastOneValueIndexed of (uint64 -> AtLeastOne<'a, 'b> -> Option<'c>) | LeftValuesOnly of ('a -> Option<'b> -> Option<'c>) | LeftValuesOnlyIndexed of (uint64 -> 'a -> Option<'b> -> Option<'c>) -let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVector<'b> = - let rec inner (pointer: uint64) (size: uint64) (tree: btree>) : btree> * uint64 = +let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a, 'b>) : SparseVector<'b> = + let rec inner + (pointer: uint64) + (size: uint64) + (tree: btree>) + : btree> * uint64 = match tree with | Node(x1, x2) -> let halfSize = size / 2UL @@ -80,7 +84,13 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec | None -> Leaf(UserValue(None)), 0UL | Some v' -> let res = f v' - let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL + + let nvals = + if res.IsSome then + (uint64 size) * 1UL + else + 0UL + Leaf(UserValue(res)), nvals | UnaryOp.ValuesOnlyIndexed f -> match v with @@ -92,16 +102,26 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec Leaf(UserValue(res)), nvals else let res = f pointer v' + if res.IsNone then Leaf(UserValue(res)), 0UL else let halfSize = size / 2UL let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) - let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + mkNode t1 t2, nvals1 + nvals2 | UnaryOp.AllCells f -> let res = f v - let nvals = if res.IsSome then (uint64 size) * 1UL else 0UL + + let nvals = + if res.IsSome then + (uint64 size) * 1UL + else + 0UL + Leaf(UserValue(res)), nvals | UnaryOp.AllCellsIndexed f -> if size = 1UL then @@ -111,19 +131,32 @@ let private mapInner (vector: SparseVector<'a>) (op: UnaryOp<'a,'b>) : SparseVec else let halfSize = size / 2UL let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) - let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + mkNode t1 t2, nvals1 + nvals2 let storage, nvals = inner 0UL vector.storage.size vector.storage.data SparseVector(vector.length, nvals, Storage(vector.storage.size, storage)) -let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (op: BinaryOp<'a,'b,'c>) : Result, Error> = +let private map2Inner + (vector1: SparseVector<'a>) + (vector2: SparseVector<'b>) + (op: BinaryOp<'a, 'b, 'c>) + : Result, Error> = let len1 = vector1.length - let rec inner (pointer: uint64) (size: uint64) (tree1: btree>) (tree2: btree>) : Result> * uint64, Error> = + let rec inner + (pointer: uint64) + (size: uint64) + (tree1: btree>) + (tree2: btree>) + : Result> * uint64, Error> = match (tree1, tree2) with | Node(x1, x2), Node(y1, y2) -> let halfSize = size / 2UL + match inner pointer halfSize x1 y1 with | Error e -> Error e | Ok(t1, nvals1) -> @@ -132,6 +165,7 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) | Node(x1, x2), Leaf(v2) -> let halfSize = size / 2UL + match inner pointer halfSize x1 (Leaf(v2)) with | Error e -> Error e | Ok(t1, nvals1) -> @@ -140,6 +174,7 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) | Leaf(v1), Node(y1, y2) -> let halfSize = size / 2UL + match inner pointer halfSize (Leaf(v1)) y1 with | Error e -> Error e | Ok(t1, nvals1) -> @@ -158,10 +193,17 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o if size > 1UL && isIndexedOp then let halfSize = size / 2UL + match inner pointer halfSize (Leaf(UserValue(v1))) (Leaf(UserValue(v2))) with | Error e -> Error e | Ok(t1, nvals1) -> - match inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v1))) (Leaf(UserValue(v2))) with + match + inner + (pointer + (uint64 halfSize) * 1UL) + halfSize + (Leaf(UserValue(v1))) + (Leaf(UserValue(v2))) + with | Error e -> Error e | Ok(t2, nvals2) -> Ok(mkNode t1 t2, nvals1 + nvals2) else @@ -175,10 +217,8 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o match v1, v2 with | Some a, Some b -> f pointer a b | _ -> None - | BinaryOp.AllCells f -> - f v1 v2 - | BinaryOp.AllCellsIndexed f -> - f pointer v1 v2 + | BinaryOp.AllCells f -> f v1 v2 + | BinaryOp.AllCellsIndexed f -> f pointer v1 v2 | BinaryOp.AtLeastOneValue f -> match v1, v2 with | Some a, Some b -> f (AtLeastOne.Both(a, b)) @@ -200,7 +240,11 @@ let private map2Inner (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) (o | Some a -> f pointer a v2 | None -> None - let nnz = match res with Some _ -> (uint64 size) * 1UL | None -> 0UL + let nnz = + match res with + | Some _ -> (uint64 size) * 1UL + | None -> 0UL + Ok(Leaf(UserValue(res)), nnz) | _ -> Error Error.InconsistentStructureOfStorages @@ -335,7 +379,12 @@ let map (vector: SparseVector<'a>) f = | Leaf(Dummy) -> Leaf(Dummy), 0UL | Leaf(UserValue(v)) -> let res = f v - let nnz = match res with None -> 0UL | _ -> (uint64 size) * 1UL + + let nnz = + match res with + | None -> 0UL + | _ -> (uint64 size) * 1UL + Leaf(UserValue(res)), nnz let storage, nvals = inner vector.storage.size vector.storage.data @@ -351,14 +400,22 @@ let mapi (vector: SparseVector<'a>) f = (mkNode t1 t2), nvals1 + nvals2 | Leaf(Dummy) -> Leaf(Dummy), 0UL | Leaf(UserValue(v)) -> - if size = 1UL then + if size = 1UL then let res = f pointer v - let nnz = match res with Some _ -> 1UL | None -> 0UL + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + Leaf(UserValue(res)), nnz else let halfSize = size / 2UL let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) - let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + (mkNode t1 t2), nvals1 + nvals2 let storage, nvals = inner 0UL vector.storage.size vector.storage.data @@ -445,10 +502,10 @@ let unsafeGet (v: SparseVector<'a>) (index: uint64) = getFromTree v.storage.data v.storage.size index /// Gather: w[i] = v[idx[i]] -let gather (v : SparseVector<'value>) (idx : SparseVector>) : SparseVector<'value> = - map idx (fun i -> - match i with - | Some i-> unsafeGet v i +let gather (v: SparseVector<'value>) (idx: SparseVector>) : SparseVector<'value> = + map idx (fun i -> + match i with + | Some i -> unsafeGet v i | None -> None) let mergeSort (v: SparseVector<'a>) (compare: Option<'a> -> Option<'a> -> int) : SparseVector<'a> =