| 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 *) |
| 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) |
| 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) |
| 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 |
Parent Directory
| 
Revision Log
| 
Patch
