Vector.map2

QuadTree.Tests/QuadTree.Tests.fsproj

@@ -7,6 +7,7 @@
 
   <ItemGroup>
     <Compile Include="Tests.fs" />
+    <Compile Include="Tests.Vector.fs" />
   </ItemGroup>
 
   <ItemGroup>

QuadTree.Tests/Tests.Vector.fs

@@ -0,0 +1,58 @@
+module Vector.Tests
+
+open System
+open Xunit
+
+open Vector
+open Common
+
+let printVector (vector: SparseVector<_>) =
+    printfn "Vector:"
+    printfn "   Length: %A" vector.length
+    printfn "   Nvals: %A" vector.nvals
+    printfn "   Storage:"
+    printfn "      Size: %A" vector.storage.size
+    printfn "      Data: %A" vector.storage.data
+
+[<Fact>]
+let ``Simple map2`` () =
+    let v1 =
+        let tree =
+            Vector.btree.Node(
+                Vector.btree.Node(Vector.btree.Leaf(Some(1)), Vector.btree.Leaf(None)),
+                Vector.btree.Leaf(Some(2))
+            )
+
+        let store = Storage(8UL<storageSize>, tree)
+        SparseVector(8UL<dataLength>, 6UL<nvals>, store)
+
+    let v2 =
+        let tree =
+            Vector.btree.Node(
+                Vector.btree.Node(Vector.btree.Leaf(Some(2)), Vector.btree.Leaf(None)),
+                Vector.btree.Node(Vector.btree.Leaf(None), Vector.btree.Leaf(Some(1)))
+            )
+
+        let store = Storage(8UL<storageSize>, tree)
+        SparseVector(8UL<dataLength>, 4UL<nvals>, store)
+
+    let f x y =
+        match (x, y) with
+        | Some(a), Some(b) -> Some(a + b)
+        | _ -> None
+
+    let expected =
+        let tree =
+            Vector.btree.Node(
+                Vector.btree.Node(Vector.btree.Leaf(Some(3)), Vector.btree.Leaf(None)),
+                Vector.btree.Node(Vector.btree.Leaf(None), Vector.btree.Leaf(Some(3)))
+            )
+
+        let store = Storage(8UL<storageSize>, tree)
+        Result.Success(SparseVector(8UL<dataLength>, 4UL<nvals>, store))
+
+    let actual = Vector.map2 v1 v2 f
+
+    let eq = actual = expected
+
+    Assert.True(eq)

QuadTree.Tests/Tests.fs

@@ -3,5 +3,36 @@
 open System
 open Xunit
 
+open Common
+
+[<Fact>]
+let ``Power of two for 1`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 1UL = 1UL)
+
+[<Fact>]
+let ``Power of two for 2`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 2UL = 2UL)
+
+[<Fact>]
+let ``Power of two for 3`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 3UL = 4UL)
+
+[<Fact>]
+let ``Power of two for 12`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 12UL = 16UL)
+
+[<Fact>]
+let ``Power of two for 1025`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 1025UL = 2048UL)
+
+[<Fact>]
+let ``Power of two for 524290`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 524290UL = 1048576UL)
+
+[<Fact>]
+let ``Power of two for 1048576`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 1048576UL = 1048576UL)
+
 [<Fact>]
-let ``My test`` () = Assert.True(true)
+let ``Power of two for 4611686018427388001`` () =
+    Assert.True(Common.getNearestUpperPowerOfTwo 4611686018427388001UL = 9223372036854776000UL)

QuadTree/Common.fs

@@ -1,5 +1,9 @@
 module Common
 
+[<Measure>]
+type nvals
+
+
 type BinSearchTree<'value> =
     | Leaf of 'value
     | Node of BinSearchTree<'value> * 'value * BinSearchTree<'value>
@@ -117,13 +121,19 @@ let treeOfPowersOfTwo =
     )
 
 let getNearestUpperPowerOfTwo (x: uint64) =
+    let MAX = 9223372036854776000UL
+
     let rec find tree rightBound =
         match tree with
         | BinSearchTree.Node(left, v, right) ->
             if x = v then v
             elif x < v then find left v
-            elif x <= rightBound then rightBound
-            else failwith "Unfinished"
-        | _ -> failwith "Unfinished"
-
-    find treeOfPowersOfTwo 9223372036854776000UL
+            else find right rightBound
+        | BinSearchTree.Leaf(v) -> if x <= v then v else rightBound
+
+    if x = MAX then
+        MAX
+    elif x < MAX then
+        find treeOfPowersOfTwo 9223372036854776000UL
+    else
+        failwithf "Argument is too large. Must be not greater then %A" MAX

QuadTree/LinearAlgebra.fs

@@ -12,9 +12,9 @@
         if x % 2u = 0u then res else op_add res v
 
 let vxm op_add op_mult (vector: SparseVector<'a>) (matrix: SparseMatrix<'b>) =
-    if vector.length = uint matrix.nrows then
+    if uint64 vector.length = uint64 matrix.nrows then
         let inner len vector matrix =
             match (vector, matrix) with
             | btree.Leaf(v1), qtree.Leaf(v2) ->
                 let v = op_mult v1 v2
                 btree.Leaf(multScalar op_add len v), len

QuadTree/Matrix.fs

@@ -1,5 +1,6 @@
 module Matrix
 
+open Common
 (*
 | x1 | x2 |
 ----------
@@ -16,8 +17,6 @@ type columnId
 [<Measure>]
 type rowId
 
-[<Measure>]
-type nvals
 
 [<Struct>]
 type SparseMatrix<'value> =

QuadTree/Vector.fs

@@ -1,14 +1,28 @@
 module Vector
 
+open Common
+
 type 'value btree =
     | Leaf of 'value
     | Node of 'value btree * 'value btree
 
+[<Measure>]
+type dataLength
+
+[<Measure>]
+type storageSize
+
+[<Struct>]
+type Storage<'value> =
+    val size: uint64<storageSize>
+    val data: btree<'value>
+    new(_size, _data) = { size = _size; data = _data }
+
 [<Struct>]
 type SparseVector<'value> =
-    val length: uint
-    val nvals: uint
-    val storage: btree<Option<'value>>
+    val length: uint64<dataLength>
+    val nvals: uint64<nvals>
+    val storage: Storage<Option<'value>>
 
     new(_length, _nvals, _storage) =
         { length = _length
@@ -40,24 +54,34 @@ let map2 (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f =
     let len1 = vector1.length
 
     if len1 = vector2.length then
-        let rec inner (len: uint) vector1 vector2 =
+        let rec inner (size: uint64<storageSize>) vector1 vector2 =
             match (vector1, vector2) with
             | Node(t1, t2), Leaf(_) ->
-                let new_t1, nvals1 = inner (len / 2u) t1 vector2
-                let new_t2, nvals2 = inner (len / 2u) t2 vector2
+                let new_t1, nvals1 = inner (size / 2UL) t1 vector2
+                let new_t2, nvals2 = inner (size / 2UL) t2 vector2
                 (mkNode new_t1 new_t2), nvals1 + nvals2
             | Leaf(_), Node(t1, t2) ->
-                let new_t1, nvals1 = inner (len / 2u) vector1 t1
-                let new_t2, nvals2 = inner (len / 2u) vector1 t2
+                let new_t1, nvals1 = inner (size / 2UL) vector1 t1
+                let new_t2, nvals2 = inner (size / 2UL) vector1 t2
                 (mkNode new_t1 new_t2), nvals1 + nvals2
             | Node(t1, t2), Node(t3, t4) ->
-                let new_t1, nvals1 = inner (len / 2u) t1 t3
-                let new_t2, nvals2 = inner (len / 2u) t2 t4
+                let new_t1, nvals1 = inner (size / 2UL) t1 t3
+                let new_t2, nvals2 = inner (size / 2UL) t2 t4
                 (mkNode new_t1 new_t2), nvals1 + nvals2
-            | Leaf(v1), Leaf(v2) -> Leaf(f v1 v2), len
+            | Leaf(v1), Leaf(v2) ->
+                let res = f v1 v2
+
+                let nnz =
+                    match res with
+                    | None -> 0UL<nvals>
+                    | _ -> (uint64 size) * 1UL<nvals>
+
+                Leaf(res), nnz
+
+        let storage, nvals =
+            inner vector1.storage.size vector1.storage.data vector2.storage.data
 
-        let storage, nvals = inner len1 vector1.storage vector2.storage
-        Result.Success(SparseVector(len1, nvals, storage))
+        Result.Success(SparseVector(len1, nvals, (Storage(vector1.storage.size, storage))))
     else
         Result.Failure "The length of the vector1 must be equals to the length of the vector2."