Skip to content

Commit e95dc24

Browse files
NoahStoryMNoahStoryM
authored
Relax input restrictions for block-diagonal-matrix to support empty arrays (#104)
* Relax input restrictions for `block-diagonal-matrix` * Avoid unnecessary parametric polymorphic * [doc] Clarify empty 2D array behavior * Replace throw-err function with `(const 1)` for empty array creation * Use make-array instead of build-simple-array to create empty arrays * Make untyped racket support `(block-diagonal-matrix '())`
1 parent 8bd2e16 commit e95dc24

File tree

4 files changed

+89
-25
lines changed

4 files changed

+89
-25
lines changed

‎math-doc/math/scribblings/math-matrix.scrbl‎

Lines changed: 35 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,11 @@
22

33
@(require scribble/eval
44
racket/sandbox
5-
(for-label racket/base racket/vector racket/match racket/unsafe/ops racket/string
5+
(for-label racket/base
6+
racket/match
7+
racket/vector
8+
racket/string
9+
racket/unsafe/ops
610
(except-in racket/list permutations) ; FIXME
711
math plot
812
(only-in typed/racket/base
@@ -250,10 +254,10 @@ The length of @racket[xs] must be positive.
250254

251255
@define[block-diagonal-url]{http://en.wikipedia.org/wiki/Block_matrix#Block_diagonal_matrices}
252256

253-
@defproc[(block-diagonal-matrix [Xs (Listof (Matrix A))] [zero A 0]) (Matrix A)]{
257+
@defproc[(block-diagonal-matrix [Xs (Listof (Array A))] [zero A 0]) (Array A)]{
254258
@margin-note*{@hyperlink[block-diagonal-url]{Wikipedia: Block-diagonal matrices}}
255-
Returns a matrix with matrices @racket[Xs] along the diagonal and @racket[zero] everywhere else.
256-
The length of @racket[Xs] must be positive.
259+
Returns an array with two-dimensional arrays @racket[Xs] along the diagonal and
260+
@racket[zero] everywhere else.
257261
@examples[#:eval typed-eval
258262
(block-diagonal-matrix (list (matrix [[6 7] [8 9]])
259263
(diagonal-matrix '(7 5 7))
@@ -262,6 +266,33 @@ The length of @racket[Xs] must be positive.
262266
(block-diagonal-matrix (list (make-matrix 2 2 2.0+3.0i)
263267
(make-matrix 2 2 5.0+7.0i))
264268
0.0+0.0i)]
269+
270+
Empty two-dimensional arrays are valid inputs. They contribute to the resulting
271+
array's @tech{shape}.
272+
@examples[#:eval typed-eval
273+
(block-diagonal-matrix (list (make-array #(2 0) 1)
274+
(matrix [[6 7] [8 9]])))
275+
(block-diagonal-matrix (list (matrix [[6 7] [8 9]])
276+
(make-array #(2 0) 1)))
277+
(block-diagonal-matrix (list (make-array #(0 2) 1)
278+
(matrix [[6 7] [8 9]])))
279+
(block-diagonal-matrix (list (matrix [[6 7] [8 9]])
280+
(make-array #(0 2) 1)))
281+
(block-diagonal-matrix (list (matrix [[6 7] [8 9]])
282+
(make-array #(2 0) 1)
283+
(diagonal-matrix '(7 5 7))
284+
(make-array #(0 2) 1)
285+
(col-matrix [1 2 3])
286+
(row-matrix [4 5 6])))
287+
(block-diagonal-matrix (list (make-array #(2 0) 1)
288+
(make-array #(0 3) 1)))
289+
(block-diagonal-matrix (list (make-array #(0 3) 1)
290+
(make-array #(2 0) 1)))]
291+
292+
If @racket[Xs] is @racket[null], the result is an empty array with @tech{shape}
293+
@racket[#(0 0)].
294+
@examples[#:eval typed-eval
295+
(block-diagonal-matrix '())]
265296
}
266297

267298
@define[vandermonde-url]{http://en.wikipedia.org/wiki/Vandermonde_matrix}

‎math-lib/math/matrix.rkt‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
matrix-inverse
1717
matrix-solve)
1818
(except-in "private/matrix/matrix-constructors.rkt"
19+
block-diagonal-matrix
1920
vandermonde-matrix)
2021
(except-in "private/matrix/matrix-basic.rkt"
2122
matrix-1norm
@@ -85,6 +86,9 @@
8586
(require/untyped-contract
8687
(begin (require "private/matrix/matrix-types.rkt"))
8788
"private/matrix/matrix-constructors.rkt"
89+
[block-diagonal-matrix
90+
(All (A) (case-> ((Listof (Matrix A)) -> (Matrix (U A 0)))
91+
((Listof (Matrix A)) A -> (Matrix A))))]
8892
[vandermonde-matrix ((Listof Number) Integer -> (Matrix Number))])
8993

9094
(require/untyped-contract
@@ -188,6 +192,7 @@
188192
matrix-inverse
189193
matrix-solve
190194
;; matrix-constructors.rkt
195+
block-diagonal-matrix
191196
vandermonde-matrix
192197
;; matrix-basic.rkt
193198
matrix-1norm

‎math-lib/math/private/matrix/matrix-constructors.rkt‎

Lines changed: 28 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -85,16 +85,19 @@
8585
;; ===================================================================================================
8686
;; Block diagonal matrices
8787

88-
(: block-diagonal-matrix/zero* (All (A) (Vectorof (Matrix A)) A -> (Matrix A)))
88+
(: block-diagonal-matrix/zero* (All (A) (Vectorof (Array A)) A -> (Array A)))
8989
(define (block-diagonal-matrix/zero* as zero)
9090
(define num (vector-length as))
9191
(define-values (ms ns)
92-
(let-values ([(ms ns) (for/fold: ([ms : (Listof Index) empty]
93-
[ns : (Listof Index) empty]
94-
) ([a (in-vector as)])
95-
(define-values (m n) (matrix-shape a))
96-
(values (cons m ms) (cons n ns)))])
97-
(values (reverse ms) (reverse ns))))
92+
(for/foldr: ([ms : (Listof Index) empty]
93+
[ns : (Listof Index) empty]
94+
) ([a (in-vector as)])
95+
(define ds (array-shape a))
96+
(unless (= 2 (vector-length ds))
97+
(raise-argument-error 'block-diagonal-matrix "two-dimensional array" a))
98+
(define m (vector-ref ds 0))
99+
(define n (vector-ref ds 1))
100+
(values (cons m ms) (cons n ns))))
98101
(define res-m (assert (apply + ms) index?))
99102
(define res-n (assert (apply + ns) index?))
100103
(define vs ((inst make-vector Index) res-m 0))
@@ -136,19 +139,24 @@
136139
[else
137140
zero])))))
138141

139-
(: block-diagonal-matrix/zero (All (A) ((Listof (Matrix A)) A -> (Matrix A))))
140-
(define (block-diagonal-matrix/zero as zero)
141-
(let ([as (list->vector as)])
142-
(define num (vector-length as))
143-
(cond [(= num 0)
144-
(raise-argument-error 'block-diagonal-matrix/zero "nonempty List" as)]
145-
[(= num 1)
146-
(unsafe-vector-ref as 0)]
147-
[else
148-
(block-diagonal-matrix/zero* as zero)])))
149-
150-
(: block-diagonal-matrix (All (A) (case-> ((Listof (Matrix A)) -> (Matrix (U A 0)))
151-
((Listof (Matrix A)) A -> (Matrix A)))))
142+
(: block-diagonal-matrix/zero (All (A) (case-> (Null Any -> (Array Nothing))
143+
((Listof (Array A)) A -> (Array A)))))
144+
(define block-diagonal-matrix/zero
145+
(let ([id (build-simple-array #(0 0) (λ: ([js : Indexes])
146+
(error "this procedure should never be called")))])
147+
(λ (as zero)
148+
(if (null? as)
149+
id
150+
(let ([as (list->vector as)])
151+
(define num (vector-length as))
152+
(cond [(= num 1)
153+
(unsafe-vector-ref as 0)]
154+
[else
155+
(block-diagonal-matrix/zero* as zero)]))))))
156+
157+
(: block-diagonal-matrix (All (A) (case-> (Null -> (Array Nothing))
158+
((Listof (Array A)) -> (Array (U A 0)))
159+
((Listof (Array A)) A -> (Array A)))))
152160
(define block-diagonal-matrix
153161
(case-lambda
154162
[(as) (block-diagonal-matrix/zero as 0)]

‎math-test/math/tests/matrix-tests.rkt‎

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -191,11 +191,31 @@
191191
[0 0 0 0 0 5 0 0 0]
192192
[0 0 0 0 0 0 2 4 6]]))
193193

194+
(check-equal?
195+
(block-diagonal-matrix
196+
(list (matrix [[1 2] [3 4]])
197+
(make-array #(2 0) 1)
198+
(matrix [[1 2 3] [4 5 6]])
199+
(make-array #(0 2) 1)
200+
(matrix [[1] [3] [5]])
201+
(matrix [[2 4 6]])))
202+
(matrix [[1 2 0 0 0 0 0 0 0 0 0]
203+
[3 4 0 0 0 0 0 0 0 0 0]
204+
[0 0 0 0 0 0 0 0 0 0 0]
205+
[0 0 0 0 0 0 0 0 0 0 0]
206+
[0 0 1 2 3 0 0 0 0 0 0]
207+
[0 0 4 5 6 0 0 0 0 0 0]
208+
[0 0 0 0 0 0 0 1 0 0 0]
209+
[0 0 0 0 0 0 0 3 0 0 0]
210+
[0 0 0 0 0 0 0 5 0 0 0]
211+
[0 0 0 0 0 0 0 0 2 4 6]]))
212+
194213
(check-equal?
195214
(block-diagonal-matrix (map (λ: ([i : Integer]) (matrix [[i]])) '(1 2 3 4)))
196215
(diagonal-matrix '(1 2 3 4)))
197216

198-
(check-exn exn:fail:contract? (λ () (block-diagonal-matrix '())))
217+
(check-equal? (block-diagonal-matrix '())
218+
(build-simple-array #(0 0) (λ (_) (error "This procedure should never be called"))))
199219

200220
;; Vandermonde matrix
201221

0 commit comments

Comments
 (0)