12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319 |
- ; -*- mode: scheme; coding: utf-8 -*-
- ; Replacement for Guile C-based array system - Tests
- ; (c) Daniel Llorens - 2016-2021
- ; This library is free software; you can redistribute it and/or modify it under
- ; the terms of the GNU General Public License as published by the Free
- ; Software Foundation; either version 3 of the License, or (at your option) any
- ; later version.
- ; Run with $GUILE -L mod test.scm
- (import (newra) (newra tools) (newra read) (newra test misc) (newra test map-ladder)
- (srfi :64) (srfi :26) (srfi :8) (only (srfi :1) fold iota drop)
- (ice-9 match) (only (rnrs base) vector-map vector-for-each))
- (define (ra->string ra) (call-with-output-string (cut display ra <>)))
- (define (string->ra s) (call-with-input-string s read))
- (set! test-log-to-file #f)
- (test-begin "newra")
- ; -----------------------
- ; auxiliary functions
- ; -----------------------
- (test-equal
- 6 ((@ (newra vector) vector-fold) (lambda (a c) (+ c (car a))) 0 #((1) (2) (3))))
- (test-equal
- #(2 3) ((@ (newra vector) vector-copy) #(1 2 3 4) 1 3))
- ; loop-fun from (newra test misc) FIXME may become ra-index-map!
- (define ra0 (make-ra-root (make-aseq) (c-dims)))
- (define ra1 (make-ra-root (make-aseq) (c-dims 2)))
- (define ra2 (make-ra-root (make-aseq) (c-dims 2 3)))
- (define ra3 (make-ra-root (make-aseq) (c-dims 2 3 4)))
- (test-assert (ra-equal? (make-ra-root #(1 2 3)) (list->ra 1 '(1 2 3))))
- (test-assert (not (ra-equal? (make-ra 0 3 4) (make-ra 0 3)))) ; ra-equal? doesn't rank-extend
- (test-equal "0"
- (with-output-to-string (lambda () (%ra-loop (vector-map dim-len (ra-dims ra0)) 0 () (display (ra0))))))
- (test-equal "01"
- (with-output-to-string (lambda () (%ra-loop (vector-map dim-len (ra-dims ra1)) 1 (i) (display (+ i))))))
- (test-equal "012123"
- (with-output-to-string (lambda () (%ra-loop (vector-map dim-len (ra-dims ra2)) 2 (i j) (display (+ i j))))))
- (test-equal "012312342345123423453456"
- (with-output-to-string (lambda () (%ra-loop (vector-map dim-len (ra-dims ra3)) 3 (i j k) (display (+ i j k))))))
- (define a0 (ra->array (as-ra ra0 #:type #t)))
- (define a1 (ra->array (as-ra ra1 #:type #t)))
- (define a2 (ra->array (as-ra ra2 #:type #t)))
- (define a3 (ra->array (as-ra ra3 #:type #t)))
- (test-equal "(0)"
- (call-with-output-string (lambda (o) (ra-loop ra0 (lambda () (format o "(~a)" (ra0)))))))
- (test-equal "(0)(1)"
- (call-with-output-string (lambda (o) (ra-loop ra1 (lambda (i) (format o "(~a)" (ra1 i)))))))
- (test-equal "(0)(1)(2)(3)(4)(5)"
- (call-with-output-string (lambda (o) (ra-loop ra2 (lambda (i j) (format o "(~a)" (ra2 i j)))))))
- (test-equal "(0)(1)(2)(3)(4)(5)(6)(7)(8)(9)(10)(11)(12)(13)(14)(15)(16)(17)(18)(19)(20)(21)(22)(23)"
- (call-with-output-string (lambda (o) (ra-loop ra3 (lambda (i j k) (format o "(~a)" (ra3 i j k)))))))
- (test-equal "(0)"
- (call-with-output-string (lambda (o) (array-loop a0 (lambda () (format o "(~a)" (array-ref a0)))))))
- (test-equal "(0)(1)"
- (call-with-output-string (lambda (o) (array-loop a1 (lambda (i) (format o "(~a)" (array-ref a1 i)))))))
- (test-equal "(0)(1)(2)(3)(4)(5)"
- (call-with-output-string (lambda (o) (array-loop a2 (lambda (i j) (format o "(~a)" (array-ref a2 i j)))))))
- (test-equal "(0)(1)(2)(3)(4)(5)(6)(7)(8)(9)(10)(11)(12)(13)(14)(15)(16)(17)(18)(19)(20)(21)(22)(23)"
- (call-with-output-string (lambda (o) (array-loop a3 (lambda (i j k) (format o "(~a)" (array-ref a3 i j k)))))))
- ; -----------------------
- ; array->ra, ra->array, printers
- ; -----------------------
- (let* ((ra0 (array->ra #(1 2 3)))
- (ra1 (array->ra #@1(1 2 3)))
- (ra2 (array->ra #2((1 2) (3 4))))
- (ra3 (array->ra #2@1@1((1 2) (3 4))))
- (ra4 (array->ra #0(99)))
- (ra5 (array->ra #0s64(99)))
- (ra6 (array->ra #0((a)))))
- (test-equal (ra->string ra0) "#%1:3(1 2 3)")
- (test-equal (ra->string ra1) "#%1@1:3(1 2 3)")
- (test-equal (ra->string ra2) "#%2:2:2((1 2) (3 4))")
- (test-equal (ra->string ra3) "#%2@1:2@1:2((1 2) (3 4))")
- (parameterize ((*ra-parenthesized-rank-zero* #t))
- (test-equal (ra->string ra4) "#%0(99)")
- (test-equal (ra->string ra5) "#%0s64(99)")
- (test-equal (ra->string ra6) "#%0((a))"))
- (parameterize ((*ra-parenthesized-rank-zero* #f))
- (test-equal (ra->string ra4) "#%0 99")
- (test-equal (ra->string ra5) "#%0s64 99")
- (test-equal (ra->string ra6) "#%0 (a)"))
- (test-equal #(1 2 3) (ra->array ra0))
- (test-equal #@1(1 2 3) (ra->array ra1))
- (test-equal #2((1 2) (3 4)) (ra->array ra2))
- (test-equal #2@1@1((1 2) (3 4)) (ra->array ra3))
- (test-equal #0(99) (ra->array ra4))
- (test-equal #0s64(99) (ra->array ra5))
- (test-equal #0((a)) (ra->array ra6)))
- ; dead axes
- (test-equal "#%2d:d:10((0 1 2 3 4 5 6 7 8 9))" (ra->string (ra-transpose (ra-i 10) 1)))
- ; printing of string elements (for example).
- (test-equal "#%0(\"hello\")" (ra->string (make-ra "hello")))
- (test-equal "#%1:2(\"hello\" \"bye\")" (ra->string (make-ra-root #("hello" "bye") (c-dims 2))))
- ; -----------------------
- ; ra-iota, ra-i
- ; -----------------------
- (test-equal "#%3d:2:3:4(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23)))"
- (ra->string (ra-i 2 3 4)))
- (test-equal "#%3d:2:0:4(() ())"
- (ra->string (ra-i 2 0 4)))
- (test-equal "#%0d(0)"
- (ra->string (ra-i)))
- (test-equal "#%1d:4(9 8 7 6)"
- (ra->string (ra-iota 4 9 -1)))
- (test-equal "#%1d:4(9 10 11 12)"
- (ra->string (ra-iota 4 9)))
- (test-equal "#%1d:0()"
- (ra->string (ra-iota 0)))
- ; default ra-iota has lo #f so it will match any lower bound and act as index placeholder.
- (test-equal "#%1@2:3(2 3 4)"
- (ra->string (ra-copy! (make-ra-new #t 'o (c-dims '(2 4))) (ra-iota))))
- ; mixing dead and unbounded axes
- (let ((a (ra-i #f #t #f 2 3)))
- (test-equal 5 (a 0 0 0 1 2))
- (test-equal 5 (a 0 0 1 1 2))
- (test-equal 11 (a 0 1 0 1 2))
- ; reducing the unbounded axis
- (test-equal "#%4d:d:d:2:3((((6 7 8) (9 10 11))))"
- (ra->string (ra-from a #t 1))))
- ; unbounded both ways
- (let ((a (ra-i #f '(#f #t) #f 2 3)))
- (test-equal "#%4d:d:d:2:3((((-6 -5 -4) (-3 -2 -1))))"
- (ra->string (ra-from a #t -1 #t))))
- ; 2/3/4 use moving slice but 1 uses direct slicing in the lo..hi range.
- (define (test-lof rsfe)
- (test-equal
- "(#%0(o) #%0d(2))(#%0(o) #%0d(3))(#%0(o) #%0d(4))"
- (call-with-output-string
- (lambda (o)
- (rsfe 1 (lambda a (display a o)) (make-ra-new #t 'o (c-dims '(2 4))) (ra-iota))))))
- (test-lof ra-slice-for-each-1)
- (test-lof ra-slice-for-each-2)
- (test-lof ra-slice-for-each-3)
- (test-lof ra-slice-for-each-4)
- ; -----------------------
- ; make-ra-shared
- ; -----------------------
- (let* ((ra2 (array->ra #2((1 2) (3 4))))
- (ra3 (array->ra #2@1@1((1 2) (3 4))))
- (ra4 (array->ra #0(99))))
- (test-equal "#%0(99)" (ra->string (make-ra-shared ra4 (lambda () '()))))
- (test-equal "#%1:2(1 4)" (ra->string (make-ra-shared ra2 (lambda (i) (list i i)) 2)))
- (test-equal "#%1:2(1 3)" (ra->string (make-ra-shared ra2 (lambda (i) (list i 0)) 2)))
- (test-equal "#%1:2(2 4)" (ra->string (make-ra-shared ra2 (lambda (i) (list i 1)) 2)))
- (test-equal "#%1:2(1 2)" (ra->string (make-ra-shared ra2 (lambda (j) (list 0 j)) 2)))
- (test-equal "#%1:2(3 4)" (ra->string (make-ra-shared ra2 (lambda (j) (list 1 j)) 2)))
- (test-equal "#%1@1:2(1 4)" (ra->string (make-ra-shared ra3 (lambda (i) (list i i)) '(1 2))))
- (test-equal "#%1@1:2(1 3)" (ra->string (make-ra-shared ra3 (lambda (i) (list i 1)) '(1 2))))
- (test-equal "#%1@1:2(2 4)" (ra->string (make-ra-shared ra3 (lambda (i) (list i 2)) '(1 2))))
- (test-equal "#%1@1:2(1 2)" (ra->string (make-ra-shared ra3 (lambda (j) (list 1 j)) '(1 2))))
- (test-equal "#%1@1:2(3 4)" (ra->string (make-ra-shared ra3 (lambda (j) (list 2 j)) '(1 2)))))
- ; -----------------------
- ; make-ra-new, make-ra
- ; -----------------------
- (let* ((ra5 (make-ra-new #t 0 (c-dims '(1 3) '(1 2)))))
- (array-index-map! (ra-root ra5) (lambda i i))
- (test-equal (ra->string ra5) "#%2@1:3@1:2(((0) (1)) ((2) (3)) ((4) (5)))")
- (test-equal 3 (ra-len ra5)))
- (let* ((ra5 (make-typed-ra 's64 0 '(1 3) '(1 2))))
- (array-index-map! (ra-root ra5) (lambda i (car i)))
- (test-equal (ra->string ra5) "#%2s64@1:3@1:2((0 1) (2 3) (4 5))")
- (test-equal 3 (ra-len ra5)))
- ; -----------------------
- ; make-ra-root
- ; -----------------------
- (define ra6 (make-ra-root #(1 2 3 4 5 6) (c-dims '(1 2) '(1 3))))
- (test-equal (ra->string ra6) "#%2@1:2@1:3((1 2 3) (4 5 6))")
- (define ra7a (make-ra-root (make-aseq 1) (c-dims '(1 2) '(1 3))))
- (test-equal (ra->string ra7a) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (define ra7b (make-ra-root #(1 4 2 5 3 6) `#(,(make-dim 2 1 1) ,(make-dim 3 1 2)) -3))
- (test-equal (ra->string ra7b) "#%2@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal 2 (ra-len ra6))
- (test-equal 2 (ra-len ra7a))
- (test-equal 2 (ra-len ra7b))
- ; -----------------------
- ; ra-slice, ra-ref, ra-cell
- ; -----------------------
- (define ra8 (make-ra-root (make-aseq 1) (c-dims '(1 2) '(1 3))))
- (test-equal 2 (ra-len ra8))
- (test-equal (ra->string (ra-cell ra8)) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra-cell ra8 1)) "#%1d@1:3(1 2 3)")
- (test-equal (ra->string (ra-cell ra8 2)) "#%1d@1:3(4 5 6)")
- (test-equal 5 (ra-cell ra8 2 2))
- ; applicable!
- (test-equal (ra->string (ra8)) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra8 1)) "#%1d@1:3(1 2 3)")
- (test-equal (ra->string (ra8 2)) "#%1d@1:3(4 5 6)")
- (test-equal 5 (ra8 2 2))
- (test-equal (ra->string (ra-slice ra8)) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra-slice ra8 1)) "#%1d@1:3(1 2 3)")
- (test-equal (ra->string (ra-slice ra8 2)) "#%1d@1:3(4 5 6)")
- (test-equal (ra->string (ra-slice ra8 2 2)) "#%0d(5)")
- (test-equal 5 (ra-ref (ra-slice ra8 2 2)))
- (test-assert (throws-exception? 'bad-number-of-indices (lambda () (ra-ref ra8))))
- (test-assert (throws-exception? 'bad-number-of-indices (lambda () (ra-ref ra8 1))))
- (test-assert (throws-exception? 'dim-check-out-of-range (lambda () (ra-ref ra8 0 0))))
- (test-assert (throws-exception? 'dim-check-out-of-range (lambda () (ra-ref ra8 3 1))))
- (test-equal 1 (ra-ref ra8 1 1))
- (test-equal 2 (ra-ref ra8 1 2))
- (test-equal 3 (ra-ref ra8 1 3))
- (test-equal 4 (ra-ref ra8 2 1))
- (test-equal 5 (ra-ref ra8 2 2))
- (test-equal 6 (ra-ref ra8 2 3))
- ; -----------------------
- ; ra-transpose (see below for ra-transpose with dead axes)
- ; -----------------------
- (test-equal (ra->string (ra-transpose ra7a 1 0)) "#%2d@1:3@1:2((1 4) (2 5) (3 6))")
- (test-equal (ra->string (ra-transpose ra7b 1 0)) "#%2@1:3@1:2((1 4) (2 5) (3 6))")
- (test-equal (ra->string (ra-transpose ra7a 0 1)) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra-transpose ra7b 0 1)) "#%2@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra-transpose ra7a 0 0)) "#%1d@1:2(1 5)")
- (test-equal (ra->string (ra-transpose ra7b 0 0)) "#%1@1:2(1 5)")
- (test-assert (throws-exception? 'bad-number-of-axes (lambda () (ra-transpose (ra-iota 3) 0 1))))
- (let ((ra0 (make-ra 99))) (test-assert (ra-equal? ra0 (ra-transpose ra0))))
- ; other cases
- (test-equal (ra->string (ra-transpose ra7a)) "#%2d@1:2@1:3((1 2 3) (4 5 6))")
- (test-equal (ra->string (ra-transpose ra7b)) "#%2@1:2@1:3((1 2 3) (4 5 6))")
- (let ((ra1 (ra-i 3)))
- (test-assert (ra-equal? (ra-transpose ra1) (ra-transpose ra1 0)))
- (test-eq (ra-root ra1) (ra-root (ra-transpose ra1 0))))
- (let ((ra2 (ra-i 3 4)))
- (test-assert (ra-equal? (ra-transpose ra2) (ra-transpose ra2 0 1)))
- (test-eq (ra-root ra2) (ra-root (ra-transpose ra2))))
- (let ((ra3 (ra-i 3 4 5)))
- (test-assert (ra-equal? (ra-transpose ra3) (ra-transpose ra3 0 1 2)))
- (test-eq (ra-root ra3) (ra-root (ra-transpose ra3)))
- (test-assert (ra-equal? (ra-transpose ra3 1 0) (ra-transpose ra3 1 0 2)))
- ; these two have a dead axes so the cannot be matched one to the other.
- (test-equal (ra-dims (ra-transpose ra3 1)) (ra-dims (ra-transpose ra3 1 2 3))))
- ; untranspose
- (let* ((a (ra-copy #t (ra-i 2 3 4)))
- (b (ra-transpose a 2 0 1))
- (c (ra-untranspose b 2 0 1)))
- (test-eq (ra-root a) (ra-root c))
- (test-assert (ra-equal? a c))
- (test-equal (ra-dims a) (ra-dims c)))
- (let* ((a (ra-copy #t (ra-i 2 3 4 5)))
- (b (ra-transpose a 2 0 1))
- (c (ra-untranspose b 2 0 1)))
- (test-eq (ra-root a) (ra-root c))
- (test-assert (ra-equal? a c))
- (test-equal (ra-dims a) (ra-dims c)))
- ; -----------------------
- ; ra-reverse
- ; -----------------------
- (let ((ra (ra-i 2 3 2)))
- (test-assert (ra-equal? ra (ra-reverse ra)))
- (test-equal "#%3d:2:3:2(((6 7) (8 9) (10 11)) ((0 1) (2 3) (4 5)))" (ra->string (ra-reverse ra 0)))
- (test-equal "#%3d:2:3:2(((4 5) (2 3) (0 1)) ((10 11) (8 9) (6 7)))" (ra->string (ra-reverse ra 1)))
- (test-equal "#%3d:2:3:2(((1 0) (3 2) (5 4)) ((7 6) (9 8) (11 10)))" (ra->string (ra-reverse ra 2)))
- (test-equal "#%3d:2:3:2(((5 4) (3 2) (1 0)) ((11 10) (9 8) (7 6)))" (ra->string (ra-reverse ra 1 2)))
- (test-equal "#%3d:2:3:2(((7 6) (9 8) (11 10)) ((1 0) (3 2) (5 4)))" (ra->string (ra-reverse ra 2 0)))
- (test-assert (ra-equal? (ra-reverse ra 2 0) (ra-reverse ra 0 2)))
- (test-assert (ra-equal? (ra-reverse ra 2 0 1) (ra-reverse (ra-reverse (ra-reverse ra 0) 1) 2)))
- (test-eq (ra-root ra) (ra-root (ra-reverse ra 2 0))))
- (let ((ra (make-ra-root #(1 2 3 4) (vector (make-dim 4 -1)))))
- (test-equal "#%1@-1:4(4 3 2 1)" (ra->string (ra-reverse ra 0))))
- ; -----------------------
- ; ra-slice-for-each
- ; -----------------------
- (define ra-empty0 (make-ra-root (make-aseq 1) (c-dims '(1 0) '(2 1))))
- (define ra-empty1 (make-ra-root (make-aseq 1) (c-dims '(1 1) '(2 1))))
- (define ra-empty2 (make-ra-root (make-aseq 1) (c-dims '(1 0) '(2 2))))
- (test-equal 0 (ra-len ra-empty0))
- (test-equal 1 (ra-len ra-empty1))
- (test-equal 0 (ra-len ra-empty2))
- (for-each
- (lambda (ra-slice-for-each)
- (test-begin (procedure-name ra-slice-for-each))
- (test-equal "#%2d@1:0@2:0()\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 0 (lambda (o) (format s "~a\n" o)) ra-empty0))))
- (test-equal "#%2d@1:1@2:0(())\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 0 (lambda (o) (format s "~a\n" o)) ra-empty1))))
- (test-equal "#%2d@1:0@2:1()\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 0 (lambda (o) (format s "~a\n" o)) ra-empty2))))
- (test-equal "#%2@1:2@1:3((1 2 3) (4 5 6))\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 0 (lambda (o) (format s "~a\n" o)) ra6))))
- (test-equal "#%1@1:3(1 2 3)\n#%1@1:3(4 5 6)\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 1 (lambda (o) (format s "~a\n" o)) ra6))))
- (test-equal "1\n2\n3\n4\n5\n6\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 2 (lambda (o) (format s "~a\n" (ra-ref o))) ra6))))
- (test-equal "2\n4\n6\n8\n10\n12\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 2 (lambda (a b) (format s "~a\n" (+ (ra-ref a) (ra-ref b)))) ra6 ra7a))))
- (test-equal "2\n4\n6\n8\n10\n12\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 2 (lambda (a b) (format s "~a\n" (+ (ra-ref a) (ra-ref b)))) ra6 ra7b))))
- (test-equal "(#%2@1:2@1:3((1 2 3) (4 5 6)) #%2d@1:2@1:3((1 2 3) (4 5 6)) #%2@1:2@1:3((1 2 3) (4 5 6)))\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 0 (lambda x (format s "~a\n" x)) ra6 ra7a ra7b))))
- (test-equal "(#%1@1:3(1 2 3) #%1d@1:3(1 2 3) #%1@1:3(1 2 3))\n(#%1@1:3(4 5 6) #%1d@1:3(4 5 6) #%1@1:3(4 5 6))\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 1 (lambda x (format s "~a\n" x)) ra6 ra7a ra7b))))
- (test-equal "(#%0(1) #%0d(1) #%0(1))\n(#%0(2) #%0d(2) #%0(2))\n(#%0(3) #%0d(3) #%0(3))\n(#%0(4) #%0d(4) #%0(4))\n(#%0(5) #%0d(5) #%0(5))\n(#%0(6) #%0d(6) #%0(6))\n"
- (call-with-output-string
- (lambda (s) (ra-slice-for-each 2 (lambda x (format s "~a\n" x)) ra6 ra7a ra7b))))
- (test-end (procedure-name ra-slice-for-each)))
- (list ra-slice-for-each-1 ra-slice-for-each-2
- ra-slice-for-each-3 ra-slice-for-each-4))
- ; -----------------------
- ; ra-offset - from guile/test-suite/tests/arrays.test
- ; -----------------------
- (test-begin "ra-offset")
- ; plain vector
- (test-equal 0 (ra-offset (make-ra 0 4)))
- ; plain array rank 2
- (test-equal 0 (ra-offset (make-ra 0 4 4)))
- ; row of rank-2 array, I
- (test-equal 0 (ra-offset ((make-ra 0 5 3) 0)))
- ; row of rank-2 array, II
- (test-equal 4 (ra-offset ((make-ra 0 6 4) 1)))
- ; col of rank-2 array, I
- (test-equal 0 (ra-offset ((ra-transpose (make-ra 0 5 3) 1 0) 0)))
- ; col of rank-2 array, II
- (test-equal 1 (ra-offset ((ra-transpose (make-ra 0 6 4) 1 0) 1)))
- ; of inverted array; shared-array-root's doc is unclear as 'first' is unclear. But we do the same.
- (test-equal 2 (shared-array-offset (make-shared-array #(1 2 3) (lambda (i) (list (- 2 i))) 3)))
- (test-equal 2 (ra-offset (make-ra-shared (array->ra #(1 2 3)) (lambda (i) (list (- 2 i))) 3)))
- (test-end "ra-offset")
- ; -----------------------
- ; ra-slice-for-each compatibility - from guile/test-suite/tests/array-map.test
- ; -----------------------
- (for-each
- (match-lambda
- ((name ra-slice-for-each list->ra list->typed-ra make-ra ra-copy!
- make-ra-shared array->ra ra->array ra-set! ra-ref)
- (let ((test-name (format #f "~a" name)))
- (test-begin test-name)
- ; 1 argument frame rank 1
- (test-equal
- #2((1 3 9) (2 7 8))
- (ra->array
- (let* ((a (list->ra 2 '((9 1 3) (7 8 2)))))
- (ra-slice-for-each 1 (lambda (a) (sort! (ra->array a) <)) a)
- a)))
- ; 1 argument frame rank 1, non-zero base indices
- (test-equal
- #2@1@1((1 3 9) (2 7 8))
- (ra->array
- (let* ((a (make-ra *unspecified* '(1 2) '(1 3)))
- (b (array->ra #2@1@1((9 1 3) (7 8 2)))))
- (ra-copy! a b)
- (ra-slice-for-each 1 (lambda (a) (sort! (ra->array a) <)) a)
- a)))
- ; 2 arguments frame rank 1
- (test-equal
- #f64(8 -1)
- (ra->array
- (let* ((x (list->typed-ra 'f64 2 '((9 1) (7 8))))
- (y (array->ra (f64vector 99 99))))
- (ra-slice-for-each 1 (lambda (y x) (ra-set! y (- (ra-ref x 0) (ra-ref x 1)))) y x)
- y)))
- ; regression: zero-sized frame loop without unrolling
- (test-equal
- 99
- (let* ((x 99)
- (o (make-ra 0. 0 3 2)))
- (ra-slice-for-each 2
- (lambda (o a0 a1)
- (set! x 0))
- o
- (make-ra-shared (make-ra 1. 0 1) (const '(0 0)) 0 3)
- (make-ra 2. 0 3))
- x))
- (test-end test-name))))
- `(("oldra" ,array-slice-for-each ,list->array ,list->typed-array
- ,make-array ,(lambda (a b) (array-copy! b a)) ,make-shared-array
- ,(lambda (x) x) ,(lambda (x) x) ,array-set! ,array-ref)
- ("newra" ,ra-slice-for-each ,list->ra ,list->typed-ra
- ,make-ra ,ra-copy! ,make-ra-shared
- ,array->ra ,ra->array ,ra-set! ,ra-ref)
- ))
- ; -----------------------
- ; setter
- ; -----------------------
- (define ra9 (make-ra-root (make-vector 6) (c-dims '(-1 0) '(1 3))))
- (set! (ra9 -1 1) 99)
- (set! (ra9 -1 2) 77)
- (set! (ra9 -1 3) 88)
- (set! (ra9 0 1) 33)
- (set! (ra9 0 2) 11)
- (set! (ra9 0 3) 22)
- (test-equal (ra->string ra9) "#%2@-1:2@1:3((99 77 88) (33 11 22))")
- (test-equal 2 (ra-len ra9))
- (test-equal #2@-1:2@1:3((99 77 88) (33 44 22)) (ra->array (set! (ra9 0 2) 44)))
- ; -----------------------
- ; test through the ra-map! interface, also ra-copy!, ra-fill!, ra-swap! ra-equal?
- ; -----------------------
- (define ra11 (make-ra-new #t 0 (c-dims 10)))
- (define ra12 (make-ra-root (make-aseq) (c-dims 10)))
- (define ra13 (make-ra-root (make-aseq 10 -1) (c-dims 10)))
- (test-equal 10 (ra-len ra11))
- (test-equal 10 (ra-len ra12))
- (test-equal 10 (ra-len ra13))
- (test-equal "#%1:10(0 1 2 3 4 5 6 7 8 9)" (ra->string (ra-copy! ra11 ra12)))
- (test-equal "#%1:10(0 1 2 3 4 5 6 7 8 9)" (ra->string (ra-copy! ra11 (ra-copy #t ra12))))
- (let ((ra5a (make-ra-new #t 0 (c-dims '(1 2) '(1 3))))
- (ra6a (make-ra-root (vector-copy #(1 2 3 4 5 6)) (c-dims '(1 2) '(1 3)))))
- (test-equal "#%2@1:2@1:3((1 2 3) (4 5 6))" (ra->string (ra-copy! ra5a ra6a)))
- (test-assert (ra-equal? ra6a ra5a))
- (test-assert (ra-equal? ra6a ra5a ra6a))
- (set! (ra5a 1 1) 99)
- (test-assert (not (ra-equal? ra5a ra6a)))
- (set! (ra6a 1 1) 99)
- (test-assert (ra-equal? ra5a ra6a))
- (test-equal "#%2@1:2@1:3((x x x) (x x x))" (ra->string (ra-fill! ra5a 'x)))
- (test-equal "#%2@1:2@1:3((x x x) (x x x))" (ra->string ra5a))
- (test-assert (not (ra-equal? ra6a ra5a)))
- (test-assert (not (ra-equal? (string->ra "#%(1 2 3)") (string->ra "#%(1 2 3 4)"))))
- (test-assert (not (ra-equal? (string->ra "#%1f64(1 2 3)") (string->ra "#%(1 2 3)"))))
- (test-assert (ra-equal? (make-ra-root #(99 99 99 99) (c-dims '(1 2) '(1 2)))
- (ra-fill! (make-ra-root (vector 1 2 3 4) (c-dims '(1 2) '(1 2))) 99))))
- (test-begin "ra-for-each")
- (test-equal "(10 0 10)(9 1 9)(8 2 8)(7 3 7)(6 4 6)(5 5 5)(4 6 4)(3 7 3)(2 8 2)(1 9 1)"
- (call-with-output-string (lambda (s) (ra-for-each (lambda x (display x s)) ra13 ra12 ra13))))
- (test-end "ra-for-each")
- (ra-map! ra11 (lambda () (random 100)))
- (for-each
- (match-lambda
- ((ra-map! name)
- (test-begin (string-append "3 args - " name))
- (test-equal "#%1:10(-10 -8 -6 -4 -2 0 2 4 6 8)"
- (call-with-output-string (cute display (ra-map! ra11 - ra12 ra13) <>)))
- (test-end (string-append "3 args - " name))))
- `((,(cut ra-map*! ra-slice-for-each-1 <...>) "fe1")
- (,(cut ra-map*! ra-slice-for-each-2 <...>) "fe2")
- (,(cut ra-map*! ra-slice-for-each-3 <...>) "fe3")
- (,(cut ra-map*! ra-slice-for-each-4 <...>) "fe4")
- (,ra-map! "ra-map!")))
- ; test with enough args to hit the rest list version.
- (for-each
- (match-lambda
- ((ra-map! name)
- (test-begin (string-append "4 args - " name))
- (test-equal "#%1:10(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1)"
- (call-with-output-string (cute display (ra-map! ra11 - ra12 ra13 ra12) <>)))
- (test-end (string-append "4 args - " name))))
- `((,(cut ra-map*! ra-slice-for-each-1 <...>) "fe1")
- (,(cut ra-map*! ra-slice-for-each-2 <...>) "fe2")
- (,(cut ra-map*! ra-slice-for-each-3 <...>) "fe3")
- (,(cut ra-map*! ra-slice-for-each-4 <...>) "fe4")
- (,ra-map! "ra-map!")))
- (test-begin "ra-for-each")
- (test-equal "(10 0 10 0)(9 1 9 1)(8 2 8 2)(7 3 7 3)(6 4 6 4)(5 5 5 5)(4 6 4 6)(3 7 3 7)(2 8 2 8)(1 9 1 9)"
- (call-with-output-string (lambda (s) (ra-for-each (lambda x (display x s)) ra13 ra12 ra13 ra12))))
- (test-end "ra-for-each")
- (test-begin "ra-swap!")
- (let* ((a (ra-copy #t (ra-i 3 2)))
- (root-a (ra-root a))
- (ca (ra-copy a))
- (b (list->ra 2 '((a b) (c d) (e f))))
- (root-b (ra-root b))
- (cb (ra-copy b)))
- (ra-swap! a b)
- (test-eq root-a (ra-root a))
- (test-eq root-b (ra-root b))
- (test-assert (ra-equal? ca b) (ra-equal? cb a)))
- (test-end "ra-swap!")
- ; -----------------------
- ; ra->list
- ; -----------------------
- (test-equal '(1 2 3) (ra->list (string->ra "#%(1 2 3)")))
- (test-equal '(1 2 3) (ra->list (string->ra "#%@1(1 2 3)")))
- (test-equal '((1 2) (3 4)) (ra->list (string->ra "#%2((1 2) (3 4))")))
- (test-equal '((1 2) (3 4)) (ra->list (string->ra "#%2@1@1((1 2) (3 4))")))
- (test-equal '(((1 2 3) (3 4 5)) ((4 5 6) (6 7 8))) (ra->list (string->ra "#%3@1@1@-1(((1 2 3) (3 4 5)) ((4 5 6) (6 7 8)))")))
- (test-equal 99 (ra->list (string->ra "#%0(99)")))
- ; -----------------------
- ; reader
- ; -----------------------
- (for-each
- (lambda (str)
- (test-equal (format #f "#%3~a:2:2:2(((1 2) (3 4)) ((5 6) (7 8)))" str)
- (ra->string (string->ra (format #f "#%3~a(((1 2) (3 4)) ((5 6) (7 8)))" str))))
- (test-equal (format #f "#%3~a:2:2:2(((1 2) (3 4)) ((5 6) (7 8)))" str)
- (ra->string (string->ra (format #f "#%3~a[((1 2) [3 4]) [[5 6] (7 8)]]" str))))
- (test-equal (format #f "#%2~a:2:2((1 2) (3 4))" str)
- (ra->string (string->ra (format #f "#%2~a((1 2) (3 4))" str))))
- (test-equal (format #f "#%1~a:4(1 2 3 4)" str)
- (ra->string (string->ra (format #f "#%1~a(1 2 3 4)" str))))
- (test-equal (format #f "#%1~a:12(1 2 3 4 5 6 7 8 9 10 11 12)" str)
- (ra->string (string->ra (format #f "#%1~a(1 2 3 4 5 6 7 8 9 10 11 12)" str))))
- (test-equal (format #f "#%2~a@1:2@1:2((1 2) (3 4))" str)
- (ra->string (string->ra (format #f "#%2~a@1@1((1 2) (3 4))" str))))
- (test-equal (format #f "#%2~a@1:2@1:2((1 2) (3 4))" str)
- (ra->string (string->ra (format #f "#%2~a@1@1:2((1 2) (3 4))" str))))
- (test-equal (format #f "#%2~a@-1:2@1:2((1 2) (3 4))" str)
- (ra->string (string->ra (format #f "#%2~a@-1@1((1 2) (3 4))" str)))))
- '("s32" ""))
- (test-equal "#%0(#(1 2 3))" (ra->string (string->ra "#%0(#(1 2 3))")))
- (test-equal "#%1f64:3(1.0 2.0 3.0)" (ra->string (string->ra "#%1f64(1 2 3)")))
- (test-equal "#%0(#%1:3(1 2 3))" (ra->string (string->ra "#%0[#%[1 2 3]]")))
- (test-equal "#%1f64:3(1.0 2.0 3.0)" (ra->string (string->ra "#%1f64[1 2 3]")))
- (test-equal "#%3:0:0:0()" (ra->string (string->ra "#%3()")))
- (test-equal "#%3:2:0:0(() ())" (ra->string (string->ra "#%3(() ())")))
- (test-equal "#%3:1:1:0((()))" (ra->string (string->ra "#%3((())))")))
- ; -----------------------
- ; list->ra, list->typed-ra
- ; -----------------------
- (test-equal "#%0(99)" (ra->string (list->ra 0 99)))
- (test-equal "#%1:3(1 2 3)" (ra->string (list->ra 1 '(1 2 3))))
- (test-equal "#%0((1 2 3))" (ra->string (list->ra 0 '(1 2 3))))
- (test-equal "#%2:2:2((1 2) (3 4))" (ra->string (list->ra 2 '((1 2) (3 4)))))
- (test-equal "#%2:2:3((1 2 3) (4 5 6))" (ra->string (list->ra 2 '((1 2 3) (4 5 6)))))
- (test-equal "#%2:3:2((1 2) (3 4) (5 6))" (ra->string (list->ra 2 '((1 2) (3 4) (5 6)))))
- (test-equal "#%1:2((1 2) (3 4))" (ra->string (list->ra 1 '((1 2) (3 4)))))
- (test-equal "#%0(((1 2) (3 4)))" (ra->string (list->ra 0 '((1 2) (3 4)))))
- (test-equal "#%0f64(99.0)" (ra->string (list->typed-ra 'f64 0 99)))
- (test-equal "#%1f64:3(1.0 2.0 3.0)" (ra->string (list->typed-ra 'f64 1 '(1 2 3))))
- (test-equal "#%2f64:2:2((1.0 2.0) (3.0 4.0))" (ra->string (list->typed-ra 'f64 2 '((1 2) (3 4)))))
- (test-equal "#%1f64@1:3(1.0 2.0 3.0)" (ra->string (list->typed-ra 'f64 '(1) '(1 2 3))))
- (test-equal "#%1f64@1:3(1.0 2.0 3.0)" (ra->string (list->typed-ra 'f64 '((1 3)) '(1 2 3))))
- (test-equal "#%1f64@-1:3(1.0 2.0 3.0)" (ra->string (list->ra 'f64 '(-1) '(1 2 3))))
- (test-equal "#%1f64@-1:3(1.0 2.0 3.0)" (ra->string (list->ra 'f64 '((-1 1)) '(1 2 3))))
- ; -----------------------
- ; ra-index-map!
- ; -----------------------
- (test-equal "#%2:2:3(((0 0) (0 1) (0 2)) ((1 0) (1 1) (1 2)))"
- (ra->string (let ((x (make-ra 0 2 3))) (ra-index-map! x (lambda x x)))))
- (test-equal "#%0(99)"
- (ra->string (let ((x (make-ra 0))) (ra-index-map! x (lambda x 99)))))
- ; -----------------------
- ; ra-dimensions, ra-shape
- ; -----------------------
- (test-equal '((-1 3) (0 4))
- (ra-shape (make-ra 'foo '(-1 3) 5)))
- (test-equal '((-1 3) 5)
- (ra-dimensions (make-ra 'foo '(-1 3) 5)))
- ; -----------------------
- ; raw prefix match
- ; -----------------------
- (let ((ra0 (ra-i 2 3))
- (ra1 (ra-i 2)))
- (test-equal
- "#%2d:2:3((0 1 2) (3 4 5))-#%1d:2(0 1)|"
- (call-with-output-string
- (lambda (o) (ra-slice-for-each 0 (lambda (ra0 ra1) (format o "~a-~a|" ra0 ra1)) ra0 ra1))))
- (test-equal
- "#%1d:3(0 1 2)-#%0d(0)|#%1d:3(3 4 5)-#%0d(1)|"
- (call-with-output-string
- (lambda (o) (ra-slice-for-each 1 (lambda (ra0 ra1) (format o "~a-~a|" ra0 ra1)) ra0 ra1))))
- (test-equal
- "#%0d(0)-#%0d(0)|#%0d(1)-#%0d(0)|#%0d(2)-#%0d(0)|#%0d(3)-#%0d(1)|#%0d(4)-#%0d(1)|#%0d(5)-#%0d(1)|"
- (call-with-output-string
- (lambda (o) (ra-slice-for-each 2 (lambda (ra0 ra1) (format o "~a-~a|" ra0 ra1)) ra0 ra1))))
- (test-assert
- (throws-exception? 'unset-len-for-dim
- (lambda () (ra-slice-for-each 3 (lambda (ra0 ra1) 0) ra0 ra1)))))
- ; -----------------------
- ; prefix match on item (not cell) variants
- ; -----------------------
- (test-assert
- (ra-equal?
- (string->ra "#%1:2(-2 -5)")
- (let ((ra0 (ra-copy #t (ra-i 2 3)))
- (ra1 (ra-copy #t (ra-i 2))))
- (ra-map! ra1 - ra0))))
- (test-assert
- (ra-equal?
- (string->ra "#%2:2:3((0 0 0) (-1 -1 -1))")
- (let ((ra0 (ra-copy #t (ra-i 2 3)))
- (ra1 (ra-copy #t (ra-i 2))))
- (ra-map! ra0 - ra1))))
- (test-assert
- (ra-equal?
- (string->ra "#%3:4:3:2(((0 0) (1 1) (2 2)) ((3 3) (4 4) (5 5)) ((6 6) (7 7) (8 8)) ((9 9) (10 10) (11 11)))")
- (ra-copy! (make-ra 99 4 3 2) (ra-i 4 3))))
- (test-assert
- (ra-equal?
- (string->ra "#%2:3:2((77 77) (77 77) (77 77))")
- (ra-copy! (make-ra 99 3 2) (make-ra 77))))
- ; -----------------------
- ; ra-fold
- ; -----------------------
- ; these are slow :-/
- ; numpy (1.16.2) - time(np.sum(np.arange(1e8))) ~ 0.15 s
- ; octave (4.4.1) - a = time(); b=sum(0:999999999); time()-a ~ 3.1 s
- ; newra - ,time (ra-fold + 0 (ra-iota #e1e8)) ~ 4.7 s
- (test-equal (* #e1e6 (- #e1e6 1) 1/2) (ra-fold + 0 (ra-iota #e1e6)))
- (test-equal (* #e1e6 (- #e1e6 1) 1/2) (ra-fold + 0 (ra-i 100 100 100)))
- ; -----------------------
- ; ra-any ra-every
- ; -----------------------
- (test-assert (ra-every positive? (list->ra 1 '(1 2 3 4 5))))
- (test-equal -3 (ra-any (lambda (x) (and (negative? x) x)) (list->ra 1 '(1 2 -3 4 5))))
- (test-equal #(0 2) (ra-any (lambda (a i j) (and (zero? a) (vector i j)))
- (list->ra 2 '((3 4 0) (1 2 9)))
- (ra-iota #f)
- (ra-transpose (ra-iota #f) 1)))
- ; -----------------------
- ; inf dims I - (make-dim #f) = (make-dim #f 0 1)
- ; -----------------------
- (test-assert (ra-equal? (ra-i 3) (make-ra-root (make-aseq) (c-dims 3))))
- ; inf dimension
- (test-assert (not (dim-len (make-dim #f))))
- ; make an array out of inf root
- (test-assert (ra-equal? (ra-i 3) (make-ra-root (make-aseq) (c-dims 3))))
- ; make an inf array
- (let ((rainf (make-ra-root (make-aseq) (c-dims #t))))
- (throws-exception? 'unset-len-for-dim (lambda () (ra-for-each pk rainf)))
- (test-equal #(10 8 6) (ra->array (ra-map! (make-ra #f 3) - (ra-iota 3 10 -1) rainf)))
- (test-equal #(-10 -8 -6) (ra->array (ra-map! (make-ra #f 3) - rainf (ra-iota 3 10 -1)))))
- (let ((rainf (ra-i #t 3 4)))
- (test-equal #(1204 1205 1206 1207) (ra->array (ra-copy #t (rainf 100 1))))
- (test-equal '(#f 3 4) (ra-dimensions rainf)))
- ; properties of inf arrays
- (test-equal '((#f #f)) (ra-shape (ra-iota)))
- ; -----------------------
- ; inf dims II - (make-dim #f 0 0) = dead axis
- ; -----------------------
- (test-equal
- #2((11 12 13) (21 22 23))
- (ra->array
- (ra-map! (make-ra #f 2 3) +
- (make-ra-root #(10 20) (vector (make-dim 2 0 1) (make-dim #f 0 0)))
- (make-ra-root #(1 2 3) (vector (make-dim #f 0 0) (make-dim 3 0 1))))))
- ; using generalized transpose
- (test-equal
- #2((11 12 13) (21 22 23))
- (ra->array
- (ra-map! (make-ra #f 2 3) +
- (ra-iota 2 10 10)
- (ra-transpose (ra-iota 3 1 1) 1))))
- ; copying arrays with dead axes
- (let ((ra (ra-copy #t (ra-transpose (ra-i 3) 1))))
- (test-equal "#%2:d:3((0 1 2))" (ra->string ra))
- (test-equal #(0 1 2) (ra-root ra)))
- ; -----------------------
- ; inf dims III - dimensions can be unbounded in both directions. For these the origin is 0.
- ; -----------------------
- (let ((ii (make-ra-root (make-aseq) (vector (make-dim #f #f 1)))))
- (test-equal 99 (ra-ref ii 99))
- (test-equal -99 (ra-ref ii -99)))
- ; -----------------------
- ; from
- ; -----------------------
- (define fromu (@ (newra from) fromu))
- (define fromb (@ (newra from) fromb))
- (define A (ra-map! (make-ra 0 10 10) + (ra-transpose (ra-iota 10) 1) (ra-iota 10 0 10)))
- (define b (ra-i 2))
- (define c (make-ra-root (make-aseq 10 2) (vector (make-dim 3 1))))
- (define d (ra-i 2 2))
- (define iz (ra-i 3))
- (ra-from A iz)
- (ra-from A 0)
- (test-equal "#%2:3:10((0 1 2 3 4 5 6 7 8 9) (10 11 12 13 14 15 16 17 18 19) (20 21 22 23 24 25 26 27 28 29))"
- (ra->string (ra-from A (ra-copy #t (ra-iota 3)))))
- (test-equal "#%2:3:2((0 1) (10 11) (20 21))" (ra->string (ra-from A (ra-iota 3) (ra-iota 2))))
- ; manual examples
- (let* ((a (list->ra 2 '((1 2 3) (a b c))))
- (b (ra-from a #t (ra-iota 3 2 -1)))
- (bc (ra-from-copy a #t (ra-iota 3 2 -1)))
- (c (ra-from a #t (list->ra 1 '(2 1 0)))))
- (test-equal "#%2:2:3((3 2 1) (c b a))" (ra->string b) (ra->string c))
- (test-assert (eq? (ra-root a) (ra-root b)))
- (test-assert (not (eq? (ra-root a) (ra-root bc))))
- (test-assert (not (eq? (ra-root a) (ra-root c)))))
- ; ------------------------
- ; tests
- ; ------------------------
- (define (test-from-from? id A . i)
- ; to be able to test integers on fromu
- (let ((ii (map (match-lambda ((? ra? x) x) ((? integer? x) (make-ra x))) i)))
- (test-begin id)
- ; beatable vs unbeatable
- (test-assert (ra-equal? (apply fromb A i) (apply fromu A ii)))
- ; general as unbeatable (except integers), vs unbeatable
- (test-assert (ra-equal? (apply ra-from A (map (lambda (x) (if (ra? x) (ra-copy #t x) x)) i))
- (apply fromu A ii)))
- ; general as beatable, vs beatable
- (let ((X (apply ra-from A i))
- (Y (apply fromb A i)))
- (test-assert (ra-equal? X Y))
- ; purely beatable indices preserve the root.
- (test-eq (ra-root A) (ra-root Y))
- (test-eq (ra-root A) (ra-root X)))
- ; general as beatable, vs unbeatable
- (test-assert (ra-equal? (apply ra-from A i) (apply fromu A ii)))
- ; general as unbeatable/beatable (2 args), vs unbeatable
- (match i
- ((i j)
- (match ii
- ((ii jj)
- (test-assert (ra-equal? (ra-from A (if (ra? i) (ra-copy #t i) i) j)
- (fromu A ii jj)))
- (test-assert (ra-equal? (ra-from A i (if (ra? j) (ra-copy #t j) j))
- (fromu A ii jj))))))
- (else #f))
- (test-end id)))
- ; ------------------------
- ; one arg
- ; rank 0
- (test-from-from? "00" A (make-ra-root (make-aseq 3) (vector)))
- (test-from-from? "01" A 2)
- (test-from-from? "02" A (make-ra 2))
- ; rank 1
- (test-from-from? "03" A (ra-iota 3))
- (test-from-from? "04" A (make-ra-root (make-aseq) (vector (make-dim 3 1 1))))
- (test-from-from? "05" A (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 1))))
- (test-from-from? "06" A (make-ra-root (make-aseq 1 2) (vector (make-dim 3 1 1))))
- (test-from-from? "07" A (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 2))))
- (test-from-from? "08" A (make-ra-root (make-aseq 3 2) (vector (make-dim 2 1 3))))
- ; rank 2
- (test-from-from? "09" A (ra-i 2 2))
- (test-from-from? "10" A (make-ra-root (make-aseq 3) (vector (make-dim 2 1 2) (make-dim 2 1 3))))
- ; ------------------------
- ; two args
- ; rank 0 0
- (test-from-from? "11" A (make-ra-root (make-aseq 3) (vector))
- (make-ra-root (make-aseq 2) (vector)))
- (test-from-from? "12" A 3 (make-ra-root (make-aseq 2) (vector)))
- (test-from-from? "13" A (make-ra-root (make-aseq 3) (vector)) 2)
- (test-from-from? "14" A 3 2)
- ; rank 1 1
- (test-from-from? "15" A (ra-iota 3) (ra-iota 2 4))
- (test-from-from? "16" A (make-ra-root (make-aseq) (vector (make-dim 3 1 1)))
- (make-ra-root (make-aseq) (vector (make-dim 3 1 2))))
- (test-from-from? "17" A (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 1)))
- (make-ra-root (make-aseq 1 2) (vector (make-dim 3 1 1))))
- (test-from-from? "18" A (make-ra-root (make-aseq 1 2) (vector (make-dim 3 1 1)))
- (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 2))))
- (test-from-from? "19" A (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 2)))
- (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 2))))
- (test-from-from? "20" A (make-ra-root (make-aseq 3 2) (vector (make-dim 2 1 3)))
- (make-ra-root (make-aseq 1 1) (vector (make-dim 3 1 2))))
- ; rank 2 2
- (test-from-from? "21" A (ra-i 3 3) (ra-i 2 2))
- (test-from-from? "22" A (make-ra-root (make-aseq 3) (vector (make-dim 2 1 2) (make-dim 2 1 3)))
- (make-ra-root (make-aseq 3) (vector (make-dim 2 1 2) (make-dim 2 1 3))))
- ; placeholders
- (let* ((a (ra-i 2 3 4 5 6))
- (ref0 (ra-from a 0 (ra-iota 3)))
- (ref1 (ra-from a 0 (ra-iota 3) 1))
- (ref2 (ra-from a 0 (ra-iota 3) (ra-iota 4) (ra-iota 5) 2)))
- (test-assert (ra-equal? a (ra-from a #t)))
- (test-assert (ra-equal? a (ra-from a (ldots 1))))
- (test-assert (ra-equal? a (ra-from a #t #t #t #t #t)))
- (test-assert (ra-equal? a (ra-from a (ldots))))
- (test-assert (ra-equal? ref0 (ra-from a 0 #t)))
- (test-assert (ra-equal? ref0 (ra-from a 0 (ldots 1))))
- (test-assert (ra-equal? ref0 (ra-from a 0 (ldots 0))))
- (test-assert (ra-equal? ref1 (ra-from a 0 #t 1)))
- (test-assert (ra-equal? ref1 (ra-from a 0 (ldots 1) 1)))
- (test-assert (ra-equal? ref2 (ra-from a 0 #t #t #t 2)))
- (test-assert (ra-equal? ref2 (ra-from a 0 (ldots 3) 2)))
- (test-assert (ra-equal? ref2 (ra-from a 0 (ldots) 2))))
- ; ------------------------
- ; other A
- (throws-exception? 'dim-check-out-of-range (lambda () (ra-from (ra-i 4) (ra-iota 6))))
- (throws-exception? 'dim-check-out-of-range (lambda () (ra-from (ra-i 4) 4)))
- (let ((A (make-ra-root (make-aseq) (vector (make-dim 4 -3 1)))))
- (test-equal 0 (ra-ref (fromu A (make-ra -3))))
- (test-equal 0 (ra-ref (fromb A -3)))
- (test-equal 0 (ra-ref (ra-from A -3)))
- (test-equal 0 (ra-ref (fromu A (make-ra -3))))
- (test-equal 0 (ra-ref (fromb A (make-ra -3))))
- (test-equal 0 (ra-ref (ra-from A (make-ra -3)))))
- (let ((A (make-ra-root #(0 1 2 3 4 5 6 7) (vector (make-dim 4 -3 1)))))
- (test-equal 0 (ra-ref (fromu A (make-ra -3))))
- (test-equal 0 (ra-ref (fromb A -3)))
- (test-equal 0 (ra-ref (ra-from A -3)))
- (test-equal 0 (ra-ref (fromu A (make-ra -3))))
- (test-equal 0 (ra-ref (fromb A (make-ra -3))))
- (test-equal 0 (ra-ref (ra-from A (make-ra -3)))))
- (test-equal "#%1d:2(0 1)" (ra->string (ra-from (ra-i 4) (ra-iota 2))))
- (test-equal "#%1d:4(0 1 2 3)" (ra->string (ra-from (ra-i #t) (ra-iota 4))))
- (test-equal "#%1d:4(0 -1 -2 -3)" (ra->string (ra-from (make-ra-root (make-aseq) (vector (make-dim 4 -3 -1))) (ra-iota 4 -3))))
- ; note that arrays are always indexed upwards, so you cannot have (lo hi) be (#f number).
- (throws-exception? 'dim-check-out-of-range (lambda () (ra-from (ra-i #f) (ra-iota 4 -3)))) ; error: -3 < 0
- (throws-exception? 'dim-check-out-of-range
- (lambda () (ra-from (make-ra-root (make-aseq) (vector (make-dim 4 -3 -1)))
- (ra-iota 5 -3)))) ; -3+5 > -3+4
- (throws-exception? 'dim-check-out-of-range (lambda () (ra-from (ra-i 4) (ra-iota #f))))
- (throws-exception? 'dim-check-out-of-range (lambda () (ra-from (ra-copy #t (ra-i 4)) (ra-iota #f))))
- (let ((A (make-ra-root (make-aseq) (vector (make-dim 4 1 3) (make-dim 3 1)))))
- (test-equal "#%1d@1:4(1 4 7 10)" (ra->string (ra-from A #t 2)))
- (test-equal "#%1d@1:3(3 4 5)" (ra->string (ra-from A 2 #t))))
- ; -----------------------
- ; ra-amend! FIXME needs more tests
- ; -----------------------
- (define (ra-I . i) (ra-copy #t (apply ra-i i)))
- (define (amend-case A . i) (ra->string (apply ra-amend! A i)))
- (test-equal "#%2:2:3((a b c) (3 4 5))" (amend-case (ra-I 2 3) (array->ra #(a b c)) 0))
- (test-equal "#%2:2:3((0 1 2) (x y z))" (amend-case (ra-I 2 3) (array->ra #(x y z)) 1))
- (test-equal "#%2:2:3((a 1 2) (b 4 5))" (amend-case (ra-I 2 3) (array->ra #(a b)) #t 0))
- (test-equal "#%2:2:3((0 x 2) (3 y 5))" (amend-case (ra-I 2 3) (array->ra #(x y)) #t 1))
- (test-equal "#%2:2:3((x x x) (x x x))" (amend-case (ra-I 2 3) 'x))
- (test-equal "#%2:2:3((x x x) (x x x))" (amend-case (ra-I 2 3) (make-ra 'x)))
- (test-equal "#%2:2:3((a a a) (b b b))" (amend-case (ra-I 2 3) (array->ra #(a b))))
- (test-equal "#%2:2:3((x y z) (x y z))" (amend-case (ra-I 2 3) (ra-transpose (array->ra #(x y z)) 1)))
- (test-equal "#%2:2:3((0 x 2) (3 x 5))" (amend-case (ra-I 2 3) 'x (array->ra #(0 1)) 1))
- (test-equal "#%2:2:3((0 x 2) (3 x 5))" (amend-case (ra-I 2 3) 'x (ra-i 2) 1))
- (test-equal "#%2:2:3((a b c) (3 4 5))" (amend-case (ra-I 2 3) (array->ra #2((a b c))) (array->ra #(0))))
- (test-equal "#%2:2:3((0 1 2) (x y z))" (amend-case (ra-I 2 3) (array->ra #2((x y z))) (array->ra #(1))))
- (test-equal "#%2:2:3((a 1 2) (b 4 5))" (amend-case (ra-I 2 3) (array->ra #(a b)) #t 0))
- (test-equal "#%2:2:3((0 x 2) (3 y 5))" (amend-case (ra-I 2 3) (array->ra #(x y)) #t 1))
- (test-equal "#%2:2:3((a 1 2) (b 4 5))" (amend-case (ra-I 2 3) (array->ra #2((a) (b))) #t (array->ra #(0))))
- (test-equal "#%2:2:3((0 x 2) (3 y 5))" (amend-case (ra-I 2 3) (array->ra #2((x) (y))) #t (array->ra #(1))))
- (test-equal "#%2:2:3((x y 2) (j k 5))" (amend-case (ra-I 2 3) (array->ra #2((x y) (j k))) #t (array->ra #(0 1))))
- (test-equal "#%2:2:3((a 1 b) (3 4 5))" (amend-case (ra-I 2 3) (array->ra #(a b)) 0 (array->ra #(0 2))))
- (test-equal "#%2:2:3((0 x 2) (3 y 5))" (amend-case (ra-I 2 3) (array->ra #(x y)) #t 1))
- (test-equal "#%1:3(b 2 a)" (amend-case (list->ra 1 '(1 2 3)) (array->ra #(a b)) (array->ra #(2 0))))
- (test-equal "#%2:2:3((k 1 j) (y 4 x))" (amend-case (ra-I 2 3) (array->ra #2((x y) (j k))) (array->ra #(1 0)) (array->ra #(2 0))))
- (test-equal "#%2:2:3((0 x 2) (3 4 5))" (amend-case (ra-I 2 3) 'x 0 1))
- ; adapted from guile-ploy
- (test-equal "#%1:20(#f a a b b #f c c #f d #f d #f #f #f #f #f #f #f #f)"
- (amend-case (make-ra #f 20) (array->ra #(a b c d)) (array->ra #2((1 2) (3 4) (6 7) (9 11)))))
- ; with placeholders
- (test-equal "#%3:4:3:2(((0 x) (2 x) (4 x)) ((6 x) (8 x) (10 x)) ((12 x) (14 x) (16 x)) ((18 x) (20 x) (22 x)))"
- (amend-case (ra-I 4 3 2) 'x (ldots) 1))
- ; -----------------------
- ; ra-ravel
- ; -----------------------
- (test-assert (ra-order-c? (ra-i)))
- (test-assert (ra-order-c? (ra-i 2)))
- (test-assert (ra-order-c? (ra-i 2 3)))
- (test-assert (ra-order-c? (ra-i 2 3 4)))
- (test-assert (not (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 0 1 3 2))))
- (test-assert (not (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 0 1 3 2) 3)))
- (test-assert (ra-order-c? (ra-transpose (ra-i 1 2 3 4) 0 1 3 2) 2))
- (test-assert (ra-order-c? (ra-transpose (ra-i 1 2 3 4) 0 1 3 2) 1))
- (test-assert (not (ra-order-c? (ra-from (ra-i 1 2 3 4) #t #t #t (ra-iota 2 0 2))))) ; last step 1, packed
- (test-assert (ra-order-c? (ra-from (ra-i 1 2 3 4) #t #t #t (ra-iota 2 0 2)) 4))
- (test-assert (ra-order-c? (ra-tile (ra-i 1 2 3 4) 0 1)))
- (test-assert (ra-order-c? (ra-transpose (ra-i 5 1 3 1 4) 0 3 2 1)))
- (test-assert (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 1 0 2 3) 2 2))
- (test-assert (not (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 1 0 2 3) 2 1)))
- (test-assert (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 3 1 2 0) 2 1))
- (test-assert (not (ra-order-c? (ra-transpose (ra-i 2 3 4 5) 3 1 2 0) 2 2)))
- (test-equal "#%1:18(1 7 13 2 8 14 3 9 15 4 10 16 5 11 17 6 12 18)"
- (ra->string
- (ra-ravel
- (ra-transpose
- (make-ra-root (list->vector (iota 18 1)) (c-dims '(1 3) '(4 9)))
- 1 0))))
- (let ((ra (make-ra-root (list->vector (iota 18 1)) (c-dims '(1 3) '(4 9)))))
- (test-eq (ra-root ra) (ra-root (ra-ravel ra)))
- (test-equal "#%1:18(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18)"
- (ra->string (ra-ravel ra))))
- (test-equal "#%1:1(3)" (ra->string (ra-ravel (make-ra 3))))
- ; partial ravel
- (define (test-ravel-n ra keep-root?)
- (let loop ((i (ra-rank ra)))
- (when (>= i 0)
- (let ((ri (ra-ravel ra i)))
- (when keep-root?
- (test-assert (ra-equal? (ra-ravel ri) (ra-ravel ra)))
- (test-eq (ra-root ra) (ra-root ri)))
- (test-equal (ra->list (ra-ravel ri)) (ra->list (ra-ravel ra)))
- (test-equal (+ (ra-rank ra) 1 (- i)) (ra-rank ri)))
- (loop (- i 1)))))
- (let* ((ra (ra-i 2 3 4 5 6))
- (rb (ra-from (ra-i 2 3 4 5 6) #t #t #t #t (ra-iota 3 0 2))))
- (test-ravel-n ra #t)
- (test-ravel-n rb #t)
- (test-ravel-n (ra-transpose ra 1 0) #f)
- (test-ravel-n (ra-transpose rb 1 0) #f))
- ; not prefix, free ravel
- (test-equal "#%2d:2:12((0 1 2 3 4 5 6 7 8 9 10 11) (12 13 14 15 16 17 18 19 20 21 22 23))"
- (ra->string (ra-ravel (ra-i 2 3 4) 2 1)))
- ; not prefix, copy required
- (test-assert "#%2:2:12((0 4 8 1 5 9 2 6 10 3 7 11) (12 16 20 13 17 21 14 18 22 15 19 23))"
- (ra->string (ra-ravel (ra-transpose (ra-i 2 3 4) 0 2 1) 2 1)))
- ; -----------------------
- ; ra-reshape
- ; -----------------------
- (define (test-reshape k a shape check-shape)
- (let* ((b (apply ra-reshape a k shape)))
- (test-assert (ra-equal? (ra-ravel a) (ra-ravel b)))
- (test-eq (ra-root a) (ra-root b))
- (test-equal check-shape (ra-shape b))))
- (test-reshape 0 (ra-i 4 4)
- '(2 2) '((0 1) (0 1) (0 3)))
- (test-reshape 1 (ra-i 4 4)
- '(2 2) '((0 3) (0 1) (0 1)))
- (test-reshape 0 (ra-i 6)
- '(2 3) '((0 1) (0 2)))
- (test-reshape 0 (ra-i 6)
- '((2 4) (3 4)) '((2 4) (3 4)))
- (test-reshape 0 (ra-transpose (ra-i 3 2 4) 1 2 0)
- '(2 2) '((0 1) (0 1) (0 2) (0 1)))
- (test-reshape 0 (ra-from (make-ra-root (make-aseq) (c-dims '(4 9) '(1 4))) (ra-iota 4 5) (ra-iota 2 1))
- '((1 2) 2) '((1 2) (0 1) (0 1)))
- (test-reshape 0 (ra-transpose (make-ra-root (list->vector (iota 18 1)) (c-dims '(1 3) '(4 9))) 1 0)
- '(2 3) '((0 1) (0 2) (1 3)))
- (test-reshape 0 (ra-transpose (make-ra-root (make-aseq) (c-dims '(4 9) '(1 4))) 1 0)
- '((1 2) 2) '((1 2) (0 1) (4 9)))
- ; reshape of inf length - but lo must be set
- (let* ((a (ra-iota #f 9))
- (b (ra-reshape a 0 '(2 3))))
- (test-equal '((2 3)) (ra-shape b))
- (test-eq (ra-root a) (ra-root b))
- (test-equal 9 (ra-ref b 2))
- (test-equal 10 (ra-ref b 3)))
- ; -----------------------
- ; ra-tile
- ; -----------------------
- (define (test-tile a shape check-shape)
- (let* ((b (apply ra-tile a 0 shape)))
- (ra-slice-for-each 2 (lambda (b) (test-assert (ra-equal? a b)))
- ; enable loop in the dead axis case since there's only that argument.
- (ra-singletonize b))
- (test-assert (eq? (ra-root a) (ra-root b)))
- (test-equal check-shape (ra-shape b))))
- (test-tile (ra-i 5)
- '(2 3) '((0 1) (0 2) (0 4)))
- (test-tile (ra-transpose (make-ra-root (make-aseq) (c-dims '(4 9) '(1 4))) 1 0)
- '(2 3) '((0 1) (0 2) (1 4) (4 9)))
- (test-tile (ra-transpose (make-ra-root (make-aseq) (c-dims '(4 9) '(1 4))) 1 0)
- '((2 4) (-1 3)) '((2 4) (-1 3) (1 4) (4 9)))
- (test-tile (ra-i 5)
- '(2 #f) '((0 1) (0 #f) (0 4)))
- ; -----------------------
- ; ra-rotate!
- ; -----------------------
- (let ((a (ra-copy #t (ra-i 4 3))))
- (ra-rotate! 0 a)
- (test-assert (ra-equal? (string->ra "#%2:4:3((0 1 2) (3 4 5) (6 7 8) (9 10 11))") a))
- (ra-rotate! 1 a)
- (test-assert (ra-equal? (string->ra "#%2:4:3((3 4 5) (6 7 8) (9 10 11) (0 1 2))") a))
- (ra-rotate! 2 a)
- (test-assert (ra-equal? (string->ra "#%2:4:3((9 10 11) (0 1 2) (3 4 5) (6 7 8))") a))
- (ra-rotate! 3 a)
- (test-assert (ra-equal? (string->ra "#%2:4:3((6 7 8) (9 10 11) (0 1 2) (3 4 5))") a))
- (ra-rotate! -1 a)
- (test-assert (ra-equal? (string->ra "#%2:4:3((3 4 5) (6 7 8) (9 10 11) (0 1 2))") a)))
- ; -----------------------
- ; ra-singletonize
- ; -----------------------
- (test-equal '(1 2 1 3) (ra-dimensions (ra-singletonize (ra-transpose (ra-i 2 3) 1 3))))
- ; -----------------------
- ; ra-clip
- ; -----------------------
- (let* ((i0 (ra-transpose (ra-iota) 0))
- (i1 (ra-transpose (ra-iota) 1))
- (i2 (ra-transpose (ra-iota) 2))
- (f (lambda a (format #f "~{~a~}" a)))
- (b (ra-clip (ra-map! (make-ra-new #t 'a (c-dims '(4 6) '(0 2) '(0 4))) f i0 i1 i2)
- (ra-map! (make-ra-new #t 'b (c-dims '(2 9) '(1 4))) f i0 i1))))
- (test-equal '((4 6) (1 2) (0 4)) (ra-shape b))
- (test-equal
- "#%3@4:3@1:2:5(((\"410\" \"411\" \"412\" \"413\" \"414\") (\"420\" \"421\" \"422\" \"423\" \"424\")) ((\"510\" \"511\" \"512\" \"513\" \"514\") (\"520\" \"521\" \"522\" \"523\" \"524\")) ((\"610\" \"611\" \"612\" \"613\" \"614\") (\"620\" \"621\" \"622\" \"623\" \"624\")))"
- (ra->string b)))
- ; -----------------------
- ; a bug in c0f60b1b76118a601715d331c265d1126b0d1e7c & before
- ; -----------------------
- (let ()
- (define ra0 (make-ra-root #f64(0 1 2 3 4)))
- (define ra1 (ra-copy! (make-typed-ra 'f64 0 5) ra0))
- (test-assert (ra-equal? ra0 ra1))
- (test-equal (ra-ref ra0 4) (ra-ref ra1 4)))
- (let ()
- (define ra0 (make-ra-root #u8(0 1 2 3 4)))
- (define ra1 (ra-copy! (make-typed-ra 'u8 0 5) ra0))
- (test-assert (ra-equal? ra0 ra1))
- (test-equal (ra-ref ra0 4) (ra-ref ra1 4)))
- ; -----------------------
- ; ra-slice creates a new descriptor with no shared dim vector
- ; -----------------------
- (let ()
- (define ra0 (ra-i 2 3 4))
- (define v0 (vector-copy (ra-dims ra0)))
- (define ra1 (ra-slice ra0))
- (test-assert (not (eq? (ra-dims ra0) (ra-dims ra1))))
- (vector-for-each (lambda (a b) (test-equal a b))
- v0 (ra-dims ra1))
- (vector-fill! (ra-dims ra1) #f)
- (vector-for-each (lambda (a b) (test-equal a b))
- v0 (ra-dims ra0)))
- ; -----------------------
- ; concatenation
- ; -----------------------
- (test-assert (ra-equal? (ra-cat #t 0 (ra-i 1 2) (ra-i 2 2)) (array->ra #2((0 1) (0 1) (2 3)))))
- (test-assert (ra-equal? (ra-cat #t 0 (ra-iota 2 1) (ra-iota 3 3)) (array->ra #1(1 2 3 4 5))))
- (test-assert (ra-equal? (ra-cat #t -1 (ra-iota 2 1) (ra-iota 2 4)) (array->ra #2((1 2) (4 5)))))
- (test-assert (ra-equal? (ra-cat #t 1 (ra-iota 2 1) (ra-iota 2 4)) (array->ra #2((1 4) (2 5)))))
- (test-assert (ra-equal? (ra-cat #t 0 (make-ra 'a) (ra-iota 2)) (array->ra #1(a 0 1))))
- (test-assert (ra-equal? (ra-cat #t 1 (make-ra 'a) (ra-iota 2)) (array->ra #2((a 0) (a 1)))))
- (test-assert (ra-equal? (ra-cat #t -1 (make-ra 'a) (ra-iota 2)) (array->ra #2((a a) (0 1)))))
- (test-assert (ra-equal? (ra-cat #t 1 (array->ra #(a b)) (ra-i 2 2)) (array->ra #2((a 0 1) (b 2 3)))))
- (test-assert (ra-equal? (ra-cat #t 0 (array->ra #(a b)) (ra-i 2 2)) (array->ra #2((a a) (b b) (0 1) (2 3)))))
- (test-assert (ra-equal? (ra-scat #t 0 (make-ra 'a) (make-ra 'b) (make-ra 'c)) (array->ra #1(a b c))))
- (test-assert (ra-equal? (ra-scat #t 1 (make-ra 'a) (make-ra 'b) (make-ra 'c)) (array->ra #2((a) (b) (c)))))
- (test-assert (ra-equal? (ra-scat #t 0 (array->ra #(1 2 3)) (make-ra 4) (array->ra #(5 6))) (array->ra #1(1 2 3 4 5 6))))
- (test-assert (ra-equal? (ra-scat #t 0 (array->ra #2((0 1) (2 3))) (array->ra #(a b))) (array->ra #2((0 1 a b) (2 3 a b)))))
- (test-assert (ra-equal? (ra-scat #t 1 (array->ra #2((0 1) (2 3))) (array->ra #(a b))) (array->ra #2((0 1) (2 3) (a b)))))
- (test-assert (ra-equal? (ra-scat #t 0 (array->ra #2((0 1))) (array->ra #(a))) (array->ra #2((0 1 a)))))
- (test-assert (ra-equal? (ra-scat #t -1 (array->ra #(1 2 3)) (array->ra #(a b c))) (array->ra #2((1 a) (2 b) (3 c)))))
- (test-assert (ra-equal? (ra-scat #t -1 (make-ra 'a) (array->ra #(x y z))) (array->ra #2((a x) (a y) (a z)))))
- ; non-zero base indices on the concat axis
- (let* ((a0 (ra-i 2 4))
- (a1 (ra-reshape a0 0 '(1 2)))
- (b (ra-i 1 4)))
- (test-assert (ra-equal? (ra-cat #t 0 a0 b) (ra-cat #t 0 a1 b))))
- (let* ((a0 (ra-i 4 2))
- (a1 (ra-untranspose (ra-reshape (ra-transpose a0 1 0) 0 '(1 2)) 1 0))
- (b (ra-i 4 1)))
- (test-assert (ra-equal? (ra-scat #t 0 a0 b) (ra-scat #t 0 a1 b))))
- ; non-zero base indices on a non-concat axis
- (let ((a (make-ra 'a '(1 2) '(1 4)))
- (b (make-ra 'b '(1 3) '(1 4))))
- (test-equal "#%2:5@1:4((a a a a) (a a a a) (b b b b) (b b b b) (b b b b))"
- (ra->string (ra-cat #t 0 a b)))
- (test-equal "#%2:5@1:4((a a a a) (a a a a) (b b b b) (b b b b) (b b b b))"
- (ra->string (ra-scat #t 1 a b))))
- ; -----------------------
- ; ra-map
- ; -----------------------
- ; this requires ra-slice-for-each-check to fix axes where largest rank argument has dead
- (test-equal "#%2f64:3:4((1.0 2.0 3.0 4.0) (2.0 4.0 6.0 8.0) (3.0 6.0 9.0 12.0))"
- (ra->string (ra-map 'f64 * (ra-iota 3 1) (ra-transpose (ra-iota 4 1) 1))))
- ; lower bounds are respected
- (test-equal "#%2:2@1:3((9 9 9) (18 18 18))"
- (ra->string (ra-map #t * (ra-iota 2 1) (ra-transpose (make-ra 9 '(1 3)) 1))))
- (test-equal "#%2:3:4((1 2 3 4) (6 7 8 9) (11 12 13 14))"
- (ra->string (ra-map #f + (ra-iota 3 1) (ra-i 3 4))))
- ; -----------------------
- ; demo of ra-format FIXME somehow check
- ; -----------------------
- (let* ((ra (ra-i 1 8 9 3))
- (ra (ra-map! (ra-copy #t ra) sqrt ra)))
- (ra-format ra #:fmt "~4,2f"))
- (let ((ra (ra-set! (ra-set! (ra-copy #t (ra-i 3 4 3))
- (ra-i 2 3) 1 2 1)
- (make-ra-root #(hello world of ras) (c-dims 2 2))
- 2 1 2)))
- (ra-format ra #:fmt "~a"))
- (let ((ra (ra-i 2 2 2 2 2 2 2 2)))
- (ra-format ra #:compact? #t))
- (let* ((ra (ra-set! (ra-copy #t (ra-i 7)) (make-ra-root #(hello world of ras) (c-dims 2 2)) 3))
- (ra (ra-tile ra (ra-rank ra) 1)))
- (ra-format ra))
- ; example from srfi-163.
- (let* ((arr
- #2@1:2@1:3((#2((1 2) (3 4)) 9 #2((3 4) (5 6)))
- (#(42 43) #2((8 7 6)) #2((90 91) (100 101)))))
- (ra (array->ra arr))
- (ra (ra-map! (ra-copy ra) (lambda (x) (if (array? x) (array->ra x) x)) ra)))
- (ra-format ra #:prefix? #t #:compact? #t)
- (ra-format ra #:prefix? #t #:compact? #f))
- (let ((ra (array->ra #2@1:2@1:3((1 2 3) (4 5 6)))))
- (ra-format ra))
- (let ((ra (make-ra 'zero)))
- (ra-format ra))
- ; shorter than the prefix; was a bug
- (let ((ra (make-ra 'x)))
- (ra-format ra))
- ; when size is 0, just print the prefix
- (ra-format (ra-i 3 0 4))
- ; when size is unbounded, just print the prefix. Not ideal...
- (ra-format (ra-i #t 3 4))
- ; when there are dead axes, print the result of ra-singletonize, except for the prefix. Not ideal...
- (ra-format (ra-i 3 #f 4))
- ; -----------------------
- ; the end.
- ; -----------------------
- ;; (define error-count (test-runner-fail-count (test-runner-current)))
- ;; (test-end "newra")
- ;; (exit error-count)
|