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