1 USING: accessors arrays io kernel math namespaces splitting
2 prettyprint sequences sorting vectors words inverse summary
3 shuffle math.functions sets ;
6 TUPLE: dimensioned value top bot ;
8 ERROR: dimensions-not-equal ;
10 M: dimensions-not-equal summary drop "Dimensions do not match" ;
12 : remove-one ( seq obj -- seq )
13 1array split1 append ;
15 : 2remove-one ( seq seq obj -- seq seq )
16 [ remove-one ] curry bi@ ;
18 : symbolic-reduce ( seq seq -- seq seq )
20 [ first 2remove-one symbolic-reduce ] unless-empty ;
22 : <dimensioned> ( n top bot -- obj )
27 : >dimensioned< ( d -- n top bot )
28 [ bot>> ] [ top>> ] [ value>> ] tri ;
30 \ <dimensioned> [ [ dimensioned boa ] undo ] define-inverse
32 : dimensions ( dimensioned -- top bot )
33 [ top>> ] [ bot>> ] bi ;
35 : check-dimensions ( d d -- )
36 [ dimensions 2array ] same?
37 [ throw-dimensions-not-equal ] unless ;
39 : 2values ( dim dim -- val val ) [ value>> ] bi@ ;
41 : <dimension-op ( dim dim -- top bot val val )
42 2dup check-dimensions dup dimensions 2swap 2values ;
44 : dimension-op> ( top bot val -- dim )
47 : d+ ( d d -- d ) <dimension-op + dimension-op> ;
49 : d- ( d d -- d ) <dimension-op - dimension-op> ;
52 { } { } <dimensioned> ;
55 [ dup number? [ scalar ] when ] bi@
56 [ [ top>> ] bi@ append ] 2keep
57 [ [ bot>> ] bi@ append ] 2keep
58 2values * dimension-op> ;
60 : d-neg ( d -- d ) -1 d* ;
62 : d-sq ( d -- d ) dup d* ;
65 >dimensioned< recip dimension-op> ;
67 : d/ ( d d -- d ) d-recip d* ;
69 : comparison-op ( d d -- n n ) 2dup check-dimensions 2values ;
71 : d< ( d d -- ? ) comparison-op < ;
73 : d<= ( d d -- ? ) comparison-op <= ;
75 : d> ( d d -- ? ) comparison-op > ;
77 : d>= ( d d -- ? ) comparison-op >= ;
79 : d= ( d d -- ? ) comparison-op number= ;
81 : d~ ( d d delta -- ? ) [ comparison-op ] dip ~ ;
83 : d-min ( d d -- d ) [ d< ] most ;
85 : d-max ( d d -- d ) [ d> ] most ;
87 : d-product ( v -- d ) 1 scalar [ d* ] reduce ;
89 : d-sum ( v -- d ) unclip-slice [ d+ ] reduce ;
91 : d-infimum ( v -- d ) unclip-slice [ d-min ] reduce ;
93 : d-supremum ( v -- d ) unclip-slice [ d-max ] reduce ;
95 \ d+ [ d- ] [ d- ] define-math-inverse
96 \ d- [ d+ ] [ d- ] define-math-inverse
97 \ d* [ d/ ] [ d/ ] define-math-inverse
98 \ d/ [ d* ] [ d/ ] define-math-inverse
99 \ d-recip [ d-recip ] define-inverse