extra/sequences/modified/modified.factor

   1 ! Copyright (C) 2008 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays kernel locals math sequences
   4 sequences.private ;
   5 IN: sequences.modified
   6
   7 TUPLE: modified ;
   8
   9 GENERIC: modified-nth ( n seq -- elt )
  10
  11 M: modified nth modified-nth ;
  12 M: modified nth-unsafe modified-nth ;
  13
  14 GENERIC: modified-set-nth ( elt n seq -- )
  15
  16 M: modified set-nth modified-set-nth ;
  17 M: modified set-nth-unsafe modified-set-nth ;
  18
  19 INSTANCE: modified sequence
  20
  21 TUPLE: 1modified < modified seq ;
  22
  23 M: modified length seq>> length ;
  24 M: modified set-length seq>> set-length ;
  25
  26 M: 1modified like seq>> like ;
  27 M: 1modified new-sequence seq>> new-sequence ;
  28
  29 TUPLE: scaled < 1modified c ;
  30
  31 C: <scaled> scaled
  32
  33 : scale ( seq c -- new-seq )
  34     dupd <scaled> swap like ;
  35
  36 M: scaled modified-nth ( n seq -- elt )
  37     [ seq>> nth ] [ c>> * ] bi ;
  38
  39 M:: scaled modified-set-nth ( elt n seq -- )
  40     ! don't set c to 0!
  41     elt seq c>> / n seq seq>> set-nth ;
  42
  43 TUPLE: offset < 1modified n ;
  44
  45 C: <offset> offset
  46
  47 : seq-offset ( seq n -- new-seq )
  48     dupd <offset> swap like ;
  49
  50 M: offset modified-nth ( n seq -- elt )
  51     [ seq>> nth ] [ n>> + ] bi ;
  52
  53 M:: offset modified-set-nth ( elt n seq -- )
  54     elt seq n>> - n seq seq>> set-nth ;
  55
  56 TUPLE: summed < modified seqs ;
  57
  58 C: <summed> summed
  59
  60 M: summed length seqs>> longest length ;
  61
  62 M: summed modified-nth ( n seq -- elt )
  63     seqs>> [ ?nth [ + ] when* ] with 0 swap reduce ;
  64
  65 M: summed modified-set-nth ( elt n seq -- ) immutable ;
  66
  67 M: summed set-length ( n seq -- )
  68     seqs>> [ set-length ] with each ;
  69
  70 M: summed virtual-exemplar ( summed -- seq )
  71     seqs>> ?first ;
  72
  73 : <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
  74
  75 : <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;