Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

# SCM Repository

[smlnj] Diff of /sml/trunk/src/smlnj-lib/Util/univariate-stats.sml
 [smlnj] / sml / trunk / src / smlnj-lib / Util / univariate-stats.sml

# Diff of /sml/trunk/src/smlnj-lib/Util/univariate-stats.sml

revision 1720, Thu Dec 9 22:23:42 2004 UTC revision 1733, Thu Dec 16 05:37:04 2004 UTC
# Line 12  Line 12
12       * kind permits calculation of average deviation and median.       * kind permits calculation of average deviation and median.
13       * It is also considerably more expensive because it keeps an       * It is also considerably more expensive because it keeps an
14       * array of all points while the "light" variety is constant-size. *)       * array of all points while the "light" variety is constant-size. *)
15      type light type heavy      type light
16        type heavy
17
18      type 'a sample              (* light or heavy *)      type 'a sample              (* light or heavy *)
19      type 'a evaluation          (* light or heavy *)      type 'a evaluation          (* light or heavy *)
# Line 46  Line 47
47      infix 8 \$  val op \$ = Unsafe.Array.sub      infix 8 \$  val op \$ = Unsafe.Array.sub
48      infix 3 <- fun (a, i) <- x = Unsafe.Array.update (a, i, x)      infix 3 <- fun (a, i) <- x = Unsafe.Array.update (a, i, x)
49
50      type light = unit      (* two kinds of "extra info" *)
51      type heavy = real array * int      type light = unit             (* nothing *)
52      type 'a sample = ('a * int * real * real * real * real)      type heavy = real array * int (* rubber array of points, size *)
53      type 'a evaluation = ('a * int * real * real * real * real * real * real)      (* a sample : extra info * N * sum x^4 * sum x^3 * sum x^2 * sum x : *)
54        type 'a sample = 'a * int * real * real * real * real
55      fun insert (x, n, (a, sz)) =      (* an evaluation: extra info * N * N as real *
56          let val (a, sz) =       *                             mean * variance * standard deviation *
57                  if n<sz then (a, sz)       *                             skew * kurtosis : *)
58                  else let val sz = sz+sz      datatype 'a evaluation =
59                           val b=Array.tabulate(sz,fn i=>if i<n then a\$i else 0.0)               E of { ext_info: 'a, (* extra info *)
60                       in (b, sz) end                      ni:   int,    (* number of points *)
61          in (a,n)<-x; (a, sz) end                      nr:   real,   (* number of points (as real) *)
62                        mean: real,
63                        sd2:  real,   (* sd*sd = variance *)
64                        sd:   real,   (* standard deviation *)
65                        skew: real,
66                        kurtosis: real }
67
68      val SZ = 1024               (* minimum allocated size of heavy array *)      val SZ = 1024               (* minimum allocated size of heavy array *)
69      val lempty = ((), 0, 0.0, 0.0, 0.0, 0.0)      val lempty = ((), 0, 0.0, 0.0, 0.0, 0.0)
# Line 65  Line 71
71
72      fun ladd (x:real, ((), n, sx4, sx3, sx2, sx1)) =      fun ladd (x:real, ((), n, sx4, sx3, sx2, sx1)) =
73          let val x2 = x*x val (x3, x4) = (x2*x, x2*x2)          let val x2 = x*x val (x3, x4) = (x2*x, x2*x2)
74          in ((), n+1, sx4+x4, sx3+x3, sx2+x2, sx1+x) end          in ((), n+1, sx4+x4, sx3+x3, sx2+x2, sx1+x)
75            end
76
77      fun hadd (x:real, ((a, sz), n, sx4, sx3, sx2, sx1)) =      fun hadd (x:real, ((a, sz), n, sx4, sx3, sx2, sx1)) =
78          let val x2 = x*x val (x3, x4) = (x2*x, x2*x2)          let val x2 = x*x val (x3, x4) = (x2*x, x2*x2)
# Line 79  Line 86
86             ((a, sz), n+1, sx4+x4, sx3+x3, sx2+x2, sx1+x)             ((a, sz), n+1, sx4+x4, sx3+x3, sx2+x2, sx1+x)
87          end          end
88
89      fun evaluate (state, ni, sx4, sx3, sx2, sx1) =      fun evaluate (ext_info, ni, sx4, sx3, sx2, sx1) =
90          let val n = real ni         val n' = n - 1.0          let val n = real ni
91              val m = sx1/n           val m2 = m*m         val m3 = m2*m              val n' = n-1.0
92                val m = sx1/n
93                val m2 = m*m
94                val m3 = m2*m
95              val sd2 = (sx2 + m*(n*m-2.0*sx1))/n'              val sd2 = (sx2 + m*(n*m-2.0*sx1))/n'
96              val sd = Math.sqrt sd2  val (sd3, sd4) = (sd*sd2, sd2*sd2)              val sd = Math.sqrt sd2
97                val (sd3, sd4) = (sd*sd2, sd2*sd2)
98              val sk = (sx3-m*(3.0*(sx2-sx1*m)+n*m2))/(n*sd3)              val sk = (sx3-m*(3.0*(sx2-sx1*m)+n*m2))/(n*sd3)
99              val k = ((sx4+m*(6.0*sx2*m-4.0*(sx3+sx1*m2)+n*m3))/(n*sd4))-3.0              val k = ((sx4+m*(6.0*sx2*m-4.0*(sx3+sx1*m2)+n*m3))/(n*sd4))-3.0
100          in (state, ni, n, m, sd2, sd, sk, k) end          in E { ext_info = ext_info, ni = ni, nr = n, mean = m,
101                   sd2 = sd2, sd = sd, skew = sk, kurtosis = k }
102            end
103
104        fun unE (E r) = r
105
106      fun N (state, ni, nr, m, sd2, sd, sk, k) = ni      fun N e = #ni (unE e)
107      fun n (state, ni, nr, m, sd2, sd, sk, k) = nr      fun n e = #nr (unE e)
108      fun mean (state, ni, nr, m, sd2, sd, sk, k) = m      fun mean e = #mean (unE e)
109      fun variance (state, ni, nr, m, sd2, sd, sk, k) = sd2      fun variance e = #sd2 (unE e)
110      fun standardDeviation (state, ni, nr, m, sd2, sd, sk, k) = sd      fun standardDeviation e = #sd (unE e)
111      fun skew (state, ni, nr, m, sd2, sd, sk, k) = sk      fun skew e = #skew (unE e)
112      fun kurtosis (state, ni, nr, m, sd2, sd, sk, k) = k      fun kurtosis e = #kurtosis (unE e)
113
114      fun median ((a, sz), ni, nr, m, sd2, sd, sk, k) =      fun median (E { ext_info = (a, _), ni, ... }) =
115          RealOrderStats.median' (ArraySlice.slice (a, 0, SOME ni))          RealOrderStats.median' (ArraySlice.slice (a, 0, SOME ni))
116
117      fun averageDeviation ((a, sz), ni, nr, m, sd2, sd, sk, k) =      fun averageDeviation (E { ext_info = (a, _), ni, nr, mean = m, ... }) =
118          let fun ad (i, ds) = if i>ni then ds/nr else ad (i+1, ds + abs(a\$i-m))          let fun ad (i, ds) = if i>ni then ds/nr else ad (i+1, ds + abs(a\$i-m))