Math.NET Numerics
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

2504 lines
108 KiB

// (c) Microsoft Corporation 2005-2009.
//----------------------------------------------------------------------------
// An implementation of generic dense and sparse matrix types.
//
// Overview and suffix documentation
// _GU = generic unspecialized (Matrix<T>, Vector<T> etc.)
// _GUA = generic unspecialized op on (underlying) array
// _DS = Double specialized (Matrix<float> = matrix, Vector<float> = vector etc.)
//
// DM = dense matrix
// SM = sparse matrix
// V = vector (dense)
// RV = row vector (dense)
namespace Microsoft.FSharp.Math
#nowarn "60" // implementations in augmentations
#nowarn "69" // implementations in augmentations
open Microsoft.FSharp.Math
open System
open System.Globalization
open System.Collections
open System.Collections.Generic
open System.Diagnostics
type permutation = int -> int
module Helpers =
let sparseNYI() = failwith "this operation is not supported on sparse matrices"
let sparseNotMutable() = failwith "sparse matrices are not mutable"
[<RequiresExplicitTypeArguments>]
let opsdata<'T> = GlobalAssociations.TryGetNumericAssociation<'T>()
open Helpers
/// The value stored for the dictionary of numeric operations. If none is present then this indicates
/// no operations are known for this type.
type OpsData<'T> = INumeric<'T> option
type DenseMatrix<'T>(opsData : OpsData<'T>, values : 'T[,]) =
member m.OpsData = opsData
member m.Values = values
member m.NumRows = values.GetLength(0)
member m.NumCols = values.GetLength(1)
member m.ElementOps =
match opsData with
| None -> raise (new System.NotSupportedException("The element type carried by this matrix does not support numeric operations"))
| Some a -> a
member m.Item
with get (i,j) = values.[i,j]
and set (i,j) x = values.[i,j] <- x
type SparseMatrix<'T>(opsData : OpsData<'T>, sparseValues : 'T array, sparseRowOffsets : int array, ncols:int, columnValues: int array) =
member m.OpsData = opsData;
member m.NumCols = ncols
member m.NumRows = sparseRowOffsets.Length - 1
member m.SparseColumnValues = columnValues
member m.SparseRowOffsets = sparseRowOffsets (* nrows + 1 elements *)
member m.SparseValues = sparseValues
member m.ElementOps =
match opsData with
| None -> raise (new System.NotSupportedException("The element type carried by this matrix does not support numeric operations"))
| Some a -> a
member m.MinIndexForRow i = m.SparseRowOffsets.[i]
member m.MaxIndexForRow i = m.SparseRowOffsets.[i+1]
member m.Item
with get (i,j) =
let imax = m.NumRows
let jmax = m.NumCols
if j < 0 || j >= jmax || i < 0 || i >= imax then raise (new System.ArgumentOutOfRangeException()) else
let kmin = m.MinIndexForRow i
let kmax = m.MaxIndexForRow i
let rec loopRow k =
(* note: could do a binary chop here *)
if k >= kmax then m.ElementOps.Zero else
let j2 = columnValues.[k]
if j < j2 then m.ElementOps.Zero else
if j = j2 then sparseValues.[k] else
loopRow (k+1)
loopRow kmin
#if FX_NO_DEBUG_DISPLAYS
#else
[<System.Diagnostics.DebuggerDisplay("{DebugDisplay}")>]
#endif
[<StructuredFormatDisplay("matrix {StructuredDisplayAsArray}")>]
[<StructuralEquality(false); StructuralComparison(false)>]
//[<System.Diagnostics.DebuggerTypeProxy(typedefof<MatrixDebugView<_>>)>]
type Matrix<'T> =
| DenseRepr of DenseMatrix<'T>
| SparseRepr of SparseMatrix<'T>
interface System.IComparable
interface IStructuralComparable
interface IStructuralEquatable
interface IEnumerable<'T>
interface IEnumerable
member m.ElementOps = match m with DenseRepr mr -> mr.ElementOps | SparseRepr mr -> mr.ElementOps
member m.NumRows = match m with DenseRepr mr -> mr.NumRows | SparseRepr mr -> mr.NumRows
member m.NumCols = match m with DenseRepr mr -> mr.NumCols | SparseRepr mr -> mr.NumCols
member m.Item
with get (i,j) =
match m with
| DenseRepr dm -> dm.[i,j]
| SparseRepr sm -> sm.[i,j]
and set (i,j) x =
match m with
| DenseRepr dm -> dm.[i,j] <- x
| SparseRepr _ -> sparseNotMutable()
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.IsDense = match m with DenseRepr mr -> true | SparseRepr mr -> false
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.IsSparse = match m with DenseRepr mr -> false | SparseRepr mr -> true
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.InternalSparseColumnValues = match m with DenseRepr mr -> invalidOp "not a sparse matrix" | SparseRepr mr -> mr.SparseColumnValues
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.InternalSparseRowOffsets = match m with DenseRepr mr -> invalidOp "not a sparse matrix" | SparseRepr mr -> mr.SparseRowOffsets
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.InternalSparseValues = match m with DenseRepr mr -> invalidOp "not a sparse matrix" | SparseRepr mr -> mr.SparseValues
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member m.InternalDenseValues = match m with DenseRepr mr -> mr.Values | SparseRepr mr -> invalidOp "not a dense matrix"
#if FX_NO_DEBUG_DISPLAYS
#else
[<System.Diagnostics.DebuggerDisplay("{DebugDisplay}")>]
#endif
#if FX_NO_DEBUG_PROXIES
#else
[<System.Diagnostics.DebuggerTypeProxy(typedefof<RowVectorDebugView<_>>)>]
#endif
[<StructuredFormatDisplay("rowvec {StructuredDisplayAsArray}")>]
[<Sealed>]
type RowVector<'T>(opsRV : INumeric<'T> option, arrRV : 'T array ) =
interface System.IComparable
interface IStructuralComparable
interface IStructuralEquatable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member x.InternalValues = arrRV
member x.Values = arrRV
member x.OpsData = opsRV
interface IEnumerable<'T> with
member x.GetEnumerator() = (arrRV :> seq<_>).GetEnumerator()
interface IEnumerable with
member x.GetEnumerator() = (arrRV :> IEnumerable).GetEnumerator()
member x.Length = arrRV.Length
member x.NumCols = arrRV.Length
member x.ElementOps =
match opsRV with
| None -> raise (new System.NotSupportedException("The element type carried by this row vector does not support numeric operations"))
| Some a -> a
member v.Item
with get i = arrRV.[i]
and set i x = arrRV.[i] <- x
and
[<Sealed>]
RowVectorDebugView<'T>(v: RowVector<'T>) =
#if FX_NO_DEBUG_DISPLAYS
#else
[<System.Diagnostics.DebuggerBrowsable(System.Diagnostics.DebuggerBrowsableState.RootHidden)>]
#endif
member x.Items = v |> Seq.truncate 1000 |> Seq.to_array
#if FX_NO_DEBUG_DISPLAYS
#else
[<System.Diagnostics.DebuggerDisplay("{DebugDisplay}")>]
#endif
#if FX_NO_DEBUG_PROXIES
#else
[<System.Diagnostics.DebuggerTypeProxy(typedefof<VectorDebugView<_>>)>]
#endif
[<StructuredFormatDisplay("vector {StructuredDisplayAsArray}")>]
[<Sealed>]
type Vector<'T>(opsV : INumeric<'T> option, arrV : 'T array) =
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member x.InternalValues = arrV
member x.Values = arrV
member x.OpsData = opsV
interface System.IComparable
interface IStructuralComparable
interface IStructuralEquatable
interface IEnumerable<'T> with
member x.GetEnumerator() = (arrV :> seq<_>).GetEnumerator()
interface IEnumerable with
member x.GetEnumerator() = (arrV :> IEnumerable).GetEnumerator()
member m.Length = arrV.Length
member m.NumRows = arrV.Length
member m.ElementOps =
match opsV with
| None -> raise (new System.NotSupportedException("The element type carried by this vector does not support numeric operations"))
| Some a -> a
member v.Item
with get i = arrV.[i]
and set i x = arrV.[i] <- x
#if FX_NO_DEBUG_PROXIES
#else
and
[<Sealed>]
VectorDebugView<'T>(v: Vector<'T>) =
[<System.Diagnostics.DebuggerBrowsable(System.Diagnostics.DebuggerBrowsableState.RootHidden)>]
member x.Items = v |> Seq.truncate 1000 |> Seq.to_array
#endif
/// Implementations of operations that will work for any type
module GenericImpl =
type OpsData<'T> = INumeric<'T> option
let opsOfOpsData (d : OpsData<'T>) =
match d with
| None -> raise (new System.NotSupportedException("The element type '"+(typeof<'T>).ToString()+"' carried by this vector or matrix does not support numeric operations (i.e. does not have a registered numeric association)"))
| Some a -> a
let getNormOps (ops:INumeric<'T>) =
match box ops with
| :? INormFloat<'T> as ops -> ops
| _ -> raise (new System.NotSupportedException("The element type '"+(typeof<'T>.ToString())+"' carried by this vector or matrix does not support the INormFloat<_> operation (i.e. does not have a registered numeric association that supports this type)"))
let mkDenseMatrixGU ops arr = DenseMatrix(ops,arr)
let mkRowVecGU ops arr = RowVector(ops, arr)
let mkVecGU ops arr = Vector(ops,arr)
let inline getArray2 (arrDM : _[,]) i j = arrDM.[i,j]
let inline setArray2 (arrDM : _[,]) i j x = arrDM.[i,j] <- x
let inline createArray m = Array.zeroCreate m
let inline createArray2 m n = Array2D.zeroCreate m n
let inline assignArray2 m n f arr =
for i = 0 to m - 1 do
for j = 0 to n - 1 do
(arr : _[,]).[i,j] <- f i j
let inline assignDenseMatrixGU f (a:DenseMatrix<_>) =
assignArray2 a.NumRows a.NumCols f a.Values
let inline assignArray m f (arr : _[]) =
for i = 0 to m - 1 do
arr.[i] <- f i
let inline assignVecGU f (a:Vector<_>) =
assignArray a.NumRows f a.Values
let inline assignRowVecGU f (a:RowVector<_>) =
assignArray a.NumCols f a.Values
let inline createDenseMatrixGU ops m n f = (* inline eliminates unknown f call *)
let arr = createArray2 m n
assignArray2 m n f arr;
DenseMatrix(ops,arr)
let createRowVecGU ops m f =
let arr = createArray m
assignArray m f arr;
mkRowVecGU ops arr
let inline createVecGU ops m f = (* inline eliminates unknown f call *)
let arr = createArray m
assignArray m f arr;
mkVecGU ops arr
/// Create a matrix from a sparse sequence
let initSparseMatrixGU maxi maxj ops s =
(* nb. could use sorted dictionary but that is in System.dll *)
let tab = Array.create maxi null
let count = ref 0
for (i,j,v) in s do
if i < 0 || i >= maxi || j <0 || j >= maxj then failwith "initial value out of range";
count := !count + 1;
let tab2 =
match tab.[i] with
| null ->
let tab2 = new Dictionary<_,_>(3)
tab.[i] <- tab2;
tab2
| tab2 -> tab2
tab2.[j] <- v
// optimize this line....
let offsA =
let rowsAcc = Array.zeroCreate (maxi + 1)
let mutable acc = 0
for i = 0 to maxi-1 do
rowsAcc.[i] <- acc;
acc <- match tab.[i] with
| null -> acc
| tab2 -> acc+tab.[i].Count
rowsAcc.[maxi] <- acc;
rowsAcc
let colsA,valsA =
let colsAcc = new ResizeArray<_>(!count)
let valsAcc = new ResizeArray<_>(!count)
for i = 0 to maxi-1 do
match tab.[i] with
| null -> ()
| tab2 -> tab2 |> Seq.to_array |> Array.sortBy (fun kvp -> kvp.Key) |> Array.iter (fun kvp -> colsAcc.Add(kvp.Key); valsAcc.Add(kvp.Value));
colsAcc.ToArray(), valsAcc.ToArray()
SparseMatrix(opsData=ops, sparseValues=valsA, sparseRowOffsets=offsA, ncols=maxj, columnValues=colsA)
let zeroizeDenseMatrixGUA arr m n : DenseMatrix<'T> =
let opsData = opsdata<'T>
let ops = opsOfOpsData opsData
let zero = ops.Zero
assignArray2 m n (fun i j -> zero) arr;
DenseMatrix(opsData,arr)
let zeroizeArray opsData arr m =
let ops = opsOfOpsData opsData
let zero = ops.Zero
assignArray m (fun i -> zero) arr
let zeroizeVecGUA arr m : Vector<'T> =
let opsData = opsdata<'T>
zeroizeArray opsData arr m;
mkVecGU opsData arr
let zeroizeRowVecGUA arr m : RowVector<'T> =
let opsData = opsdata<'T>
zeroizeArray opsData arr m;
mkRowVecGU opsData arr
let listDenseMatrixGU ops xss =
let m = List.length xss
match xss with
| [] -> invalidArg "xss" "unexpected empty list"
| h :: t ->
let n = List.length h
if not (List.forall (fun xs -> List.length xs=n) t) then invalidArg "xss" "the lists are not all of the same length";
let values = (Array2D.zeroCreate m n)
List.iteri (fun i rw -> List.iteri (fun j x -> values.[i,j] <- x) rw) xss;
DenseMatrix(ops,values)
let listRowVecGU ops xs = mkRowVecGU ops (Array.of_list xs)
let listVecGU ops xs = mkVecGU ops (Array.of_list xs)
let seqDenseMatrixGU ops xss = listDenseMatrixGU ops (xss |> Seq.to_list |> List.map Seq.to_list)
let seqVecGU ops xss = listVecGU ops (xss |> Seq.to_list)
let seqRowVecGU ops xss = listRowVecGU ops (xss |> Seq.to_list)
let inline binaryOpDenseMatrixGU f (a:DenseMatrix<_>) (b:DenseMatrix<_>) = (* pointwise binary operator *)
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
if nA<>nB || mA<>mB then invalidArg "a" "the two matrices do not have compatible dimensions";
let arrA = a.Values
let arrB = b.Values
createDenseMatrixGU a.OpsData mA nA (fun i j -> f (getArray2 arrA i j) (getArray2 arrB i j))
let nonZeroEntriesSparseMatrixGU (a:SparseMatrix<_>) =
// This is heavily used, and this version is much faster than
// the sequence operators.
let entries = new ResizeArray<_>(a.SparseColumnValues.Length)
let imax = a.NumRows
let ops = a.ElementOps
let zero = ops.Zero
for i in 0 .. imax - 1 do
let kmin = a.MinIndexForRow i
let kmax = a.MaxIndexForRow i
for k in kmin .. kmax - 1 do
let j = a.SparseColumnValues.[k]
let v = a.SparseValues.[k]
if v <> zero then
entries.Add((i,j,v))
(entries :> seq<_>)
let nonzeroEntriesDenseMatrixGU (a:DenseMatrix<_>) =
let imax = a.NumRows
let jmax = a.NumCols
let ops = a.ElementOps
let zero = ops.Zero
seq { for i in 0 .. imax - 1 do
for j in 0 .. jmax - 1 do
let v = a.[i,j]
if v <> zero then
yield (i,j,v) }
// pointwise operation on two sparse matrices. f must be zero-zero-preserving, i.e. (f 0 0 = 0)
let binaryOpSparseMatrixGU f (a:SparseMatrix<_>) (b:SparseMatrix<_>) =
let ops = a.ElementOps
let zero = ops.Zero
let imin1 = 0
let imax1 = a.NumRows
let imax2 = b.NumRows
let jmax1 = a.NumCols
let jmax2 = b.NumCols
if imax1 <> imax2 || jmax1 <> jmax2 then invalidArg "b" "the two matrices do not have compatible dimensions";
let imin = 0
let imax = imax1
let jmax = jmax1
let rowsR = Array.zeroCreate (imax+1)
let colsR = new ResizeArray<_>(max a.SparseColumnValues.Length b.SparseColumnValues.Length)
let valsR = new ResizeArray<_>(max a.SparseValues.Length b.SparseValues.Length)
let jMax = ref 0
let rec loopRows i =
rowsR.[i] <- valsR.Count;
if i >= imax1 then () else
let kmin1 = a.MinIndexForRow i
let kmax1 = a.MaxIndexForRow i
let kmin2 = b.MinIndexForRow i
let kmax2 = b.MaxIndexForRow i
let rec loopRow k1 k2 =
if k1 >= kmax1 && k2 >= kmax2 then () else
let j1 = if k1 >= kmax1 then jmax else a.SparseColumnValues.[k1]
let j2 = if k2 >= kmax2 then jmax else b.SparseColumnValues.[k2]
let v1 = if j1 <= j2 then a.SparseValues.[k1] else zero
let v2 = if j2 <= j1 then b.SparseValues.[k2] else zero
let jR = min j1 j2
let vR = f v1 v2
(* if vR <> zero then *)
colsR.Add(jR);
valsR.Add(vR);
loopRow (if j1 <= j2 then k1+1 else k1) (if j2 <= j1 then k2+1 else k2)
loopRow kmin1 kmin2;
loopRows (i+1)
loopRows imin;
SparseMatrix(opsData= a.OpsData,
sparseRowOffsets=rowsR,
ncols= a.NumCols,
columnValues=colsR.ToArray(),
sparseValues=valsR.ToArray())
let inline binaryOpRowVecGU f (a:RowVector<_>) (b:RowVector<_>) = (* pointwise binary operator *)
let mA = a.NumCols
let mB = b.NumCols
if mA<>mB then invalidArg "b" "the two vectors do not have compatible dimensions"
createRowVecGU a.OpsData mA (fun i -> f a.[i] b.[i])
let inline binaryOpVecGU f (a:Vector<_>) (b:Vector<_>) = (* pointwise binary operator *)
let mA = a.NumRows
let mB = b.NumRows
if mA<>mB then invalidArg "b" "the two vectors do not have compatible dimensions"
createVecGU a.OpsData mA (fun i -> f a.[i] b.[i])
let inline unaryOpDenseMatrixGU f (a:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
createDenseMatrixGU a.OpsData mA nA (fun i j -> f (getArray2 arrA i j))
let inline unaryOpRowVecGU f (a:RowVector<_>) =
let mA = a.NumCols
let arrA = a.Values
createRowVecGU a.OpsData mA (fun j -> f arrA.[j])
let inline unaryOpVectorGU f (a:Vector<_>) =
let mA = a.NumRows
let arrA = a.Values
createVecGU a.OpsData mA (fun i -> f arrA.[i])
let unaryOpSparseGU f (a:SparseMatrix<_>) = (* pointwise zero-zero-preserving binary operator (f 0 = 0) *)
SparseMatrix(opsData=a.OpsData,
sparseRowOffsets=Array.copy a.SparseRowOffsets,
columnValues=Array.copy a.SparseColumnValues,
sparseValues=Array.map f a.SparseValues,
ncols=a.NumCols)
// Strictly speaking, sparse arrays are non mutable so no copy is ever needed. But implementing it *)
// anyway in case we move to mutability *)
let copySparseGU (a:SparseMatrix<_>) =
SparseMatrix(opsData=a.OpsData,
sparseRowOffsets=Array.copy a.SparseRowOffsets,
columnValues=Array.copy a.SparseColumnValues,
sparseValues=Array.copy a.SparseValues,
ncols=a.NumCols)
let addDenseMatrixGU (a:DenseMatrix<_>) b = let ops = a.ElementOps in binaryOpDenseMatrixGU (fun x y -> ops.Add(x, y)) a b
let addSparseMatrixGU (a:SparseMatrix<_>) b = let ops = a.ElementOps in binaryOpSparseMatrixGU (fun x y -> ops.Add(x, y)) a b
let addRowVecGU (a:RowVector<_>) b = let ops = a.ElementOps in binaryOpRowVecGU (fun x y -> ops.Add(x, y)) a b
let addVecGU (a:Vector<_>) b = let ops = a.ElementOps in binaryOpVecGU (fun x y -> ops.Add(x, y)) a b
let subDenseMatrixGU (a:DenseMatrix<_>) b = let ops = a.ElementOps in binaryOpDenseMatrixGU (fun x y -> ops.Subtract(x, y)) a b
let subSparseMatrixGU (a:SparseMatrix<_>) b = let ops = a.ElementOps in binaryOpSparseMatrixGU (fun x y -> ops.Subtract(x, y)) a b
let subRowVecGU (a:RowVector<_>) b = let ops = a.ElementOps in binaryOpRowVecGU (fun x y -> ops.Subtract(x, y)) a b
let subVecGU (a:Vector<_>) b = let ops = a.ElementOps in binaryOpVecGU (fun x y -> ops.Subtract(x, y)) a b
///Point-wise multiplication
let cptMulDenseMatrixGU (a:DenseMatrix<_>) b = let ops = a.ElementOps in binaryOpDenseMatrixGU (fun x y -> ops.Multiply(x, y)) a b
let cptMulSparseMatrixGU (a:SparseMatrix<_>) b = let ops = a.ElementOps in binaryOpSparseMatrixGU (fun x y -> ops.Multiply(x, y)) a b
let cptMulRowVecGU (a:RowVector<_>) b = let ops = a.ElementOps in binaryOpRowVecGU (fun x y -> ops.Multiply(x, y)) a b
let cptMulVecGU (a:Vector<_>) b = let ops = a.ElementOps in binaryOpVecGU (fun x y -> ops.Multiply(x, y)) a b
let cptMaxDenseMatrixGU (a:DenseMatrix<_>) b = let ops = a.ElementOps in binaryOpDenseMatrixGU max a b
let cptMinDenseMatrixGU (a:DenseMatrix<_>) b = let ops = a.ElementOps in binaryOpDenseMatrixGU min a b
let cptMaxSparseMatrixGU (a:SparseMatrix<_>) b = let ops = a.ElementOps in binaryOpSparseMatrixGU max a b
let cptMinSparseMatrixGU (a:SparseMatrix<_>) b = let ops = a.ElementOps in binaryOpSparseMatrixGU min a b
let cptMaxVecGU (a:Vector<_>) b = let ops = a.ElementOps in binaryOpVecGU max a b
let cptMinVecGU (a:Vector<_>) b = let ops = a.ElementOps in binaryOpVecGU min a b
let add (ops : INumeric<'T>) x y = ops.Add(x,y)
let sub (ops : INumeric<'T>) x y = ops.Subtract(x,y)
let mul (ops : INumeric<'T>) x y = ops.Multiply(x,y)
let inline foldR f z (a,b) =
let mutable res = z in
for i = a to b do
res <- f res i
res
let inline sumfR f (a,b) =
let mutable res = 0.0
for i = a to b do
res <- res + f i
res
let inline sumRGU (ops : INumeric<_>) f r =
let zero = ops.Zero
r |> foldR (fun z k -> add ops z (f k)) zero
let genericMulDenseMatrix (a:DenseMatrix<_>) (b:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two matrices do not have compatible dimensions"
let ops = a.ElementOps
let arrA = a.Values
let arrB = b.Values
createDenseMatrixGU a.OpsData mA nB
(fun i j -> (0,nA - 1) |> sumRGU ops (fun k -> mul ops (getArray2 arrA i k) (getArray2 arrB k j)))
let debug = false
// SParse matrix multiplication algorithm. inline to get specialization at the 'double' type
let inline genericMulSparse zero add mul (a:SparseMatrix<_>) (b:SparseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two matrices do not have compatible dimensions"
let C = new ResizeArray<_>()
let jC = new ResizeArray<_>()
let MA1 = mA + 1
let offsAcc = Array.zeroCreate MA1
let index = Array.zeroCreate mA
let temp = Array.create mA zero
let ptr = new Dictionary<_,_>(11)
if debug then printf "start, #items in result = %d, #offsAcc = %d, mA = %d\n" jC.Count offsAcc.Length mA;
let mutable mlast = 0
for i = 0 to mA-1 do
if debug then printf "i = %d, mlast = %d\n" i mlast;
offsAcc.[i] <- mlast
let kmin1 = a.MinIndexForRow i
let kmax1 = a.MaxIndexForRow i
if kmin1 < kmax1 then
let mutable itemp = 0
let mutable ptrNeedsClear = true // clear the ptr table on demand.
for j = kmin1 to kmax1 - 1 do
if debug then printf " j = %d\n" j;
let ja_j = a.SparseColumnValues.[j]
let kmin2 = b.MinIndexForRow ja_j
let kmax2 = b.MaxIndexForRow ja_j
for k = kmin2 to kmax2 - 1 do
let jb_k = b.SparseColumnValues.[k]
if debug then printf " i = %d, j = %d, k = %d, ja_j = %d, jb_k = %d\n" i j k ja_j jb_k;
let va = a.SparseValues.[j]
let vb = b.SparseValues.[k]
if debug then printf " va = %O, vb = %O\n" va vb;
let summand = mul va vb
if debug then printf " summand = %O\n" summand;
if ptrNeedsClear then (ptr.Clear();ptrNeedsClear <- false);
if not (ptr.ContainsKey(jb_k)) then
if debug then printf " starting entry %d\n" jb_k;
ptr.[jb_k] <- itemp
let ptr_jb_k = itemp
temp.[ptr_jb_k] <- summand
index.[ptr_jb_k] <- jb_k
itemp <- itemp + 1
else
if debug then printf " adding to entry %d\n" jb_k;
let ptr_jb_k = ptr.[jb_k]
temp.[ptr_jb_k] <- add temp.[ptr_jb_k] summand
done
done
if itemp > 0 then
// Sort by index.
// REVIEW: avoid the allocations here
let sorted = (temp.[0..itemp-1],index.[0..itemp-1]) ||> Array.zip
Array.sortInPlaceBy (fun (v,idx) -> idx) sorted
for s = 0 to itemp-1 do
let (v,idx) = sorted.[s]
if debug then printf " writing value %O at index %d to result matrix\n" v idx;
C.Add(v)
jC.Add(idx)
if debug then printf " itemp = %d, mlast = %d\n" itemp mlast;
mlast <- mlast + itemp
done
offsAcc.[mA] <- mlast;
if debug then printf "done, #items in result = %d, #offsAcc = %d, mA = %d\n" jC.Count offsAcc.Length mA;
SparseMatrix(opsData = a.OpsData,
sparseRowOffsets=offsAcc,
ncols= nB,
columnValues=jC.ToArray(),
sparseValues=C.ToArray())
let mulSparseMatrixGU (a: SparseMatrix<_>) b =
let ops = a.ElementOps
let zero = ops.Zero
genericMulSparse zero (add ops) (mul ops) a b
let mulRowVecVecGU (a:RowVector<_>) (b:Vector<_>) =
let mA = a.NumCols
let nB = b.NumRows
if mA<>nB then invalidArg "b" "the two vectors do not have compatible dimensions"
let ops = a.ElementOps
(0,mA - 1) |> sumRGU ops (fun k -> mul ops a.[k] b.[k])
let rowvecDenseMatrixGU (x:RowVector<_>) = createDenseMatrixGU x.OpsData 1 x.NumCols (fun _ j -> x.[j])
let vectorDenseMatrixGU (x:Vector<_>) = createDenseMatrixGU x.OpsData x.NumRows 1 (fun i _ -> x.[i])
let mulVecRowVecGU a b = genericMulDenseMatrix (vectorDenseMatrixGU a) (rowvecDenseMatrixGU b)
let mulRowVecDenseMatrixGU (a:RowVector<_>) (b:DenseMatrix<_>) =
let nA = a.NumCols
let nB = b.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two vectors do not have compatible dimensions"
let ops = a.ElementOps
let arrA = a.Values
let arrB = b.Values
createRowVecGU a.OpsData nB
(fun j -> (0,nA - 1) |> sumRGU ops (fun k -> mul ops arrA.[k] (getArray2 arrB k j)))
let mulDenseMatrixVecGU (a:DenseMatrix<_>) (b:Vector<_>) =
let nA = a.NumCols
let mA = a.NumRows
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two inputs do not have compatible dimensions"
let ops = b.ElementOps
let arrA = a.Values
let arrB = b.Values
createVecGU b.OpsData mA
(fun i -> (0,nA - 1) |> sumRGU ops (fun k -> mul ops (getArray2 arrA i k) arrB.[k]))
let mulSparseVecGU (a:SparseMatrix<_>) (b:Vector<_>) =
let nA = a.NumCols
let mA = a.NumRows
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two inputs do not have compatible dimensions"
let ops = b.ElementOps
let zero = ops.Zero
createVecGU b.OpsData mA (fun i ->
let mutable acc = zero
for k = a.MinIndexForRow i to a.MaxIndexForRow i - 1 do
let j = a.SparseColumnValues.[k]
let v = a.SparseValues.[k]
acc <- add ops acc (mul ops v b.[j]);
acc)
let mulRVSparseMatrixGU (a:RowVector<_>) (b:SparseMatrix<_>) =
let nA = b.NumCols
let mA = b.NumRows
let mB = a.NumCols
if mA<>mB then invalidArg "b" "the two inputs do not have compatible dimensions"
let ops = b.ElementOps
let arr = createArray nA
zeroizeArray a.OpsData arr nA;
for i = 0 to mA - 1 do
for k = b.MinIndexForRow i to b.MaxIndexForRow i - 1 do
let j = b.SparseColumnValues.[k]
let v = b.SparseValues.[k]
arr.[j] <- add ops arr.[j] (mul ops a.[i] v)
mkRowVecGU a.OpsData arr
let scaleDenseMatrixGU k (a:DenseMatrix<_>) = let ops = a.ElementOps in unaryOpDenseMatrixGU (fun x -> ops.Multiply(k,x)) a
let scaleRowVecGU k (a:RowVector<_>) = let ops = a.ElementOps in unaryOpRowVecGU (fun x -> ops.Multiply(k,x)) a
let scaleVecGU k (a:Vector<_>) = let ops = a.ElementOps in unaryOpVectorGU (fun x -> ops.Multiply(k,x)) a
let scaleSparseMatrixGU k (a:SparseMatrix<_>) = let ops = a.ElementOps in unaryOpSparseGU (fun x -> ops.Multiply(k,x)) a
let negDenseMatrixGU (a:DenseMatrix<_>) = let ops = a.ElementOps in unaryOpDenseMatrixGU (fun x -> ops.Negate(x)) a
let negRowVecGU (a:RowVector<_>) = let ops = a.ElementOps in unaryOpRowVecGU (fun x -> ops.Negate(x)) a
let negVecGU (a:Vector<_>) = let ops = a.ElementOps in unaryOpVectorGU (fun x -> ops.Negate(x)) a
let negSparseMatrixGU (a:SparseMatrix<_>) = let ops = a.ElementOps in unaryOpSparseGU (fun x -> ops.Negate(x)) a
let mapDenseMatrixGU f (a : DenseMatrix<'T>) : DenseMatrix<'T> =
let arrA = a.Values
createDenseMatrixGU a.OpsData a.NumRows a.NumCols (fun i j -> f (getArray2 arrA i j))
let mapVecGU f (a:Vector<_>) =
let mA= a.NumRows
createVecGU a.OpsData mA (fun i -> f a.[i])
let copyDenseMatrixGU (a : DenseMatrix<'T>) : DenseMatrix<'T> =
let arrA = a.Values
createDenseMatrixGU a.OpsData a.NumRows a.NumCols (fun i j -> getArray2 arrA i j)
let copyVecGU (a:Vector<_>) =
let mA= a.NumRows
createVecGU a.OpsData mA (fun i -> a.[i])
let copyRowVecGU (a:RowVector<_>) =
let mA= a.NumCols
createRowVecGU a.OpsData mA (fun i -> a.[i])
let to_denseSparseMatrixGU (a:SparseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
createDenseMatrixGU a.OpsData mA nA (fun i j -> a.[i,j])
let mapiDenseMatrixGU f (a: DenseMatrix<'T>) : DenseMatrix<'T> =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
createDenseMatrixGU a.OpsData mA nA (fun i j -> f i j (getArray2 arrA i j))
let mapiRowVecGU f (a:RowVector<_>) =
let mA= a.NumCols
createRowVecGU a.OpsData mA (fun i -> f i a.[i])
let mapiVecGU f (a:Vector<_>) =
let mA= a.NumRows
createVecGU a.OpsData mA (fun i -> f i a.[i])
let permuteVecGU (p:permutation) (a:Vector<_>) =
let mA= a.NumRows
createVecGU a.OpsData mA (fun i -> a.[p i])
let permuteRowVecGU (p:permutation) (a:RowVector<_>) =
let mA= a.NumCols
createRowVecGU a.OpsData mA (fun i -> a.[p i])
let inline inplace_mapiDenseMatrixGU f (a:DenseMatrix<_>) =
let arrA = a.Values
assignDenseMatrixGU (fun i j -> f i j (getArray2 arrA i j)) a
let inline inplace_mapiRowVecGU f (a:RowVector<_>) =
assignRowVecGU (fun i -> f i a.[i]) a
let inline inplace_mapiVecGU f (a:Vector<_>) =
assignVecGU (fun i -> f i a.[i]) a
let inline foldDenseMatrixGU f z (a:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
let mutable acc = z
for i = 0 to mA-1 do
for j = 0 to nA-1 do
acc <- f acc (getArray2 arrA i j)
acc
let inline foldVecGU f z (a:Vector<_>) =
let mA = a.NumRows
let mutable acc = z
for i = 0 to mA-1 do acc <- f acc a.[i]
acc
let inline foldiDenseMatrixGU f z (a:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
let mutable acc = z
for i = 0 to mA-1 do
for j = 0 to nA-1 do
acc <- f i j acc (getArray2 arrA i j)
acc
let inline foldiVecGU f z (a:Vector<_>) =
let mA = a.NumRows
let mutable acc = z
for i = 0 to mA-1 do acc <- f i acc a.[i]
acc
let rec forallR f (n,m) = (n > m) || (f n && forallR f (n+1,m))
let rec existsR f (n,m) = (n <= m) && (f n || existsR f (n+1,m))
let foralliDenseMatrixGU pred (a:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
(0,mA-1) |> forallR (fun i ->
(0,nA-1) |> forallR (fun j ->
pred i j (getArray2 arrA i j)))
let foralliVecGU pred (a:Vector<_>) =
let mA = a.NumRows
(0,mA-1) |> forallR (fun i ->
pred i a.[i])
let existsiDenseMatrixGU pred (a:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let arrA = a.Values
(0,mA-1) |> existsR (fun i ->
(0,nA-1) |> existsR (fun j ->
pred i j (getArray2 arrA i j)))
let existsiVecGU pred (a:Vector<_>) =
let mA = a.NumRows
(0,mA-1) |> existsR (fun i ->
pred i a.[i])
let sumDenseMatrixGU (a:DenseMatrix<_>) =
let ops = a.ElementOps
let zero = ops.Zero
foldDenseMatrixGU (fun acc aij -> add ops acc aij) zero a
let sumSparseMatrixGU (a:SparseMatrix<_>) =
let ops = a.ElementOps
let zero = ops.Zero
a |> nonZeroEntriesSparseMatrixGU |> Seq.fold (fun acc (_,_,aij) -> add ops acc aij) zero
let sumVecGU (a:Vector<_>) =
let ops = a.ElementOps
let zero = ops.Zero
foldVecGU (fun acc ai -> add ops acc ai) zero a
let prodDenseMatrixGU (a:DenseMatrix<_>) =
let ops = a.ElementOps
let one = ops.One
foldDenseMatrixGU (fun acc aij -> mul ops acc aij) one a
let prodSparseMatrixGU (a:SparseMatrix<_>) = a |> to_denseSparseMatrixGU |> prodDenseMatrixGU
let inline fold2DenseMatrixGU f z (a:DenseMatrix<_>) (b:DenseMatrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
if nA <> nB || mA <> mB then invalidArg "b" "the two matrices do not have compatible dimensions"
let arrA = a.Values
let arrB = b.Values
let mutable acc = z
for i = 0 to mA-1 do
for j = 0 to nA-1 do
acc <- f acc (getArray2 arrA i j) (getArray2 arrB i j)
acc
let inline fold2VecGU f z (a:Vector<_>) (b:Vector<_>) =
let mA = a.NumRows
let mB = b.NumRows
if mA <> mB then invalidArg "b" "the two vectors do not have compatible dimensions"
let mutable acc = z
for i = 0 to mA-1 do acc <- f acc a.[i] b.[i]
acc
let dotDenseMatrixGU (a:DenseMatrix<_>) b =
let ops = a.ElementOps
fold2DenseMatrixGU (fun z va vb -> add ops z (mul ops va vb)) ops.Zero a b
let dotVecGU (a:Vector<_>) b =
let ops = a.ElementOps
let zero = ops.Zero
fold2VecGU (fun z va vb -> add ops z (mul ops va vb)) zero a b
let normDenseMatrixGU (a:DenseMatrix<_>) =
let normOps = getNormOps a.ElementOps
foldDenseMatrixGU (fun z aij -> z + ((normOps.Norm aij)**2.0)) 0.0 a |> sqrt
let normSparseMatrixGU (a:SparseMatrix<_>) =
let normOps = getNormOps a.ElementOps
a |> nonZeroEntriesSparseMatrixGU |> Seq.fold (fun acc (_,_,aij) -> acc + ((normOps.Norm aij)**2.0)) 0.0 |> sqrt
let inplaceAddDenseMatrixGU (a:DenseMatrix<_>) (b:DenseMatrix<_>) =
let ops = a.ElementOps
let arrB = b.Values
inplace_mapiDenseMatrixGU (fun i j x -> add ops x (getArray2 arrB i j)) a
let inplaceAddVecGU (a:Vector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiVecGU (fun i x -> add ops x b.[i]) a
let inplaceAddRowVecGU (a:RowVector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiRowVecGU (fun i x -> add ops x b.[i]) a
let inplaceSubDenseMatrixGU (a:DenseMatrix<_>) (b:DenseMatrix<_>) =
let ops = a.ElementOps
let arrB = b.Values
inplace_mapiDenseMatrixGU (fun i j x -> sub ops x (getArray2 arrB i j)) a
let inplaceSubVecGU (a:Vector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiVecGU (fun i x -> sub ops x b.[i]) a
let inplaceSubRowVecGU (a:RowVector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiRowVecGU (fun i x -> sub ops x b.[i] ) a
let inplaceCptMulDenseMatrixGU (a:DenseMatrix<_>) (b:DenseMatrix<_>) =
let ops = a.ElementOps
let arrB = b.Values
inplace_mapiDenseMatrixGU (fun i j x -> mul ops x (getArray2 arrB i j)) a
let inplaceCptMulVecGU (a:Vector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiVecGU (fun i x -> mul ops x b.[i]) a
let inplaceCptMulRowVecGU (a:RowVector<_>) (b:Vector<_>) =
let ops = a.ElementOps
inplace_mapiRowVecGU (fun i x -> mul ops x b.[i] ) a
let inplaceScaleDenseMatrixGU x (a:DenseMatrix<_>) =
let ops = a.ElementOps
inplace_mapiDenseMatrixGU (fun i j y -> ops.Multiply(x,y)) a
let inplaceScaleVecGU x (a:Vector<_>) =
let ops = a.ElementOps
inplace_mapiVecGU (fun i y -> ops.Multiply(x,y)) a
let inplaceScaleRowVecGU x (a:RowVector<_>) =
let ops = a.ElementOps
inplace_mapiRowVecGU (fun i y -> ops.Multiply(x,y)) a
let wrapList (pre,mid,post) show l =
match l with
| [] -> [pre;post]
| [x] -> [pre;show x;post]
| x::xs -> [pre;show x] @ (List.collect (fun x -> [mid;show x]) xs) @ [post]
let showItem opsData x =
try
let ops = opsOfOpsData opsData
ops.ToString(x,"g10",System.Globalization.CultureInfo.InvariantCulture)
with :? System.NotSupportedException -> (box x).ToString()
let mapR f (n,m) = if m < n then [] else List.init (m-n+1) (fun i -> f (n+i))
let primShowDenseMatrixGU (sepX,sepR) (a : DenseMatrix<'e>) =
let nA = a.NumCols
let mA = a.NumRows
let ops = a.OpsData
let showLine i = wrapList ("[",";","]") (showItem ops) ((0,nA-1) |> mapR (fun j -> a.[i,j])) |> Array.of_list |> System.String.Concat
wrapList ("matrix [",";"+sepX,"]"+sepR) showLine [0..mA-1] |> Array.of_list |> System.String.Concat
let showDenseMatrixGU m = primShowDenseMatrixGU ("\n","\n") m
let debugShowDenseMatrixGU m = primShowDenseMatrixGU ("" ,"" ) m
let showVecGU s (a : Vector<_>) =
let mA = a.NumRows
let ops = a.OpsData
wrapList (s+" [",";","]") (showItem ops) ((0,mA-1) |> mapR (fun i -> a.[i])) |> Array.of_list |> System.String.Concat
let showRowVecGU s (a : RowVector<_>) =
let mA = a.NumCols
let ops = a.OpsData
wrapList (s+" [",";","]") (showItem ops) ((0,mA-1) |> mapR (fun i -> a.[i])) |> Array.of_list |> System.String.Concat
/// Implementations of operations specific to floating point types
module DoubleImpl =
module GU = GenericImpl
open Instances
// Element type OpsData
//type elem = float
let zero = 0.0
let one = 1.0
let inline sub (x:float) (y:float) = x - y
let inline add (x:float) (y:float) = x + y
let inline mul (x:float) (y:float) = x * y
let inline neg (x:float) = -x
// Specialized: these know the relevant set of
// ops without doing a table lookup based on runtime type
let FloatOps = Some (FloatNumerics :> INumeric<float>)
let inline initDenseMatrixDS m n f = GU.createDenseMatrixGU FloatOps m n f
let inline createRowVecDS m f = GU.createRowVecGU FloatOps m f
let inline createVecDS m f = GU.createVecGU FloatOps m f
let inline mkDenseMatrixDS arr = GU.mkDenseMatrixGU FloatOps arr
let inline mkRowVecDS arr = GU.mkRowVecGU FloatOps arr
let inline mkVecDS arr = GU.mkVecGU FloatOps arr
let inline listDenseMatrixDS ll = GU.listDenseMatrixGU FloatOps ll
let inline listRowVecDS l = GU.listRowVecGU FloatOps l
let inline listVecDS l = GU.listVecGU FloatOps l
let inline seqDenseMatrixDS ll = GU.seqDenseMatrixGU FloatOps ll
let inline seqRowVecDS l = GU.seqRowVecGU FloatOps l
let inline seqVecDS l = GU.seqVecGU FloatOps l
let constDenseMatrixDS m n x = GU.createDenseMatrixGU FloatOps m n (fun i j -> x)
let constRowVecDS m x = GU.createRowVecGU FloatOps m (fun i -> x)
let constVecDS m x = GU.createVecGU FloatOps m (fun i -> x)
let scalarDenseMatrixDS x = constDenseMatrixDS 1 1 x
let scalarRowVecDS x = constRowVecDS 1 x
let scalarVecDS x = constVecDS 1 x
// Beware - when compiled with non-generic code createArray2 creates an array of null values,
// not zero values. Hence the optimized version can only be used when compiling with generics.
let inline zeroDenseMatrixDS m n =
let arr = GU.createArray2 m n
GU.mkDenseMatrixGU FloatOps arr
// Specialized: these inline down to the efficient loops we need
let addDenseMatrixDS a b = GU.binaryOpDenseMatrixGU add a b
let addSparseDS a b = GU.binaryOpSparseMatrixGU add a b
let addRowVecDS a b = GU.binaryOpRowVecGU add a b
let addVecDS a b = GU.binaryOpVecGU add a b
let subDenseMatrixDS a b = GU.binaryOpDenseMatrixGU sub a b
let subSparseDS a b = GU.binaryOpSparseMatrixGU sub a b
let mulSparseDS a b = GU.genericMulSparse zero add mul a b
let subRowVecDS a b = GU.binaryOpRowVecGU sub a b
let subVecDS a b = GU.binaryOpVecGU sub a b
let cptMulDenseMatrixDS a b = GU.binaryOpDenseMatrixGU mul a b
let cptMulSparseDS a b = GU.binaryOpSparseMatrixGU mul a b
let cptMulRowVecDS a b = GU.binaryOpRowVecGU mul a b
let cptMulVecDS a b = GU.binaryOpVecGU mul a b
type smatrix = SparseMatrix<float>
type dmatrix = DenseMatrix<float>
type vector = Vector<float>
type rowvec = RowVector<float>
let cptMaxDenseMatrixDS (a:dmatrix) (b:dmatrix) = GU.binaryOpDenseMatrixGU max a b
let cptMinDenseMatrixDS (a:dmatrix) (b:dmatrix) = GU.binaryOpDenseMatrixGU min a b
let cptMaxSparseDS (a:smatrix) (b:smatrix) = GU.binaryOpSparseMatrixGU max a b
let cptMinSparseDS (a:smatrix) (b:smatrix) = GU.binaryOpSparseMatrixGU min a b
let cptMaxVecDS (a:vector) (b:vector) = GU.binaryOpVecGU max a b
let cptMinVecDS (a:vector) (b:vector) = GU.binaryOpVecGU min a b
// Don't make any mistake about these ones re. performance.
let mulDenseMatrixDS (a:dmatrix) (b:dmatrix) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two matrices do not have compatible dimensions"
// Beware - when compiled with non-generic code createArray2 creates an array of null values,
// not zero values. However we fill in all the entries to the array, hence OK.
let arr = GU.createArray2 mA nB
let arrA = a.Values
let arrB = b.Values
for i = 0 to mA - 1 do
for j = 0 to nB - 1 do
let mutable r = 0.0
for k = 0 to mB - 1 do
r <- r + mul (GU.getArray2 arrA i k) (GU.getArray2 arrB k j)
GU.setArray2 arr i j r
mkDenseMatrixDS arr
let mulRowVecDenseMatrixDS (a:rowvec) (b:dmatrix) =
let nA = a.NumCols
let nB = b.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two inputs do not have compatible dimensions"
let arr = Array.zeroCreate nB
let arrA = a.Values
let arrB = b.Values
for j = 0 to nB - 1 do
let mutable r = 0.0
for k = 0 to mB - 1 do
r <- r + mul arrA.[k] (GU.getArray2 arrB k j)
arr.[j] <- r
mkRowVecDS arr
let mulDenseMatrixVecDS (a:dmatrix) (b:vector) =
let nA = a.NumCols
let mA = a.NumRows
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two inputs do not have compatible dimensions"
let arr = Array.zeroCreate mA
let arrA = a.Values
let arrB = b.Values
for i = 0 to mA - 1 do
let mutable r = 0.0
for k = 0 to nA - 1 do
r <- r + mul (GU.getArray2 arrA i k) arrB.[k]
arr.[i] <- r
mkVecDS arr
let mulRowVecVecDS (a:rowvec) (b:vector) =
let nA = a.NumCols
let mB = b.NumRows
if nA<>mB then invalidArg "b" "the two vectors do not have compatible dimensions"
let arrA = a.Values
let arrB = b.Values
let mutable r = 0.0
for k = 0 to nA - 1 do
r <- r + mul arrA.[k] arrB.[k]
r
let rowvecDenseMatrixDS (x:rowvec) = initDenseMatrixDS 1 x.NumCols (fun _ j -> x.[j])
let vectorDenseMatrixDS (x:vector) = initDenseMatrixDS x.NumRows 1 (fun i _ -> x.[i])
let mulVecRowVecDS a b = mulDenseMatrixDS (vectorDenseMatrixDS a) (rowvecDenseMatrixDS b)
let scaleDenseMatrixDS k m = GU.unaryOpDenseMatrixGU (fun x -> mul k x) m
let scaleSparseDS k m = GU.unaryOpSparseGU (fun x -> mul k x) m
let scaleRowVecDS k m = GU.unaryOpRowVecGU (fun x -> mul k x) m
let scaleVecDS k m = GU.unaryOpVectorGU (fun x -> mul k x) m
let negDenseMatrixDS m = GU.unaryOpDenseMatrixGU (fun x -> neg x) m
let negSparseDS m = GU.unaryOpSparseGU (fun x -> neg x) m
let negRowVecDS m = GU.unaryOpRowVecGU (fun x -> neg x) m
let negVecDS m = GU.unaryOpVectorGU (fun x -> neg x) m
let traceDenseMatrixDS (a:dmatrix) =
let nA = a.NumCols
let mA = a.NumRows
if nA<>mA then invalidArg "a" "expected a square matrix";
let arrA = a.Values
(0,nA-1) |> GU.sumfR (fun i -> GU.getArray2 arrA i i)
let sumDenseMatrixDS a = GU.foldDenseMatrixGU add zero a
let sumVecDS a = GU.foldVecGU add zero a
let prodDenseMatrixDS a = GU.foldDenseMatrixGU mul one a
let prodVecDS a = GU.foldVecGU mul one a
let dotDenseMatrixDS a b = GU.fold2DenseMatrixGU (fun z va vb -> add z (mul va vb)) zero a b
let dotVecDS a b = GU.fold2VecGU (fun z va vb -> add z (mul va vb)) zero a b
let sumfDenseMatrixDS f m = GU.foldDenseMatrixGU (fun acc aij -> add acc (f aij)) zero m
let normDenseMatrixDS m = sqrt (sumfDenseMatrixDS (fun x -> x*x) m)
let inplaceAddDenseMatrixDS a (b:DenseMatrix<_>) = let arrB = b.Values in GU.inplace_mapiDenseMatrixGU (fun i j x -> x + GU.getArray2 arrB i j) a
let inplaceAddVecDS a (b:Vector<_>) = let arrB = b.Values in GU.inplace_mapiVecGU (fun i x -> x + arrB.[i]) a
let inplace_addRowVecDS a (b:RowVector<_>) = let arrB = b.Values in GU.inplace_mapiRowVecGU (fun i x -> x + arrB.[i]) a
let inplaceSubDenseMatrixDS a (b:DenseMatrix<_>) = let arrB = b.Values in GU.inplace_mapiDenseMatrixGU (fun i j x -> x - GU.getArray2 arrB i j) a
let inplaceSubVecDS a (b:Vector<_>) = let arrB = b.Values in GU.inplace_mapiVecGU (fun i x -> x - arrB.[i]) a
let inplace_subRowVecDS a (b:RowVector<_>) = let arrB = b.Values in GU.inplace_mapiRowVecGU (fun i x -> x - arrB.[i]) a
let inplaceCptMulDenseMatrixDS a (b:DenseMatrix<_>) = let arrB = b.Values in GU.inplace_mapiDenseMatrixGU (fun i j x -> x * GU.getArray2 arrB i j) a
let inplaceCptMulVecDS a (b:Vector<_>) = let arrB = b.Values in GU.inplace_mapiVecGU (fun i x -> x * arrB.[i]) a
let inplace_cptMulRowVecDS a (b:RowVector<_>) = let arrB = b.Values in GU.inplace_mapiRowVecGU (fun i x -> x * arrB.[i]) a
let inplaceScaleDenseMatrixDS (a:float) b = GU.inplace_mapiDenseMatrixGU (fun i j x -> a * x) b
let inplaceScaleVecDS (a:float) b = GU.inplace_mapiVecGU (fun i x -> a * x) b
let inplace_scaleRowVecDS (a:float) b = GU.inplace_mapiRowVecGU (fun i x -> a * x) b
/// Generic operations that, when used on floating point types, use the specialized versions in DoubleImpl
module SpecializedGenericImpl =
open Microsoft.FSharp.Math.Instances
open Microsoft.FSharp.Math.GlobalAssociations
module GU = GenericImpl
module DS = DoubleImpl
type smatrix = SparseMatrix<float>
type dmatrix = DenseMatrix<float>
type vector = Vector<float>
type rowvec = RowVector<float>
let inline dense x = DenseRepr(x)
let inline sparse x = SparseRepr(x)
let inline createMx ops m n f = GU.createDenseMatrixGU ops m n f |> dense
let inline createVx ops m f = GU.createVecGU ops m f
let inline createRVx ops m f = GU.createRowVecGU ops m f
let nonZeroEntriesM a =
match a with
| DenseRepr a -> GU.nonzeroEntriesDenseMatrixGU a
| SparseRepr a -> GU.nonZeroEntriesSparseMatrixGU a
/// Merge two sorted sequences
let mergeSorted cf (s1: seq<'T>) (s2: seq<'b>) =
seq { use e1 = s1.GetEnumerator()
use e2 = s2.GetEnumerator()
let havee1 = ref (e1.MoveNext())
let havee2 = ref (e2.MoveNext())
while !havee1 || !havee2 do
if !havee1 && !havee2 then
let v1 = e1.Current
let v2 = e2.Current
let c = cf v1 v2
if c < 0 then
do havee1 := e1.MoveNext()
yield Some(v1),None
elif c = 0 then
do havee1 := e1.MoveNext()
do havee2 := e2.MoveNext()
yield Some(v1),Some(v2)
else
do havee2 := e2.MoveNext()
yield (None,Some(v2))
elif !havee1 then
let v1 = e1.Current
do havee1 := e1.MoveNext()
yield (Some(v1),None)
else
let v2 = e2.Current
do havee2 := e2.MoveNext()
yield (None,Some(v2)) }
/// Non-zero entries from two sequences
let mergedNonZeroEntriesM (a:Matrix<_>) (b:Matrix<_>) =
let ops = a.ElementOps
let zero = ops.Zero
mergeSorted (fun (i1,j1,_) (i2,j2,_) -> let c = compare i1 i2 in if c <> 0 then c else compare j1 j2) (nonZeroEntriesM a) (nonZeroEntriesM b)
|> Seq.map (function | Some(i,j,v1),Some(_,_,v2) -> (i,j,v1,v2)
| Some(i,j,v1),None -> (i,j,v1,zero)
| None, Some(i,j,v2) -> (i,j,zero,v2)
| None, None -> failwith "unreachable")
// Creation
let listM xss : Matrix<'T> = GU.listDenseMatrixGU opsdata<'T> xss |> dense
let listV xss : Vector<'T> = GU.listVecGU opsdata<'T> xss
let listRV xss : RowVector<'T> = GU.listRowVecGU opsdata<'T> xss
let arrayM xss : Matrix<'T> = GU.mkDenseMatrixGU opsdata<'T> (Array2D.copy xss) |> dense
let arrayV xss : Vector<'T> = GU.mkVecGU opsdata<'T> (Array.copy xss)
let arrayRV xss : RowVector<'T> = GU.mkRowVecGU opsdata<'T> (Array.copy xss)
let seqM xss : Matrix<'T> = GU.seqDenseMatrixGU opsdata<'T> xss |> dense
let seqV xss : Vector<'T> = GU.seqVecGU opsdata<'T> xss
let seqRV xss : RowVector<'T> = GU.seqRowVecGU opsdata<'T> xss
let initM m n f : Matrix<'T> = GU.createDenseMatrixGU opsdata<'T> m n f |> dense
let initRV m f : RowVector<'T> = GU.createRowVecGU opsdata<'T> m f
let initV m f : Vector<'T> = GU.createVecGU opsdata<'T> m f
let inline inplace_assignM f a =
match a with
| SparseRepr a -> sparseNotMutable()
| DenseRepr a -> GU.assignDenseMatrixGU f a
let inline assignV f a = GU.assignVecGU f a
let coerce2 x = unbox(box(x))
let loosenDM (x: dmatrix) : DenseMatrix<_> = coerce2 x
let loosenSM (x: smatrix) : SparseMatrix<_> = coerce2 x
let loosenV (x: vector) : Vector<_> = coerce2 x
let loosenRV (x: rowvec) : RowVector<_> = coerce2 x
let loosenF (x: float) : 'T = coerce2 x
let tightenDM (x: DenseMatrix<_>) : dmatrix = coerce2 x
let tightenSM (x: SparseMatrix<_>) : smatrix = coerce2 x
let tightenV (x: Vector<_>) : vector = coerce2 x
let tightenRV (x: RowVector<_>) : rowvec = coerce2 x
let tightenF (x: 'T) : float = coerce2 x
let zeroM m n =
let arr = GU.createArray2 m n
// This is quite performance critical
// Avoid assigining zeros into the array
match box arr with
| :? (float[,]) as arr -> GU.mkDenseMatrixGU DS.FloatOps arr |> loosenDM |> dense
| _ ->
GU.zeroizeDenseMatrixGUA arr m n |> dense
let zeroV m : Vector<'T> =
let arr = GU.createArray m
// Avoid assigining zeros into the array
match box (arr: 'T[]) with
| :? (float[]) as arr -> GU.mkVecGU DS.FloatOps arr |> loosenV
| _ ->
GU.zeroizeVecGUA arr m
let zeroRV m : RowVector<'T> =
let arr = GU.createArray m
// Avoid assigining zeros into the array
match box (arr: 'T[]) with
| :? (float[]) as arr -> GU.mkRowVecGU DS.FloatOps arr |> loosenRV
| _ ->
GU.zeroizeRowVecGUA arr m
let initNumericM m n f =
let arr = GU.createArray2 m n
let opsData = opsdata<'T>
let ops = GU.opsOfOpsData opsData
GU.assignArray2 m n (f ops) arr;
GU.mkDenseMatrixGU opsData arr |> dense
let identityM m =
let arr = GU.createArray2 m m
// This is quite performance critical
// Avoid assigining zeros into the array
match box arr with
| :? (float[,]) as arr ->
for i = 0 to m - 1 do
arr.[i,i] <- 1.0
GU.mkDenseMatrixGU DS.FloatOps arr |> loosenDM |> dense
| _ ->
let opsData = opsdata<'T>
let ops = GU.opsOfOpsData opsData
let zero = ops.Zero
let one = ops.One
GU.assignArray2 m m (fun i j -> if i = j then one else zero) arr;
GU.mkDenseMatrixGU opsData arr |> dense
let createNumericV m f : Vector<'T> =
let arr = GU.createArray m
let opsData = opsdata<'T>
let ops = GU.opsOfOpsData opsData
GU.assignArray m (f ops) arr;
GU.mkVecGU opsData arr
let constM m n x = initM m n (fun i j -> x)
let constRV m x = initRV m (fun i -> x)
let constV m x = initV m (fun i -> x)
let scalarM x = constM 1 1 x
let scalarRV x = constRV 1 x
let scalarV x = constV 1 x
let diagnM (v:Vector<_>) n =
let ops = v.ElementOps
let zero = ops.Zero
let nV = v.NumRows + (if n < 0 then -n else n)
createMx v.OpsData nV nV (fun i j -> if i+n=j then v.[i] else zero)
let diagM v = diagnM v 0
let constDiagM n x : Matrix<'T> =
let opsData = opsdata<'T>
let ops = GU.opsOfOpsData opsData
let zero = ops.Zero
createMx opsData n n (fun i j -> if i=j then x else zero)
// Note: we drop sparseness on pointwise multiplication of sparse and dense.
let inline binaryOpM opDenseDS opDenseGU opSparseDS opSparseMatrixGU a b =
match a,b with
| DenseRepr a,DenseRepr b ->
match box a with
| (:? dmatrix as a) -> opDenseDS a (tightenDM b) |> loosenDM |> dense
| _ -> opDenseGU a b |> dense
| SparseRepr a,SparseRepr b ->
match box a with
| (:? smatrix as a) -> opSparseDS a (tightenSM b) |> loosenSM |> sparse
| _ -> opSparseMatrixGU a b |> sparse
| SparseRepr a, DenseRepr b -> opDenseGU (GU.to_denseSparseMatrixGU a) b |> dense
| DenseRepr a, SparseRepr b -> opDenseGU a (GU.to_denseSparseMatrixGU b) |> dense
let inline unaryOpM opDenseDS opDenseGU opSparseDS opSparseMatrixGU b =
match b with
| DenseRepr b ->
match box b with
| (:? dmatrix as b) -> opDenseDS b |> loosenDM |> dense
| _ -> opDenseGU b |> dense
| SparseRepr b ->
match box b with
| (:? smatrix as b) -> opSparseDS b |> loosenSM |> sparse
| _ -> opSparseMatrixGU b |> sparse
let inline floatUnaryOpM opDenseDS opDenseGU opSparseDS opSparseMatrixGU b =
match b with
| DenseRepr b ->
match box b with
| (:? dmatrix as b) -> opDenseDS b |> loosenF
| _ -> opDenseGU b
| SparseRepr b ->
match box b with
| (:? smatrix as b) -> opSparseDS b |> loosenF
| _ -> opSparseMatrixGU b
let addM a b = binaryOpM DS.addDenseMatrixDS GU.addDenseMatrixGU DS.addSparseDS GU.addSparseMatrixGU a b
let subM a b = binaryOpM DS.subDenseMatrixDS GU.subDenseMatrixGU DS.subSparseDS GU.subSparseMatrixGU a b
let mulM a b = binaryOpM DS.mulDenseMatrixDS GU.genericMulDenseMatrix DS.mulSparseDS GU.mulSparseMatrixGU a b
let cptMulM a b = binaryOpM DS.cptMulDenseMatrixDS GU.cptMulDenseMatrixGU DS.cptMulSparseDS GU.cptMulSparseMatrixGU a b
let cptMaxM a b = binaryOpM DS.cptMaxDenseMatrixDS GU.cptMaxDenseMatrixGU DS.cptMaxSparseDS GU.cptMaxSparseMatrixGU a b
let cptMinM a b = binaryOpM DS.cptMinDenseMatrixDS GU.cptMinDenseMatrixGU DS.cptMinSparseDS GU.cptMinSparseMatrixGU a b
let addRV a b =
match box a with
| (:? rowvec as a) -> DS.addRowVecDS a (tightenRV b) |> loosenRV
| _ -> GU.addRowVecGU a b
let addV a b =
match box a with
| (:? vector as a) -> DS.addVecDS a (tightenV b) |> loosenV
| _ -> GU.addVecGU a b
let subRV a b =
match box a with
| (:? rowvec as a) -> DS.subRowVecDS a (tightenRV b) |> loosenRV
| _ -> GU.subRowVecGU a b
let subV a b =
match box a with
| (:? vector as a) -> DS.subVecDS a (tightenV b) |> loosenV
| _ -> GU.subVecGU a b
let mulRVM a b =
match b with
| DenseRepr b ->
match box a with
| (:? rowvec as a) -> DS.mulRowVecDenseMatrixDS a (tightenDM b) |> loosenRV
| _ -> GU.mulRowVecDenseMatrixGU a b
| SparseRepr b -> GU.mulRVSparseMatrixGU a b
let mulMV a b =
match a with
| DenseRepr a ->
match box a with
| (:? dmatrix as a) -> DS.mulDenseMatrixVecDS a (tightenV b) |> loosenV
| _ -> GU.mulDenseMatrixVecGU a b
| SparseRepr a -> GU.mulSparseVecGU a b
let mulRVV a b =
match box a with
| (:? rowvec as a) -> DS.mulRowVecVecDS a (tightenV b) |> loosenF
| _ -> GU.mulRowVecVecGU a b
let mulVRV a b =
match box a with
| (:? vector as a) -> DS.mulVecRowVecDS a (tightenRV b) |> loosenDM |> dense
| _ -> GU.mulVecRowVecGU a b |> dense
let cptMulRV a b =
match box a with
| (:? rowvec as a) -> DS.cptMulRowVecDS a (tightenRV b) |> loosenRV
| _ -> GU.cptMulRowVecGU a b
let cptMulV a b =
match box a with
| (:? vector as a) -> DS.cptMulVecDS a (tightenV b) |> loosenV
| _ -> GU.cptMulVecGU a b
let cptMaxV a b =
match box a with
| (:? vector as a) -> DS.cptMaxVecDS a (tightenV b) |> loosenV
| _ -> GU.cptMaxVecGU a b
let cptMinV a b =
match box a with
| (:? vector as a) -> DS.cptMinVecDS a (tightenV b) |> loosenV
| _ -> GU.cptMinVecGU a b
let scaleM a b = unaryOpM (fun b -> DS.scaleDenseMatrixDS (tightenF a) b) (GU.scaleDenseMatrixGU a)
(fun b -> DS.scaleSparseDS (tightenF a) b) (GU.scaleSparseMatrixGU a) b
let scaleRV a b =
match box b with
| (:? rowvec as b) -> DS.scaleRowVecDS (tightenF a) b |> loosenRV
| _ -> GU.scaleRowVecGU a b
let scaleV a b =
match box b with
| (:? vector as b) -> DS.scaleVecDS (tightenF a) b |> loosenV
| _ -> GU.scaleVecGU a b
let dotM a b =
match a,b with
| DenseRepr a,DenseRepr b ->
match box b with
| (:? dmatrix as b) -> DS.dotDenseMatrixDS (tightenDM a) b |> loosenF
| _ -> GU.dotDenseMatrixGU a b
| _ ->
let ops = a.ElementOps
mergedNonZeroEntriesM a b |> Seq.fold (fun z (_,_,va,vb) -> GU.add ops z (GU.mul ops va vb)) ops.Zero
let dotV a b =
match box b with
| (:? vector as b) -> DS.dotVecDS (tightenV a) b |> loosenF
| _ -> GU.dotVecGU a b
let negM a = unaryOpM DS.negDenseMatrixDS GU.negDenseMatrixGU DS.negSparseDS GU.negSparseMatrixGU a
let negRV a =
match box a with
| (:? rowvec as a) -> DS.negRowVecDS a |> loosenRV
| _ -> GU.negRowVecGU a
let negV a =
match box a with
| (:? vector as a) -> DS.negVecDS a |> loosenV
| _ -> GU.negVecGU a
let traceMGU (a:Matrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
if nA<>mA then invalidArg "a" "expected a square matrix";
let ops = a.ElementOps
(0,nA-1) |> GU.sumRGU ops (fun i -> a.[i,i])
let traceM a = floatUnaryOpM DS.traceDenseMatrixDS (dense >> traceMGU) (sparse >> traceMGU) (sparse >> traceMGU) a
let sumM a = floatUnaryOpM DS.sumDenseMatrixDS GU.sumDenseMatrixGU GU.sumSparseMatrixGU GU.sumSparseMatrixGU a
let prodM a = floatUnaryOpM DS.prodDenseMatrixDS GU.prodDenseMatrixGU GU.prodSparseMatrixGU GU.prodSparseMatrixGU a
let normM a = floatUnaryOpM DS.normDenseMatrixDS GU.normDenseMatrixGU GU.normSparseMatrixGU GU.normSparseMatrixGU a
let opsM a =
match a with
| DenseRepr a -> a.OpsData
| SparseRepr a -> a.OpsData
let transM a =
match a with
| DenseRepr a ->
createMx a.OpsData a.NumCols a.NumRows (fun i j -> a.[j,i])
| SparseRepr a ->
a |> GU.nonZeroEntriesSparseMatrixGU |> Seq.map (fun (i,j,v) -> (j,i,v)) |> GU.initSparseMatrixGU a.NumCols a.NumRows a.OpsData |> sparse
let permuteRows (p: permutation) a =
match a with
| DenseRepr a ->
createMx a.OpsData a.NumCols a.NumRows (fun i j -> a.[p i,j])
| SparseRepr a ->
a |> GU.nonZeroEntriesSparseMatrixGU |> Seq.map (fun (i,j,v) -> (p i,j,v)) |> GU.initSparseMatrixGU a.NumCols a.NumRows a.OpsData |> sparse
let permuteColumns (p: permutation) a =
match a with
| DenseRepr a ->
createMx a.OpsData a.NumCols a.NumRows (fun i j -> a.[i,p j])
| SparseRepr a ->
a |> GU.nonZeroEntriesSparseMatrixGU |> Seq.map (fun (i,j,v) -> (i,p j,v)) |> GU.initSparseMatrixGU a.NumCols a.NumRows a.OpsData |> sparse
let transRV (a:RowVector<_>) =
createVx a.OpsData a.NumCols (fun i -> a.[i])
let transV (a:Vector<_>) =
createRVx a.OpsData a.NumRows (fun i -> a.[i])
let inplaceAddM a b =
match a,b with
| DenseRepr a,DenseRepr b ->
match box a with
| (:? dmatrix as a) -> DS.inplaceAddDenseMatrixDS a (tightenDM b)
| _ -> GU.inplaceAddDenseMatrixGU a b
| _ -> sparseNotMutable()
let inplaceAddV a b =
match box a with
| (:? vector as a) -> DS.inplaceAddVecDS a (tightenV b)
| _ -> GU.inplaceAddVecGU a b
let inplaceSubM a b =
match a,b with
| DenseRepr a,DenseRepr b ->
match box a with
| (:? dmatrix as a) -> DS.inplaceSubDenseMatrixDS a (tightenDM b)
| _ -> GU.inplaceSubDenseMatrixGU a b
| _ -> sparseNotMutable()
let inplaceSubV a b =
match box a with
| (:? vector as a) -> DS.inplaceSubVecDS a (tightenV b)
| _ -> GU.inplaceSubVecGU a b
let inplaceCptMulM a b =
match a,b with
| DenseRepr a,DenseRepr b ->
match box a with
| (:? dmatrix as a) -> DS.inplaceCptMulDenseMatrixDS a (tightenDM b)
| _ -> GU.inplaceCptMulDenseMatrixGU a b
| _ -> sparseNotMutable()
let inplaceCptMulV a b =
match box a with
| (:? vector as a) -> DS.inplaceCptMulVecDS a (tightenV b)
| _ -> GU.inplaceCptMulVecGU a b
let inplaceScaleM a b =
match b with
| DenseRepr b ->
match box b with
| (:? dmatrix as b) -> DS.inplaceScaleDenseMatrixDS (tightenF a) b
| _ -> GU.inplaceScaleDenseMatrixGU a b
| _ -> sparseNotMutable()
let inplaceScaleV a b =
match box b with
| (:? vector as b) -> DS.inplaceScaleVecDS (tightenF a) b
| _ -> GU.inplaceScaleVecGU a b
let existsM f a =
match a with
| SparseRepr a -> sparseNYI() // note: martin says "run f on a token element if it's not full"
| DenseRepr a -> GU.existsiDenseMatrixGU (fun _ _ -> f) a
let existsV f a = GU.existsiVecGU (fun _ -> f) a
let forallM f a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> GU.foralliDenseMatrixGU (fun _ _ -> f) a
let forallV f a = GU.foralliVecGU (fun _ -> f) a
let existsiM f a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> GU.existsiDenseMatrixGU f a
let existsiV f a = GU.existsiVecGU f a
let foralliM f a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> GU.foralliDenseMatrixGU f a
let foralliV f a = GU.foralliVecGU f a
let mapM f a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> DenseRepr(GU.mapDenseMatrixGU f a)
let mapV f a = GU.mapVecGU f a
let copyM a =
match a with
| SparseRepr a -> SparseRepr (GU.copySparseGU a)
| DenseRepr a -> DenseRepr (GU.copyDenseMatrixGU a)
let copyV a = GU.copyVecGU a
let copyRV a = GU.copyRowVecGU a
let mapiM f a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> DenseRepr (GU.mapiDenseMatrixGU f a)
let mapiV f a = GU.mapiVecGU f a
let permuteV p a = GU.permuteVecGU p a
let permuteRV p a = GU.permuteRowVecGU p a
let mapiRV f a = GU.mapiRowVecGU f a
let to_denseM a =
match a with
| SparseRepr a -> GU.to_denseSparseMatrixGU a |> dense
| DenseRepr _ -> a
let initSparseM i j x : Matrix<'T> =
let opsData = opsdata<'T>
GU.initSparseMatrixGU i j opsData x |> sparse
let initDenseM i j x : Matrix<'T> =
let r = zeroM i j
x |> Seq.iter (fun (i,j,v) -> r.[i,j] <- v);
r
let getDiagnM (a:Matrix<_>) n =
let nA = a.NumCols
let mA = a.NumRows
if nA<>mA then invalidArg "a" "expected a square matrix";
let ops = a.ElementOps
let ni = if n < 0 then -n else 0
let nj = if n > 0 then n else 0
GU.createVecGU (opsM a) (max (nA-abs(n)) 0) (fun i -> a.[i+ni,i+nj])
let getDiagM a = getDiagnM a 0
let inline inplace_mapiM f a =
match a with
| SparseRepr a -> sparseNotMutable()
| DenseRepr a -> GU.inplace_mapiDenseMatrixGU f a
let inline inplace_mapiV f a = GU.inplace_mapiVecGU f a
let inline foldM f z a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> GU.foldDenseMatrixGU f z a
let inline foldV f z a = GU.foldVecGU f z a
let inline foldiM f z a =
match a with
| SparseRepr a -> sparseNYI()
| DenseRepr a -> GU.foldiDenseMatrixGU f z a
let inline foldiV f z a = GU.foldiVecGU f z a
let compareM (comp: IComparer) (a:Matrix<'T>) (b:Matrix<'T>) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
let c = compare mA mB
if c <> 0 then c else
let c = compare nA nB
if c <> 0 then c else
match a,b with
| DenseRepr a, DenseRepr b ->
let rec go2 i j =
if j < nA then
let c = comp.Compare( a.[i,j], b.[i,j])
if c <> 0 then c else
go2 i (j+1)
else 0
let rec go1 i =
if i < mA then
let c = go2 i 0
if c <> 0 then c
else go1 (i+1)
else 0
go1 0
| _ ->
match (mergedNonZeroEntriesM a b |> Seq.tryPick (fun (i,j,v1,v2) -> let c = comp.Compare(v1,v2) in if c = 0 then None else Some(c))) with
| None -> 0
| Some(c) -> c
let equalsM (comp: IEqualityComparer) (a:Matrix<'T>) (b:Matrix<'T>) =
let nA = a.NumCols
let mA = a.NumRows
let nB = b.NumCols
let mB = b.NumRows
(mA = mB ) && (nA = nB) &&
match a,b with
| DenseRepr a, DenseRepr b ->
let rec go2 i j = j >= nA || (comp.Equals( a.[i,j], b.[i,j]) && go2 i (j+1) )
let rec go1 i = i >= mA || (go2 i 0 && go1 (i+1))
go1 0
| _ ->
mergedNonZeroEntriesM a b |> Seq.forall (fun (i,j,v1,v2) -> comp.Equals(v1,v2))
let compareV (comp: IComparer) (a:Vector<'T>) (b:Vector<'T>) =
let mA = a.NumRows
let mB = b.NumRows
let c = compare mA mB
if c <> 0 then c else
let rec go2 j =
if j < mA then
let c = comp.Compare(a.[j],b.[j])
if c <> 0 then c else go2 (j+1)
else 0
go2 0
let equalsV (comp: IEqualityComparer) (a:Vector<'T>) (b:Vector<'T>) =
let mA = a.NumRows
let mB = b.NumRows
(mA = mB) &&
let rec go2 j = (j >= mA) || (comp.Equals(a.[j],b.[j]) && go2 (j+1))
go2 0
let equalsRV (comp: IEqualityComparer) (a:RowVector<'T>) (b:RowVector<'T>) =
let mA = a.NumCols
let mB = b.NumCols
(mA = mB) &&
let rec go2 j = (j >= mA) || (comp.Equals(a.[j],b.[j]) && go2 (j+1))
go2 0
let compareRV (comp: IComparer) (a:RowVector<'T>) (b:RowVector<'T>) =
let mA = a.NumCols
let mB = b.NumCols
let c = compare mA mB
if c <> 0 then c else
let rec go2 j =
if j < mA then
let c = comp.Compare(a.[j],b.[j])
if c <> 0 then c else go2 (j+1)
else 0
go2 0
let inline combineHash x y = (x <<< 1) + y + 631
let hashM (comp:IEqualityComparer) (a:Matrix<_>) =
let nA = a.NumCols
let mA = a.NumRows
let acc = hash mA + hash nA
a |> nonZeroEntriesM |> Seq.truncate 20 |> Seq.fold (fun z v -> combineHash z (comp.GetHashCode v)) acc
let hashV (comp:IEqualityComparer) (a:Vector<_>) =
let mA = a.NumRows
hash mA +
(let mutable c = 0
for i = 0 to mA - 1 do
c <- combineHash c (comp.GetHashCode a.[i])
c)
let hashRV (comp:IEqualityComparer) (a:RowVector<_>) =
let mA = a.NumCols
hash mA +
(let mutable c = 0
for i = 0 to mA - 1 do
c <- combineHash c (comp.GetHashCode a.[i])
c)
type range = int * int
let startR ((a,b) : range) = a
let countR ((a,b) : range) = (b-a)+1
let idxR ((a,b) : range) i = a+i
let inR ((a,b) : range) i = a <= i && i <= b
let getRowM (a:Matrix<_>) i = createRVx (opsM a) a.NumCols (fun j -> a.[i,j])
let selColM (a:Matrix<_>) j = createVx (opsM a) a.NumRows (fun i -> a.[i,j])
let getRegionV (a:Vector<_>) r = createVx a.OpsData (countR r) (fun i -> a.[idxR r i])
let getRegionRV (a:RowVector<_>) r = createRVx a.OpsData (countR r) (fun i -> a.[idxR r i])
let getRegionM a ri rj =
match a with
| DenseRepr a -> createMx a.OpsData (countR ri) (countR rj) (fun i j -> a.[idxR ri i, idxR rj j])
| _ -> nonZeroEntriesM a
|> Seq.filter (fun (i,j,_) -> inR ri i && inR rj j)
|> Seq.map (fun (i,j,v) -> (i-startR ri,j-startR rj,v))
|> initSparseM (countR ri) (countR rj)
let getColsM (a:Matrix<_>) rj = getRegionM a (0,a.NumRows - 1) rj
let getRowsM (a:Matrix<_>) ri = getRegionM a ri (0,a.NumCols - 1)
let rowvecM (x:RowVector<_>) = initM 1 x.NumCols (fun _ j -> x.[j])
let vectorM (x:Vector<_>) = initM x.NumRows 1 (fun i _ -> x.[i])
let to_vectorM x = selColM x 0
let to_rowvecM x = getRowM x 0
let to_scalarM (x:Matrix<_>) = x.[0,0]
//----------------------------------------------------------------------------
// type Matrix<'T> augmentation
//--------------------------------------------------------------------------*)
type Matrix<'T> with
static member ( + )(a: Matrix<'T>,b) = SpecializedGenericImpl.addM a b
static member ( - )(a: Matrix<'T>,b) = SpecializedGenericImpl.subM a b
[<OverloadID("MultiplyMatrixMatrix")>]
static member ( * )(a: Matrix<'T>,b) = SpecializedGenericImpl.mulM a b
[<OverloadID("MultiplyMatrixVector")>]
static member ( * )(a: Matrix<'T>,b : Vector<'T>) = SpecializedGenericImpl.mulMV a b
[<OverloadID("MultiplyMatrixScalar")>]
static member ( * )((m: Matrix<'T>),k : 'T) = SpecializedGenericImpl.scaleM k m
static member ( .* )(a: Matrix<'T>,b) = SpecializedGenericImpl.cptMulM a b
[<OverloadID("MultiplyScalarMatrix")>]
static member ( * )(k,m: Matrix<'T>) = SpecializedGenericImpl.scaleM k m
static member ( ~- )(m: Matrix<'T>) = SpecializedGenericImpl.negM m
static member ( ~+ )(m: Matrix<'T>) = m
member m.GetSlice (?start1,?finish1,?start2,?finish2) =
let start1 = match start1 with None -> 0 | Some v -> v
let finish1 = match finish1 with None -> m.NumRows - 1 | Some v -> v
let start2 = match start2 with None -> 0 | Some v -> v
let finish2 = match finish2 with None -> m.NumCols - 1 | Some v -> v
SpecializedGenericImpl.getRegionM m (start1,finish1) (start2,finish2)
member m.SetSlice (?start1,?finish1,?start2,?finish2,vs:Matrix<_>) =
let start1 = match start1 with None -> 0 | Some v -> v
let finish1 = match finish1 with None -> m.NumRows - 1 | Some v -> v
let start2 = match start2 with None -> 0 | Some v -> v
let finish2 = match finish2 with None -> m.NumCols - 1 | Some v -> v
for i = start1 to finish1 do
for j = start2 to finish2 do
m.[i,j] <- vs.[i-start1,j-start2]
override m.ToString() =
match m with
| DenseRepr m -> GenericImpl.showDenseMatrixGU m
| SparseRepr m -> "<sparse>"
member m.DebugDisplay =
let txt =
match m with
| DenseRepr m -> GenericImpl.debugShowDenseMatrixGU m
| SparseRepr m -> "<sparse>"
new System.Text.StringBuilder(txt) // return an object with a ToString with the right value, rather than a string. (strings get shown using quotes)
member m.StructuredDisplayAsArray =
let rec layout m =
match m with
| DenseRepr dm -> box (Array2D.init m.NumRows m.NumCols (fun i j -> m.[i,j]))
| SparseRepr sm -> (if m.NumRows < 20 && m.NumCols < 20 then layout (SpecializedGenericImpl.to_denseM m) else box(SpecializedGenericImpl.nonZeroEntriesM m))
layout m
member m.Dimensions = m.NumRows,m.NumCols
member m.Transpose = SpecializedGenericImpl.transM m
member m.PermuteRows (p: permutation) : Matrix<'T> = SpecializedGenericImpl.permuteRows p m
member m.PermuteColumns (p: permutation) : Matrix<'T> = SpecializedGenericImpl.permuteColumns p m
interface IEnumerable<'T> with
member m.GetEnumerator() =
(seq { for i in 0 .. m.NumRows-1 do
for j in 0 .. m.NumCols - 1 do
yield m.[i,j] }).GetEnumerator()
interface IEnumerable with
member m.GetEnumerator() = ((m :> IEnumerable<_>).GetEnumerator() :> IEnumerator)
interface System.IComparable with
member m.CompareTo(yobj:obj) = SpecializedGenericImpl.compareM (LanguagePrimitives.FSharpComparer()) m (yobj :?> Matrix<'T>)
interface IStructuralComparable with
member m.CompareTo(yobj:obj,comp:System.Collections.IComparer) = SpecializedGenericImpl.compareM comp m (yobj :?> Matrix<'T>)
override m.GetHashCode() = SpecializedGenericImpl.hashM (LanguagePrimitives.FSharpEqualityComparer()) m
override m.Equals(yobj:obj) =
match yobj with
| :? Matrix<'T> as m2 -> SpecializedGenericImpl.equalsM (LanguagePrimitives.FSharpEqualityComparer()) m m2
| _ -> false
interface IStructuralEquatable with
member m.GetHashCode(comp:System.Collections.IEqualityComparer) = SpecializedGenericImpl.hashM comp m
member m.Equals(yobj:obj,comp:System.Collections.IEqualityComparer) =
match yobj with
| :? Matrix<'T> as m2 -> SpecializedGenericImpl.equalsM comp m m2
| _ -> false
//----------------------------------------------------------------------------
// type Vector<'T> augmentation
//--------------------------------------------------------------------------*)
type Vector<'T> with
static member ( + )(a: Vector<'T>,b) = SpecializedGenericImpl.addV a b
static member ( - )(a: Vector<'T>,b) = SpecializedGenericImpl.subV a b
static member ( .* )(a: Vector<'T>,b) = SpecializedGenericImpl.cptMulV a b
[<OverloadID("ScalarVectorMultiply")>]
static member ( * )(k,m: Vector<'T>) = SpecializedGenericImpl.scaleV k m
[<OverloadID("VectorRowVectorMultiply")>]
static member ( * )(a: Vector<'T>,b) = SpecializedGenericImpl.mulVRV a b
[<OverloadID("VectorScalarMultiply")>]
static member ( * )(m: Vector<'T>,k) = SpecializedGenericImpl.scaleV k m
static member ( ~- )(m: Vector<'T>) = SpecializedGenericImpl.negV m
static member ( ~+ )(m: Vector<'T>) = m
member m.GetSlice (?start,?finish) =
let start = match start with None -> 0 | Some v -> v
let finish = match finish with None -> m.NumRows - 1 | Some v -> v
SpecializedGenericImpl.getRegionV m (start,finish)
member m.SetSlice (?start,?finish,vs:Vector<_>) =
let start = match start with None -> 0 | Some v -> v
let finish = match finish with None -> m.NumRows - 1 | Some v -> v
for i = start to finish do
m.[i] <- vs.[i-start]
override m.ToString() = GenericImpl.showVecGU "vector" m
member m.DebugDisplay =
let txt = GenericImpl.showVecGU "vector" m
new System.Text.StringBuilder(txt) // return an object with a ToString with the right value, rather than a string. (strings get shown using quotes)
member m.StructuredDisplayAsArray = Array.init m.NumRows (fun i -> m.[i])
member m.Details = m.Values
member m.Transpose = SpecializedGenericImpl.transV m
member m.Permute (p:permutation) = SpecializedGenericImpl.permuteV p m
interface System.IComparable with
member m.CompareTo(y:obj) = SpecializedGenericImpl.compareV (LanguagePrimitives.FSharpComparer()) m (y :?> Vector<'T>)
interface IStructuralComparable with
member m.CompareTo(y:obj,comp:System.Collections.IComparer) = SpecializedGenericImpl.compareV comp m (y :?> Vector<'T>)
interface IStructuralEquatable with
member x.GetHashCode(comp) = SpecializedGenericImpl.hashV comp x
member x.Equals(yobj,comp) =
match yobj with
| :? Vector<'T> as v2 -> SpecializedGenericImpl.equalsV comp x v2
| _ -> false
override x.GetHashCode() =
SpecializedGenericImpl.hashV (LanguagePrimitives.FSharpEqualityComparer()) x
override x.Equals(yobj) =
match yobj with
| :? Vector<'T> as v2 -> SpecializedGenericImpl.equalsV (LanguagePrimitives.FSharpEqualityComparer()) x v2
| _ -> false
//----------------------------------------------------------------------------
// type RowVector<'T> augmentation
//--------------------------------------------------------------------------*)
type RowVector<'T> with
static member ( + )(a: RowVector<'T>,b) = SpecializedGenericImpl.addRV a b
static member ( - )(a: RowVector<'T>,b) = SpecializedGenericImpl.subRV a b
static member ( .* )(a: RowVector<'T>,b) = SpecializedGenericImpl.cptMulRV a b
[<OverloadID("ScalarRowVectorMultiply")>]
static member ( * )(k,v: RowVector<'T>) = SpecializedGenericImpl.scaleRV k v
[<OverloadID("RowVectorMatrixMultiply")>]
static member ( * )(a: RowVector<'T>,b: Matrix<'T>) = SpecializedGenericImpl.mulRVM a b
[<OverloadID("RowVectorVectorMultiply")>]
static member ( * )(a: RowVector<'T>,b:Vector<'T>) = SpecializedGenericImpl.mulRVV a b
[<OverloadID("RowVectorScalarMultiply")>]
static member ( * )(v: RowVector<'T>,k:'T) = SpecializedGenericImpl.scaleRV k v
static member ( ~- )(v: RowVector<'T>) = SpecializedGenericImpl.negRV v
static member ( ~+ )(v: RowVector<'T>) = v
member m.GetSlice (?start,?finish) =
let start = match start with None -> 0 | Some v -> v
let finish = match finish with None -> m.NumCols - 1 | Some v -> v
SpecializedGenericImpl.getRegionRV m (start,finish)
member m.SetSlice (?start,?finish,vs:RowVector<_>) =
let start = match start with None -> 0 | Some v -> v
let finish = match finish with None -> m.NumCols - 1 | Some v -> v
for i = start to finish do
m.[i] <- vs.[i-start]
override m.ToString() = GenericImpl.showRowVecGU "rowvec" m
member m.DebugDisplay =
let txt = GenericImpl.showRowVecGU "rowvec" m
new System.Text.StringBuilder(txt) // return an object with a ToString with the right value, rather than a string. (strings get shown using quotes)
member m.StructuredDisplayAsArray = Array.init m.NumCols (fun i -> m.[i])
member m.Details = m.Values
member m.Transpose = SpecializedGenericImpl.transRV m
member m.Permute (p:permutation) = SpecializedGenericImpl.permuteRV p m
interface System.IComparable with
member m.CompareTo(y) = SpecializedGenericImpl.compareRV (LanguagePrimitives.FSharpComparer()) m (y :?> RowVector<'T>)
interface IStructuralComparable with
member m.CompareTo(y,comp) = SpecializedGenericImpl.compareRV comp m (y :?> RowVector<'T>)
interface IStructuralEquatable with
member x.GetHashCode(comp) = SpecializedGenericImpl.hashRV comp x
member x.Equals(yobj,comp) =
match yobj with
| :? RowVector<'T> as rv2 -> SpecializedGenericImpl.equalsRV comp x rv2
| _ -> false
override x.GetHashCode() =
SpecializedGenericImpl.hashRV (LanguagePrimitives.FSharpEqualityComparer()) x
override x.Equals(yobj) =
match yobj with
| :? RowVector<'T> as rv2 -> SpecializedGenericImpl.equalsRV (LanguagePrimitives.FSharpEqualityComparer()) x rv2
| _ -> false
type matrix = Matrix<float>
type vector = Vector<float>
type rowvec = RowVector<float>
module MRandom =
let seed = 99
let randomGen = new System.Random(seed)
let float f = randomGen.NextDouble() * f
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Matrix = begin
module Generic = begin
module MS = SpecializedGenericImpl
// Accessors
let get (a:Matrix<_>) i j = a.[i,j]
let set (a:Matrix<_>) i j x = a.[i,j] <- x
// Creation
let of_list xss = MS.listM xss
let of_seq xss = MS.seqM xss
let init m n f = MS.initM m n f
let of_array2 arr = MS.arrayM arr
let to_array2 (m:Matrix<_>) = Array2D.init m.NumRows m.NumCols (fun i j -> get m i j)
let initNumeric m n f = MS.initNumericM m n f
let inplace_assign f a = MS.inplace_assignM f a
let zero m n = MS.zeroM m n
let identity m = MS.identityM m
let create m n x = MS.constM m n x
let of_scalar x = MS.scalarM x
let diag v = MS.diagM v
let initDiagonal v = MS.diagM v
let init_diagonal v = initDiagonal v
let constDiag n x = MS.constDiagM n x
// Operators
let add a b = MS.addM a b
let sub a b = MS.subM a b
let mul a b = MS.mulM a b
let mulRV a b = MS.mulRVM a b
let mulV a b = MS.mulMV a b
let cptMul a b = MS.cptMulM a b
let cptMax a b = MS.cptMaxM a b
let cptMin a b = MS.cptMinM a b
let scale a b = MS.scaleM a b
let dot a b = MS.dotM a b
let neg a = MS.negM a
let trace a = MS.traceM a
let sum a = MS.sumM a
let prod a = MS.prodM a
let norm a = MS.normM a
let transpose a = MS.transM a
let inplace_add a b = MS.inplaceAddM a b
let inplace_sub a b = MS.inplaceSubM a b
let inplace_cptMul a b = MS.inplaceCptMulM a b
let inplace_scale a b = MS.inplaceScaleM a b
let exists f a = MS.existsM f a
let forall f a = MS.forallM f a
let existsi f a = MS.existsiM f a
let foralli f a = MS.foralliM f a
let map f a = MS.mapM f a
let copy a = MS.copyM a
let mapi f a = MS.mapiM f a
let getDiagN a n = MS.getDiagnM a n
let getDiag a = MS.getDiagnM a 0
let to_dense a = MS.to_denseM a
let initDense i j a = MS.initDenseM i j a
let initSparse i j a = MS.initSparseM i j a
let init_dense i j a = initDense i j a
let init_sparse i j a = initSparse i j a
let nonzero_entries a = MS.nonZeroEntriesM a
let inplace_mapi f a = MS.inplace_mapiM f a
let fold f z a = MS.foldM f z a
let foldi f z a = MS.foldiM f z a
let compare a b = MS.compareM (LanguagePrimitives.FSharpComparer()) a b
let hash a = MS.hashM (LanguagePrimitives.FSharpEqualityComparer()) a
let getRow a i = MS.getRowM a i
let getCol a j = MS.selColM a j
let getCols a i1 i2 = MS.getColsM a (i1,i1+i2-1)
let getRows a j1 j2 = MS.getRowsM a (j1,j1+j2-1)
let getRegion a i1 j1 i2 j2 = MS.getRegionM a (i1,i1+i2-1) (j1,j1+j2-1)
let of_rowvec x = MS.rowvecM x
let of_vector x = MS.vectorM x
let to_vector x = MS.to_vectorM x
let to_rowvec x = MS.to_rowvecM x
let to_scalar x = MS.to_scalarM x
end
module MG = Generic
module DS = DoubleImpl
module GU = GenericImpl
module MS = SpecializedGenericImpl
// Element type OpsData
type elem = float
// Accessors
let get (a:matrix) i j = MG.get a i j
let set (a:matrix) i j x = MG.set a i j x
// Creation
let init m n f = DS.initDenseMatrixDS m n f |> MS.dense
let of_list xss = DS.listDenseMatrixDS xss |> MS.dense
let of_seq xss = DS.seqDenseMatrixDS xss |> MS.dense
let diag (v:vector) = MG.diag v
let initDiagonal (v:vector) = MG.diag v
let init_diagonal v = initDiagonal v
let constDiag n x : matrix = MG.constDiag n x
let create m n x = DS.constDenseMatrixDS m n x |> MS.dense
let of_scalar x = DS.scalarDenseMatrixDS x |> MS.dense
let of_array2 arr : matrix = MG.of_array2 arr
let to_array2 (m : matrix) = MG.to_array2 m
let getDiagN (a:matrix) n = MG.getDiagN a n
let getDiag (a:matrix) = MG.getDiag a
// Operators
let add (a:matrix) (b:matrix) = MS.addM a b
let sub (a:matrix) (b:matrix) = MS.subM a b
let mul (a:matrix) (b:matrix) = MS.mulM a b
let mulV (a:matrix) (b:vector) = MS.mulMV a b
let mulRV (a:rowvec) (b:matrix) = MS.mulRVM a b
let cptMul (a:matrix) (b:matrix) = MS.cptMulM a b
let cptMax (a:matrix) (b:matrix) = MS.cptMaxM a b
let cptMin (a:matrix) (b:matrix) = MS.cptMinM a b
let scale a (b:matrix) = MS.scaleM a b
let neg (a:matrix) = MS.negM a
let trace (a:matrix) = MS.traceM a
let transpose (a:matrix) = MG.transpose a
let forall f (a:matrix) = MG.forall f a
let exists f (a:matrix) = MG.exists f a
let foralli f (a:matrix) = MG.foralli f a
let existsi f (a:matrix) = MG.existsi f a
let map f (a:matrix) = MG.map f a
let copy (a:matrix) = MG.copy a
let mapi f (a:matrix) : matrix = MG.mapi f a
let fold f z (a:matrix) = MG.fold f z a
let foldi f z (a:matrix) = MG.foldi f z a
let to_dense (a:matrix) = MG.to_dense a
let initDense i j a : matrix = MG.initDense i j a
let initSparse i j a : matrix = MG.initSparse i j a
let init_dense i j a = initDense i j a
let init_sparse i j a = initSparse i j a
let nonzero_entries (a:matrix) = MG.nonzero_entries a
let zero m n = DS.zeroDenseMatrixDS m n |> MS.dense
let identity m : matrix = MG.identity m
let ones m n = create m n 1.0
let getRow (a:matrix) i = MG.getRow a i
let getCol (a:matrix) j = MG.getCol a j
let getCols (a:matrix) i1 i2 = MG.getCols a i1 i2
let getRows (a:matrix) j1 j2 = MG.getRows a j1 j2
let getRegion (a:matrix) i1 j1 i2 j2 = MG.getRegion a i1 j1 i2 j2
let rowRange (a:Matrix<_>) = (0,a.NumRows - 1)
let colRange (a:Matrix<_>) = (0,a.NumCols - 1)
let wholeRegion a = (colRange a, rowRange a)
let foldByRow f (z:Vector<'T>) (a:matrix) =
colRange a |> GU.foldR (fun z j -> MS.mapiV (fun i z -> f z (get a i j)) z) z
let foldByCol f (z:RowVector<'T>) (a:matrix) =
rowRange a |> GU.foldR (fun z i -> MS.mapiRV (fun j z -> f z (get a i j)) z) z
let foldRow f (z:'T) (a:matrix) i =
colRange a |> GU.foldR (fun (z:'T) j -> f z (get a i j)) z
let foldCol f (z:'T) (a:matrix) j =
rowRange a |> GU.foldR (fun (z:'T) i -> f z (get a i j)) z
let sum (a:matrix) = MS.sumM a
let prod (a:matrix) = MS.prodM a
let norm (a:matrix) = MS.normM a
let dot (a:matrix) b = MS.dotM a b
let cptPow a y = map (fun x -> x ** y) a
// Functions that only make sense on this type
let randomize v = map (fun vij -> MRandom.float vij) v (* res_ij = random [0,vij] values *)
let of_rowvec x : matrix = MS.rowvecM x
let of_vector x : matrix = MS.vectorM x
let to_vector x : vector = MS.to_vectorM x
let to_rowvec x : rowvec = MS.to_rowvecM x
let to_scalar x : float = MS.to_scalarM x
// Mutation
let inplace_assign f (a:matrix) = MG.inplace_assign f a
let inplace_mapi f (a:matrix) = MG.inplace_mapi f a
let inplace_add (a:matrix) b = MS.inplaceAddM a b
let inplace_sub (a:matrix) b = MS.inplaceSubM a b
let inplace_cptMul (a:matrix) b = MS.inplaceCptMulM a b
let inplace_scale a (b:matrix) = MS.inplaceScaleM a b
end
//----------------------------------------------------------------------------
// module Vector
//--------------------------------------------------------------------------*)
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Vector =
module Generic =
module OpsS = SpecializedGenericImpl
let get (a:Vector<_>) i = a.[i]
let set (a:Vector<_>) i x = a.[i] <- x
let length (v:Vector<_>) = v.Length
let of_list xss = OpsS.listV xss
let of_seq xss = OpsS.seqV xss
let init m f = OpsS.initV m f
let initNumeric m f = OpsS.createNumericV m f
let of_array arr = OpsS.arrayV arr
let to_array (v:Vector<_>) = Array.init v.Length (get v)
let create m x = OpsS.constV m x
let zero n = OpsS.zeroV n
let ones n = OpsS.createNumericV n (fun ops i -> ops.One)
let of_scalar x = OpsS.scalarV x
let add a b = OpsS.addV a b
let sub a b = OpsS.subV a b
let mulRVV a b = OpsS.mulRVV a b
let mulVRV a b = OpsS.mulVRV a b
let cptMul a b = OpsS.cptMulV a b
let cptMax a b = OpsS.cptMaxV a b
let cptMin a b = OpsS.cptMinV a b
let scale a b = OpsS.scaleV a b
let dot a b = OpsS.dotV a b
let neg a = OpsS.negV a
let transpose a = OpsS.transV a
let inplace_add a b = OpsS.inplaceAddV a b
let inplace_sub a b = OpsS.inplaceSubV a b
let inplace_cptMul a b = OpsS.inplaceCptMulV a b
let inplace_scale a b = OpsS.inplaceScaleV a b
let exists f a = OpsS.existsV f a
let forall f a = OpsS.forallV f a
let existsi f a = OpsS.existsiV f a
let foralli f a = OpsS.foralliV f a
let map f a = OpsS.mapV f a
let mapi f a = OpsS.mapiV f a
let copy a = OpsS.copyV a
let inplace_mapi f a = OpsS.inplace_mapiV f a
let fold f z a = OpsS.foldV f z a
let foldi f z a = OpsS.foldiV f z a
let compare a b = OpsS.compareV a b
let hash a = OpsS.hashV a
let inplace_assign f a = OpsS.assignV f a
let sum (a:Vector<_>) = let ops = a.ElementOps in fold (fun x y -> ops.Add(x,y)) ops.Zero a
let prod (a:Vector<_>) = let ops = a.ElementOps in fold (fun x y -> ops.Multiply(x,y)) ops.One a
let norm (a:Vector<_>) =
let normOps = GenericImpl.getNormOps a.ElementOps
sqrt (fold (fun x y -> x + normOps.Norm(y)**2.0) 0.0 a)
module VG = Generic
module VecDS = DoubleImpl
module VecGU = GenericImpl
let get (a:vector) j = VG.get a j
let set (a:vector) j x = VG.set a j x
let length (a:vector) = VG.length a
let nrows (a:vector) = VG.length a
let init m f = VecDS.createVecDS m f
let of_array arr : vector = VG.of_array arr
let to_array (m : vector) = VG.to_array m
type range = int * int
let countR ((a,b) : range) = (b-a)+1
let idxR ((a,b) : range) i = a+i
type rangef = float * float * float // start, skip, end
let countRF ((a,d,b) : rangef) = System.Convert.ToInt32((b-a)/d) + 1
//let countRF ((a,d,b) : rangef) = Float.to_int((b-a)/d) + 1
let idxRF ((a,d,b) : rangef) i = System.Math.Min (a + d * float(i),b)
let range n1 n2 = let r = (n1,n2) in init (countR r) (fun i -> float(idxR r i))
let rangef a b c = let r = (a,b,c) in init (countRF r) (fun i -> idxRF r i)
let of_list xs = VecDS.listVecDS xs
let of_seq xs = VecDS.seqVecDS xs
let create m x = VecDS.constVecDS m x
let of_scalar x = VecDS.scalarVecDS x
let add a b = VecDS.addVecDS a b
let sub a b = VecDS.subVecDS a b
let mulRVV a b = VecDS.mulRowVecVecDS a b
let mulVRV a b = VecDS.mulVecRowVecDS a b
let cptMul a b = VecDS.cptMulVecDS a b
let cptMax a b = VecDS.cptMaxVecDS a b
let cptMin a b = VecDS.cptMinVecDS a b
let scale a b = VecDS.scaleVecDS a b
let neg a = VecDS.negVecDS a
let dot a b = VecDS.dotVecDS a b
let transpose (a:vector) = VG.transpose a
let exists f (a:vector) = VG.exists f a
let forall f (a:vector) = VG.forall f a
let existsi f (a:vector) = VG.existsi f a
let foralli f (a:vector) = VG.foralli f a
let map f (a:vector) = VG.map f a
let copy (a:vector) = VG.copy a
let mapi f (a:vector) : vector = VG.mapi f a
let fold f z (a:vector) = VG.fold f z a
let foldi f z (a:vector) = VG.foldi f z a
let zero n = create n 0.0
let ones n = create n 1.0
let sum a = VecDS.sumVecDS a
let prod a = fold (fun x y -> x * y) 1.0 a
let norm (a:vector) = sqrt (fold (fun x y -> x + y * y) 0.0 a) (* fixed *)
let cptPow a y = map (fun x -> x ** y) a
let inplace_assign f (a:vector) = VG.inplace_assign f a
let inplace_mapi f (a:vector) = VG.inplace_mapi f a
let inplace_add a b = VecDS.inplaceAddVecDS a b
let inplace_sub a b = VecDS.inplaceSubVecDS a b
let inplace_cptMul a b = VecDS.inplaceCptMulVecDS a b
let inplace_scale a b = VecDS.inplaceScaleVecDS a b
//----------------------------------------------------------------------------
// module RowVector
//--------------------------------------------------------------------------*)
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module RowVector =
module Generic =
module OpsS = SpecializedGenericImpl
let get (a:RowVector<_>) i = a.[i]
let set (a:RowVector<_>) i x = a.[i] <- x
let zero n = OpsS.zeroRV n
let length (v:RowVector<_>) = v.Length
let init m f = OpsS.initRV m f
let create m x = OpsS.constRV m x
let transpose a = OpsS.transRV a
let copy a = OpsS.copyRV a
let of_list a = OpsS.listRV a
let of_array a = OpsS.arrayRV a
let of_seq a = OpsS.seqRV a
let to_array m = Array.init (length m) (get m)
module RVG = Generic
let get (a:rowvec) i = RVG.get a i
let set (a:rowvec) i x = RVG.set a i x
let length (a:rowvec) = RVG.length a
let ncols (a:rowvec) = RVG.length a
let of_array arr : rowvec = RVG.of_array arr
let to_array (m : rowvec) = RVG.to_array m
let init m f : rowvec = RVG.init m f
let create m f : rowvec = RVG.create m f
let zero n = create n 0.0
let of_list x : rowvec = RVG.of_list x
let of_seq x : rowvec = RVG.of_seq x
let transpose x : vector = RVG.transpose x
let copy x : rowvec = RVG.copy x
type Matrix<'T> with
member x.ToArray2() = Matrix.Generic.to_array2 x
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member x.NonZeroEntries = Matrix.Generic.nonzero_entries x
member x.ToScalar() = Matrix.Generic.to_scalar x
member x.ToRowVector() = Matrix.Generic.to_rowvec x
member x.ToVector() = Matrix.Generic.to_vector x
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member x.Norm = Matrix.Generic.norm x
member x.Column(n) = Matrix.Generic.getCol x n
member x.Row(n) = Matrix.Generic.getRow x n
member x.Columns (i,ni) = Matrix.Generic.getCols x i ni
member x.Rows (j,nj) = Matrix.Generic.getRows x j nj
member x.Region(i,j,ni,nj) = Matrix.Generic.getRegion x i j ni nj
member x.GetDiagonal(i) = Matrix.Generic.getDiagN x i
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerBrowsable(DebuggerBrowsableState.Collapsed)>]
#endif
member x.Diagonal = Matrix.Generic.getDiag x
member x.Copy () = Matrix.Generic.copy x
type Vector<'T> with
member x.ToArray() = Vector.Generic.to_array x
member x.Norm = Vector.Generic.norm x
member x.Copy () = Vector.Generic.copy x
type RowVector<'T> with
member x.ToArray() = RowVector.Generic.to_array x
member x.Copy () = RowVector.Generic.copy x
namespace Microsoft.FSharp.Core
/// The type of floating-point matrices. See Microsoft.FSharp.Math
type matrix = Microsoft.FSharp.Math.matrix
/// The type of floating-point vectors. See Microsoft.FSharp.Math
type vector = Microsoft.FSharp.Math.vector
/// The type of floating-point row vectors. See Microsoft.FSharp.Math
type rowvec = Microsoft.FSharp.Math.rowvec
[<AutoOpen>]
module MatrixCommonExtensions =
let matrix ll = Microsoft.FSharp.Math.Matrix.of_seq ll
let vector l = Microsoft.FSharp.Math.Vector.of_seq l
let rowvec l = Microsoft.FSharp.Math.RowVector.of_seq l