File: quasirandom.test

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (498 lines) | stat: -rw-r--r-- 13,636 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
# -*- tcl -*-
# quasirandom.test --
#     Tests for the quasi-random numbers package
#

source [file join \
	    [file dirname [file dirname [file join [pwd] [info script]]]] \
	    devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.1

testing {
    useLocal  quasirandom.tcl math::quasirandom
}

#
# Functions for integration tests
#
proc const {coords} {
    return 1.0
}

proc fx {coords} {
    set x [lindex $coords 0]
    return $x
}

proc fy {coords} {
    set y [lindex $coords 1]
    return $y
}

proc fz {coords} {
    set z [lindex $coords 2]
    return $z
}

proc fxyz4 {coords} {
    lassign $coords x y z
    return [expr {($x*$y*$z)**4}]
}

#
# Auxiliary proc
#
proc equalCoords {coords1 coords2} {
    set equal 1
    foreach c1 $coords1 c2 $coords2 {
        if { $c1 != $c2 } {
            set equal 0
            break
        }
    }
    return $equal
}

#
# Create and register (in that order!) custom matching procedures
#
proc matchTolerant { expected actual } {
    set match 1
    foreach a $actual e $expected {
	if { $e != 0.0 } {
	    if { abs($e-$a)>1.0e-7*abs($e) &&
		 abs($e-$a)>1.0e-7*abs($a)     } {
		set match 0
		break
	    }
	} else {
	    if { abs($a) > 1.0e-7 } {
		set match 0
	    }
	}
    }
    return $match
}
proc matchOnePercent { expected actual } {
    set match 1
    foreach a $actual e $expected {
	if { $e != 0.0 } {
	    if { abs($e-$a)>1.0e-2*abs($e) &&
		 abs($e-$a)>1.0e-2*abs($a)     } {
		set match 0
		break
	    }
	} else {
	    if { abs($a) > 1.0e-2 } {
		set match 0
	    }
	}
    }
    return $match
}

::tcltest::customMatch tolerant matchTolerant
::tcltest::customMatch error1percent matchOnePercent
::tcltest::customMatch equal equalCoords


#
# Testing CoordFactors: the basis of the algorithm
# Note: exact matching
#
test "Quasirandom-0.1" "Check basic factor for 1 dimension" -body {
    set f [::math::quasirandom::CoordFactors 1]
    return [expr {1.0/$f}]
} -result 1.618033988749895

test "Quasirandom-0.2" "Check basic factor for 2 dimensions" -body {
    set f [lindex [::math::quasirandom::CoordFactors 2] 0]
    return [expr {1.0/$f}]
} -result 1.324717957244746

test "Quasirandom-0.3" "Check basic factor for 3 dimensions" -body {
    set f [lindex [::math::quasirandom::CoordFactors 3] 0]
    return [expr {1.0/$f}]
} -result 1.2207440846057596

test "Quasirandom-0.4" "Check number of factors for 10 dimensions" -body {
    return [llength [::math::quasirandom::CoordFactors 10]]
} -result 10

#
# Basic interface to the qrpoints class
#
test "Quasirandom-1.0" "Simple QR generator for two dimensions" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 2

    return [simple next]
} -result {0.7548776662466927 0.5698402909980532} -cleanup {simple destroy}

test "Quasirandom-1.1" "Simple QR generator - negative dimension" -body {
    ::math::quasirandom::qrpoints create simple -1
} -returnCodes {error} -result {The dimension argument should be a positive integer value or one of circle, disk, sphere or ball}

test "Quasirandom-1.2" "Simple QR generator - set start" -body {
    ::math::quasirandom::qrpoints create simple  2
    ::math::quasirandom::qrpoints create simple2 2 -start 2

    simple next
    set coords  [simple next]

    set coords2 [simple2 next]  ;# Should be equal to the second point for the [simple] generator

    equalCoords $coords $coords2
} -result 1 -cleanup {simple destroy; simple2 destroy}

#
# Test simple methods
#
test "Quasirandom-2.1" "set-step sets and returns the value" -match equal -body {
    ::math::quasirandom::qrpoints create simple 2

    simple set-step 100
} -result 100 -cleanup {simple destroy}

test "Quasirandom-2.2" "set-evaluations sets and returns the value" -match equal -body {
    ::math::quasirandom::qrpoints create simple 2

    simple set-evaluations 100
} -result 100 -cleanup {simple destroy}

test "Quasirandom-2.3" "set-step returns the value" -match equal -body {
    ::math::quasirandom::qrpoints create simple 2

    simple set-step 100
    simple set-step
} -result 100 -cleanup {simple destroy}

test "Quasirandom-2.4" "set-evaluations returns the value" -match equal -body {
    ::math::quasirandom::qrpoints create simple 2

    simple set-evaluations 100
    simple set-evaluations
} -result 100 -cleanup {simple destroy}

#
# Test of bounds on points
#
test "Quasirandom-3.1" "Points should fall within block" -body {
    ::math::quasirandom::qrpoints create simple 10

    set correct_bound 1

    for {set i 0} {$i < 100} {incr i} {
        set coords [simple next]

        foreach c $coords {
            if { $c < 0.0 || $c > 1.0 } {
                set correct_bound 0
                break
            }
        }
    }

    return $correct_bound
} -result 1 -cleanup {simple destroy}

test "Quasirandom-3.2" "Points should fall on a circle" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple circle

    set correct_bound 1
    set radii {}

    for {set i 0} {$i < 100} {incr i} {
        set coords [simple next]

        lassign $coords x y
        lappend radii [expr {hypot($x,$y)}]
    }

    return $radii
} -result [lrepeat 100 1.0] -cleanup {simple destroy}

test "Quasirandom-3.3" "Points should fall within a disk" -match equal -body {
    ::math::quasirandom::qrpoints create simple disk

    set correct_bounds {}
    for {set i 0} {$i < 100} {incr i} {
        set coords [simple next]

        lassign $coords x y
        lappend correct_bounds [expr {hypot($x,$y) <= 1.0}]
    }

    return $correct_bounds
} -result [lrepeat 100 1] -cleanup {simple destroy}

test "Quasirandom-3.4" "Points should fall on a sphere" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple sphere

    set correct_bound 1
    set radii {}

    for {set i 0} {$i < 100} {incr i} {
        set coords [simple next]

        lassign $coords x y z
        lappend radii [expr {sqrt($x**2 + $y**2 + $z**2)}]
    }

    return $radii
} -result [lrepeat 100 1.0] -cleanup {simple destroy}

test "Quasirandom-3.5" "Points should fall within a ball" -match equal -body {
    ::math::quasirandom::qrpoints create simple ball

    set correct_bounds {}
    for {set i 0} {$i < 100} {incr i} {
        set coords [simple next]

        lassign $coords x y
        lappend correct_bounds [expr {sqrt($x**2 + $y**2 + $z**2) <= 1.0}]
    }

    return $correct_bounds
} -result [lrepeat 100 1] -cleanup {simple destroy}




#
# Test of integral methods
#
# Integrating a constant function means the result is the volume
#
test "Quasirandom-4.1" "Integrate constant function - volume = 1" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [simple integral const {{0.0 1.0} {0.0 1.0} {0.0 1.0}}]

} -result 1.0 -cleanup {simple destroy}

test "Quasirandom-4.2" "Integrate constant function - volume = 8" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [simple integral const {{0.0 2.0} {0.0 2.0} {0.0 2.0}}]

} -result 8.0 -cleanup {simple destroy}

test "Quasirandom-4.3" "Integrate constant function - circle" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple circle

    set result [simple integral const 2.0]

} -result [expr {2.0 * 2.0 * cos(-1.0)}] -cleanup {simple destroy}

test "Quasirandom-4.3" "Integrate constant function - disk" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple disk

    set result [simple integral const 2.0]

} -result [expr {2.0**2 * cos(-1.0)}] -cleanup {simple destroy}

test "Quasirandom-4.4" "Integrate constant function - sphere" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple sphere

    set result [simple integral const 2.0]

} -result [expr {4.0 * 2.0**2 * cos(-1.0)}] -cleanup {simple destroy}

test "Quasirandom-4.5" "Integrate constant function - ball" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple ball

    set result [simple integral const 2.0]

} -result [expr {4.0/3.0 * 2.0**3 * cos(-1.0)}] -cleanup {simple destroy}

# We do not use too many evaluations ... error less than 1%
test "Quasirandom-4.6" "Integrate linear function (x, y, z)" -match error1percent -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [list [simple integral fx {{0.0 1.0} {0.0 1.0} {0.0 1.0}}] \
		    [simple integral fy {{0.0 1.0} {0.0 1.0} {0.0 1.0}}] \
		    [simple integral fz {{0.0 1.0} {0.0 1.0} {0.0 1.0}}] ]

} -result {0.5 0.5 0.5} -cleanup {simple destroy}

#
# The function varies "sharply", so we need more evaluations
#
test "Quasirandom-4.7" "Integrate (xyz)**4" -match error1percent -body {
    ::math::quasirandom::qrpoints create simple 3

    # Exact answer is 1/125
    set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 1000]

} -result 0.0080 -cleanup {simple destroy}


#
# Detailed integration: provides error estimates but also an indication that
# the values can differ quite a bit
#
test "Quasirandom-5.1" "Integrate constant function with details - volume = 1" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [simple integral-detailed const {{0.0 1.0} {0.0 1.0} {0.0 1.0}}]

    set rawvalues [dict get $result -rawvalues]

} -result {1.0 1.0 1.0 1.0} -cleanup {simple destroy}


test "Quasirandom-5.2" "Integrate linear function with details - volume = 1" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [simple integral-detailed fx {{0.0 1.0} {0.0 1.0} {0.0 1.0}}]

    set rawvalues [dict get $result -rawvalues]

} -result {0.48924267415013695 0.48855550905424594 0.5278683439583554 0.48718117886246404} -cleanup {simple destroy}


test "Quasirandom-5.3" "Integrate (xyz)**4 with details - volume = 1" -match tolerant -body {
    ::math::quasirandom::qrpoints create simple 3

    set result [simple integral-detailed fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}}]

    set rawvalues [dict get $result -rawvalues]

} -result {0.0022115062627913935 0.009840104253511376 0.014937934937801888 0.007838969739655276} -cleanup {simple destroy}


#
# Test integration procedures in a different namespace
#
test "Quasirandom-6.1" "Integrate ::func::func" -match tolerant -body {
    namespace eval ::func {

        proc func {xy} {
            lassign $xy x y
            expr {$x**2+$y**2}
        }

        ::math::quasirandom::qrpoints create simple 2

        set ::result [simple integral func {{0.0 1.0} {0.0 1.0}}]
    }

    return $result

} -result {0.67353777} -cleanup {::func::simple destroy}


test "Quasirandom-6.2" "Integrate (details) ::func::func" -match tolerant -body {
    namespace eval ::func {

        proc func {xy} {
            lassign $xy x y
            expr {$x**2+$y**2}
        }

        ::math::quasirandom::qrpoints create simple 2

        set ::result [simple integral-detailed func {{0.0 1.0} {0.0 1.0}}]
    }

    return [dict get $result -estimate]

} -result {0.67353777} -cleanup {::func::simple destroy}


# TODO:
# - func in different namespace
# - implement detailed integration and test the details
# - implement minimization

#
# Hm, the less than 1% error in the above test is a coincidence. The error is more
# likely to be 10%.
#
if {0} {
    ::math::quasirandom::qrpoints create simple 3
    # Exact answer is 1/125
    set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 100]
    puts "fxyz4: $result"
    simple set-step 0
    set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 1000]
    puts "fxyz4: $result"
    set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 1000]
    puts "fxyz4: $result"
    set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 1000]
    puts "fxyz4: $result"

    package require math::statistics
    set samples {}
    for {set trial 0} {$trial < 10} {incr trial} {
	set sum 0.0

	for {set p 0} {$p < 100} {incr p} {
	    set x   [expr {rand()}]
	    set y   [expr {rand()}]
	    set z   [expr {rand()}]
	    set sum [expr {$sum + [fxyz4 [list $x $y $z]]}]
	}

	puts "Trial $trial: [expr {$sum/100.0}]"

	lappend samples [expr {$sum/100.0}]
    }

    puts "MonteCarlo (100):"
    puts [::math::statistics::mean $samples]
    puts [::math::statistics::stdev $samples]

    set samples {}
    for {set trial 0} {$trial < 10} {incr trial} {
	set sum 0.0

	for {set p 0} {$p < 1000} {incr p} {
	    set x   [expr {rand()}]
	    set y   [expr {rand()}]
	    set z   [expr {rand()}]
	    set sum [expr {$sum + [fxyz4 [list $x $y $z]]}]
	}

	puts "Trial $trial: [expr {$sum/1000.0}]"

	lappend samples [expr {$sum/1000.0}]
    }

    puts "MonteCarlo (1000):"
    puts [::math::statistics::mean $samples]
    puts [::math::statistics::stdev $samples]

    set samples {}
    for {set trial 0} {$trial < 10} {incr trial} {
	set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 100]

	lappend samples $result
    }

    puts "Quasi-random (100):"
    puts [::math::statistics::mean $samples]
    puts [::math::statistics::stdev $samples]

    set samples {}
    for {set trial 0} {$trial < 10} {incr trial} {
	set result [simple integral fxyz4 {{0.0 1.0} {0.0 1.0} {0.0 1.0}} -evaluations 1000]

	lappend samples $result
    }

    puts "Quasi-random (1000):"
    puts [::math::statistics::mean $samples]
    puts [::math::statistics::stdev $samples]


    puts [simple integral-detailed fx {{0.0 1.0} {0.0 1.0} {0.0 1.0}}]
}


# -------------------------------------------------------------------------

# End of test cases
testsuiteCleanup