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
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1732, Thu Dec 16 05:07:47 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))
119          in ad (0, 0.0) end          in ad (0, 0.0) end
120  end  end

Legend:
Removed from v.1732  
changed lines
  Added in v.1733

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0