! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel locals math math.order
-sequences sequences.private shuffle ;
+USING: accessors arrays kernel math sequences sequences.private ;
IN: sequences.modified
TUPLE: modified ;
GENERIC: modified-nth ( n seq -- elt )
+
M: modified nth modified-nth ;
M: modified nth-unsafe modified-nth ;
GENERIC: modified-set-nth ( elt n seq -- )
+
M: modified set-nth modified-set-nth ;
M: modified set-nth-unsafe modified-set-nth ;
TUPLE: 1modified < modified seq ;
-M: modified length seq>> length ;
-M: modified set-length seq>> set-length ;
-
+M: 1modified length seq>> length ;
+M: 1modified set-length seq>> set-length ;
M: 1modified virtual-exemplar seq>> ;
TUPLE: scaled < 1modified c ;
+
C: <scaled> scaled
: scale ( seq c -- new-seq )
dupd <scaled> swap like ;
-M: scaled modified-nth ( n seq -- elt )
+M: scaled modified-nth
[ seq>> nth ] [ c>> * ] bi ;
-M:: scaled modified-set-nth ( elt n seq -- elt )
+M: scaled modified-set-nth
! don't set c to 0!
- elt seq c>> / n seq seq>> set-nth ;
+ [ nip c>> / ] [ seq>> set-nth ] 2bi ;
TUPLE: offset < 1modified n ;
+
C: <offset> offset
: seq-offset ( seq n -- new-seq )
dupd <offset> swap like ;
-M: offset modified-nth ( n seq -- elt )
+M: offset modified-nth
[ seq>> nth ] [ n>> + ] bi ;
-M:: offset modified-set-nth ( elt n seq -- )
- elt seq n>> - n seq seq>> set-nth ;
+M: offset modified-set-nth
+ [ nip n>> - ] [ seq>> set-nth ] 2bi ;
TUPLE: summed < modified seqs ;
-C: <summed> summed
-M: summed length seqs>> [ length ] [ max ] map-reduce ;
+C: <summed> summed
-<PRIVATE
-: ?+ ( x/f y/f -- sum )
- #! addition that treats f as 0
- [
- swap [ + ] when*
- ] [
- [ ] [ 0 ] if*
- ] if* ;
-PRIVATE>
+M: summed length seqs>> longest length ;
-M: summed modified-nth ( n seq -- )
- seqs>> [ ?nth ?+ ] with 0 swap reduce ;
+M: summed modified-nth
+ seqs>> [ ?nth [ + ] when* ] with 0 swap reduce ;
-M: summed modified-set-nth ( elt n seq -- ) immutable ;
+M: summed modified-set-nth immutable ;
-M: summed set-length ( n seq -- )
+M: summed set-length
seqs>> [ set-length ] with each ;
-M: summed virtual-exemplar ( summed -- seq )
- seqs>> [ f ] [ first ] if-empty ;
+M: summed virtual-exemplar
+ seqs>> ?first ;
: <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
+
: <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;