factor: trim using lists

[factor.git] / extra / math / finance / finance.factor

diff --git a/extra/math/finance/finance.factor b/extra/math/finance/finance.factor
index e02f4be6240b6dfd07f4bc73fa7696072961da76..e1566f60273be1fe1d1686e8076116b090bcd86d 100644 (file)
--- a/extra/math/finance/finance.factor
+++ b/extra/math/finance/finance.factor
@@ -1,24 +1,39 @@
-! Copyright (C) 2008 John Benediktsson.
+! Copyright (C) 2008 John Benediktsson, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs kernel grouping sequences shuffle
-math math.functions math.statistics math.vectors ;
+USING: grouping kernel math math.statistics math.vectors
+sequences ;
 IN: math.finance
 
+: sma ( seq n -- newseq )
+    clump [ mean ] map ;
+
 <PRIVATE
 
-: weighted ( x y a -- z )
-    tuck [ * ] [ 1- neg * ] 2bi* + ;
+: weighted ( prev elt a -- newelt )
+    [ 1 swap - * ] [ * ] bi-curry bi* + ; inline
 
 : a ( n -- a )
-    1+ 2 swap / ;
+    1 + 2 swap / ; inline
 
 PRIVATE>
 
 : ema ( seq n -- newseq )
-    a swap unclip [ [ dup ] 2dip spin weighted ] accumulate 2nip ;
+    [ cut [ mean dup ] dip ] [ a ] bi
+    [ weighted dup ] curry map nip swap prefix ;
 
-: sma ( seq n -- newseq )
-    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 )
     rot dup ema [ swap ema ] dip v- ;
@@ -26,3 +41,17 @@ PRIVATE>
 : momentum ( seq n -- newseq )
     [ 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