-! Copyright (C) 2008 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
+! Copyright (C) 2008 John Benediktsson, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: grouping kernel math math.statistics math.vectors
+sequences ;
+IN: math.finance
-USING: arrays kernel grouping math math.statistics sequences ;
+: sma ( seq n -- newseq )
+ clump [ mean ] map ;
-IN: math.finance
+<PRIVATE
-: enumerate ( seq -- newseq )
- #! Returns a sequence where each element and its index
- -1 swap [ [ 1+ ] dip swap [ 2array ] keep swap ] { } map-as swap drop ;
+: weighted ( prev elt a -- newelt )
+ [ 1 swap - * ] [ * ] bi-curry bi* + ; inline
+
+: a ( n -- a )
+ 1 + 2 swap / ; inline
+
+PRIVATE>
: ema ( seq n -- newseq )
- #! An exponentially-weighted moving average:
- #! A = 2.0 / (N + 1)
- #! EMA[t] = (A * VAL[t]) + ((1-A) * EMA[t-1])
- 1+ 2.0 swap / dup 1 swap - swap rot
- [ [ dup ] dip * ] map swap drop 0 swap
- [ [ dup ] 2dip [ * ] dip + dup ] map
- [ drop drop ] dip 1 tail-slice >array ;
+ [ cut [ mean dup ] dip ] [ a ] bi
+ [ weighted dup ] curry map nip swap prefix ;
-: sma ( seq n -- newseq )
- #! Simple moving average
- clump [ mean ] map ;
+: dema ( seq n -- newseq )
+ [ ema ] keep [ drop 2 v*n ] [ ema ] 2bi
+ [ length tail* ] keep v- ;
+
+: gdema ( seq n v -- newseq )
+ [ [ ema ] keep dupd ema ] dip
+ [ 1 + v*n ] [ v*n ] bi-curry bi*
+ [ length tail* ] keep v- ;
+
+: tema ( seq n -- newseq )
+ [ ema ] keep dupd [ ema ] keep
+ [ drop [ 3 v*n ] bi@ [ length tail* ] keep v- ] [ ema nip ] 3bi
+ [ length tail* ] keep v+ ;
: macd ( seq n1 n2 -- newseq )
- #! Moving Average Convergence Divergence
- #! MACD[t] = EMA2[t] - EMA1[t]
- rot dup ema [ swap ema ] dip [ - ] 2map ;
+ rot dup ema [ swap ema ] dip v- ;
: momentum ( seq n -- newseq )
- #! Momentum
- #! M[t] = P[t] - P[t-n]
- 2dup tail-slice -rot swap [ length ] keep
- [ - neg ] dip swap head-slice [ - ] 2map ;
+ [ tail-slice ] 2keep [ dup length ] dip - head-slice v- ;
+
+: performance ( seq -- newseq )
+ dup first '[ _ [ - ] [ /f ] bi 100 * ] map ;
+
+: monthly ( x -- y ) 12 / ; inline
+
+: semimonthly ( x -- y ) 24 / ; inline
+
+: biweekly ( x -- y ) 26 / ; inline
+
+: weekly ( x -- y ) 52 / ; inline
+: daily-360 ( x -- y ) 360 / ; inline
+: daily-365 ( x -- y ) 365 / ; inline