suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit for `math/array' documentation; about 65% finished

Browse Source 
Replaced pointwise operators with macros that expand to applications of `array-map'; allows more precise return types and reduces compilation time

Changed literal array syntax to use #() to delimit rows instead of [] (still suggest using square parens, though)

Minor refactoring

Fixed a macro so that the only problem with "array-tests.rkt" now is that typed/rackunit is b0rked
This commit is contained in:
Neil Toronto 2012-11-24 22:12:58 -07:00
parent dd9d85feec
commit 3670916a11
22 changed files with 1631 additions and 646 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/math/array.rkt
View File

@ -50,4 +50,4 @@
Listof*
Vectorof*
Indexes
User-Indexes)
In-Indexes)

2
collects/math/private/array/array-comprehension.rkt
View File

@ -18,7 +18,7 @@
(with-syntax ([(maybe-fill ...) (if (attribute fill-expr) #'(#:fill fill-expr) #'())]
[(maybe-type ...) (if (attribute A) #'(: A) #'())])
(syntax/loc stx
(let*: ([ds : User-Indexes ds-expr]
(let*: ([ds : In-Indexes ds-expr]
[ds : Indexes (check-array-shape
ds (λ () (raise-argument-error 'name "Indexes" ds)))])
(define vs (for/vector #:length (array-shape-size ds) maybe-fill ...

122
collects/math/private/array/array-pointwise.rkt
View File

@ -1,63 +1,79 @@
#lang racket/base
(require typed/untyped-utils
(rename-in
(only-in "typed-array-pointwise.rkt"
array-map
array-sqrt
array-log
array<
array<=
array>
array>=
array=
array-not
array-and
array-or
array-if)
[array-map typed:array-map])
racket/math
(rename-in "typed-array-pointwise.rkt"
[array-map typed:array-map])
(rename-in "untyped-array-pointwise.rkt"
[array-map untyped:array-map]))
(define-typed/untyped-identifier array-map
typed:array-map untyped:array-map)
(require/untyped-contract
(begin (require "array-struct.rkt"))
"typed-array-pointwise.rkt"
[array-abs ((Array Real) -> (Array Real))]
[array-round ((Array Real) -> (Array Real))]
[array-floor ((Array Real) -> (Array Real))]
[array-ceiling ((Array Real) -> (Array Real))]
[array-truncate ((Array Real) -> (Array Real))]
[array-conjugate ((Array Number) -> (Array Number))]
[array-magnitude ((Array Number) -> (Array Real))]
[array-angle ((Array Number) -> (Array Real))]
[array-sqr ((Array Number) -> (Array Number))]
[array-exp ((Array Number) -> (Array Number))]
[array-sin ((Array Number) -> (Array Number))]
[array-cos ((Array Number) -> (Array Number))]
[array-tan ((Array Number) -> (Array Number))]
[array-asin ((Array Number) -> (Array Number))]
[array-acos ((Array Number) -> (Array Number))]
[array-atan ((Array Number) -> (Array Number))]
[array+ ((Array Number) (Array Number) -> (Array Number))]
[array* ((Array Number) (Array Number) -> (Array Number))]
[array- (case-> ((Array Number) -> (Array Number))
((Array Number) (Array Number) -> (Array Number)))]
[array/ (case-> ((Array Number) -> (Array Number))
((Array Number) (Array Number) -> (Array Number)))]
[array-scale ((Array Number) Number -> (Array Number))]
[array-expt ((Array Number) (Array Number) -> (Array Number))]
[array-min ((Array Real) (Array Real) -> (Array Real))]
[array-max ((Array Real) (Array Real) -> (Array Real))]
[array-inexact->exact ((Array Number) -> (Array Exact-Number))]
[array-exact->inexact ((Array Number) -> (Array Number))] ; should be Number -> Inexact-Number
[array-real->double-flonum ((Array Real) -> (Array Float))]
[array-number->float-complex ((Array Number) -> (Array Float-Complex))]
[array-real-part ((Array Number) -> (Array Real))]
[array-imag-part ((Array Number) -> (Array Real))]
[array-make-rectangular ((Array Real) (Array Real) -> (Array Number))])
(define-syntax-rule (define-array-op1 name op)
(define-syntax-rule (name arr) (array-map op arr)))
(define-syntax-rule (define-array-op2 name op)
(define-syntax-rule (name arr0 arr1) (array-map op arr0 arr1)))
(define-syntax-rule (define-array-op1+ name op)
(define-syntax-rule (name arr0 arrs (... ...)) (array-map op arr0 arrs (... ...))))
(define-syntax-rule (define-array-op2+ name op)
(define-syntax-rule (name arr0 arr1 arrs (... ...)) (array-map op arr0 arr1 arrs (... ...))))
(define-syntax-rule (define-array-op name op)
(define-syntax-rule (name arrs (... ...)) (array-map op arrs (... ...))))
(define-syntax-rule (array-scale arr x)
(inline-array-map (λ (y) (* x y)) arr))
(define-array-op1 array-abs abs)
(define-array-op1 array-round round)
(define-array-op1 array-floor floor)
(define-array-op1 array-ceiling ceiling)
(define-array-op1 array-truncate truncate)
(define-array-op1 array-conjugate conjugate)
(define-array-op1 array-magnitude magnitude)
(define-array-op1 array-angle angle)
(define-array-op1 array-sqrt sqrt)
(define-array-op1 array-log log)
(define-array-op1 array-sqr sqr)
(define-array-op1 array-exp exp)
(define-array-op1 array-sin sin)
(define-array-op1 array-cos cos)
(define-array-op1 array-tan tan)
(define-array-op1 array-asin asin)
(define-array-op1 array-acos acos)
(define-array-op1 array-atan atan)
(define-array-op1 array-inexact->exact inexact->exact)
(define-array-op1 array-exact->inexact exact->inexact)
(define-array-op1 array-fl real->double-flonum)
(define-array-op1 array-fc number->float-complex)
(define-array-op1 array-real-part real-part)
(define-array-op1 array-imag-part imag-part)
(define-array-op2 array-make-rectangular make-rectangular)
(define-array-op array+ +)
(define-array-op array* *)
(define-array-op1+ array- -)
(define-array-op1+ array/ /)
(define-array-op2 array-expt expt)
(define-array-op1+ array-min min)
(define-array-op1+ array-max max)
(define-array-op2+ array< <)
(define-array-op2+ array<= <=)
(define-array-op2+ array> >)
(define-array-op2+ array>= >=)
(define-array-op2+ array= =)
(define-array-op2 array-not not)
(define-syntax-rule (array-and arrs ...) (inline-array-map and arrs ...))
(define-syntax-rule (array-or arrs ...) (inline-array-map or arrs ...))
(define-syntax-rule (array-if arr0 arr1 arr2) (inline-array-map if arr0 arr1 arr2))
(provide
;; Mapping
@ -102,8 +118,8 @@
;; Number conversions
array-inexact->exact
array-exact->inexact
array-real->double-flonum
array-number->float-complex
array-fl
array-fc
array-real-part
array-imag-part
array-make-rectangular)

19
collects/math/private/array/array-print.rkt
View File

@ -3,6 +3,7 @@
;; Defines the custom printer used for array values
(require racket/pretty
racket/fixnum
"array-struct.rkt"
"utils.rkt")
@ -66,24 +67,24 @@
(define: js : Indexes (make-vector dims 0))
;; For each shape axis
(let i-loop ([#{i : Nonnegative-Fixnum} 0])
(cond [(i . < . dims) ; proves i : Index
(write-string "[" port)
(cond [(i . fx< . dims) ; proves i : Index
(write-string "#[" port)
(define di (vector-ref ds i)) ; length of axis i
;; For each index on this axis
(let ji-loop ([#{ji : Nonnegative-Fixnum} 0])
(when (ji . < . di) ; proves ji : Index
(when (ji . fx< . di) ; proves ji : Index
(vector-set! js i ji)
;; Print either nested elements or the element here
(i-loop (+ i 1))
(i-loop (fx+ i 1))
;; Print delimiter when not printing the last element on this axis
(when (ji . < . (- di 1))
(cond [(and (eq? layout 'compact) (= i (- dims 1)))
(when (ji . fx< . (fx- di 1))
(cond [(and (eq? layout 'compact) (fx= i (fx- dims 1)))
;; Keep elements on one line in compact layout
(write-string " " port)]
[else
;; +1 to indent past "(", +1 to indent past the first "[", and `i' axes
(maybe-print-newline (+ 2 i))]))
(ji-loop (+ ji 1))))
;; +1 to indent past "(", +2 to indent past the first "#[", and `i' axes
(maybe-print-newline (+ 3 (* i 2)))]))
(ji-loop (fx+ ji 1))))
(write-string "]" port)]
[else
;; Print an element

3
collects/math/private/array/array-sequence.rkt
View File

@ -5,6 +5,7 @@
typed-racket/base-env/prims
racket/unsafe/ops
"array-struct.rkt"
"utils.rkt"
(except-in "typed-array-sequence.rkt" in-array-indexes))
(require/untyped-contract
@ -56,7 +57,7 @@
[(x)
(:do-in
([(ds size dims js)
(let*: ([ds : User-Indexes ds-expr]
(let*: ([ds : In-Indexes ds-expr]
[ds : Indexes (check-array-shape
ds (λ () (raise-argument-error 'in-array-indexes "Indexes"
ds)))])

2
collects/math/private/array/array-struct.rkt
View File

@ -46,6 +46,4 @@
(syntax-parse stx
[(_ e:expr)
(syntax/loc stx (array/syntax array list flat-list->array e))]
[(_ e:expr T:expr)
(syntax/loc stx (array/syntax array list (inst flat-list->array T) e))]
[_:id (raise-syntax-error 'array "not allowed as an expression" stx)]))

51
collects/math/private/array/array-syntax.rkt
View File

@ -4,41 +4,40 @@
(provide array/syntax)
(define-for-syntax (square-bracket? e-stx)
(eq? #\[ (syntax-property e-stx 'paren-shape)))
(define-for-syntax (syntax-vector-shape e-stx)
(syntax-case e-stx ()
[#[] (list 0)]
[#[e0 e ...]
(let ([lst (syntax->list #'(e0 e ...))])
(define d (length lst))
(define ds (syntax-vector-shape (car lst)))
(if ds
(let loop ([lst (cdr lst)])
(cond [(null? lst) (cons d ds)]
[(equal? ds (syntax-vector-shape (car lst)))
(loop (cdr lst))]
[else #f]))
#f))]
[_ null]))
(define-for-syntax (syntax-list-shape e-stx)
(define lst (syntax->list e-stx))
(cond [(or (not lst) (not (square-bracket? e-stx))) null]
[(null? lst) (list 0)]
[else
(define d (length lst))
(define ds (syntax-list-shape (car lst)))
(if ds
(let loop ([lst (cdr lst)])
(cond [(null? lst) (cons d ds)]
[(equal? ds (syntax-list-shape (car lst)))
(loop (cdr lst))]
[else #f]))
#f)]))
(define-for-syntax (syntax-list-flatten e-stx)
(define-for-syntax (syntax-vector-flatten e-stx)
(reverse
(let loop ([e-stx e-stx] [acc null])
(define lst (syntax->list e-stx))
(cond [(and lst (square-bracket? e-stx))
(for/fold ([acc acc]) ([lst (in-list lst)])
(loop lst acc))]
[else
(cons e-stx acc)]))))
(syntax-case e-stx ()
[#[e ...]
(let ([lst (syntax->list #'(e ...))])
(for/fold ([acc acc]) ([lst (in-list lst)])
(loop lst acc)))]
[else
(cons e-stx acc)]))))
(define-syntax (array/syntax stx)
(syntax-case stx ()
[(_ orig-name constr ->array e)
(let ([ds (syntax-list-shape #'e)])
(let ([ds (syntax-vector-shape #'e)])
(unless ds
(raise-syntax-error (syntax->datum #'orig-name) "expected rectangular data" stx #'e))
(with-syntax ([(d ...) ds]
[(v ...) (syntax-list-flatten #'e)])
[(v ...) (syntax-vector-flatten #'e)])
(syntax/loc stx
(->array (vector d ...) (constr v ...)))))]))

5
collects/math/private/array/mutable-array.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require typed/untyped-utils
typed/racket/base
(for-syntax racket/base syntax/parse)
"array-syntax.rkt"
(except-in "typed-mutable-array.rkt"
@ -26,9 +27,9 @@
flat-vector->matrix)
(define-syntax (mutable-array stx)
(syntax-parse stx
(syntax-parse stx #:literals (:)
[(_ e:expr)
(syntax/loc stx (array/syntax mutable-array vector make-mutable-array e))]
[(_ e:expr T:expr)
[(_ e:expr : T:expr)
(syntax/loc stx (array/syntax mutable-array (inst vector T) make-mutable-array e))]
[_:id (raise-syntax-error 'mutable-array "not allowed as an expression" stx)]))

8
collects/math/private/array/typed-array-constructors.rkt
View File

@ -6,13 +6,13 @@
(provide (all-defined-out))
(: make-array (All (A) (User-Indexes A -> (Array A))))
(: make-array (All (A) (In-Indexes A -> (Array A))))
(define (make-array ds v)
(let ([ds (check-array-shape
ds (λ () (raise-argument-error 'make-array "(Vectorof Index)" 0 ds v)))])
(unsafe-build-array ds (λ (js) v))))
(: axis-index-array (User-Indexes Integer -> (Array Index)))
(: axis-index-array (In-Indexes Integer -> (Array Index)))
(define (axis-index-array ds k)
(let* ([ds (check-array-shape
ds (λ () (raise-argument-error 'axis-index-array "(Vectorof Index)" 0 ds k)))]
@ -21,14 +21,14 @@
(unsafe-build-array ds (λ: ([js : Indexes]) (unsafe-vector-ref js k)))]
[else (raise-argument-error 'axis-index-array (format "Index < ~a" dims) 1 ds k)])))
(: index-array (User-Indexes -> (Array Index)))
(: index-array (In-Indexes -> (Array Index)))
(define (index-array ds)
(let ([ds (check-array-shape
ds (λ () (raise-argument-error 'index-array "(Vectorof Index)" ds)))])
(unsafe-build-array ds (λ: ([js : Indexes])
(assert (unsafe-array-index->value-index ds js) index?)))))
(: indexes-array (User-Indexes -> (Array Indexes)))
(: indexes-array (In-Indexes -> (Array Indexes)))
(define (indexes-array ds)
(let ([ds (check-array-shape
ds (λ () (raise-argument-error 'indexes-array "(Vectorof Index)" ds)))])

12
collects/math/private/array/typed-array-indexing.rkt
View File

@ -27,11 +27,11 @@
(define (unsafe-array-set! arr js v)
((unsafe-settable-array-set-proc arr) js v))
(: array-ref (All (A) ((Array A) User-Indexes -> A)))
(: array-ref (All (A) ((Array A) In-Indexes -> A)))
(define (array-ref arr js)
((unsafe-array-proc arr) (check-array-indexes 'array-ref (array-shape arr) js)))
(: array-set! (All (A) ((Settable-Array A) User-Indexes A -> Void)))
(: array-set! (All (A) ((Settable-Array A) In-Indexes A -> Void)))
(define (array-set! arr js v)
(define ds (array-shape arr))
(define set-proc (unsafe-settable-array-set-proc arr))
@ -42,13 +42,13 @@
;; ===================================================================================================
;; Indexing using array of indexes
(: array-indexes-ref (All (A) ((Array A) (Array User-Indexes) -> (Array A))))
(: array-indexes-ref (All (A) ((Array A) (Array In-Indexes) -> (Array A))))
(define (array-indexes-ref arr idxs)
(define ds (array-shape idxs))
(define idxs-proc (unsafe-array-proc idxs))
(unsafe-build-array ds (λ: ([js : Indexes]) (array-ref arr (idxs-proc js)))))
(: array-indexes-set! (All (A) ((Settable-Array A) (Array User-Indexes) (Array A) -> Void)))
(: array-indexes-set! (All (A) ((Settable-Array A) (Array In-Indexes) (Array A) -> Void)))
(define (array-indexes-set! arr idxs vals)
(define ds (array-shape-broadcast (list (array-shape idxs) (array-shape vals))))
(let ([idxs (array-broadcast idxs ds)]
@ -230,14 +230,14 @@
;; number of indexes should match
(define num-specs (length slices))
(unless (= dims num-specs)
(error 'array-slice-ref "expected list with ~e slices; given ~e in ~e"
(error 'array-slice-ref "expected list with ~e slice specifications; given ~e in ~e"
dims num-specs orig-slices))
(let-values ([(arr jss) (slices->array-axis-transform 'array-slice-ref arr slices)])
(for/fold ([arr (unsafe-array-axis-transform arr jss)]) ([na (in-list new-axes)])
(match-define (cons k dk) na)
(array-axis-insert arr k dk)))))
(: slice-indexes-array (User-Indexes (Listof Slice-Spec) -> (Array Indexes)))
(: slice-indexes-array (In-Indexes (Listof Slice-Spec) -> (Array Indexes)))
(define (slice-indexes-array ds slices)
(array-slice-ref (indexes-array ds) slices))

301
collects/math/private/array/typed-array-pointwise.rkt
View File

@ -1,18 +1,16 @@
#lang typed/racket/base
(require (only-in racket/math conjugate)
(for-syntax racket/base)
"array-struct.rkt"
(require "array-struct.rkt"
"array-broadcast.rkt"
"utils.rkt"
(only-in "untyped-array-pointwise.rkt" inline-array-map))
(provide (all-defined-out))
(provide array-map)
(: array-map (All (R A B T ...)
(case-> ((-> R) -> (Array R))
((A -> R) (Array A) -> (Array R))
((A B T ... T -> R) (Array A) (Array B) (Array T) ... T -> (Array R)))))
(case-> ((-> R) -> (Array R))
((A -> R) (Array A) -> (Array R))
((A B T ... T -> R) (Array A) (Array B) (Array T) ... T -> (Array R)))))
(define array-map
(case-lambda:
[([f : (-> R)])
@ -34,292 +32,3 @@
(unsafe-build-array
ds (λ: ([js : Indexes]) (apply f (g0 js) (g1 js)
(map (λ: ([g : (Indexes -> T)]) (g js)) gs)))))]))
;; ===================================================================================================
;; Pointwise operation types
(define-syntax (declare-case-type stx)
(syntax-case stx (->)
[(_ name [(A ... -> B) ...])
(syntax/loc stx
(: name (case-> ((Array A) ... -> (Array B)) ...)))]))
(define-syntax-rule (declare-case-types (name ...) Ts)
(begin (declare-case-type name Ts) ...))
(declare-case-types
(array-abs)
[(Integer -> Integer)
(Exact-Rational -> Exact-Rational)
(Float -> Float)
(Real -> Real)])
(declare-case-types
(array-round array-floor array-ceiling array-truncate)
[(Integer -> Integer)
(Exact-Rational -> Integer)
(Float -> Float)
(Real -> Real)])
(declare-case-types
(array-sqrt array-log)
[(Number -> Number)])
(declare-case-types
(array-conjugate array-sqr)
[(Integer -> Integer)
(Exact-Rational -> Exact-Rational)
(Float -> Float)
(Real -> Real)
(Float-Complex -> Float-Complex)
(Number -> Number)])
(declare-case-types
(array-magnitude)
[;(Integer -> Integer) ; should be allowed
(Exact-Rational -> Exact-Rational)
(Float -> Real) ; should be Float -> Float
(Real -> Real)
(Float-Complex -> Float)
(Number -> Real)])
(declare-case-types
(array-angle)
[(Real -> Real)
(Float-Complex -> Float)
(Number -> Real)])
(declare-case-types
(array-exp array-sin array-cos array-tan array-asin array-acos array-atan)
[(Float -> Float)
(Real -> Real)
(Float-Complex -> Float-Complex)
(Number -> Number)])
(declare-case-types
(array+)
[(Integer Integer -> Integer)
(Exact-Rational Exact-Rational -> Exact-Rational)
(Float Float -> Float)
(Real Float -> Float)
(Float Real -> Float)
(Real Real -> Real)
(Float-Complex Float-Complex -> Float-Complex)
(Float-Complex Number -> Float-Complex)
(Number Float-Complex -> Float-Complex)
(Number Number -> Number)])
(declare-case-types
(array*)
[(Integer Integer -> Integer)
(Exact-Rational Exact-Rational -> Exact-Rational)
(Float Float -> Float)
(Real Real -> Real)
(Float-Complex Float-Complex -> Float-Complex)
(Number Number -> Number)])
(declare-case-types
(array-)
[(Integer -> Integer)
(Exact-Rational -> Exact-Rational)
(Float -> Float)
(Real -> Real)
;(Float-Complex -> Float-Complex) ; should be allowed
(Number -> Number)
(Integer Integer -> Integer)
(Exact-Rational Exact-Rational -> Exact-Rational)
(Float Float -> Float)
(Real Float -> Float)
(Float Real -> Float)
(Real Real -> Real)
(Float-Complex Float-Complex -> Float-Complex)
(Float-Complex Number -> Float-Complex)
(Number Float-Complex -> Float-Complex)
(Number Number -> Number)])
(declare-case-types
(array/)
[(Exact-Rational -> Exact-Rational)
(Float -> Float)
(Real -> Real)
;(Float-Complex -> Float-Complex) ; should be allowed
(Number -> Number)
(Exact-Rational Exact-Rational -> Exact-Rational)
(Float Float -> Float)
(Float Real -> Float)
(Real Real -> Real)
(Float-Complex Float-Complex -> Float-Complex)
;(Float-Complex Number -> Float-Complex) ; should be allowed
(Number Number -> Number)])
(: array-scale
(case->
((Array Integer) Integer -> (Array Integer))
((Array Exact-Rational) Exact-Rational -> (Array Exact-Rational))
((Array Float) Float -> (Array Float))
((Array Real) Real -> (Array Real))
((Array Float-Complex) Float-Complex -> (Array Float-Complex))
((Array Number) Number -> (Array Number))))
(declare-case-types
(array-expt)
[(Integer Integer -> Exact-Rational)
(Exact-Rational Integer -> Exact-Rational)
;(Float Float -> Float-Complex) ; should be allowed
(Real Real -> Number)
(Float-Complex Float-Complex -> Float-Complex)
(Number Number -> Number)])
(declare-case-types
(array-min array-max)
[(Integer Integer -> Integer)
(Exact-Rational Exact-Rational -> Exact-Rational)
(Float Float -> Float)
(Real Real -> Real)])
(: array= ((Array Number) (Array Number) -> (Array Boolean)))
(declare-case-types
(array< array<= array> array>=)
[(Real Real -> Boolean)])
(: array-not ((Array Any) -> (Array Boolean)))
(: array-and (All (A B) ((Array A) (Array B) -> (Array (U B #f)))))
(: array-or (All (A) ((Array A) (Array A) -> (Array A))))
(: array-if (All (A) ((Array Any) (Array A) (Array A) -> (Array A))))
(declare-case-types
(array-inexact->exact)
[(Real -> Exact-Rational)
(Number -> Exact-Number)])
(declare-case-types
(array-exact->inexact)
[(Integer -> Float)
(Exact-Rational -> Float)
(Float -> Float)
(Real -> Inexact-Real)
(Float-Complex -> Float-Complex)
;(Exact-Number -> Float-Complex) ; should be allowed
(Number -> Number) ; should be Number -> Inexact-Number
])
(: array-real->double-flonum ((Array Real) -> (Array Float)))
(: array-number->float-complex ((Array Number) -> (Array Float-Complex)))
(declare-case-types
(array-real-part)
[;(Integer -> Integer) ; should be allowed
(Exact-Rational -> Exact-Rational)
;(Float -> Float) ; should be allowed
(Real -> Real)
(Float-Complex -> Float)
(Number -> Real)])
(declare-case-types
(array-imag-part)
[;(Real -> Zero) ; should be allowed
(Real -> Real)
(Float-Complex -> Float)
(Number -> Real)])
(declare-case-types
(array-make-rectangular)
[(Exact-Rational Exact-Rational -> Exact-Number)
(Float Float -> Float-Complex)
(Float Real -> Float-Complex)
(Real Float -> Float-Complex)
(Real Real -> Number)])
;; ===================================================================================================
;; Pointwise operations
#|
The lift operators could be just functions, but then it wouldn't be possible to give the results more
precise types. For example, if `array-lift1' were a higher-order function, (array-lift1 exp) could
only have the type
((Array Number) -> (Array Number))
or the type
((Array Real) -> (Array Real))
Since `array-lift1' is a macro, (array-lift1 exp) can have the type
(case-> ((Array Real) -> (Array Real))
((Array Number) -> (Array Number)))
IOW, the macro lift operators allow us to have array-exp do the job of both array-real-exp and
array-number-exp.
|#
(define-syntax (array-lift1 stx)
(syntax-case stx ()
[(_ f) (syntax/loc stx (λ (arr) (inline-array-map f arr)))]))
(define-syntax (array-lift2 stx)
(syntax-case stx ()
[(_ f) (syntax/loc stx (λ (arr1 arr2) (inline-array-map f arr1 arr2)))]))
(define-syntax (array-lift3 stx)
(syntax-case stx ()
[(_ f) (syntax/loc stx (λ (arr1 arr2 arr3) (inline-array-map f arr1 arr2 arr3)))]))
(define array-abs (array-lift1 abs))
(define array-round (array-lift1 round))
(define array-floor (array-lift1 floor))
(define array-ceiling (array-lift1 ceiling))
(define array-truncate (array-lift1 truncate))
(define array-sqr (array-lift1 (λ (z) (* z z))))
(define array-sqrt (array-lift1 sqrt))
(define array-conjugate (array-lift1 conjugate))
(define array-magnitude (array-lift1 magnitude))
(define array-angle (array-lift1 angle))
(define array-log (array-lift1 log))
(define array-exp (array-lift1 exp))
(define array-sin (array-lift1 sin))
(define array-cos (array-lift1 cos))
(define array-tan (array-lift1 tan))
(define array-asin (array-lift1 asin))
(define array-acos (array-lift1 acos))
(define array-atan (array-lift1 atan))
(define array+ (array-lift2 +))
(define array* (array-lift2 *))
(define array-
(case-lambda
[(arr) (inline-array-map - arr)]
[(arr1 arr2) (inline-array-map - arr1 arr2)]))
(define array/
(case-lambda
[(arr) (inline-array-map / arr)]
[(arr1 arr2) (inline-array-map / arr1 arr2)]))
(define (array-scale arr s) ((array-lift1 (λ (x) (* s x))) arr))
(define array-expt (array-lift2 expt))
(define array-min (array-lift2 min))
(define array-max (array-lift2 max))
(define array= (array-lift2 =))
(define array< (array-lift2 <))
(define array<= (array-lift2 <=))
(define array> (array-lift2 >))
(define array>= (array-lift2 >=))
(define array-not (array-lift1 not))
(define array-and (array-lift2 and))
(define array-if (array-lift3 if))
(define array-or (array-lift2 or))
(define array-inexact->exact (array-lift1 inexact->exact))
(define array-exact->inexact (array-lift1 exact->inexact))
(define array-real->double-flonum (array-lift1 real->double-flonum))
(define array-number->float-complex (array-lift1 (λ: ([x : Number]) (+ x 0.0+0.0i))))
(define array-real-part (array-lift1 real-part))
(define array-imag-part (array-lift1 imag-part))
(define array-make-rectangular (array-lift2 make-rectangular))

2
collects/math/private/array/typed-array-sequence.rkt
View File

@ -33,7 +33,7 @@
;; ===================================================================================================
;; Sequence of indexes
(: in-array-indexes (User-Indexes -> (Sequenceof Indexes)))
(: in-array-indexes (In-Indexes -> (Sequenceof Indexes)))
(define (in-array-indexes ds)
(let: ([ds : Indexes (check-array-shape
ds (λ () (raise-argument-error 'in-array-indexes "Indexes" ds)))])

12
collects/math/private/array/typed-array-struct.rkt
View File

@ -47,6 +47,12 @@
size ds)]))]
[else (values (vector->immutable-vector ds) size strict? proc)]))
#|
(: array-procedure (All (A) ((Array A) In-Indexes -> A)))
(define (array-procedure arr js)
((Array-unsafe-proc arr) (check-array-indexes 'array-ref (Array-shape arr) js)))
|#
(struct: (A) Array ([shape : Indexes]
[size : Index]
[strict? : Boolean]
@ -55,6 +61,8 @@
#:property prop:custom-print-quotable 'never
#:property prop:custom-write (λ (arr port mode) ((array-custom-printer) arr 'array port mode))
#:property prop:equal+hash (list array-recur-equal? array-hash-code array-hash-code)
;; It would be really nice to do this, but TR can't right now:
;#:property prop:procedure array-procedure
)
(define-syntax-rule (make-unsafe-array-proc ds ref)
@ -65,7 +73,7 @@
(begin-encourage-inline
(define (array-dims arr) (vector-length (Array-shape arr))))
(: build-array (All (A) (User-Indexes (Indexes -> A) -> (Array A))))
(: build-array (All (A) (In-Indexes (Indexes -> A) -> (Array A))))
(define (build-array ds proc)
(let ([ds (check-array-shape
ds (λ () (raise-argument-error 'build-array "(Vectorof Index)" 0 ds proc)))])
@ -147,7 +155,7 @@
(define lst null)
(for-each-array-index ds (λ (js) (set! lst (cons (proc js) lst))))
(write-string "[" port)
(write-string "#[" port)
(unless (null? lst)
(let ([lst (reverse lst)])
(recur-print (car lst) port)

4
collects/math/private/array/typed-array-transform.rkt
View File

@ -11,7 +11,7 @@
;; ===================================================================================================
;; Arbitrary transforms
(: array-transform (All (A) ((Array A) User-Indexes (Indexes -> User-Indexes) -> (Array A))))
(: array-transform (All (A) ((Array A) In-Indexes (Indexes -> In-Indexes) -> (Array A))))
(define (array-transform arr new-ds idx-fun)
(define old-ds (array-shape arr))
(define old-f (unsafe-array-proc arr))
@ -111,7 +111,7 @@
;; ===================================================================================================
;; Reshape
(: array-reshape (All (A) ((Array A) User-Indexes -> (Array A))))
(: array-reshape (All (A) ((Array A) In-Indexes -> (Array A))))
(define (array-reshape arr ds)
(let ([ds (check-array-shape
ds (λ () (raise-argument-error 'array-reshape "(Vectorof Index)" 1 arr ds)))])

2
collects/math/private/array/typed-mutable-array.rkt
View File

@ -23,7 +23,7 @@
(define set-proc (make-unsafe-array-set-proc A ds (λ (j v) (unsafe-vector-set! vs j v))))
(Mutable-Array ds (vector-length vs) #t proc set-proc vs))
(: make-mutable-array (All (A) (User-Indexes (Vectorof A) -> (Mutable-Array A))))
(: make-mutable-array (All (A) (In-Indexes (Vectorof A) -> (Mutable-Array A))))
(define (make-mutable-array ds vs)
(let* ([ds (check-array-shape
ds (λ () (raise-argument-error 'make-mutable-array "(Vectorof Index)" 0 ds vs)))]

10
collects/math/private/array/typed-utils.rkt
View File

@ -12,7 +12,7 @@
(define-type (Vectorof* A) (Rec T (U A (Vectorof T))))
(define-type Indexes (Vectorof Index))
(define-type User-Indexes (U (Vectorof Integer) Indexes))
(define-type In-Indexes (U (Vectorof Integer) Indexes))
(begin-encourage-inline
@ -37,7 +37,7 @@
(loop (+ i 1) (* n d))]
[else n])))
(: check-array-shape (User-Indexes (-> Nothing) -> Indexes))
(: check-array-shape (In-Indexes (-> Nothing) -> Indexes))
(define (check-array-shape ds fail)
(define dims (vector-length ds))
(define: new-ds : Indexes (make-vector dims 0))
@ -77,12 +77,12 @@
(define: empty-vectorof-index : Indexes
#())
(: raise-array-index-error (Symbol Indexes User-Indexes -> Nothing))
(: raise-array-index-error (Symbol Indexes In-Indexes -> Nothing))
(define (raise-array-index-error name ds js)
(error name "expected indexes for shape ~e; given ~e"
(vector->list ds) js))
(: array-index->value-index (Symbol Indexes User-Indexes -> Nonnegative-Fixnum))
(: array-index->value-index (Symbol Indexes In-Indexes -> Nonnegative-Fixnum))
(define (array-index->value-index name ds js)
(define (raise-index-error) (raise-array-index-error name ds js))
(define dims (vector-length ds))
@ -96,7 +96,7 @@
[else (raise-index-error)])]
[else j])))
(: check-array-indexes (Symbol Indexes User-Indexes -> Indexes))
(: check-array-indexes (Symbol Indexes In-Indexes -> Indexes))
(define (check-array-indexes name ds js)
(define (raise-index-error) (raise-array-index-error name ds js))
(define dims (vector-length ds))

12
collects/math/private/array/untyped-array-convert.rkt
View File

@ -17,7 +17,7 @@
(define (maybe-list->vector vs)
(and vs (list->vector vs)))
(: vector-shape (All (A) ((Vectorof* A) ((Vectorof* A) -> Boolean : A)
(: vector-shape (All (A) ((Vectorof* A) ((Vectorof* A) -> Any : A)
-> (U #f (Vectorof Integer)))))
(define (vector-shape vec pred?)
(maybe-list->vector
@ -36,7 +36,7 @@
[else #f]))
#f)])]))))
(: list-shape (All (A) ((Listof* A) ((Listof* A) -> Boolean : A) -> (U #f (Vectorof Integer)))))
(: list-shape (All (A) ((Listof* A) ((Listof* A) -> Any : A) -> (U #f (Vectorof Integer)))))
(define (list-shape lst pred?)
(maybe-list->vector
(let: list-shape : (U #f (Listof Integer)) ([lst : (Listof* A) lst])
@ -56,7 +56,7 @@
;; ===============================================================================================
;; Conversion to arrays
(: first* (All (A) ((Listof* A) ((Listof* A) -> Boolean : A) -> A)))
(: first* (All (A) ((Listof* A) ((Listof* A) -> Any : A) -> A)))
(define (first* lst pred?)
(let/ec: return : A
(let: loop : A ([lst : (Listof* A) lst])
@ -65,7 +65,7 @@
(loop lst))
(error 'first* "no first* element")]))))
(: list*->flat-vector (All (A) ((Listof* A) Integer ((Listof* A) -> Boolean : A) -> (Vectorof A))))
(: list*->flat-vector (All (A) ((Listof* A) Integer ((Listof* A) -> Any : A) -> (Vectorof A))))
(define (list*->flat-vector lst size pred?)
(cond [(zero? size) (vector)]
[else
@ -77,7 +77,7 @@
(loop lst i))]))
vec]))
(: list*->array (All (A) ((Listof* A) ((Listof* A) -> Boolean : A) -> (Array A))))
(: list*->array (All (A) ((Listof* A) ((Listof* A) -> Any : A) -> (Array A))))
(define (list*->array lst pred?)
(define (raise-shape-error)
;; don't have to worry about non-Index size - can't fit in memory anyway
@ -90,7 +90,7 @@
(unsafe-mutable-array ds (list*->flat-vector lst size pred?)))]
[else (raise-shape-error)]))
(: vector*->array (All (A) ((Vectorof* A) (Any -> Boolean : A) -> (Array A))))
(: vector*->array (All (A) ((Vectorof* A) ((Vectorof* A) -> Any : A) -> (Array A))))
(define (vector*->array vec pred?)
(define (raise-shape-error)
;; don't have to worry about non-Index size - can't fit in memory anyway

7
collects/math/private/matrix/matrix-pointwise.rkt
View File

@ -47,8 +47,11 @@
((Matrix Number) -> (Matrix Number))
((Matrix Real) (Matrix Real) -> (Matrix Real))
((Matrix Number) (Matrix Number) -> (Matrix Number))))
(: matrix.sqr (case-> ((Matrix Real) -> (Matrix Real))
((Matrix Number) -> (Matrix Number))))
(: matrix.magnitude ((Matrix Number) -> (Matrix Real)))
(define matrix+ (make-matrix-pointwise2 'matrix+ array+))
(define matrix- (make-matrix-pointwise1/2 'matrix- array-))
(define matrix.sqr array-sqr)
(define matrix.magnitude array-magnitude)
(define matrix.sqr (make-matrix-pointwise1 'matrix.sqr array-sqr))
(define matrix.magnitude (make-matrix-pointwise1 'matrix.magnitude array-magnitude))

1331
collects/math/scribblings/math-array.scrbl
View File

File diff suppressed because it is too large Load Diff

3
collects/math/scribblings/rename-defines.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require (for-syntax racket/base))
(require (for-syntax racket/base)
(only-in typed/racket/base define:))
(provide rename-defines)

337
collects/math/tests/array-tests.rkt
View File

@ -164,8 +164,8 @@
(let ([arr (build-array #(3 3) (inst vector->list Index))])
(check-equal? (array->vector* arr) #[#[(0 0) (0 1) (0 2)]
#[(1 0) (1 1) (1 2)]
#[(2 0) (2 1) (2 2)]])
#[(1 0) (1 1) (1 2)]
#[(2 0) (2 1) (2 2)]])
(check-equal? arr (vector*->array (array->vector* arr) listof-index?)))
(let ([arr (build-array #(2 2 2) (inst vector->list Index))])
@ -193,37 +193,37 @@
(check-equal? (array 1.0)
(list*->array 1.0 flonum?))
(check-equal? (array [])
(check-equal? (array #[])
(list*->array '[] flonum?))
(check-equal? (array [[]])
(check-equal? (array #[#[]])
(list*->array '[[]] flonum?))
(check-equal? (array [1.0])
(check-equal? (array #[1.0])
(list*->array '[1.0] flonum?))
(check-equal? (array [[1.0]])
(check-equal? (array #[#[1.0]])
(list*->array '[[1.0]] flonum?))
(check-equal? (array [[[1.0]]])
(check-equal? (array #[#[#[1.0]]])
(list*->array '[[[1.0]]] flonum?))
(check-equal? (mutable-array 1.0)
(list*->array 1.0 flonum?))
(check-equal? (mutable-array [])
(check-equal? (mutable-array #[])
(list*->array '[] flonum?))
(check-equal? (mutable-array [[]])
(check-equal? (mutable-array #[#[]])
(list*->array '[[]] flonum?))
(check-equal? (mutable-array [1.0])
(check-equal? (mutable-array #[1.0])
(list*->array '[1.0] flonum?))
(check-equal? (mutable-array [[1.0]])
(check-equal? (mutable-array #[#[1.0]])
(list*->array '[[1.0]] flonum?))
(check-equal? (mutable-array [[[1.0]]])
(check-equal? (mutable-array #[#[#[1.0]]])
(list*->array '[[[1.0]]] flonum?))
;; ---------------------------------------------------------------------------------------------------
@ -239,8 +239,8 @@
(check-exn exn? (λ () (axis-index-array #() 0)))
(check-equal? (index-array #()) (array 0))
(check-equal? (index-array #(4)) (array [0 1 2 3]))
(check-equal? (index-array #(2 2)) (array [[0 1] [2 3]]))
(check-equal? (index-array #(4)) (array #[0 1 2 3]))
(check-equal? (index-array #(2 2)) (array #[#[0 1] #[2 3]]))
(check-equal? (indexes-array #(3 3))
(build-array #(3 3) (λ: ([js : Indexes]) (vector-copy js))))
@ -249,56 +249,56 @@
(array 1.0))
(check-equal? (diagonal-array 1 0 1.0 0.0)
(array []))
(array #[]))
(check-equal? (diagonal-array 1 1 1.0 0.0)
(array [1.0]))
(array #[1.0]))
(check-equal? (diagonal-array 2 1 1.0 0.0)
(array [[1.0]]))
(array #[#[1.0]]))
(check-equal? (diagonal-array 2 2 1.0 0.0)
(array [[1.0 0.0] [0.0 1.0]]))
(array #[#[1.0 0.0] #[0.0 1.0]]))
(check-equal? (diagonal-array 3 2 1.0 0.0)
(array [[[1.0 0.0] [0.0 0.0]]
[[0.0 0.0] [0.0 1.0]]]))
(array #[#[#[1.0 0.0] #[0.0 0.0]]
#[#[0.0 0.0] #[0.0 1.0]]]))
;; ---------------------------------------------------------------------------------------------------
;; Pointwise
;; Not much to test here because most pointwise ops are defined by the same two lifts
(check-equal? (array-sqrt (array [1.0 4.0 9.0 16.0]))
(array [1.0 2.0 3.0 4.0]))
(check-equal? (array-sqrt (array #[1.0 4.0 9.0 16.0]))
(array #[1.0 2.0 3.0 4.0]))
(check-equal? (array+ (array [1.0 2.0])
(array [10.0 20.0]))
(array [11.0 22.0]))
(check-equal? (array+ (array #[1.0 2.0])
(array #[10.0 20.0]))
(array #[11.0 22.0]))
(check-equal? (array-map inexact->exact (array [1.0 2.0]))
(array [1 2]))
(check-equal? (array-map inexact->exact (array #[1.0 2.0]))
(array #[1 2]))
(check-equal? (array-map (inst cons Float Float)
(array [1.0 2.0])
(array [10.0 20.0]))
(array #[1.0 2.0])
(array #[10.0 20.0]))
(make-mutable-array #(2) #[(1.0 . 10.0) (2.0 . 20.0)]))
;; ---------------------------------------------------------------------------------------------------
;; Fold
(let ([arr (array [[ 1.0 4.0 9.0 16.0]
[-1.0 -4.0 -9.0 -16.0]])])
(check-equal? (array-axis-sum arr 0) (array [0.0 0.0 0.0 0.0]))
(check-equal? (array-axis-prod arr 0) (array [-1.0 -16.0 -81.0 -256.0]))
(check-equal? (array-axis-min arr 0) (array [-1.0 -4.0 -9.0 -16.0]))
(check-equal? (array-axis-max arr 0) (array [ 1.0 4.0 9.0 16.0]))
(let ([arr (array #[#[ 1.0 4.0 9.0 16.0]
#[-1.0 -4.0 -9.0 -16.0]])])
(check-equal? (array-axis-sum arr 0) (array #[0.0 0.0 0.0 0.0]))
(check-equal? (array-axis-prod arr 0) (array #[-1.0 -16.0 -81.0 -256.0]))
(check-equal? (array-axis-min arr 0) (array #[-1.0 -4.0 -9.0 -16.0]))
(check-equal? (array-axis-max arr 0) (array #[ 1.0 4.0 9.0 16.0]))
(check-equal? (array-axis-fold arr 0 (inst cons Float (Listof Float)) null)
(list*->array '[[-1.0 1.0] [-4.0 4.0] [-9.0 9.0] [-16.0 16.0]]
listof-flonum?))
(check-equal? (array-axis-sum arr 1) (array [30.0 -30.0]))
(check-equal? (array-axis-prod arr 1) (array [576.0 576.0]))
(check-equal? (array-axis-min arr 1) (array [1.0 -16.0]))
(check-equal? (array-axis-max arr 1) (array [16.0 -1.0]))
(check-equal? (array-axis-sum arr 1) (array #[30.0 -30.0]))
(check-equal? (array-axis-prod arr 1) (array #[576.0 576.0]))
(check-equal? (array-axis-min arr 1) (array #[1.0 -16.0]))
(check-equal? (array-axis-max arr 1) (array #[16.0 -1.0]))
(check-equal? (array-axis-fold arr 1 (inst cons Float (Listof Float)) null)
(list*->array '[[ 16.0 9.0 4.0 1.0]
[-16.0 -9.0 -4.0 -1.0]]
@ -309,18 +309,18 @@
(check-equal? (array-all-max arr) 16.0))
(let ([arr (make-array #(3 0) 0)])
(check-equal? (array-axis-sum arr 0) (array []))
(check-equal? (array-axis-prod arr 0) (array []))
(check-equal? (array-axis-min arr 0) (array []))
(check-equal? (array-axis-max arr 0) (array []))
(check-equal? (array-axis-sum arr 0) (array #[]))
(check-equal? (array-axis-prod arr 0) (array #[]))
(check-equal? (array-axis-min arr 0) (array #[]))
(check-equal? (array-axis-max arr 0) (array #[]))
(check-exn exn? (λ () (array-axis-sum arr 1)))
(check-exn exn? (λ () (array-axis-prod arr 1)))
(check-exn exn? (λ () (array-axis-min arr 1)))
(check-exn exn? (λ () (array-axis-max arr 1)))
(check-equal? (array-axis-sum arr 1 0) (array [0 0 0]))
(check-equal? (array-axis-min arr 1 +inf.0) (array [+inf.0 +inf.0 +inf.0]))
(check-equal? (array-axis-max arr 1 -inf.0) (array [-inf.0 -inf.0 -inf.0]))
(check-equal? (array-axis-prod arr 1 1) (array [1 1 1]))
(check-equal? (array-axis-sum arr 1 0) (array #[0 0 0]))
(check-equal? (array-axis-min arr 1 +inf.0) (array #[+inf.0 +inf.0 +inf.0]))
(check-equal? (array-axis-max arr 1 -inf.0) (array #[-inf.0 -inf.0 -inf.0]))
(check-equal? (array-axis-prod arr 1 1) (array #[1 1 1]))
(check-exn exn? (λ () (array-all-sum arr)))
(check-exn exn? (λ () (array-all-prod arr)))
(check-exn exn? (λ () (array-all-min arr)))
@ -340,29 +340,29 @@
(check-equal? (array-all-min arr) 0)
(check-equal? (array-all-max arr) 0))
(let ([arr (array [[1.0 1.0 2.0 3.0] [0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-count arr 0 positive?) (array [1 1 2 2]))
(check-equal? (array-axis-count arr 1 positive?) (array [4 2]))
(let ([arr (array #[#[1.0 1.0 2.0 3.0] #[0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-count arr 0 positive?) (array #[1 1 2 2]))
(check-equal? (array-axis-count arr 1 positive?) (array #[4 2]))
(check-equal? (array-all-count arr positive?) 6))
(let ([arr (array [[1.0 1.0 2.0 3.0] [0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-andmap arr 0 positive?) (array [#f #f #t #t]))
(check-equal? (array-axis-andmap arr 1 positive?) (array [#t #f]))
(let ([arr (array #[#[1.0 1.0 2.0 3.0] #[0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-andmap arr 0 positive?) (array #[#f #f #t #t]))
(check-equal? (array-axis-andmap arr 1 positive?) (array #[#t #f]))
(check-equal? (array-all-andmap arr positive?) #f))
(let ([arr (array [[1.0 1.0 2.0 3.0] [2.0 3.0 2.0 3.0]])])
(check-equal? (array-axis-andmap arr 0 positive?) (array [#t #t #t #t]))
(check-equal? (array-axis-andmap arr 1 positive?) (array [#t #t]))
(let ([arr (array #[#[1.0 1.0 2.0 3.0] #[2.0 3.0 2.0 3.0]])])
(check-equal? (array-axis-andmap arr 0 positive?) (array #[#t #t #t #t]))
(check-equal? (array-axis-andmap arr 1 positive?) (array #[#t #t]))
(check-equal? (array-all-andmap arr positive?) #t))
(let ([arr (array [[-1.0 -1.0 -2.0 -3.0] [0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-ormap arr 0 positive?) (array [#f #f #t #t]))
(check-equal? (array-axis-ormap arr 1 positive?) (array [#f #t]))
(let ([arr (array #[#[-1.0 -1.0 -2.0 -3.0] #[0.0 -1.0 2.0 3.0]])])
(check-equal? (array-axis-ormap arr 0 positive?) (array #[#f #f #t #t]))
(check-equal? (array-axis-ormap arr 1 positive?) (array #[#f #t]))
(check-equal? (array-all-ormap arr positive?) #t))
(let ([arr (array [[-1.0 -1.0 -2.0 -3.0] [-2.0 -3.0 -2.0 -3.0]])])
(check-equal? (array-axis-ormap arr 0 positive?) (array [#f #f #f #f]))
(check-equal? (array-axis-ormap arr 1 positive?) (array [#f #f]))
(let ([arr (array #[#[-1.0 -1.0 -2.0 -3.0] #[-2.0 -3.0 -2.0 -3.0]])])
(check-equal? (array-axis-ormap arr 0 positive?) (array #[#f #f #f #f]))
(check-equal? (array-axis-ormap arr 1 positive?) (array #[#f #f]))
(check-equal? (array-all-ormap arr positive?) #f))
(let ([arr (make-array #() 0.0)])
@ -376,12 +376,12 @@
(check-equal? (array-all-ormap arr positive?) #t))
(let ([arr (make-array #(4 0) 0.0)])
(check-equal? (array-axis-count arr 0 positive?) (array []))
(check-equal? (array-axis-andmap arr 0 positive?) (array []))
(check-equal? (array-axis-ormap arr 0 positive?) (array []))
(check-equal? (array-axis-count arr 1 positive?) (array [0 0 0 0]))
(check-equal? (array-axis-andmap arr 1 positive?) (array [#t #t #t #t]))
(check-equal? (array-axis-ormap arr 1 positive?) (array [#f #f #f #f]))
(check-equal? (array-axis-count arr 0 positive?) (array #[]))
(check-equal? (array-axis-andmap arr 0 positive?) (array #[]))
(check-equal? (array-axis-ormap arr 0 positive?) (array #[]))
(check-equal? (array-axis-count arr 1 positive?) (array #[0 0 0 0]))
(check-equal? (array-axis-andmap arr 1 positive?) (array #[#t #t #t #t]))
(check-equal? (array-axis-ormap arr 1 positive?) (array #[#f #f #f #f]))
(check-equal? (array-all-count arr positive?) 0)
(check-equal? (array-all-andmap arr positive?) #t)
(check-equal? (array-all-ormap arr positive?) #f))
@ -394,11 +394,11 @@
(check-exn exn? (λ () (array-fft (make-array #(3) 1))))
(let ([arr (make-array #(4) 1)])
(check array-all= (array-fft arr) (array [4 0 0 0]))
(check array-all= (array-fft arr) (array #[4 0 0 0]))
(check array-all= (array-inverse-fft (array-fft arr)) arr))
(let ([arr (make-array #(2 2) 1)])
(check array-all= (array-fft arr) (array [[4 0] [0 0]]))
(check array-all= (array-fft arr) (array #[#[4 0] #[0 0]]))
(check array-all= (array-inverse-fft (array-fft arr)) arr))
;; ---------------------------------------------------------------------------------------------------
@ -581,32 +581,32 @@
;; ---------------------------------------------------------------------------------------------------
;; Indexing
(let ([arr (mutable-array [[0 1 2 3 4 5]
[1 2 3 4 5 6]
[2 3 4 5 6 7]
[3 4 5 6 7 8]]
(U Integer Symbol))]
[idxs (array [#(0 0) #(1 1) #(1 2) #(2 3) #(3 4) #(3 5)])]
[vals (array ['a 'b 'c 'd 'e 'f])]
(let ([arr (mutable-array #[#[0 1 2 3 4 5]
#[1 2 3 4 5 6]
#[2 3 4 5 6 7]
#[3 4 5 6 7 8]]
: (U Integer Symbol))]
[idxs (array #['#(0 0) '#(1 1) '#(1 2) '#(2 3) '#(3 4) '#(3 5)])]
[vals (array #['a 'b 'c 'd 'e 'f])]
[slices (list (:: 0 4 2) (:: 2 -1 -2))])
(check-equal? (array-indexes-ref arr idxs)
(array [0 2 3 5 7 8]))
(array #[0 2 3 5 7 8]))
(check-equal? (array-indexes-ref arr (slice-indexes-array (array-shape arr) slices))
(array-slice-ref arr slices))
(array-indexes-set! arr idxs vals)
(check-equal? arr (array [['a 1 2 3 4 5]
[1 'b 'c 4 5 6]
[2 3 4 'd 6 7]
[3 4 5 6 'e 'f]])))
(check-equal? arr (array #[#['a 1 2 3 4 5]
#[1 'b 'c 4 5 6]
#[2 3 4 'd 6 7]
#[3 4 5 6 'e 'f]])))
(check-equal? (array-slice-ref (indexes-array #()) (list (::new 2)))
(make-array #(2) #()))
(let ([arr (indexes-array #(2))])
(check-equal? (array-slice-ref arr (list (::) (::new 2)))
(array [[#(0) #(0)] [#(1) #(1)]]))
(array #[#['#(0) '#(0)] #['#(1) '#(1)]]))
(check-equal? (array-slice-ref arr (list (::new 2) (::)))
(array [[#(0) #(1)] [#(0) #(1)]]))
(array #[#['#(0) '#(1)] #['#(0) '#(1)]]))
(check-equal? (array-slice-ref arr (list (::)))
arr)
(check-equal? (array-slice-ref arr (list ::...))
@ -614,21 +614,21 @@
(let ([arr (index-array #(10))])
(check-equal? (array-slice-ref arr (list (:: 0 10 2)))
(array [0 2 4 6 8]))
(array #[0 2 4 6 8]))
(check-equal? (array-slice-ref arr (list (:: #f 10 2)))
(array [0 2 4 6 8]))
(array #[0 2 4 6 8]))
(check-equal? (array-slice-ref arr (list (:: 0 #f 2)))
(array [0 2 4 6 8]))
(array #[0 2 4 6 8]))
(check-equal? (array-slice-ref arr (list (:: #f #f 2)))
(array [0 2 4 6 8]))
(array #[0 2 4 6 8]))
(check-equal? (array-slice-ref arr (list (:: 9 -1 -2)))
(array [9 7 5 3 1]))
(array #[9 7 5 3 1]))
(check-equal? (array-slice-ref arr (list (:: 9 #f -2)))
(array [9 7 5 3 1]))
(array #[9 7 5 3 1]))
(check-equal? (array-slice-ref arr (list (:: #f -1 -2)))
(array [9 7 5 3 1]))
(array #[9 7 5 3 1]))
(check-equal? (array-slice-ref arr (list (:: #f #f -2)))
(array [9 7 5 3 1]))
(array #[9 7 5 3 1]))
(check-equal? (array-slice-ref arr (list 4))
(array 4))
(check-exn exn? (λ () (array-slice-ref arr (list -1))))
@ -642,15 +642,15 @@
(check-equal? (array-slice-ref arr (list ::...))
arr)
(check-equal? (array-slice-ref arr (list (:: 0 4 2) (:: 0 4 2)))
(array [[0 2] [8 10]]))
(array #[#[0 2] #[8 10]]))
(check-equal? (array-slice-ref arr (list (:: 0 4 2) ::...))
(array [[0 1 2 3] [8 9 10 11]]))
(array #[#[0 1 2 3] #[8 9 10 11]]))
(check-equal? (array-slice-ref arr (list ::... (:: 0 4 2)))
(array [[0 2] [4 6] [8 10] [12 14]]))
(array #[#[0 2] #[4 6] #[8 10] #[12 14]]))
(check-equal? (array-slice-ref arr (list (:: 0 4 2) 0))
(array [0 8]))
(array #[0 8]))
(check-equal? (array-slice-ref arr (list 0 (:: 0 4 2)))
(array [0 2]))
(array #[0 2]))
(check-equal? (array-slice-ref arr (list (::new 0) ::...))
(make-array #(0 4 4) 0))
(check-equal? (array-slice-ref arr (list (::new 1) ::...))
@ -667,8 +667,8 @@
#(2 4) (λ: ([js : (Vectorof Index)])
(match-define (vector j0 j1) js)
(vector j1 j0)))
(array [[#(0 0) #(1 0) #(2 0) #(3 0)]
[#(0 1) #(1 1) #(2 1) #(3 1)]]))
(array #[#['#(0 0) '#(1 0) '#(2 0) '#(3 0)]
#['#(0 1) '#(1 1) '#(2 1) '#(3 1)]]))
(check-exn exn? (λ () (array-strict (array-transform (indexes-array #(2 2)) #(3 3) identity))))
(check-exn exn? (λ () (array-strict (array-transform (indexes-array #(2 2)) #(2) identity))))
@ -678,8 +678,8 @@
(λ: ([js : (Vectorof Index)])
(match-define (vector j0 j1) js)
((inst vector Index) j1 j0)))
(array [[#(0 0) #(1 0) #(2 0) #(3 0)]
[#(0 1) #(1 1) #(2 1) #(3 1)]]))
(array #[#['#(0 0) '#(1 0) '#(2 0) '#(3 0)]
#['#(0 1) '#(1 1) '#(2 1) '#(3 1)]]))
;; Permutation
@ -697,8 +697,8 @@
(check-exn exn? (λ () (array-axis-permute arr '())))
(check-equal? (array-axis-permute arr '(0 1)) arr)
(check-equal? (array-axis-permute arr '(1 0))
(array [[#(0 0) #(1 0)]
[#(0 1) #(1 1)]])))
(array #[#['#(0 0) '#(1 0)]
#['#(0 1) '#(1 1)]])))
;; Transposition
@ -710,28 +710,31 @@
(check-exn exn? (λ () (array-axis-swap arr 0 2)))
(check-equal? (array-axis-swap arr 0 0) arr)
(check-equal? (array-axis-swap arr 1 0)
(array [[#(0 0) #(1 0)]
[#(0 1) #(1 1)]])))
(array #[#['#(0 0) '#(1 0)]
#['#(0 1) '#(1 1)]])))
(check-equal? (array-axis-swap (indexes-array #(2 2 2)) 1 2)
(array [[[#(0 0 0) #(0 1 0)]
[#(0 0 1) #(0 1 1)]]
[[#(1 0 0) #(1 1 0)]
[#(1 0 1) #(1 1 1)]]]))
(array #[#[#['#(0 0 0) '#(0 1 0)]
#['#(0 0 1) '#(0 1 1)]]
#[#['#(1 0 0) '#(1 1 0)]
#['#(1 0 1) '#(1 1 1)]]]))
;; Adding axes
(let ([arr (indexes-array #())])
(check-exn exn? (λ () (array-axis-insert arr 1 1)))
(check-equal? (array-axis-insert arr 0 2)
(array [#() #()])))
(array #['#() '#()])))
(let ([arr (indexes-array #(4))])
(check-equal? (array-axis-insert arr 0 2)
(array [[#(0) #(1) #(2) #(3)]
[#(0) #(1) #(2) #(3)]]))
(array #[#['#(0) '#(1) '#(2) '#(3)]
#['#(0) '#(1) '#(2) '#(3)]]))
(check-equal? (array-axis-insert arr 1 2)
(array [[#(0) #(0)] [#(1) #(1)] [#(2) #(2)] [#(3) #(3)]])))
(array #[#['#(0) '#(0)]
#['#(1) '#(1)]
#['#(2) '#(2)]
#['#(3) '#(3)]])))
;; Removing axes
@ -745,55 +748,55 @@
(let ([arr (indexes-array #(2 2))])
(check-equal? (array-axis-ref arr 0 0)
(array [#(0 0) #(0 1)]))
(array #['#(0 0) '#(0 1)]))
(check-equal? (array-axis-ref arr 1 0)
(array [#(0 0) #(1 0)])))
(array #['#(0 0) '#(1 0)])))
;; Reshape, flatten
(let ([arr (indexes-array #())])
(check-exn exn? (λ () (array-reshape arr #(0))))
(check-equal? (array-reshape arr #(1))
(array [#()]))
(array #['#()]))
(check-equal? (array-flatten arr)
(array [#()])))
(array #['#()])))
(let ([arr (array-map (λ: ([js : Indexes]) (vector-ref js 0))
(indexes-array #(4)))])
(check-exn exn? (λ () (array-reshape arr #())))
(check-equal? (array-reshape arr #(2 2))
(array [[0 1] [2 3]]))
(array #[#[0 1] #[2 3]]))
(check-equal? (array-flatten arr)
(array [0 1 2 3])))
(array #[0 1 2 3])))
;; Append
(check-exn exn? (λ () (array-append* (list))))
(check-exn exn? (λ () (array-append* (list (array 0) (array 1)))))
(check-equal? (array-append* (list (array [0])))
(array [0]))
(check-equal? (array-append* (list (array [0]) (array [1])))
(array [0 1]))
(check-equal? (array-append* (list (array [0]) (array 1)))
(array [0 1]))
(check-equal? (array-append* (list (array 0) (array [1])))
(array [0 1]))
(check-equal? (array-append* (list (array [0 1 2]) (array [3 4 5])))
(array [0 1 2 3 4 5]))
(check-exn exn? (λ () (array-append* (list (array [0]) (array [1])) 1)))
(check-equal? (array-append* (list (array #[0])))
(array #[0]))
(check-equal? (array-append* (list (array #[0]) (array #[1])))
(array #[0 1]))
(check-equal? (array-append* (list (array #[0]) (array 1)))
(array #[0 1]))
(check-equal? (array-append* (list (array 0) (array #[1])))
(array #[0 1]))
(check-equal? (array-append* (list (array #[0 1 2]) (array #[3 4 5])))
(array #[0 1 2 3 4 5]))
(check-exn exn? (λ () (array-append* (list (array #[0]) (array #[1])) 1)))
(check-equal? (array-append* (list (array [[0 1] [2 3]]) (array [[4 5] [6 7]])))
(array [[0 1] [2 3] [4 5] [6 7]]))
(check-equal? (array-append* (list (array [[0 1] [2 3]]) (array [[4 5] [6 7]])) 1)
(array [[0 1 4 5] [2 3 6 7]]))
(check-equal? (array-append* (list (array [[0 1] [2 3]]) (array 0)) 0)
(array [[0 1] [2 3] [0 0]]))
(check-equal? (array-append* (list (array [[0 1] [2 3]]) (array 0)) 1)
(array [[0 1 0] [2 3 0]]))
(check-equal? (array-append* (list (array [[0 1 2] [3 4 5]]) (array [0 1])) 1)
(array [[0 1 2 0 1] [3 4 5 0 1]]))
(check-exn exn? (λ () (array-append* (list (array [[0 1 2] [3 4 5]]) (array [0 1])) 0)))
(check-equal? (array-append* (list (array #[#[0 1] #[2 3]]) (array #[#[4 5] #[6 7]])))
(array #[#[0 1] #[2 3] #[4 5] #[6 7]]))
(check-equal? (array-append* (list (array #[#[0 1] #[2 3]]) (array #[#[4 5] #[6 7]])) 1)
(array #[#[0 1 4 5] #[2 3 6 7]]))
(check-equal? (array-append* (list (array #[#[0 1] #[2 3]]) (array 0)) 0)
(array #[#[0 1] #[2 3] #[0 0]]))
(check-equal? (array-append* (list (array #[#[0 1] #[2 3]]) (array 0)) 1)
(array #[#[0 1 0] #[2 3 0]]))
(check-equal? (array-append* (list (array #[#[0 1 2] #[3 4 5]]) (array #[0 1])) 1)
(array #[#[0 1 2 0 1] #[3 4 5 0 1]]))
(check-exn exn? (λ () (array-append* (list (array #[#[0 1 2] #[3 4 5]]) (array #[0 1])) 0)))
;; ---------------------------------------------------------------------------------------------------
;; Comprehensions
@ -803,7 +806,7 @@
(check-equal? (for/array: #:shape #() () : Symbol 'foo)
(mutable-array 'foo))
(check-equal? (for/array: #:shape #(2) ([x (in-naturals)]) : Integer x)
(mutable-array [0 1]))
(mutable-array #[0 1]))
(check-equal? (for/array: #:shape #(2 3) ([i (in-range 0 6)]) : (Vectorof Integer)
(vector (quotient i 3) (remainder i 3)))
(indexes-array #(2 3)))
@ -813,7 +816,7 @@
(check-equal? (for*/array: #:shape #() () : Symbol 'foo)
(mutable-array 'foo))
(check-equal? (for*/array: #:shape #(2) ([x (in-naturals)]) : Integer x)
(mutable-array [0 1]))
(mutable-array #[0 1]))
(check-equal? (for*/array: #:shape #(2 3) ([i (in-range 0 2)]
[j (in-range 0 3)]
) : (Vectorof Integer)
@ -838,7 +841,7 @@
;; ---------------------------------------------------------------------------------------------------
;; Sequences
(check-equal? (for/list: : (Listof Number) ([x (in-array (array [[1 2 3] [4 5 6]]))]) x)
(check-equal? (for/list: : (Listof Number) ([x (in-array (array #[#[1 2 3] #[4 5 6]]))]) x)
'(1 2 3 4 5 6))
(check-equal? (for/list: : (Listof Indexes) ([js (in-array (indexes-array #()))]) js)
@ -894,26 +897,26 @@
(array->list* (array-axis-swap arr 0 1))))
(check-equal? (array-list->array empty 0)
(array []))
(array #[]))
(check-exn exn? (λ () (array-list->array empty 1)))
(check-equal? (array-list->array (list (array 0) (array 1) (array 2)) 0)
(array [0 1 2]))
(array #[0 1 2]))
(check-exn exn? (λ () (array-list->array (list (array 0) (array 1) (array 2)) 1)))
(check-equal? (array-list->array (list (array [0 1]) (array [2 3])) 0)
(array [[0 1] [2 3]]))
(check-equal? (array-list->array (list (array [0 1]) (array [2 3])) 1)
(array [[0 2] [1 3]]))
(check-equal? (array-list->array (list (array #[0 1]) (array #[2 3])) 0)
(array #[#[0 1] #[2 3]]))
(check-equal? (array-list->array (list (array #[0 1]) (array #[2 3])) 1)
(array #[#[0 2] #[1 3]]))
(check-equal? (array-list->array (list (array [0 1 2]) (array 0)) 0)
(array [[0 1 2] [0 0 0]]))
(check-equal? (array-list->array (list (array [0 1 2]) (array 0)) 1)
(array [[0 0] [1 0] [2 0]]))
(check-exn exn? (λ () (array-list->array (list (array [0 1 2]) (array 0)) 2)))
(check-equal? (array-list->array (list (array #[0 1 2]) (array 0)) 0)
(array #[#[0 1 2] #[0 0 0]]))
(check-equal? (array-list->array (list (array #[0 1 2]) (array 0)) 1)
(array #[#[0 0] #[1 0] #[2 0]]))
(check-exn exn? (λ () (array-list->array (list (array #[0 1 2]) (array 0)) 2)))
(check-equal? (array-list->array (list (array [[0 1] [2 3]]) (array 0)) 0)
(array [[[0 1] [2 3]] [[0 0] [0 0]]]))
(check-equal? (array-list->array (list (array #[#[0 1] #[2 3]]) (array 0)) 0)
(array #[#[#[0 1] #[2 3]] #[#[0 0] #[0 0]]]))
(check-equal? (array->array-list (array-list->array empty 0) 0)
empty)
@ -922,18 +925,18 @@
(check-equal? (array->array-list (array-list->array (list (array 0) (array 1) (array 2)) 0) 0)
(list (array 0) (array 1) (array 2)))
(check-equal? (array->array-list (array-list->array (list (array [0 1]) (array [2 3])) 0) 0)
(list (array [0 1]) (array [2 3])))
(check-equal? (array->array-list (array-list->array (list (array [0 1]) (array [2 3])) 1) 1)
(list (array [0 1]) (array [2 3])))
(check-equal? (array->array-list (array-list->array (list (array #[0 1]) (array #[2 3])) 0) 0)
(list (array #[0 1]) (array #[2 3])))
(check-equal? (array->array-list (array-list->array (list (array #[0 1]) (array #[2 3])) 1) 1)
(list (array #[0 1]) (array #[2 3])))
(check-equal? (array->array-list (array-list->array (list (array [0 1 2]) (array 0)) 0) 0)
(list (array [0 1 2]) (array [0 0 0])))
(check-equal? (array->array-list (array-list->array (list (array [0 1 2]) (array 0)) 1) 1)
(list (array [0 1 2]) (array [0 0 0])))
(check-equal? (array->array-list (array-list->array (list (array #[0 1 2]) (array 0)) 0) 0)
(list (array #[0 1 2]) (array #[0 0 0])))
(check-equal? (array->array-list (array-list->array (list (array #[0 1 2]) (array 0)) 1) 1)
(list (array #[0 1 2]) (array #[0 0 0])))
(check-equal? (array->array-list (array-list->array (list (array [[0 1] [2 3]]) (array 0)) 0) 0)
(list (array [[0 1] [2 3]]) (array [[0 0] [0 0]])))
(check-equal? (array->array-list (array-list->array (list (array #[#[0 1] #[2 3]]) (array 0)) 0) 0)
(list (array #[#[0 1] #[2 3]]) (array #[#[0 0] #[0 0]])))
;; ---------------------------------------------------------------------------------------------------
;; Conditionals

30
collects/math/tests/mandelbrot-test.rkt
View File

@ -23,21 +23,21 @@
divtime)
(check-equal? (mandelbrot 0.2 20)
(array [[0 1 1 1 1 1 1 1 1 1 1 1 1 1 1]
[1 1 1 1 1 1 2 2 2 3 2 2 1 1 1]
[1 1 1 1 1 2 2 2 3 6 20 3 2 1 1]
[1 1 1 2 2 2 3 4 5 20 17 4 3 2 1]
[1 1 2 2 3 3 4 11 20 20 20 10 14 2 2]
[1 2 3 4 6 6 6 20 20 20 20 20 9 3 2]
[2 3 4 6 18 20 14 20 20 20 20 20 20 3 2]
[20 20 20 20 20 20 20 20 20 20 20 20 5 3 2]
[2 3 4 6 18 20 14 20 20 20 20 20 20 3 2]
[1 2 3 4 6 6 6 20 20 20 20 20 9 3 2]
[1 1 2 2 3 3 4 11 20 20 20 10 14 2 2]
[1 1 1 2 2 2 3 4 5 20 17 4 3 2 1]
[1 1 1 1 1 2 2 2 3 6 20 3 2 1 1]
[1 1 1 1 1 1 2 2 2 3 2 2 1 1 1]
[0 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]))
(array #[#[0 1 1 1 1 1 1 1 1 1 1 1 1 1 1]
#[1 1 1 1 1 1 2 2 2 3 2 2 1 1 1]
#[1 1 1 1 1 2 2 2 3 6 20 3 2 1 1]
#[1 1 1 2 2 2 3 4 5 20 17 4 3 2 1]
#[1 1 2 2 3 3 4 11 20 20 20 10 14 2 2]
#[1 2 3 4 6 6 6 20 20 20 20 20 9 3 2]
#[2 3 4 6 18 20 14 20 20 20 20 20 20 3 2]
#[20 20 20 20 20 20 20 20 20 20 20 20 5 3 2]
#[2 3 4 6 18 20 14 20 20 20 20 20 20 3 2]
#[1 2 3 4 6 6 6 20 20 20 20 20 9 3 2]
#[1 1 2 2 3 3 4 11 20 20 20 10 14 2 2]
#[1 1 1 2 2 2 3 4 5 20 17 4 3 2 1]
#[1 1 1 1 1 2 2 2 3 6 20 3 2 1 1]
#[1 1 1 1 1 1 2 2 2 3 2 2 1 1 1]
#[0 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]))
(begin
(require images/flomap)