74 lines
1.5 KiB
Factor
74 lines
1.5 KiB
Factor
! Copyright (C) 2008 Alex Chapman
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors arrays kernel locals 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 ;
|
|
|
|
INSTANCE: modified virtual-sequence
|
|
|
|
TUPLE: 1modified < modified seq ;
|
|
|
|
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
|
|
[ seq>> nth ] [ c>> * ] bi ;
|
|
|
|
M: scaled modified-set-nth
|
|
! don't set c to 0!
|
|
[ 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
|
|
[ seq>> nth ] [ n>> + ] bi ;
|
|
|
|
M: offset modified-set-nth
|
|
[ nip n>> - ] [ seq>> set-nth ] 2bi ;
|
|
|
|
TUPLE: summed < modified seqs ;
|
|
|
|
C: <summed> summed
|
|
|
|
M: summed length seqs>> longest length ;
|
|
|
|
M: summed modified-nth
|
|
seqs>> [ ?nth [ + ] when* ] with 0 swap reduce ;
|
|
|
|
M: summed modified-set-nth immutable ;
|
|
|
|
M: summed set-length
|
|
seqs>> [ set-length ] with each ;
|
|
|
|
M: summed virtual-exemplar
|
|
seqs>> ?first ;
|
|
|
|
: <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
|
|
|
|
: <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;
|