## -*- tcl -*-
# Tests for the PRNG procedures -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcllib
# procedures. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# $Id: random.test,v 1.1 2011/06/17 06:40:14 arjenmarkus Exp $
#
# Copyright (c) 2011 by Arjen Markus
# All rights reserved.
#
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.4
testsNeedTcltest 2.1
#support {
# useLocal random.tcl simulation::random
#}
testing {
useLocal random.tcl simulation::random
}
# -------------------------------------------------------------------------
#
# As the values were given with four digits, an absolute
# error is most appropriate
#
proc matchNumbers {expected actual} {
set match 1
foreach a $actual e $expected {
if {abs($a-$e) > 0.1e-4} {
set match 0
break
}
}
return $match
}
customMatch numbers matchNumbers
# -------------------------------------------------------------------------
test "Bernoulli-1.0" "Bernoulli generator with p=0" \
-body {
set p [::simulation::random::prng_Bernoulli 0.0]
set count 0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd > 0.0 } {
incr count
}
}
set count
} -result 0
test "Bernoulli-1.1" "Bernoulli generator with p=1" \
-body {
set p [::simulation::random::prng_Bernoulli 1.0]
set count 0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd > 0.0 } {
incr count
}
}
set count
} -result 1000
test "Uniform-1.0" "Uniform generator with number between -1.0 and 1.0" \
-body {
set p [::simulation::random::prng_Uniform -1.0 1.0]
set nearminus1 0
set nearplus1 0
set outside 0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd > 0.9 } {
incr nearplus1
}
if { $rnd < -0.9 } {
incr nearminus1
}
if { $rnd < -1.0 || $rnd > 1.0 } {
incr outside
}
}
#
# It is very unlikely that all 1000 numbers stay within the range -0.9 -- 0.9
#
set result [expr {$nearplus1 > 0 && $nearminus1 > 0 && $outside == 0}]
} -result 1
test "Exponential-1.0" "Exponential generator with minimum -1.0 and mean 1" \
-body {
set p [::simulation::random::prng_Exponential -1.0 1.0]
set outside 0
set mean 0.0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd < -1.0 } {
incr outside
}
set mean [expr {$mean + $rnd}]
}
set mean [expr {$mean / 1000.0}]
#
# We use a rough estimate for the deviation in the mean
#
set result [expr {$outside == 0 && abs($mean - 1.0) < 0.5}]
} -result 1
test "Discrete-1.0" "Discrete generator with numbers 0, 1, 2 and 3" \
-body {
set p [::simulation::random::prng_Discrete 4]
set outside 0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
switch -- $rnd {
0 - 1 - 2 - 3 {
# Nothing to do
}
default {
incr outside
}
}
}
set result [expr {$outside == 0}]
} -result 1
test "Poisson-1.0" "Poisson generator with mean 10" \
-body {
set p [::simulation::random::prng_Poisson 10]
set noninteger 0
set mean 0.0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { ![string is integer -strict $rnd] } {
incr noninteger
}
set mean [expr {$mean + $rnd}]
}
set mean [expr {$mean / 1000.0}]
#
# We use a rough estimate for the deviation in the mean
#
set result [expr {$noninteger == 0 && abs($mean - 10.0) < 0.5}]
} -result 1
test "Normal-1.0" "Normal generator with mean 1 and standard deviation 1" \
-body {
set p [::simulation::random::prng_Normal 1 1]
set mean 0.0
set stdev 0.0
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
set mean [expr {$mean + $rnd}]
set stdev [expr {$stdev + $rnd * $rnd}]
}
set mean [expr {$mean / 1000.0}]
set stdev [expr {sqrt($stdev / 1000.0)}]
#
# We use a rough estimate for the deviation in the mean and stdev
# Main effect of test: is the procedure syntactically correct?
#
set result [expr {abs($mean - 1.0) < 0.5 && abs($stdev - 1.0) < 0.5}]
} -result 1
#
# TODO: These tests merely check that the generated procedure "works"
#
test "Pareto-1.0" "Pareto generator with minimum 1 and steepness 2" \
-body {
set p [::simulation::random::prng_Pareto 1 2]
set rnd [$p]
set result 1
} -result 1
test "Gumbel-1.0" "Gumbel generator with minimum 1 and scale factor 3" \
-body {
set p [::simulation::random::prng_Gumbel 1 3]
set rnd [$p]
set result 1
} -result 1
test "ChiSquared-1.0" "chi-squared generator with 4 degrees of freedom" \
-body {
set p [::simulation::random::prng_chiSquared 4]
set rnd [$p]
set result 1
} -result 1
test "Disk-1.0" "disk generator with radius 2" \
-body {
set p [::simulation::random::prng_Disk 2]
set rnd [$p]
set result [llength $rnd]
} -result 2
test "Ball-1.0" "ball generator with radius 2" \
-body {
set p [::simulation::random::prng_Ball 2]
set rnd [$p]
set result [llength $rnd]
} -result 3
test "Sphere-1.0" "sphere generator with radius 2.5" \
-body {
set p [::simulation::random::prng_Sphere 2.5]
set rnd [$p]
set result [llength $rnd]
} -result 3
test "Rectangle-1.0" "rectangle generator with sides 10 and 0.1" \
-body {
set p [::simulation::random::prng_Rectangle 10 0.1]
set rnd [$p]
set result [llength $rnd]
} -result 2
test "Block-1.0" "block generator with sides 10, 0.1 and 2.5" \
-body {
set p [::simulation::random::prng_Block 10 0.1 2.5]
set rnd [$p]
set result [llength $rnd]
} -result 3
test "Triangle-1.0" "triangularly distributed numbers between -1.0 and 1.0" \
-body {
set p [::simulation::random::prng_Triangle -1.0 1.0]
set okay 1
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd < -1.0 || $rnd > 1.0 } {
set okay 0
break
}
}
set okay
} -result 1
test "Triangle-1.1" "triangularly distributed numbers between -1.0 and 1.0 (alternative)" \
-body {
set p [::simulation::random::prng_Triangle 1.0 -1.0]
set okay 1
for {set i 0} {$i < 1000} {incr i} {
set rnd [$p]
if { $rnd < -1.0 || $rnd > 1.0 } {
set okay 0
break
}
}
set okay
} -result 1
# End of test cases
testsuiteCleanup