steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sequences.modified: simplify M\ summed modified-nth.

windows-high-dpi
John Benediktsson 2018-02-17 17:03:39 -08:00
parent 8cfeab92f3
commit baddc58f93
1 changed files with 12 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
extra/sequences/modified/modified.factor
View File

@ -1,29 +1,33 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel locals math math.order USING: accessors arrays kernel locals math sequences
sequences sequences.private shuffle ; sequences.private ;
IN: sequences.modified IN: sequences.modified
TUPLE: modified ; TUPLE: modified ;
GENERIC: modified-nth ( n seq -- elt ) GENERIC: modified-nth ( n seq -- elt )
M: modified nth modified-nth ; M: modified nth modified-nth ;
M: modified nth-unsafe modified-nth ; M: modified nth-unsafe modified-nth ;
GENERIC: modified-set-nth ( elt n seq -- ) GENERIC: modified-set-nth ( elt n seq -- )
M: modified set-nth modified-set-nth ; M: modified set-nth modified-set-nth ;
M: modified set-nth-unsafe modified-set-nth ; M: modified set-nth-unsafe modified-set-nth ;
INSTANCE: modified virtual-sequence INSTANCE: modified sequence
TUPLE: 1modified < modified seq ; TUPLE: 1modified < modified seq ;
M: modified length seq>> length ; M: modified length seq>> length ;
M: modified set-length seq>> set-length ; M: modified set-length seq>> set-length ;
M: 1modified virtual-exemplar seq>> ; M: 1modified like seq>> like ;
M: 1modified new-sequence seq>> new-sequence ;
TUPLE: scaled < 1modified c ; TUPLE: scaled < 1modified c ;
C: <scaled> scaled C: <scaled> scaled
: scale ( seq c -- new-seq ) : scale ( seq c -- new-seq )
@ -37,6 +41,7 @@ M:: scaled modified-set-nth ( elt n seq -- )
elt seq c>> / n seq seq>> set-nth ; elt seq c>> / n seq seq>> set-nth ;
TUPLE: offset < 1modified n ; TUPLE: offset < 1modified n ;
C: <offset> offset C: <offset> offset
: seq-offset ( seq n -- new-seq ) : seq-offset ( seq n -- new-seq )
@ -49,22 +54,13 @@ M:: offset modified-set-nth ( elt n seq -- )
elt seq n>> - n seq seq>> set-nth ; elt seq n>> - n seq seq>> set-nth ;
TUPLE: summed < modified seqs ; TUPLE: summed < modified seqs ;
C: <summed> summed C: <summed> summed
M: summed length seqs>> longest length ; M: summed length seqs>> longest length ;
<PRIVATE
: ?+ ( x/f y/f -- sum )
! addition that treats f as 0
[
swap [ + ] when*
] [
[ ] [ 0 ] if*
] if* ;
PRIVATE>
M: summed modified-nth ( n seq -- elt ) M: summed modified-nth ( n seq -- elt )
seqs>> [ ?nth ?+ ] with 0 swap reduce ; seqs>> [ ?nth [ + ] when* ] with 0 swap reduce ;
M: summed modified-set-nth ( elt n seq -- ) immutable ; M: summed modified-set-nth ( elt n seq -- ) immutable ;
@ -75,4 +71,5 @@ M: summed virtual-exemplar ( summed -- seq )
seqs>> ?first ; seqs>> ?first ;
: <2summed> ( seq seq -- summed-seq ) 2array <summed> ; : <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
: <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ; : <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;