rng_poisson lambda
634 | | Binomial(n,p) ->
635 | let rec step n k = if n<=0 then k else step (n-1) (if gen.uniform_float64()
638 | // adopted from VC++2012u3
639 | let v = rng_gamma r (r/mean)
640 | rng_poisson(v)
641 | | Mixture(components) ->
642 | let rec oneof f c =
643 | match c with
644 | | [] -> failwith "empty mixture!"
645 | | (w,d)::tail ->
646 | if f <= w then draw gen d else oneof (f-w) tail
647 | oneof (gen.uniform_float64()) components
648 | //| _ -> raise (System.NotImplementedException())
649 |
650 |
651 | // Computes Pearson's correlation coefficient for two float arrays
652 | // The Pearson correlation is defined only if both of the standard deviations are finite and both of them are nonzero.
653 | // Returns NaN, otherwise.
654 | let correlation (x:float[]) (y:float[]) =
655 | if x.Length <> y.Length then invalidOp "Different lengths of arrays"
656 | let filtered = Seq.zip x y |> Seq.filter (fun(u,v) -> not (isNan(u) || isNan(v) || isInf(u) || isInf(v))) |> Array.ofSeq;
657 | let n = filtered.Length
658 | if n <= 1 then System.Double.NaN else
659 | let _x, _y = Array.map fst filtered, Array.map snd filtered
660 | let sx, sy = summary _x, summary _y
661 | let stdx, stdy = sqrt sx.variance, sqrt sy.variance
662 | if stdx = 0.0 || stdy = 0.0 || isInf(stdx) || isInf(stdy) then System.Double.NaN else
663 | let d1 = float(n) * sx.mean * sy.mean
664 | let d2 = float(n-1) * stdx * stdy
665 | ((filtered |> Array.map (fun(s,t)->s*t) |> Array.sum) - d1)/d2
666 |
667 | // KDE
668 |
669 | // adopted from MathNet.Numerics
670 | // https://github.com/mathnet/mathnet-numerics/blob/v3.9.0/src/Numerics/IntegralTransforms/Fourier.RadixN.cs
671 |
672 | open System.Numerics
673 |
674 | let private InverseScaleByOptions(samples:Complex[]) =
675 | let scalingFactor = 1.0/(float samples.Length)
676 | for i in 0..samples.Length-1 do
677 | samples.[i] <- samples.[i] * Complex(scalingFactor, 0.)
678 |
679 | let private ForwardScaleByOptions(samples:Complex[]) =
680 | let scalingFactor = sqrt(1.0/(float samples.Length))
681 | for i in 0..samples.Length-1 do
682 | samples.[i] <- samples.[i] * Complex(scalingFactor, 0.)
683 |
684 |
685 | let private Radix2Reorder(samples:'T[]) =
686 | let mutable j = 0
687 | for i in 0..samples.Length - 2 do
688 | if (i < j) then
689 | let temp = samples.[i]
690 | samples.[i] <- samples.[j]
691 | samples.[j] <- temp
692 |
693 | let mutable m = samples.Length
694 | let mutable cont = true
695 | while cont do
696 | m <- m >>> 1;
697 | j <- j ^^^ m;
698 | cont <- (j &&& m) = 0
699 |
700 | let private Radix2Step(samples:Complex[], exponentSign:int, levelSize:int, k:int) =
701 | // Twiddle Factor
702 | let exponent = (float exponentSign*float k)*pi/float levelSize
703 | let w = Complex(cos(exponent), sin(exponent))
704 | let step = levelSize <<< 1
705 | for i in k..step..samples.Length-1 do
706 | let ai = samples.[i]
707 | let t = w*samples.[i + levelSize]
708 | samples.[i] <- ai + t
709 | samples.[i + levelSize] <- ai - t
710 |
711 | let private Radix2(samples:Complex[], exponentSign:int) =
712 | let rec is_power_two x p =
713 | if x = p then true
714 | elif x < p then false
715 | else is_power_two x (2*p)
716 | if not <| is_power_two samples.Length 1 then invalidArg "samples" "The array length must be a power of 2."
717 |
718 | Radix2Reorder(samples)
719 | let mutable levelSize = 1
720 | while levelSize < samples.Length do
721 | for k = 0 to levelSize-1 do Radix2Step(samples, exponentSign, levelSize, k)
722 | levelSize <- levelSize * 2
723 |
724 |
725 |
726 | let private fi x = float(x)
727 |
728 | /// Inverse Fast Fourier Transform.
729 | let ifft (xs:Complex[]) =
730 | let samples = Array.copy xs
731 | Radix2(samples,1)
732 | let scalingFactor = 1.0/(float samples.Length)
733 | for i in 0..samples.Length-1 do
734 | let v = samples.[i]
735 | samples.[i] <- Complex(scalingFactor * v.Real, scalingFactor * v.Imaginary)
736 | samples
737 |
738 | /// Fast Fourier transform.
739 | let fft (xs:Complex[]) =
740 | let samples = Array.copy xs
741 | Radix2(samples,-1)
742 | samples
743 |
744 | let private (|Even|Odd|) input = if input % 2 = 0 then Even else Odd
745 |
746 | /// Descrete cosine transform.
747 | let dct (rxs:float[]) =
748 | let xs = Array.map (fun x -> Complex(x,0.0)) rxs
749 | let len = xs.Length
750 | let n = fi len
751 | let weights =
752 | let myseq = Seq.init (len-1) (fun x -> Complex(2.0, 0.0) * Complex.Exp(Complex(0.0, fi (x+1) * pi / (2.0*n))))
753 | seq { yield Complex(2.0, 0.0); yield! myseq } |> Array.ofSeq
754 | let backpermute (arr:Complex[]) ind = ind |> Seq.map (fun i -> arr.[i])
755 | let interleaved =
756 | let en = Seq.init ((len+1)/2) (fun i -> i * 2)
757 | let en2 = Seq.init (len/2) (fun i -> len - (i*2) - 1)
758 | backpermute xs (seq{ yield! en; yield! en2 }) |> Array.ofSeq
759 |
760 | Array.map2 (fun (a:Complex) (b:Complex) -> (a*b).Real) weights (fft interleaved)
761 |
762 |
763 | /// Inverse discrete cosine transform.
764 | // idct :: U.Vector CD -> U.Vector Double
765 | // http://hackage.haskell.org/package/statistics-0.10.0.0/docs/src/Statistics-Transform.html
766 | let idct (rxs:float[]) =
767 | let xs = Seq.map (fun x -> Complex(x,0.0)) rxs
768 | let len = rxs.Length
769 | let weights =
770 | let n = fi len
771 | let coeff k = Complex(2.0 * n, 0.0) * Complex.Exp(Complex(0.0, fi (k+1) * pi / (2.0*n)))
772 | seq { yield Complex(n,0.0); for i in 0..len-2 do yield coeff i }
773 | let vals = (Array.map (fun (c:Complex) -> c.Real) << ifft) (Seq.map2 (*) weights xs |> Array.ofSeq)
774 | let interleave z =
775 | let hz = z >>> 1
776 | match z with
777 | | Even _ -> vals.[hz]
778 | | Odd _ -> vals.[len - hz - 1]
779 | [| for i in 0..len-1 do yield interleave(i) |]
780 |
781 | // http://hackage.haskell.org/package/statistics-0.10.5.0/docs/src/Statistics-Function.html#nextHighestPowerOfTwo
782 | //
783 | // Efficiently compute the next highest power of two for a
784 | // non-negative integer. If the given value is already a power of
785 | // two, it is returned unchanged. If negative, zero is returned.
786 | let private nextHighestPowerOfTwo n =
787 | let i0 = n - 1
788 | let i1 = i0 ||| (i0 >>> 1)
789 | let i2 = i1 ||| (i1 >>> 2)
790 | let i4 = i2 ||| (i2 >>> 4)
791 | let i8 = i4 ||| (i4 >>> 8)
792 | let i16 = i8 ||| (i8 >>> 16)
793 | let _i32 = i16 ||| (i16 >>> 32)
794 | 1 + _i32
795 |
796 | let histogram_ n xmin xmax xs =
797 | if n < 1 then invalidArg "n" "must be > 0"
798 | let isNotFinite x = System.Double.IsNaN x || System.Double.IsInfinity x
799 | if isNotFinite xmin then invalidArg "xmin" (sprintf "is %g" xmin)
800 | if isNotFinite xmax then invalidArg "xmax" (sprintf "is %g" xmax)
801 | if xmin >= xmax then invalidOp "xmin should be less than xmax"
802 | let h = Array.zeroCreate n
803 | let step = (xmax - xmin) / float n
804 | let add x =
805 | if not(isNan x) && x >= xmin && x <= xmax then
806 | let idx = min (n-1) (int((x-xmin)/step))
807 | h.[idx] <- h.[idx] + 1
808 | xs |> Seq.iter add
809 | h
810 |
811 | /// Approximate comparison of two double values.
812 | /// Tolerance `ulps` is in units of least precision.
813 | let within (ulps:uint32) a b =
814 | // See e.g. "Comparing Floating Point Numbers, 2012 Edition" by Bruce Dawson
815 | // https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
816 | let ai = System.BitConverter.DoubleToInt64Bits a
817 | let bi = System.BitConverter.DoubleToInt64Bits b
818 | let cmp ai bi = if ai<=bi then bi-ai <= int64 ulps else ai-bi <= int64 ulps
819 | if ai<0L && bi>=0L then cmp (System.Int64.MinValue-ai) bi
820 | elif ai>=0L && bi<0L then cmp ai (System.Int64.MinValue-bi)
821 | else cmp ai bi
822 |
823 | /// Root of a function using Ridders method.
824 | // Ridders, C.F.J. (1979) A new algorithm for computing a single
825 | // root of a real continuous function.
826 | // /IEEE Transactions on Circuits and Systems/ 26:979--980.
827 | let ridders tolerance (lb, ub) (f : float->float) =
828 | // The function must have opposite signs when evaluated at the lower
829 | // and upper bounds of the search (i.e. the root must be bracketed).
830 |
831 | let rec iter a fa b fb i =
832 | if 100 <= i then None // Too many iterations performed. Fail
833 | else
834 | if within 1u a b then Some a // Root is bracketed within 1 ulp. No improvement could be made
835 | else
836 | let d = abs(b-a)
837 | let dm = (b-a) * 0.5
838 | let m = a + dm
839 | let fm = f m
840 | if 0.0 = fm then Some m else
841 | let dn = float(sign(fb - fa)) * dm * fm / sqrt(fm*fm - fa*fb)
842 | let n = m - float(sign dn) * min (abs dn) (abs dm - 0.5 * tolerance)
843 | if d < tolerance then Some n else
844 | if n=a || n=b then
845 | // Ridder's approximation coincide with one of old bounds. Revert to bisection
846 | if 0 > sign fm * sign fa then iter a fa m fm (i+1)
847 | else iter m fm b fb (i+1)
848 | else
849 | let fn = f n
850 | if 0.0 = fn then Some n
851 | elif 0.0 > fn*fm then iter n fn m fm (i+1)
852 | elif 0.0 > fn*fa then iter a fa n fn (i+1)
853 | else iter n fn b fb (i+1)
854 |
855 | if not (tolerance>=0.0) then invalidArg "tolerance" "must be greater than 0.0"
856 | let flb = f lb
857 | if 0.0 = flb then Some lb else
858 | let fub = f ub
859 | if 0.0 = fub then Some ub
860 | elif 0.0 < fub*flb then None // root is not bracketed
861 | else iter lb flb ub fub 0
862 |
863 | // from http://hackage.haskell.org/package/statistics-0.10.5.0/docs/src/Statistics-Sample-KernelDensity.html#kde
864 | //
865 | /// Gaussian kernel density estimator for one-dimensional data, using
866 | /// the method of Botev et al.
867 | //
868 | // Botev. Z.I., Grotowski J.F., Kroese D.P. (2010). Kernel density estimation via diffusion.
869 | // /Annals of Statistics/ 38(5):2916-2957.
870 | //
871 | // The result is a pair of vectors, containing:
872 | //
873 | // * The coordinates of each mesh point.
874 | //
875 | // * Density estimates at each mesh point.
876 | //
877 | // n0 The number of mesh points to use in the uniform discretization
878 | // of the interval @(min,max)@. If this value is not a power of
879 | // two, then it is rounded up to the next power of two.
880 | //
881 | // min Lower bound (@min@) of the mesh range.
882 | // max Upper bound (@max@) of the mesh range.
883 | // NaN in the sample are ignored.
884 | let kde2 n0 min max (sample:float seq) =
885 | // check kde2 arguments
886 | if sample = null then invalidArg "sample" "cannot be null"
887 | else if(n0 = 1) then invalidArg "n0" "cannot be 1"
888 | else
889 | let xs = Seq.filter (System.Double.IsNaN >> not) sample |> Array.ofSeq
890 | if Array.isEmpty xs then invalidArg "sample" "doesn't contain numeric values"
891 | let m_sqrt_2_pi = sqrt (2.0*pi)
892 | let m_sqrt_pi = sqrt pi
893 | let r = max - min
894 | let len = fi xs.Length
895 | let ni = nextHighestPowerOfTwo n0
896 | let n = fi ni
897 | let sqr a = a*a
898 | let mesh =
899 | let d = r/(n - 1.0)
900 | Array.init ni (fun z -> min + d * fi z)
901 |
902 | let density =
903 | let a =
904 | let h = Seq.map (fun x -> float(x) / len) (histogram_ ni min max xs) |> Array.ofSeq
905 | let sh = Array.sum h
906 | (dct << Array.map (fun p -> p/sh)) h
907 |
908 | let iv = [| for i in 1..ni-1 do yield sqr(fi i) |]
909 | let a2v = a |> Seq.skip(1) |> Seq.map (fun q -> sqr(q*0.5)) |> Array.ofSeq
910 | let t_star =
911 | let rec f q t =
912 | let g i a2 = i ** q * a2 * exp ((-i) * sqr(pi) * t)
913 | 2.0 * pi ** (q*2.0) * Seq.sum (Seq.map2 g iv a2v)
914 | let rec go s h : float =
915 | let si = fi s
916 | let k0 =
917 | let enum = seq{ for i in 1 .. s do yield 2*i - 1 }
918 | fi(Seq.fold (*) 1 enum) / m_sqrt_2_pi
919 | let _const = (1.0 + 0.5 ** (si+0.5)) / 3.0
920 | let time = (2.0 * _const * k0 / len / h) ** (2.0 / (3.0 + 2.0 * si))
921 | if s=1 then h else go (s-1) (f si time)
922 |
923 | let eq x = x - (len * (2.0 * m_sqrt_pi) * go 6 (f 7.0 x)) ** (-0.4)
924 | match ridders 1e-14 (0.0,0.1) eq with Some root -> root | None -> (0.28 * len ** (-0.4))
925 |
926 | let f2 b z = b * exp (sqr z * sqr pi * t_star * (-0.5))
927 | let a2 = Seq.map2 f2 a [| for i in 0..ni-1 do yield fi i |] |> Array.ofSeq
928 | let a1 = idct a2
929 | let a0 = Array.map (fun x -> x / (2.0*r)) a1
930 | a0
931 | (mesh, density)
932 |
933 | /// Gaussian kernel density estimator for one-dimensional data, using
934 | /// the method of Botev et al.
935 | //
936 | // The result is a pair of vectors, containing:
937 | //
938 | // * The coordinates of each mesh point. The mesh interval is chosen
939 | // to be 20% larger than the range of the sample. (To specify the
940 | // mesh interval, use 'kde2'.)
941 | //
942 | // * Density estimates at each mesh point.
943 | //
944 | // n0 The number of mesh points to use in the uniform discretization
945 | // of the interval @(min,max)@. If this value is not a power of
946 | // two, then it is rounded up to the next power of two.
947 | let kde n0 (xs:float seq) =
948 | if(xs = null) then invalidArg "sample" "cannot be empty"
949 | else
950 | let mutable max = System.Double.MinValue
951 | let mutable min = System.Double.MaxValue
952 | let range =
953 | if Seq.isEmpty xs then
954 | min <- 0.0
955 | max <- 0.0
956 | 1.0 // unreasonable guess
957 | else
958 | xs |> Seq.iter (fun xsi ->
959 | if max < (xsi) then
960 | max <- xsi
961 | if min > (xsi) then
962 | min <- xsi)
963 | if min >= max then 1.0 else max - min
964 | kde2 n0 (min - range/10.0) (max + range/10.0) xs
965 |
966 | module Serialization =
967 | open Angara.Serialization
968 |
969 | let rec serializeDistribution (d:Distribution) =
970 | let islist =
971 | match d with
972 | | Uniform(lower,upper) -> [String "U"; Double lower; Double upper]
973 | | LogUniform(lower,upper) -> [String "LU"; Double lower; Double upper]
974 | | Linear(lower,upper,density) -> [String "L"; Double lower; Double upper; Double density]
975 | | Normal(mean, stdev) -> [String "N"; Double mean; Double stdev]
976 | | LogNormal(mean, stdev) -> [String "LN"; Double mean; Double stdev]
977 | | Gamma(a, b) -> [String "G"; Double a; Double b]
978 | | Binomial(n, p) -> [String "B"; Int n; Double p]
979 | | NegativeBinomial(mean, r) -> [String "NB"; Double mean; Double r]
980 | | Bernoulli(p) -> [String "C"; Double p]
981 | | Exponential(mean) -> [String "E"; Double mean]
982 | | Poisson(mean) -> [String "P"; Double mean]
983 | | Mixture(components) ->
984 | let cc = components |> List.map (fun (weight, c) ->
985 | Seq [Double weight; serializeDistribution c])
986 | [String "M"; Seq(cc)]
987 | Seq islist
988 |
989 | let rec deserializeDistribution (is:InfoSet) =
990 | let invalidInfoSet() = invalidArg "is" "invalid InfoSet"
991 | match is with
992 | | Seq content ->
993 | match content |> List.ofSeq with
994 | | tag::args ->
995 | match tag.ToStringValue() with
996 | | "U" -> match args with [Double lower; Double upper] -> Uniform(lower, upper) | _ -> invalidInfoSet()
997 | | "LU" -> match args with [Double lower; Double upper]-> LogUniform(lower, upper) | _ -> invalidInfoSet()
998 | | "L" -> match args with [Double lower; Double upper; Double density]-> Linear(lower, upper, density) | _ -> invalidInfoSet()
999 | | "N" -> match args with [Double mean; Double stdev]-> Normal(mean, stdev) | _ -> invalidInfoSet()
1000 | | "LN" -> match args with [Double mean; Double stdev]-> LogNormal(mean, stdev) | _ -> invalidInfoSet()
1001 | | "G" -> match args with [Double a; Double b]-> Gamma(a, b) | _ -> invalidInfoSet()
1002 | | "NB" -> match args with [Double mean; Double r]-> NegativeBinomial(mean, r) | _ -> invalidInfoSet()
1003 | | "B" -> match args with [Int n; Double p]-> Binomial(n, p) | _ -> invalidInfoSet()
1004 | | "C" -> match args with [Double p]-> Bernoulli(p) | _ -> invalidInfoSet()
1005 | | "E" -> match args with [Double p]-> Exponential(p) | _ -> invalidInfoSet()
1006 | | "P" -> match args with [Double p]-> Poisson(p) | _ -> invalidInfoSet()
1007 | | "M" ->
1008 | match args with
1009 | | [Seq is_components] ->
1010 | let components =
1011 | is_components
1012 | |> Seq.map (function
1013 | | (Seq is_c) ->
1014 | match List.ofSeq is_c with [Double weight; is_d] -> weight, deserializeDistribution is_d | _ -> invalidInfoSet()
1015 | | _ -> invalidInfoSet())
1016 | |> List.ofSeq
1017 | Mixture components
1018 | | _ -> invalidInfoSet()
1019 | | _ -> invalidInfoSet()
1020 | | _ -> invalidInfoSet()
1021 | | _ -> invalidInfoSet()
1022 |
1023 | let serializeMersenneTwister (mt:MT19937) =
1024 | let seed = mt.get_seed()
1025 | use buffer = new System.IO.MemoryStream (seed.Length*4)
1026 | use writer = new System.IO.BinaryWriter(buffer)
1027 | seed |> Array.iter writer.Write
1028 | ByteArray(buffer.GetBuffer())
1029 |
1030 | let deserializeMersenneTwister is =
1031 | match is with
1032 | | ByteArray byteseq ->
1033 | let buffer = Array.ofSeq byteseq
1034 | use reader = new System.IO.BinaryReader(new System.IO.MemoryStream (buffer))
1035 | let seed = Array.init (buffer.Length/4) (fun _ -> reader.ReadUInt32())
1036 | MT19937 seed
1037 | | _ -> invalidArg "is" "Invalid InfoSet"
1038 |
1039 | type DistributionSerializer() =
1040 | interface ISerializer with
1041 | member x.TypeId = "ProbDist"
1042 | member x.Serialize _ d = serializeDistribution d
1043 | member x.Deserialize _ is = deserializeDistribution is
1044 |
1045 | type MersenneTwisterSerializer() =
1046 | interface ISerializer with
1047 | member x.TypeId = "MeresenneTwister"
1048 | member x.Serialize _ mt = serializeMersenneTwister mt
1049 | member x.Deserialize _ is = deserializeMersenneTwister is
1050 |
--------------------------------------------------------------------------------
/src/Angara.Statistics/paket.references:
--------------------------------------------------------------------------------
1 | Angara.Serialization
--------------------------------------------------------------------------------
/src/Angara.Statistics/paket.template:
--------------------------------------------------------------------------------
1 | type project
2 | title
3 | ##ProjectName##
4 | owners
5 | Vassily Lyutsarev
6 | authors
7 | Vassily Lyutsarev
8 | projectUrl
9 | http://github.com/microsoft/Angara.Statistics
10 | iconUrl
11 | https://raw.githubusercontent.com/microsoft/Angara.Statistics/master/docs/files/img/logo.png
12 | licenseUrl
13 | http://github.com/microsoft/Angara.Statistics/blob/master/LICENSE.txt
14 | requireLicenseAcceptance
15 | false
16 | copyright
17 | Copyright 2015
18 | tags
19 | statistics probability fsharp
20 | summary
21 | A collection of statistics algorithms from Mersenne twister generator to MCMC sampling.
22 | description
23 | Includes Mersenne twister random number generator, common probability distributions, statistics and quantiles, kernel density estimator, Metropolis-Hastings MCMC sampler.
24 |
25 |
26 |
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/Angara.Statistics.Tests.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | d5620a55-aa34-4de7-a970-b2168a06d28d
9 | Library
10 | Angara.Statistics.Tests
11 | Angara.Statistics.Tests
12 | v4.5.2
13 | 4.4.0.0
14 | Angara.Statistics.Tests
15 |
16 | ..\..\
17 |
18 |
19 | true
20 | full
21 | false
22 | false
23 | bin\Debug\
24 | DEBUG;TRACE
25 | 3
26 | Project
27 |
28 |
29 |
30 |
31 |
32 |
33 | pdbonly
34 | true
35 | true
36 | bin\Release\
37 | TRACE
38 | 3
39 |
40 |
41 | 11
42 |
43 |
44 |
45 |
46 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
47 |
48 |
49 |
50 |
51 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
52 |
53 |
54 |
55 |
56 |
57 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 | True
76 |
77 |
78 |
79 |
80 |
81 | Angara.Statistics
82 | {5161430d-44b4-441c-be95-89c02f215d38}
83 | True
84 |
85 |
86 |
87 |
88 |
89 |
90 | ..\..\packages\Angara.Serialization\lib\net452\Angara.Serialization.dll
91 | True
92 | True
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 | ..\..\packages\test\Angara.Serialization.Json\lib\net452\Angara.Serialization.Json.dll
102 | True
103 | True
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 | ..\..\packages\test\FsUnit\lib\net45\FsUnit.NUnit.dll
113 | True
114 | True
115 |
116 |
117 | ..\..\packages\test\FsUnit\lib\net45\NHamcrest.dll
118 | True
119 | True
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 | ..\..\packages\test\Newtonsoft.Json\lib\net35\Newtonsoft.Json.dll
129 | True
130 | True
131 |
132 |
133 |
134 |
135 |
136 |
137 | ..\..\packages\test\Newtonsoft.Json\lib\net20\Newtonsoft.Json.dll
138 | True
139 | True
140 |
141 |
142 |
143 |
144 |
145 |
146 | ..\..\packages\test\Newtonsoft.Json\lib\net40\Newtonsoft.Json.dll
147 | True
148 | True
149 |
150 |
151 |
152 |
153 |
154 |
155 | ..\..\packages\test\Newtonsoft.Json\lib\net45\Newtonsoft.Json.dll
156 | True
157 | True
158 |
159 |
160 |
161 |
162 |
163 |
164 | ..\..\packages\test\Newtonsoft.Json\lib\portable-net45+wp80+win8+wpa81+dnxcore50\Newtonsoft.Json.dll
165 | True
166 | True
167 |
168 |
169 |
170 |
171 |
172 |
173 | ..\..\packages\test\Newtonsoft.Json\lib\portable-net40+sl5+wp80+win8+wpa81\Newtonsoft.Json.dll
174 | True
175 | True
176 |
177 |
178 |
179 |
180 |
181 |
182 | ..\..\packages\test\NUnit\lib\nunit.framework.dll
183 | True
184 | True
185 |
186 |
187 |
188 |
189 |
190 |
191 | ..\..\packages\test\Unquote\lib\net40\Unquote.dll
192 | True
193 | True
194 |
195 |
196 |
197 |
198 |
199 |
200 | ..\..\packages\test\Unquote\lib\net45\Unquote.dll
201 | True
202 | True
203 |
204 |
205 |
206 |
207 |
208 |
209 | ..\..\packages\test\Unquote\lib\portable-net45+netcore45+wpa81+wp8+MonoAndroid1+MonoTouch1\Unquote.dll
210 | True
211 | True
212 |
213 |
214 |
215 |
216 |
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/App.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/FilzbachTests.fs:
--------------------------------------------------------------------------------
1 | module FilzbachTests
2 | open NUnit.Framework
3 | open FsUnit
4 | open Swensen.Unquote
5 |
6 | open Angara.Filzbach
7 |
8 | let uniform = Angara.Statistics.Uniform(0.,1.)
9 |
10 | []
11 | let ParametersTests() =
12 | let p0 = Parameters.Empty
13 | p0.CountValues |> should equal 0
14 | p0.AllValues |> should equal [||]
15 | (fun () -> p0.GetValue 0 |> ignore) |> should throw typeof
16 | (fun () -> p0.GetValue "unknown" |> ignore) |> should throw typeof
17 | (fun () -> p0.GetValue("unknown",0) |> ignore) |> should throw typeof
18 | (fun () -> p0.GetDefinition "unknown" |> ignore) |> should throw typeof
19 | (p0:>IParameters).Count |> should equal 0
20 |
21 | // scalar
22 | (fun () -> p0.Add(null, [|0.5|],0.,1.) |> ignore) |> should throw typeof // empty name
23 | (fun () -> p0.Add("", [|0.5|],0.,1.) |> ignore) |> should throw typeof // empty name
24 | (fun () -> p0.Add("s", [||],0.,1.) |> ignore) |> should throw typeof // empty values
25 | (fun () -> p0.Add("s", [|0.5|],1.,0.) |> ignore) |> should throw typeof // lower>upper
26 | (fun () -> p0.Add("s", [|0.|],0.5,1.) |> ignore) |> should throw typeof // value out of range
27 | (fun () -> p0.Add("s", [|0.5|],0.,1.,isLog=true) |> ignore) |> should throw typeof // lower for log par
28 | let p1 = p0.Add("s", [|0.5|],0.,1.)
29 | p0.Add("s", [|0.5|],0.,1.) |> should equal p1
30 | (fun () -> p1.Add("s", [|0.5|],0.,1.) |> ignore) |> should throw typeof // duplicate name
31 | p1.CountValues |> should equal 1
32 | p1.AllValues |> List.ofSeq |> should equal [0.5]
33 | p1.GetValue 0 |> should equal 0.5
34 | (fun () -> p1.GetValue 1 |> ignore) |> should throw typeof
35 | (fun () -> p1.GetValue -1 |> ignore) |> should throw typeof
36 | p1.GetValue "s" |> should equal 0.5
37 | p1.GetValue("s", 0) |> should equal 0.5
38 | (fun () -> p1.GetValue("s", 1) |> ignore) |> should throw typeof
39 | p1.GetDefinition "s" |> should equal {index=0; size=1; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
40 | (p1:>IParameters).Count |> should equal 1
41 | (p1:>IParameters).ContainsKey "s" |> should be True
42 | (p1:>IParameters).ContainsKey "a" |> should be False
43 | (p1:>IParameters).["s"] |> should equal [|0.5|]
44 | let v = ref [||]
45 | (p1:>IParameters).TryGetValue("s", v) |> should be True
46 | !v |> should equal [|0.5|]
47 | (p1:>IParameters).Keys |> Seq.toList |> should equal ["s"]
48 | (p1:>IParameters).Values |> Seq.toList |> should equal [[|0.5|]]
49 |
50 | // vector
51 | (fun () -> p0.Add("v", [|0.5; -0.5|],0.,1.) |> ignore) |> should throw typeof // value out of range
52 | let p2 = p0.Add("v", [|0.6;0.7|],0.,1.)
53 | p2.CountValues |> should equal 2
54 | p2.AllValues |> List.ofSeq |> should equal [0.6;0.7]
55 | p2.GetValue 0 |> should equal 0.6
56 | p2.GetValue 1 |> should equal 0.7
57 | (fun () -> p2.GetValue "v" |> ignore) |> should throw typeof // vector syntax
58 | p2.GetValue("v", 0) |> should equal 0.6
59 | p2.GetValue("v", 1) |> should equal 0.7
60 | p2.GetDefinition "v" |> should equal {index=0; size=2; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
61 | (p2:>IParameters).Count |> should equal 1
62 | (p2:>IParameters).ContainsKey "v" |> should be True
63 | (p2:>IParameters).ContainsKey "a" |> should be False
64 | (p2:>IParameters).["v"] |> should equal [|0.6;0.7|]
65 | (p2:>IParameters).TryGetValue("v", v) |> should be True
66 | !v |> should equal [|0.6;0.7|]
67 | (p2:>IParameters).Keys |> Seq.toList |> should equal ["v"]
68 | (p2:>IParameters).Values |> Seq.toList |> should equal [[|0.6;0.7|]]
69 |
70 | // second scalar
71 | let p3 = p2.Add("s", [|0.5|],0.,1.)
72 | p2.Add("s", [|0.5|],0.,1.) |> should equal p3
73 | (fun () -> p1.Add("s", [|0.5|],0.,1.) |> ignore) |> should throw typeof // duplicate name
74 | p3.CountValues |> should equal 3
75 | p3.AllValues |> List.ofSeq |> should equal [0.6;0.7;0.5]
76 | p3.GetValue 0 |> should equal 0.6
77 | p3.GetValue 1 |> should equal 0.7
78 | p3.GetValue 2 |> should equal 0.5
79 | p3.GetValue("v", 0) |> should equal 0.6
80 | p3.GetValue("v", 1) |> should equal 0.7
81 | p3.GetValue "s" |> should equal 0.5
82 | p3.GetValue("s", 0) |> should equal 0.5
83 | p3.GetDefinition "s" |> should equal {index=2; size=1; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
84 | p3.GetDefinition "v" |> should equal {index=0; size=2; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
85 | (p3:>IParameters).Count |> should equal 2
86 | (p3:>IParameters).ContainsKey "s" |> should be True
87 | (p3:>IParameters).ContainsKey "v" |> should be True
88 | (p3:>IParameters).ContainsKey "a" |> should be False
89 | (p3:>IParameters).["s"] |> should equal [|0.5|]
90 | (p3:>IParameters).["v"] |> should equal [|0.6;0.7|]
91 | (p3:>IParameters).TryGetValue("s", v) |> should be True
92 | !v |> should equal [|0.5|]
93 | (p3:>IParameters).TryGetValue("v", v) |> should be True
94 | !v |> should equal [|0.6;0.7|]
95 | (p3:>IParameters).Keys |> Seq.toList |> should equal ["s";"v"]
96 | (p3:>IParameters).Values |> Seq.toList |> should equal [[|0.5|]; [|0.6;0.7|]]
97 |
98 | // second vector
99 | let p4 = p1.Add("v", [|0.6;0.7|],0.,1.)
100 | p1.Add("v", [|0.6;0.7|],0.,1.) |> should equal p4
101 | p4.CountValues |> should equal 3
102 | p4.AllValues |> List.ofSeq |> should equal [0.5;0.6;0.7]
103 | p4.GetValue 0 |> should equal 0.5
104 | p4.GetValue 1 |> should equal 0.6
105 | p4.GetValue 2 |> should equal 0.7
106 | p4.GetValue("v", 0) |> should equal 0.6
107 | p4.GetValue("v", 1) |> should equal 0.7
108 | p4.GetValue "s" |> should equal 0.5
109 | p4.GetValue("s", 0) |> should equal 0.5
110 | p4.GetDefinition "s" |> should equal {index=0; size=1; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
111 | p4.GetDefinition "v" |> should equal {index=1; size=2; lower=0.; upper=1.; delay=0; prior=uniform; isLog=false; log_priordf=id}
112 | (p4:>IParameters).Count |> should equal 2
113 | (p4:>IParameters).ContainsKey "s" |> should be True
114 | (p4:>IParameters).ContainsKey "v" |> should be True
115 | (p4:>IParameters).ContainsKey "a" |> should be False
116 | (p4:>IParameters).["s"] |> should equal [|0.5|]
117 | (p4:>IParameters).["v"] |> should equal [|0.6;0.7|]
118 | (p4:>IParameters).TryGetValue("s", v) |> should be True
119 | !v |> should equal [|0.5|]
120 | (p4:>IParameters).TryGetValue("v", v) |> should be True
121 | !v |> should equal [|0.6;0.7|]
122 | (p4:>IParameters).Keys |> Seq.toList |> should equal ["s";"v"]
123 | (p4:>IParameters).Values |> Seq.toList |> should equal [[|0.5|]; [|0.6;0.7|]]
124 |
125 | []
126 | let SamplerTests() =
127 | let assertfail() : 'a = raise (AssertionException(null))
128 | let mt = Angara.Statistics.MT19937()
129 | let logl (p:Parameters) =
130 | let s = p.AllValues |> Seq.sum
131 | - log (1. + exp(-s))
132 | let sample = Sampler.Create(Parameters.Empty, mt, logl)
133 | test <@ Seq.isEmpty sample.Parameters.AllValues @>
134 | test <@ Seq.isEmpty (sample.Probe(true, logl).Parameters.AllValues) @>
135 | let s2 = Sampler.Create(Parameters.Empty.Add("a",1.), mt, logl)
136 | test <@ s2.Parameters.AllValues |> Seq.toList = [1.] @>
137 | test <@ s2.Probe(true, logl).Parameters.AllValues |> Seq.toList = [1.] @>
138 | let s3 = Sampler.Create(Parameters.Empty.Add("a",Angara.Statistics.Uniform(1.,2.)), mt, logl)
139 | let v3 = match s3.Parameters.AllValues |> Seq.toList with [v] -> v | _ -> assertfail()
140 | test <@ v3 > 1. && v3 < 2. @>
141 | let s3' = s3 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(false,logl) in Some (s',s')) |> Seq.last
142 | let v3' = match s3'.Parameters.AllValues |> Seq.toList with [v] -> v | _ -> assertfail()
143 | test <@ s3'.IsAccepted && (v3 <> v3') @>
144 | let s3'' = s3 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(true,logl) in Some (s',s')) |> Seq.last
145 | let v3'' = match s3''.Parameters.AllValues |> Seq.toList with [v] -> v | _ -> assertfail()
146 | test <@ s3''.IsAccepted && (v3 <> v3'') @>
147 |
148 | let s4 = Sampler.Create(Parameters.Empty.Add("a",Angara.Statistics.Uniform(1.,2.)).Add("b",3.), mt, logl)
149 | let v4, v41 = match s4.Parameters.AllValues |> Seq.toList with [v;v'] -> v,v' | _ -> assertfail()
150 | test <@ v41 = 3. && v4 > 1. && v4 < 2. @>
151 | let s4' = s4 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(false,logl) in Some (s',s')) |> Seq.last
152 | let v4', v41' = match s4'.Parameters.AllValues |> Seq.toList with [v;v'] -> v,v' | _ -> assertfail()
153 | test <@ v41' = 3. && s4'.IsAccepted && (v4 <> v4') @>
154 | let s4'' = s4 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(true,logl) in Some (s',s')) |> Seq.last
155 | let v4'', v41'' = match s4''.Parameters.AllValues |> Seq.toList with [v;v'] -> v,v' | _ -> assertfail()
156 | test <@ v41'' = 3. && s4''.IsAccepted && (v4 <> v4'') @>
157 |
158 | let s5 = Sampler.Create(Parameters.Empty.Add("b",[|3.;3.1|]).Add("a",Angara.Statistics.Uniform(1.,2.)), mt, logl)
159 | let v51, v52, v5 = match s5.Parameters.AllValues |> Seq.toList with [v;v';v''] -> v,v',v'' | _ -> assertfail()
160 | test <@ v51 = 3. && v52 = 3.1 && v5 > 1. && v5 < 2. @>
161 | let s5' = s5 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(false,logl) in Some (s',s')) |> Seq.last
162 | let v51', v52', v5' = match s5'.Parameters.AllValues |> Seq.toList with [v;v';v''] -> v,v',v'' | _ -> assertfail()
163 | test <@ v51' = 3. && v52' = 3.1 && s5'.IsAccepted && (v5 <> v5') @>
164 | let s5'' = s5 |> Seq.unfold (fun s -> if s.IsAccepted then None else let s' = s.Probe(true,logl) in Some (s',s')) |> Seq.last
165 | let v51'', v52'', v5'' = match s5''.Parameters.AllValues |> Seq.toList with [v;v';v''] -> v,v',v'' | _ -> assertfail()
166 | test <@ v51'' = 3. && v52'' = 3.1 && s5''.IsAccepted && (v5 <> v5'') @>
167 |
168 | []
169 | let ContinueationTest() =
170 | let logl (p:Parameters) =
171 | let s = p.AllValues |> Seq.sum
172 | - log (1. + exp(-s))
173 | let pp =
174 | Parameters.Empty
175 | .Add("b", Angara.Statistics.Uniform(1.,2.))
176 | .Add("a",Angara.Statistics.Normal(3.,4.),2)
177 | .Add("a b",Angara.Statistics.Uniform(5.,6.))
178 | let r = Sampler.runmcmc(pp, logl, 100, 100, 1)
179 | 100 =! (r.samples |> Seq.length)
180 | let r1' = Sampler.runmcmc(pp, logl, 50, 100, 1)
181 | 100 =! (r1'.samples |> Seq.length)
182 | r.acceptanceRate <>! r1'.acceptanceRate
183 | r.samples <>! r1'.samples
184 | let r1 = Sampler.continuemcmc(r1', logl, 100, 100)
185 | r.acceptanceRate =! r1.acceptanceRate
186 | r.samples =! r1.samples
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/SerializationTests.fs:
--------------------------------------------------------------------------------
1 | module SerializationTests
2 |
3 | open NUnit.Framework
4 | open Swensen.Unquote
5 |
6 | open Angara.Serialization
7 | open Angara.Statistics
8 | open Angara.Filzbach
9 | open Angara.Statistics.Serialization
10 | open Angara.Filzbach.Serialization
11 |
12 | []
13 | let DistributionSerialization() =
14 | let lib = SerializerLibrary.CreateDefault()
15 | lib.Register(DistributionSerializer())
16 | let check d =
17 | let is = serializeDistribution d
18 | d =! deserializeDistribution is
19 | let json = Json.FromObject(lib,d).ToString()
20 | d =! Json.ToObject(Newtonsoft.Json.Linq.JObject.Parse json,lib)
21 | Uniform(1., 2.) |> check
22 | LogUniform(1.,2.) |> check
23 | Normal(1., 2.) |> check
24 | LogNormal(1.,2.) |> check
25 | Gamma(1., 2.) |> check
26 | NegativeBinomial(1., 2.) |> check
27 | Binomial(2, 1.) |> check
28 | Bernoulli(0.7) |> check
29 | Exponential(2.) |> check
30 | Poisson(2.) |> check
31 | Mixture[0.4,LogNormal(1.,2.); 0.6,Normal(3.,4.)] |> check
32 | //
33 | raises <@ deserializeDistribution InfoSet.EmptyMap @>
34 | raises <@ deserializeDistribution (InfoSet.Seq[]) @>
35 | raises <@ deserializeDistribution (InfoSet.String "") @>
36 | raises <@ deserializeDistribution (InfoSet.Double 1.) @>
37 |
38 | []
39 | let MersenneTwisterSerialization() =
40 | let lib = SerializerLibrary.CreateDefault()
41 | lib.Register(MersenneTwisterSerializer())
42 | let check2 (mt1:MT19937) (mt2:MT19937) =
43 | mt1.uniform_uint32() =! mt2.uniform_uint32()
44 | mt1.uniform_float64() =! mt2.uniform_float64()
45 | mt1.normal() =! mt2.normal()
46 | mt1.uniform_uint32() =! mt2.uniform_uint32()
47 | let check mt =
48 | let is = serializeMersenneTwister mt
49 | let json = Json.FromObject(lib,mt).ToString()
50 | check2 (MT19937(mt)) (deserializeMersenneTwister is)
51 | check2 (MT19937(mt)) (Json.ToObject(Newtonsoft.Json.Linq.JObject.Parse json,lib))
52 | let mutable mt = MT19937()
53 | for _ in 1..4 do
54 | let seed = mt.get_seed()
55 | check2 mt (MT19937(seed))
56 | check (MT19937(seed))
57 | mt <- MT19937(seed)
58 | mt.uniform_uint32() |> ignore
59 |
60 | []
61 | let ParametersSerialization() =
62 | let lib = SerializerLibrary.CreateDefault()
63 | lib.Register(ParametersSerializer())
64 | let check p =
65 | let is = serializeParameters p
66 | p =! deserializeParameters is
67 | let json = Json.FromObject(lib,p).ToString()
68 | p =! Json.ToObject(Newtonsoft.Json.Linq.JObject.Parse json,lib)
69 | Parameters.Empty |> check
70 | Parameters.Empty.Add("a", 1.) |> check
71 | Parameters.Empty.Add("a", 1.).Add("b", [|2.; 3.|]) |> check
72 | Parameters.Empty.Add("b", [|2.; 3.|]).Add("a", 1.) |> check
73 | Parameters.Empty
74 | .Add("a", Uniform(1.,2.))
75 | .Add("z y w", LogUniform(3.,4.), 2)
76 | .Add("k", Normal(5.,6.), 3)
77 | .Add("l", LogNormal(7.,8.),2) |> check
78 |
79 | raises <@ deserializeParameters InfoSet.EmptyMap @>
80 | raises <@ deserializeParameters (InfoSet.Seq[]) @>
81 | raises <@ deserializeParameters (InfoSet.String "") @>
82 | raises <@ deserializeParameters (InfoSet.Double 1.) @>
83 |
84 | []
85 | let SamplerSerialization() =
86 | let lib = SerializerLibrary.CreateDefault()
87 | Register([lib])
88 | let logl (p:Parameters) =
89 | let s = p.AllValues |> Seq.sum
90 | - log (1. + exp(-s))
91 | let s =
92 | Sampler.Create(Parameters.Empty.Add("b", Uniform(1.,2.)).Add("a",Normal(3.,4.),2).Add("a b",Uniform(5.,6.)), MT19937(), logl)
93 | |> Seq.unfold (fun s -> if s.Iteration>100 then None else let s' = s.Probe(true,logl) in Some (s',s'))
94 | |> Seq.last
95 | let json = Json.FromObject(lib, s).ToString()
96 | let s2 = Json.ToObject(Newtonsoft.Json.Linq.JObject.Parse json,lib)
97 | test <@ (s.Parameters.AllValues |> Seq.toArray) = (s2.Parameters.AllValues |> Seq.toArray) @>
98 |
99 | let s' = s |> Seq.unfold (fun s ->
100 | if s.Iteration>200 then None else let s' = s.Probe(true,logl) in Some (s',s')) |> Seq.last
101 | let s2' = s2 |> Seq.unfold (fun s ->
102 | if s.Iteration>200 then None else let s' = s.Probe(true,logl) in Some (s',s')) |> Seq.last
103 | test <@ (s'.Parameters.AllValues |> Seq.toArray) = (s2'.Parameters.AllValues |> Seq.toArray) @>
104 |
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/Tests.fs:
--------------------------------------------------------------------------------
1 | module statistics.Tests
2 | open NUnit.Framework
3 | open FsUnit
4 | open Swensen.Unquote.Assertions
5 | type Complex = System.Numerics.Complex
6 |
7 | open Angara.Statistics
8 |
9 |
10 | []
11 | let QSummary() =
12 | let qnan = {min=nan;lb95=nan;lb68=nan;median=nan;ub68=nan;ub95=nan;max=nan}
13 | qsummary Seq.empty |> should equal qnan
14 | // qsummary filters out nan and infinity values
15 | qsummary [nan] |> should equal qnan
16 | qsummary [infinity] |> should equal qnan
17 | qsummary [-infinity] |> should equal qnan
18 | for one in [-System.Double.MaxValue; -1.; 0.; 1.; System.Double.MaxValue] do
19 | qsummary [one] |> should equal {min=one;lb95=one;lb68=one;median=one;ub68=one;ub95=one;max=one}
20 | qsummary [1.;2.] |> should equal {min=1. ;lb95=1. ;lb68=1. ;median=1.5 ;ub68=2. ;ub95=2. ;max=2.}
21 | // > quantile(1:27 * 300,c(0.025,0.16,0.5,0.84,0.975),type=8)
22 | // 2.5% 16% 50% 84% 97.5%
23 | // 305 1412 4200 6988 8095
24 | let q = qsummary [300. .. 300. .. 8100.]
25 | q.min |> should equal 300.
26 | q.max |> should equal 8100.
27 | within 2u q.lb95 305. |> should be True
28 | within 2u q.lb68 1412. |> should be True
29 | within 2u q.median 4200. |> should be True
30 | within 2u q.ub68 6988. |> should be True
31 | within 2u q.ub95 8095. |> should be True
32 |
33 |
34 |
35 | []
36 | let Radix2TransformsRealSineCorrectly () =
37 | let n = 16
38 | let step = pi2/float n
39 | let samples = Array.init 16 (fun i -> let x = step * float i in Complex(sin x, 0.))
40 | let spectrum = fft samples
41 | spectrum |> should haveLength 16
42 | spectrum |> Array.iteri (fun i c ->
43 | c.Real |> should (equalWithin 1.e-12) 0.0)
44 | spectrum |> Array.iteri (fun i c ->
45 | c.Imaginary |> should (equalWithin 1.e-12) (match i with 1 -> -8.0 | 15 -> 8.0 | _ -> 0.))
46 | let restore = ifft spectrum
47 | Seq.zip restore samples |> Seq.iteri (fun i (r,s) ->
48 | r.Real |> should (equalWithin 1.e-12) s.Real
49 | r.Imaginary |> should (equalWithin 1.e-12) s.Imaginary)
50 |
51 | []
52 | let dct_1() =
53 | let result = dct [|1.0|]
54 | result |> should (equalWithin 1.e-12) [|2.0|]
55 |
56 | []
57 | let dct_2a() =
58 | let result = dct [|1.0; 0.0|]
59 | result |> should (equalWithin 1.e-12) [|2.0; 2. * cos(pi*0.25)|]
60 |
61 | []
62 | let dct_2b() =
63 | let result = dct [|0.0; 1.0|]
64 | result |> should (equalWithin 1.e-12) [|2.0; 2. * cos(pi*0.75)|]
65 |
66 | []
67 | let dct_4() =
68 | let result = dct [|1.0; 0.0; 0.0; 0.0|]
69 | result |> should (equalWithin 1.e-12) [|2.0; 2.*cos(pi*1./8.); 2.*cos(pi*2./8.); 2.*cos(pi*3./8.)|]
70 |
71 | []
72 | let within_tests() =
73 | let omicron = System.Double.Epsilon // smallest positive float
74 | let rec find_eps d = if 0.5*d + 1.0 = 1.0 then 1.0+d else find_eps (0.5*d)
75 | let epsilon = find_eps 1.0 // smallest float greater than one
76 | // minus 0 -- the second representation of zero
77 | let minus0 = -omicron / 2.0
78 | minus0 |> should equal 0.0
79 | let bits_0 = System.BitConverter.DoubleToInt64Bits 0.0
80 | let bits_minus0 = System.BitConverter.DoubleToInt64Bits minus0
81 | bits_minus0 |> should not' (equal bits_0)
82 | //
83 | // equality
84 | within 0u 1. 1. |> should be True
85 | within 0u -1. -1. |> should be True
86 | within 0u 0. 0. |> should be True
87 | within 0u minus0 minus0 |> should be True
88 | within 0u 0. minus0 |> should be True
89 | within 0u minus0 0. |> should be True
90 | // adjacent
91 | within 1u 0. omicron |> should be True
92 | within 0u 0. omicron |> should be False
93 | within 1u minus0 omicron |> should be True
94 | within 0u minus0 omicron |> should be False
95 | within 1u 0. -omicron |> should be True
96 | within 0u 0. -omicron |> should be False
97 | within 1u minus0 -omicron |> should be True
98 | within 0u minus0 -omicron |> should be False
99 | within 0u 1. epsilon |> should be False
100 | within 1u 1. epsilon |> should be True
101 | within 2u 1. epsilon |> should be True
102 | within System.UInt32.MaxValue 1. epsilon |> should be True
103 | within 0u epsilon 1. |> should be False
104 | within 1u epsilon 1. |> should be True
105 | within 2u epsilon 1. |> should be True
106 | within System.UInt32.MaxValue epsilon 1. |> should be True
107 | // two steps apart
108 | within 2u 0. (2.*omicron) |> should be True
109 | within 1u 0. (2.*omicron) |> should be False
110 | within 0u 0. (2.*omicron) |> should be False
111 | within 1u omicron -omicron |> should be False
112 | within 2u omicron -omicron |> should be True
113 | within 1u -omicron omicron |> should be False
114 | within 2u -omicron omicron |> should be True
115 | //
116 | for one in [1.; -1.] do
117 | let some = seq {1..100} |> Seq.scan (fun f i -> f*epsilon) (one*epsilon)
118 | some |> Seq.mapi (fun i f -> within (uint32 i) one f) |> should not' (contain true)
119 | some |> Seq.mapi (fun i f -> within (uint32 i + 1u) one f) |> should not' (contain false)
120 |
121 | []
122 | let ridders_tests() =
123 | ridders 0. (-1.0, -2.0) (fun x -> x) =! None
124 | ridders 0. (1.0, 2.0) (fun x -> x) =! None
125 | ridders 0. (-2.0, -1.0) (fun x -> x) =! None
126 | ridders 0. (2.0, 1.0) (fun x -> x) =! None
127 | ridders 0. (1.0, 0.0) (fun x -> x) =! (Some 0.0)
128 | ridders 0. (0.0, 1.0) (fun x -> x) =! (Some 0.0)
129 | ridders 0. (-1.0, 1.0) (fun x -> x) =! (Some 0.0)
130 | ridders 0. (1.0, -1.0) (fun x -> x) =! (Some 0.0)
131 | // for linear function the solution is exact on the first iteration
132 | ridders 0. (-1.0, 2.0) (fun x -> x) =! (Some 0.0)
133 | ridders 1e-5 (-1.0, 2.0) (fun x -> x) =! (Some 0.0)
134 | ridders 0. (1.0, -2.0) (fun x -> x) =! (Some 0.0)
135 | ridders 1e-5 (1.0, -2.0) (fun x -> x) =! (Some 0.0)
136 | // quadratic function is well-behaved
137 | ridders 0. (0.5, 2.0) (fun x -> x * (x-1.)) =! (Some 1.0)
138 | ridders 1e-5 (-1.0, 2.0) (fun x -> x) =! (Some 0.0)
139 | let t1 = ridders 1e-3 (0.5, 2.0) (fun x -> x * (x-1.))
140 | test <@ t1.IsSome && abs(t1.Value - 1.0) < 1e-3 @>
141 | let t2 = ridders 1e-15 (0.5, 2.0) (fun x -> x * (x-1.))
142 | test <@ t2.IsSome && abs(t2.Value - 1.0) < 1e-15 @>
143 | // check exit by within 1u
144 | let t3 = ridders 0.0 (0.5, 2.0) (fun x -> if x < 1. then -1.0 else 1.0)
145 | test <@ t3.IsSome && t3.Value <> 1.0 && within 1u t3.Value 1. @>
146 | // check bisection branch when discriminant vanishes to 0
147 | let f4 x = (sqrt System.Double.Epsilon) * (x-1.)
148 | let t4 = ridders 0.0 (0.5, 2.0) f4
149 | test <@ t4.IsSome && within 1u t4.Value 1. @>
150 |
151 |
152 | []
153 | let KernelDensityEstimation_2() =
154 | let x,y = kde 2 [| 0.0; 1.0 |]
155 | x |> should (equalWithin 1.e-12) [| -0.1; 1.1 |]
156 | y |> should (equalWithin 1.e-12) [| 1.0/1.2; 1.0/1.2 |]
157 |
158 | []
159 | let KernelDensityEstimation_Normal() =
160 | let data = [| 0.204644865259654; -0.144545587125715; -0.118956445994713; -0.0469338391365766; 0.03745006601189; 0.0474434648487626;
161 | 0.0489947779088937; -0.023541123128428; -0.141367168805941; 0.0209207976156952; 0.124715845091793; -0.0255870975000263; 0.0146939287935733;
162 | -0.0125076454183801; -0.0451149615797648; 0.0844723611892559; 0.122250651498093; 0.0404912275709768; -0.237762060020886; -0.062608563178955;
163 | 0.0011964951706472; 0.251393099849191; 0.100797742833248; -0.00924513612403402; 0.00391431437480729; -0.00179251318410974; -0.0496055274851082;
164 | 0.0139763147460233; -0.022857038101599; -0.0156334781559978; -0.117729953886438; -0.0145329856473145; 0.168665446368054; -0.125197371233141;
165 | 0.140664523630094; -0.151865856740158; -0.0512219960203086; -0.0782859725775293; 0.051599570148176; -0.150777387039718; -0.125869365367987;
166 | -0.0701060122655738; -0.0362676987446099; -0.110384234156303; -0.0560945580954171; -0.0799446580772691; 0.0691093208986571; 0.0484885695433568;
167 | 0.0340971746323898; -0.06710993 |]
168 |
169 | let x,y = kde 16 data
170 |
171 | // Computed by Haskell's "kde":
172 | let xs = [| -0.28667757600789373; -0.24754516321828757; -0.2084127504286814; -0.16928033763907527; -0.1301479248494691; -9.101551205986294e-2; -5.1883099270256805e-2; -1.2750686480650641e-2; 2.6381726308955522e-2; 6.551413909856169e-2; 0.10464655188816785; 0.143778964677774; 0.18291137746738012; 0.22204379025698634; 0.26117620304659245; 0.30030861583619867 |]
173 | x |> should (equalWithin 1.e-12) xs
174 |
175 | let ys = [| 0.3379500767022503; 0.5684242002094704; 1.0274500185402244; 1.6464757237918854; 2.308063063786562; 2.9326163272608494; 3.42003145533083; 3.5678322580123796; 3.2496570321332054; 2.6063628556585825; 1.9158662533355955; 1.352070206249444; 0.938051703727766; 0.6397244704517325; 0.43125358539892195; 0.3160521681770156 |]
176 | y |> should (equalWithin 0.5) ys
177 |
178 | // from previous version of Angara.Math.KDE
179 | let ys' = [|
180 | 0.35517311013031783
181 | 0.64705323814149784
182 | 1.1707958297235739
183 | 1.7912613969845474
184 | 2.3510114101830766
185 | 2.7648724576259442
186 | 3.0276889436729015
187 | 3.1184456454369429
188 | 2.9667295647726752
189 | 2.5660398727253959
190 | 2.0422444692266968
191 | 1.5465126340059054
192 | 1.1396742615948274
193 | 0.81015114105654906
194 | 0.55401464652080867
195 | 0.40621277696505254
196 | |]
197 | y |> should (equalWithin 1.e-12) ys'
198 | []
199 | let const_tests() =
200 | test <@ maxint+1.0 = maxint && maxint-1.0 < maxint @>
201 | test <@ 1.0 - tolerance < 1.0 && 1.0 - 0.5*tolerance = 1.0 @>
202 |
203 | []
204 | let Mersenne_twister_copy_constructor() =
205 | let mt = MT19937()
206 | mt.normal() |> ignore
207 | let mt_copy = MT19937(mt)
208 | test <@ mt.uniform_uint32() = mt_copy.uniform_uint32() @>
209 |
210 | []
211 | let logistic_tests() =
212 | test <@ logistic 0. = 0.5 @>
213 | test <@ logistic -infinity = 0. @>
214 | test <@ logistic infinity = 1. @>
215 | test <@ within 1u (logistic -log_tolerance) 1. @>
216 | test <@ logistic (log System.Double.Epsilon - 1.) = 0. @>
217 | test <@ logit 0.5 = 0. @>
218 | test <@ logit 0.4 < 0. @>
219 | test <@ logit 0. = -infinity @>
220 | test <@ logit 0.6 > 0. @>
221 | test <@ logit 1. = infinity @>
222 | test <@ within 1u -(logit 0.4) (logit 0.6) @>
223 | test <@ within 1u ((logit >> logistic) 0.6) 0.6 @>
224 | test <@ within 1u ((logit >> logistic) 0.4) 0.4 @>
225 | test <@ within 2u ((logistic >> logit) 0.6) 0.6 @>
226 | test <@ within 2u ((logistic >> logit) 0.4) 0.4 @>
227 |
--------------------------------------------------------------------------------
/tests/Angara.Statistics.Tests/paket.references:
--------------------------------------------------------------------------------
1 | Angara.Serialization
2 | group Test
3 | NUnit
4 | NUnit.Runners
5 | FsUnit
6 | Unquote
7 | Angara.Serialization.Json
--------------------------------------------------------------------------------