From 29f98d69b97a4400d8f1af2f42f769a0e342ed9c Mon Sep 17 00:00:00 2001 From: cannorin Date: Thu, 19 Sep 2024 18:43:00 +0900 Subject: [PATCH 1/3] Add join operator to vector and matrix --- src/FSharpPlus.TypeLevel/Data/Matrix.fs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus.TypeLevel/Data/Matrix.fs b/src/FSharpPlus.TypeLevel/Data/Matrix.fs index b870b2c61..953049453 100644 --- a/src/FSharpPlus.TypeLevel/Data/Matrix.fs +++ b/src/FSharpPlus.TypeLevel/Data/Matrix.fs @@ -251,6 +251,10 @@ module Vector = let inline apply (f: Vector<'a -> 'b, 'n>) (v: Vector<'a, 'n>) : Vector<'b, 'n> = map2 id f v + [] + let join (vv: Vector, 'n>): Vector<'a, 'n> = + { Items = Array.init (Array.length vv.Items) (fun i -> vv.Items.[i].Items.[i]) } + let inline norm (v: Vector< ^a, ^n >) : ^a = v |> toArray |> Array.sumBy (fun x -> x * x) |> sqrt let inline maximumNorm (v: Vector< ^a, ^n >) : ^a = @@ -327,6 +331,14 @@ module Matrix = for j = 0 to Array2D.length2 m1.Items - 1 do f i j m1.Items.[i, j] m2.Items.[i, j] + let inline apply (f: Matrix<'a -> 'b, 'm, 'n>) (m: Matrix<'a, 'm, 'n>) : Matrix<'b, 'm, 'n> = map2 id f m + + [] + let join (m: Matrix, 'm, 'n>) : Matrix<'a, 'm, 'n> = + { Items = + Array2D.init (Array2D.length1 m.Items) (Array2D.length2 m.Items) + (fun i j -> m.Items.[i, j].Items.[i, j] ) } + let inline rowLength (_: Matrix<'a, 'm, 'n>) : 'm = Singleton<'m> let inline colLength (_: Matrix<'a, 'm, 'n>) : 'n = Singleton<'n> let inline rowLength' (_: Matrix<'a, ^m, 'n>) : int = RuntimeValue (Singleton< ^m >) @@ -571,8 +583,9 @@ type Matrix<'Item, 'Row, 'Column> with static member inline Return (x: 'x) : Matrix<'x, 'm, 'n> = Matrix.replicate Singleton Singleton x static member inline Pure (x: 'x) : Matrix<'x, 'm, 'n> = Matrix.replicate Singleton Singleton x - static member inline ( <*> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.map2 id f x - static member inline ( <.> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.map2 id f x + static member inline ( <*> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.apply f x + static member inline ( <.> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.apply f x + static member inline Join (x: Matrix, 'm, 'n>) = Matrix.join x static member inline get_Zero () : Matrix<'a, 'm, 'n> = Matrix.zero static member inline ( + ) (m1, m2) = Matrix.map2 (+) m1 m2 static member inline ( - ) (m1, m2) = Matrix.map2 (-) m1 m2 @@ -607,6 +620,7 @@ type Vector<'Item, 'Length> with static member inline Pure (x: 'x) : Vector<'x, 'n> = Vector.replicate Singleton x static member inline ( <*> ) (f: Vector<'x -> 'y, 'n>, x: Vector<'x, 'n>) : Vector<'y, 'n> = Vector.apply f x static member inline ( <.> ) (f: Vector<'x -> 'y, 'n>, x: Vector<'x, 'n>) : Vector<'y, 'n> = Vector.apply f x + static member inline Join (x: Vector, 'n>) : Vector<'x, 'n> = Vector.join x [] static member inline Zip (x, y) = Vector.zip x y From 6644a0183a0fd2484a729151a6b62a911b6cf5b8 Mon Sep 17 00:00:00 2001 From: cannorin Date: Thu, 19 Sep 2024 19:11:53 +0900 Subject: [PATCH 2/3] Add bind operator to vector and matrix using join --- src/FSharpPlus.TypeLevel/Data/Matrix.fs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/FSharpPlus.TypeLevel/Data/Matrix.fs b/src/FSharpPlus.TypeLevel/Data/Matrix.fs index 953049453..d264101a3 100644 --- a/src/FSharpPlus.TypeLevel/Data/Matrix.fs +++ b/src/FSharpPlus.TypeLevel/Data/Matrix.fs @@ -251,10 +251,17 @@ module Vector = let inline apply (f: Vector<'a -> 'b, 'n>) (v: Vector<'a, 'n>) : Vector<'b, 'n> = map2 id f v + /// + /// Converts the vector of vectors to a square matrix and returns its diagonal. + /// + /// [] let join (vv: Vector, 'n>): Vector<'a, 'n> = { Items = Array.init (Array.length vv.Items) (fun i -> vv.Items.[i].Items.[i]) } + let inline bind (f: 'a -> Vector<'b, 'n>) (v: Vector<'a, 'n>) : Vector<'b, 'n> = + v |> map f |> join + let inline norm (v: Vector< ^a, ^n >) : ^a = v |> toArray |> Array.sumBy (fun x -> x * x) |> sqrt let inline maximumNorm (v: Vector< ^a, ^n >) : ^a = @@ -333,12 +340,18 @@ module Matrix = let inline apply (f: Matrix<'a -> 'b, 'm, 'n>) (m: Matrix<'a, 'm, 'n>) : Matrix<'b, 'm, 'n> = map2 id f m + /// + /// Converts the matrix of matrices to a 3D cube matrix and returns its diagonal. + /// + /// [] let join (m: Matrix, 'm, 'n>) : Matrix<'a, 'm, 'n> = { Items = Array2D.init (Array2D.length1 m.Items) (Array2D.length2 m.Items) (fun i j -> m.Items.[i, j].Items.[i, j] ) } + let inline bind (f: 'a -> Matrix<'b, 'm, 'n>) (m: Matrix<'a, 'm, 'n>) : Matrix<'b, 'm, 'n> = m |> map f |> join + let inline rowLength (_: Matrix<'a, 'm, 'n>) : 'm = Singleton<'m> let inline colLength (_: Matrix<'a, 'm, 'n>) : 'n = Singleton<'n> let inline rowLength' (_: Matrix<'a, ^m, 'n>) : int = RuntimeValue (Singleton< ^m >) @@ -586,6 +599,7 @@ type Matrix<'Item, 'Row, 'Column> with static member inline ( <*> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.apply f x static member inline ( <.> ) (f: Matrix<'x -> 'y, 'm, 'n>, x: Matrix<'x, 'm, 'n>) = Matrix.apply f x static member inline Join (x: Matrix, 'm, 'n>) = Matrix.join x + static member inline ( >>= ) (x: Matrix<'x, 'm, 'n>, f: 'x -> Matrix<'y, 'm, 'n>) = Matrix.bind f x static member inline get_Zero () : Matrix<'a, 'm, 'n> = Matrix.zero static member inline ( + ) (m1, m2) = Matrix.map2 (+) m1 m2 static member inline ( - ) (m1, m2) = Matrix.map2 (-) m1 m2 @@ -621,6 +635,7 @@ type Vector<'Item, 'Length> with static member inline ( <*> ) (f: Vector<'x -> 'y, 'n>, x: Vector<'x, 'n>) : Vector<'y, 'n> = Vector.apply f x static member inline ( <.> ) (f: Vector<'x -> 'y, 'n>, x: Vector<'x, 'n>) : Vector<'y, 'n> = Vector.apply f x static member inline Join (x: Vector, 'n>) : Vector<'x, 'n> = Vector.join x + static member inline ( >>= ) (x: Vector<'x, 'n>, f: 'x -> Vector<'y, 'n>) = Vector.bind f x [] static member inline Zip (x, y) = Vector.zip x y From c9af144f45928a58919705c5647fa3db38d30fde Mon Sep 17 00:00:00 2001 From: cannorin Date: Sun, 22 Sep 2024 16:38:58 +0900 Subject: [PATCH 3/3] Create a separate test file for vectors and matrices --- .../FSharpPlus.Tests/FSharpPlus.Tests.fsproj | 1 + tests/FSharpPlus.Tests/Matrix.fs | 98 +++++++++++++++++++ tests/FSharpPlus.Tests/TypeLevel.fs | 52 +--------- 3 files changed, 100 insertions(+), 51 deletions(-) create mode 100644 tests/FSharpPlus.Tests/Matrix.fs diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index 4a8e29469..734bf6e45 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -35,6 +35,7 @@ + diff --git a/tests/FSharpPlus.Tests/Matrix.fs b/tests/FSharpPlus.Tests/Matrix.fs new file mode 100644 index 000000000..3e0d59b01 --- /dev/null +++ b/tests/FSharpPlus.Tests/Matrix.fs @@ -0,0 +1,98 @@ +namespace FSharpPlus.Tests + +open System +open NUnit.Framework +open Helpers + +open FSharpPlus +open FSharpPlus.Data +open FSharpPlus.TypeLevel + +module VectorTests = + [] + let constructorAndDeconstructorWorks() = + let v1 = vector (1,2,3,4,5) + let v2 = vector (1,2,3,4,5,6,7,8,9,0,1,2,3,4,5) + let (Vector(_,_,_,_,_)) = v1 + let (Vector(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_)) = v2 + () + + [] + let applicativeWorks() = + let v = vector ((fun i -> i + 1), (fun i -> i * 2)) + let u = vector (2, 3) + let vu = v <*> u + NUnit.Framework.Assert.IsInstanceOf>>>> (Some vu) + CollectionAssert.AreEqual ([|3; 6|], Vector.toArray vu) + + [] + let satisfiesApplicativeLaws() = + let u = vector ((fun i -> i - 1), (fun i -> i * 2)) + let v = vector ((fun i -> i + 1), (fun i -> i * 3)) + let w = vector (1, 1) + + areEqual (result id <*> v) v + areEqual (result (<<) <*> u <*> v <*> w) (u <*> (v <*> w)) + areEqual (result 2) ((result (fun i -> i + 1) : Vector int, S>>) <*> result 1) + areEqual (u <*> result 1) (result ((|>) 1) <*> u) + + [] + let satisfiesMonadLaws() = + let k = fun (a: int) -> vector (a - 1, a * 2) + let h = fun (a: int) -> vector (a + 1, a * 3) + let m = vector (1, 2) + + areEqual (result 2 >>= k) (k 2) + areEqual (m >>= result) m + areEqual (m >>= (fun x -> k x >>= h)) ((m >>= k) >>= h) + +module MatrixTests = + [] + let constructorAndDeconstructorWorks() = + let m1 = + matrix ( + (1,0,0,0), + (0,1,0,0), + (0,0,1,0) + ) + let m2 = + matrix ( + (1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), + (0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0), + (0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0), + (0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0), + (0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0), + (0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0), + (0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0), + (0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0) + ) + let (Matrix(_x1,_x2,_x3)) = m1 + let (Matrix(_y1: int*int*int*int*int*int*int*int*int*int*int*int*int*int*int*int,_y2,_y3,_y4,_y5,_y6,_y7,_y8)) = m2 + () + + [] + let satisfiesApplicativeLaws() = + let u = matrix ( + ((fun i -> i - 1), (fun i -> i * 2)), + ((fun i -> i + 1), (fun i -> i * 3)) + ) + let v = matrix ( + ((fun i -> i - 2), (fun i -> i * 5)), + ((fun i -> i + 2), (fun i -> i * 7)) + ) + let w = matrix ((1, 1), (1, 2)) + + areEqual (result id <*> v) v + areEqual (result (<<) <*> u <*> v <*> w) (u <*> (v <*> w)) + areEqual ((result (fun i -> i + 1) : Matrix int, S>, S>>) <*> result 1) (result 2) + areEqual (u <*> result 1) (result ((|>) 1) <*> u) + + [] + let satisfiesMonadLaws() = + let k = fun (a: int) -> matrix ((a - 1, a * 2), (a + 1, a * 3)) + let h = fun (a: int) -> matrix ((a - 2, a * 5), (a + 2, a * 7)) + let m = matrix ((1, 1), (1, 2)) + + areEqual (result 2 >>= k) (k 2) + areEqual (m >>= result) m + areEqual (m >>= (fun x -> k x >>= h)) ((m >>= k) >>= h) diff --git a/tests/FSharpPlus.Tests/TypeLevel.fs b/tests/FSharpPlus.Tests/TypeLevel.fs index f5aa68482..0322c93aa 100644 --- a/tests/FSharpPlus.Tests/TypeLevel.fs +++ b/tests/FSharpPlus.Tests/TypeLevel.fs @@ -150,38 +150,8 @@ module NatTests = Assert (g2 =^ S(S(S(S(S(S Z)))))) -open FSharpPlus.Data - -module MatrixTests = - [] - let matrixTests = - let v1 = vector (1,2,3,4,5) - let v2 = vector (1,2,3,4,5,6,7,8,9,0,1,2,3,4,5) - let (Vector(_,_,_,_,_)) = v1 - let (Vector(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_)) = v2 - - let m1 = - matrix ( - (1,0,0,0), - (0,1,0,0), - (0,0,1,0) - ) - let m2 = - matrix ( - (1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), - (0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0), - (0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0), - (0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0), - (0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0), - (0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0), - (0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0), - (0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0) - ) - let (Matrix(_x1,_x2,_x3)) = m1 - let (Matrix(_y1: int*int*int*int*int*int*int*int*int*int*int*int*int*int*int*int,_y2,_y3,_y4,_y5,_y6,_y7,_y8)) = m2 - () - open Helpers +open FSharpPlus.Data module TypeProviderTests = type ``0`` = TypeNat<0> @@ -206,23 +176,3 @@ module TypeProviderTests = Assert (Matrix.colLength row1 =^ (Z |> S |> S |> S)) areEqual 5 (Matrix.get Z (S Z) row1) areEqual [3; 6; 9] (Vector.toList col2) - -module TestFunctors1 = - [] - let applicativeOperatorWorks() = - let v = vector ((fun i -> i + 1), (fun i -> i * 2)) - let u = vector (2, 3) - let vu = v <*> u - NUnit.Framework.Assert.IsInstanceOf>>>> (Some vu) - CollectionAssert.AreEqual ([|3; 6|], Vector.toArray vu) - -module TestFunctors2 = - open FSharpPlus - - [] - let applicativeWorksWithoutSubsumption() = - let v = vector ((fun i -> i + 1), (fun i -> i * 2)) - let u = vector (2, 3) - let vu = v <*> u - NUnit.Framework.Assert.IsInstanceOf>>>> (Some vu) - CollectionAssert.AreEqual ([|3; 6|], Vector.toArray vu) \ No newline at end of file