extra/sequences/repeating/repeating.factor

   1 ! Copyright (C) 2008 Alex Chapman
   2 ! Copyright (C) 2012 John Benediktsson
   3 ! Copyright (C) 2023 nomennescio
   4 ! See https://factorcode.org/license.txt for BSD license
   5 USING: accessors circular kernel math sequences ;
   6 IN: sequences.repeating
   7
   8 TUPLE: cycles
   9 { circular circular read-only }
  10 { length integer read-only } ;
  11
  12 : <cycles> ( seq length -- cycles )
  13     [ <circular> ] dip cycles boa ;
  14
  15 : cycle ( seq length -- new-seq )
  16     dupd <cycles> swap like ;
  17
  18 : repeat ( seq times -- new-seq )
  19     over length * cycle ;
  20
  21 M: cycles length length>> ;
  22
  23 M: cycles set-length length<< ;
  24
  25 M: cycles virtual@ circular>> ;
  26
  27 M: cycles virtual-exemplar circular>> ;
  28
  29 INSTANCE: cycles virtual-sequence
  30
  31 <PRIVATE
  32
  33 : full-cycle? ( cycle -- ? ) [ length>> ] [ circular>> length ] bi >= ; inline
  34
  35 PRIVATE>
  36
  37 M: cycles minimum dup full-cycle? [ circular>> minimum ] [ (minimum) ] if ; inline
  38 M: cycles maximum dup full-cycle? [ circular>> maximum ] [ (maximum) ] if ; inline
  39
  40 TUPLE: element-repeats < sequence-view
  41 { times integer read-only } ;
  42
  43 C: <element-repeats> element-repeats
  44
  45 M: element-repeats length [ seq>> length ] [ times>> ] bi * ;
  46
  47 M: element-repeats virtual@ [ times>> /i ] [ seq>> ] bi ;
  48
  49 INSTANCE: element-repeats immutable-sequence
  50
  51 : repeat-elements ( seq times -- new-seq )
  52     dupd <element-repeats> swap like ;