1 ! Copyright (C) 2008 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel math math.order
4 sequences sequences.private shuffle ;
9 GENERIC: modified-nth ( n seq -- elt )
10 M: modified nth modified-nth ;
11 M: modified nth-unsafe modified-nth ;
13 GENERIC: modified-set-nth ( elt n seq -- )
14 M: modified set-nth modified-set-nth ;
15 M: modified set-nth-unsafe modified-set-nth ;
17 INSTANCE: modified virtual-sequence
19 TUPLE: 1modified < modified seq ;
21 M: modified length seq>> length ;
22 M: modified set-length seq>> set-length ;
24 M: 1modified virtual-seq seq>> ;
26 TUPLE: scaled < 1modified c ;
29 : scale ( seq c -- new-seq )
30 dupd <scaled> swap like ;
32 M: scaled modified-nth ( n seq -- elt )
33 [ seq>> nth ] [ c>> * ] bi ;
35 M: scaled modified-set-nth ( elt n seq -- elt )
37 tuck [ c>> / ] 2dip seq>> set-nth ;
39 TUPLE: offset < 1modified n ;
42 : seq-offset ( seq n -- new-seq )
43 dupd <offset> swap like ;
45 M: offset modified-nth ( n seq -- elt )
46 [ seq>> nth ] [ n>> + ] bi ;
48 M: offset modified-set-nth ( elt n seq -- )
49 tuck [ n>> - ] 2dip seq>> set-nth ;
51 TUPLE: summed < modified seqs ;
54 M: summed length seqs>> [ length ] [ max ] map-reduce ;
57 : ?+ ( x/f y/f -- sum )
58 #! addition that treats f as 0
66 M: summed modified-nth ( n seq -- )
67 seqs>> [ ?nth ?+ ] with 0 swap reduce ;
69 M: summed modified-set-nth ( elt n seq -- ) immutable ;
71 M: summed set-length ( n seq -- )
72 seqs>> [ set-length ] with each ;
74 M: summed virtual-seq ( summed -- seq ) [ ] { } map-as ;
76 : <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
77 : <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;