Tcl Library Source Code

Check-in [adb569bb63]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge RC with latest fixes.
Timelines: family | ancestors | descendants | both | tcllib-1-16-rc
Files: files | file ages | folders
SHA1: adb569bb6379a2f748c9c92293106574a1c1bcca
User & Date: aku 2014-01-31 06:12:23
Context
2014-01-31
06:31
Bumped ftp to 2.4.12, see [3b14767f50]. check-in: 6e03cd1a77 user: aku tags: tcllib-1-16-rc
06:12
Merge RC with latest fixes. check-in: adb569bb63 user: aku tags: tcllib-1-16-rc
2014-01-30
20:05
Solving two tickets regarding the math::geometry package check-in: ffa444f6ab user: markus tags: trunk
2014-01-29
21:12
Merge RC with latest fixes check-in: 59ef0e2775 user: andreask tags: tcllib-1-16-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/math/ChangeLog.









1
2
3
4
5
6
7







2014-01-19  Arjen Markus <[email protected]>
	* stat_kernel.tcl: Corrected use of bandwidth
	* statistics.test: Added margin per kernel - not quite satisfactory in the case of the uniform kernel

2014-01-18  Arjen Markus <[email protected]>
	* statistics.tcl: Added stat_kernel.tcl
	* stat_kernel.tcl: Implements a straightforward kernel density estimation procedure
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2014-01-30  Arjen Markus <[email protected]>
	* geometry.tcl: Corrected edge case in pointInsidePolygon (by closer checking
	                intersection of line segments; ticket c1ca34ead3).
	                Also introduced a procedure calculateDistanceToPolygon to solve ticket bff902be35
	* math_geometry.man: Description of new procedure pointInsidePolygon
	* geometry.test: Added test cases based on both tickets
	* pkgIndex.tcl: Bumped version to 1.1.3

2014-01-19  Arjen Markus <[email protected]>
	* stat_kernel.tcl: Corrected use of bandwidth
	* statistics.test: Added margin per kernel - not quite satisfactory in the case of the uniform kernel

2014-01-18  Arjen Markus <[email protected]>
	* statistics.tcl: Added stat_kernel.tcl
	* stat_kernel.tcl: Implements a straightforward kernel density estimation procedure

Changes to modules/math/geometry.tcl.

427
428
429
430
431
432
433




















434
435
436
437
438
439
440
...
595
596
597
598
599
600
601


















602
603
604
605
606
607
608
...
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
....
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
	set dist [calculateDistanceToLineSegment $P [list $Ax $Ay $Bx $By]]
	if {$minDist=="none" || $dist < $minDist} {
	    set minDist $dist
	}
    }
    return $minDist
}





















# ::math::geometry::findClosestPointOnPolyline
#
#       Return the point on a polyline which is closest to a given point.
#
# Arguments:
#       P           a point
................................................................................
    set l1y1 [lindex $linesegment1 1]
    set l1x2 [lindex $linesegment1 2]
    set l1y2 [lindex $linesegment1 3]
    set l2x1 [lindex $linesegment2 0]
    set l2y1 [lindex $linesegment2 1]
    set l2x2 [lindex $linesegment2 2]
    set l2y2 [lindex $linesegment2 3]


















    return [expr {([ccw [list $l1x1 $l1y1] [list $l1x2 $l1y2] [list $l2x1 $l2y1]]\
	    *[ccw [list $l1x1 $l1y1] [list $l1x2 $l1y2] [list $l2x2 $l2y2]] <= 0) \
	    && ([ccw [list $l2x1 $l2y1] [list $l2x2 $l2y2] [list $l1x1 $l1y1]]\
	    *[ccw [list $l2x1 $l2y1] [list $l2x2 $l2y2] [list $l1x2 $l1y2]] <= 0)}]
}

# ::math::geometry::findLineSegmentIntersection
................................................................................
	} else {
	    return "none"
	}
    }
    set r [list \
               [expr {$l1x1 + $na * ($l1x2 - $l1x1) / $d}] \
               [expr {$l1y1 + $na * ($l1y2 - $l1y1) / $d}]]
    return $r 
}


# ::math::geometry::polylinesIntersect
#
#       Checks whether two polylines intersect.
#
................................................................................
    set polygonBbox [bbox $polygon]

    set pointFarAway [list \
        [expr {[lindex $polygonBbox 0]-[lindex $polygonBbox 2]}] \
        [expr {[lindex $polygonBbox 1]-0.1*[lindex $polygonBbox 3]}]]

    set infinityLine [concat $pointFarAway $P]

    # calculate number of intersections
    set noOfIntersections 0
    #   1. count intersections between the line and the polygon's sides
    foreach {x1 y1} [lrange $closedPolygon 0 end-2] {x2 y2} [lrange $closedPolygon 2 end] {
	if {[lineSegmentsIntersect $infinityLine [list $x1 $y1 $x2 $y2]]} {
	    incr noOfIntersections
	}






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







>







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
...
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
...
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
....
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
	set dist [calculateDistanceToLineSegment $P [list $Ax $Ay $Bx $By]]
	if {$minDist=="none" || $dist < $minDist} {
	    set minDist $dist
	}
    }
    return $minDist
}

# ::math::geometry::calculateDistanceToPolygon
#
#       Calculate the distance between a point and a polygon.
#
# Arguments:
#       P           a point
#       polygon     a polygon
#
# Results:
#       dist        the smallest distance between P and any point
#                   on the polygon
#
# Note:
#       The polygon does not need to be closed - this is taken
#       care of in the procedure.
#
proc ::math::geometry::calculateDistanceToPolygon {P polygon} {
    return [::math::geometry::calculateDistanceToPolyline $P [ClosedPolygon $polygon]]
}

# ::math::geometry::findClosestPointOnPolyline
#
#       Return the point on a polyline which is closest to a given point.
#
# Arguments:
#       P           a point
................................................................................
    set l1y1 [lindex $linesegment1 1]
    set l1x2 [lindex $linesegment1 2]
    set l1y2 [lindex $linesegment1 3]
    set l2x1 [lindex $linesegment2 0]
    set l2y1 [lindex $linesegment2 1]
    set l2x2 [lindex $linesegment2 2]
    set l2y2 [lindex $linesegment2 3]

    #
    # First check the distance between the endpoints
    #
    set margin 1.0e-7
    if { [calculateDistanceToLineSegment [lrange $linesegment1 0 1] $linesegment2] < $margin } {
        return 1
    }
    if { [calculateDistanceToLineSegment [lrange $linesegment1 2 3] $linesegment2] < $margin } {
        return 1
    }
    if { [calculateDistanceToLineSegment [lrange $linesegment2 0 1] $linesegment1] < $margin } {
        return 1
    }
    if { [calculateDistanceToLineSegment [lrange $linesegment2 2 3] $linesegment1] < $margin } {
        return 1
    }

    return [expr {([ccw [list $l1x1 $l1y1] [list $l1x2 $l1y2] [list $l2x1 $l2y1]]\
	    *[ccw [list $l1x1 $l1y1] [list $l1x2 $l1y2] [list $l2x2 $l2y2]] <= 0) \
	    && ([ccw [list $l2x1 $l2y1] [list $l2x2 $l2y2] [list $l1x1 $l1y1]]\
	    *[ccw [list $l2x1 $l2y1] [list $l2x2 $l2y2] [list $l1x2 $l1y2]] <= 0)}]
}

# ::math::geometry::findLineSegmentIntersection
................................................................................
	} else {
	    return "none"
	}
    }
    set r [list \
               [expr {$l1x1 + $na * ($l1x2 - $l1x1) / $d}] \
               [expr {$l1y1 + $na * ($l1y2 - $l1y1) / $d}]]
    return $r
}


# ::math::geometry::polylinesIntersect
#
#       Checks whether two polylines intersect.
#
................................................................................
    set polygonBbox [bbox $polygon]

    set pointFarAway [list \
        [expr {[lindex $polygonBbox 0]-[lindex $polygonBbox 2]}] \
        [expr {[lindex $polygonBbox 1]-0.1*[lindex $polygonBbox 3]}]]

    set infinityLine [concat $pointFarAway $P]

    # calculate number of intersections
    set noOfIntersections 0
    #   1. count intersections between the line and the polygon's sides
    foreach {x1 y1} [lrange $closedPolygon 0 end-2] {x2 y2} [lrange $closedPolygon 2 end] {
	if {[lineSegmentsIntersect $infinityLine [list $x1 $y1 $x2 $y2]]} {
	    incr noOfIntersections
	}

Changes to modules/math/geometry.test.

408
409
410
411
412
413
414
415


416
417
418
419
420
421
422
...
501
502
503
504
505
506
507








508
509
510
} 1
test geometry-15.11 {geometry::pointInsidePolygon, polygon already closed} {
    math::geometry::pointInsidePolygon {5 5} {4 4 4 6 6 6 6 4 4 4}
} 1
test geometry-15.12 {geometry::pointInsidePolygon, polygon with zero-length side} {
    math::geometry::pointInsidePolygon {5 5} {4 4 4 6 6 6 6 6 6 4}
} 1





###
# rectangleInsidePolygon
###
test geometry-16.1 {geometry::rectangleInsidePolygon, simple} {
    math::geometry::rectangleInsidePolygon {0 10} {10 0} {-10 -10 0 11 11 11 11 0}
................................................................................
    math::geometry::between {0 0} {4 4} 0.5
} {2.0 2.0}

test geometry-17.13 {octant} {
    math::geometry::octant {-10 -12}
} northwest










###
testsuiteCleanup






|
>
>







 







>
>
>
>
>
>
>
>



408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
} 1
test geometry-15.11 {geometry::pointInsidePolygon, polygon already closed} {
    math::geometry::pointInsidePolygon {5 5} {4 4 4 6 6 6 6 4 4 4}
} 1
test geometry-15.12 {geometry::pointInsidePolygon, polygon with zero-length side} {
    math::geometry::pointInsidePolygon {5 5} {4 4 4 6 6 6 6 6 6 4}
} 1
test geometry-15.13 {geometry::pointInsidePolygon, edge case polygon/point, ticket c1ca34ead3} {
    math::geometry::pointInsidePolygon {3.0 -1.5} {2.0 2.0 -2.0 2.0 -2.0 -2.0 2.0 -2.0}
} 0


###
# rectangleInsidePolygon
###
test geometry-16.1 {geometry::rectangleInsidePolygon, simple} {
    math::geometry::rectangleInsidePolygon {0 10} {10 0} {-10 -10 0 11 11 11 11 0}
................................................................................
    math::geometry::between {0 0} {4 4} 0.5
} {2.0 2.0}

test geometry-17.13 {octant} {
    math::geometry::octant {-10 -12}
} northwest


###
# calculateDistanceToPolygon
###
test geometry-18.1 {geometry::calculateDistanceToPolygon, non-closed polygon, point on polygon} {
    eval withFourDecimals [::math::geometry::calculateDistanceToPolygon {2.0 0.5} {2.0 2.0 -2.0 2.0 -2.0 -2.0 2.0 -2.0}]
} 0.0


###
testsuiteCleanup

Changes to modules/math/math_geometry.man.

1
2
3
4
5
6
7
8
9
..
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213















214
215
216
217
218
219
220
...
277
278
279
280
281
282
283
284

285
286
287
288
289
290
291
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin math::geometry n 1.1.2]
[keywords angle]
[keywords distance]
[keywords line]
[keywords math]
[keywords {plane geometry}]
[keywords point]
[copyright {2001 by Ideogramic ApS and other parties}]
................................................................................
[copyright {2004 by Arjen Markus}]
[copyright {2010 by Andreas Kupries}]
[copyright {2010 by Kevin Kenny}]
[moddesc   {Tcl Math Library}]
[titledesc {Geometrical computations}]
[category  Mathematics]
[require Tcl [opt 8.3]]
[require math::geometry [opt 1.1.2]]

[description]
[para]
The [package math::geometry] package is a collection of functions for
computations and manipulations on two-dimensional geometrical objects,
such as points, lines and polygons.

................................................................................
[para]

[para]

[call [cmd ::math::geometry::calculateDistanceToPolyline] [arg P] [arg polyline]]

Calculate the distance of point P to the polyline and
return the result.

[list_begin arguments]
[arg_def list P] List of two numbers, the coordinates of the point

[arg_def list polyline] List of numbers, the coordinates of the
vertices of the polyline
[list_end]
















[para]

[call [cmd ::math::geometry::findClosestPointOnLine] [arg P] [arg line]]

Return the point on a line which is closest to a given point.

[list_begin arguments]
................................................................................
[list_end]

[para]

[call [cmd ::math::geometry::lineSegmentsIntersect] [arg linesegment1] [arg linesegment2]]

Check if two line segments intersect or coincide. Returns 1 if that is
the case, 0 otherwise (in two dimensions only).


[list_begin arguments]
[arg_def list linesegment1] First line segment
[arg_def list linesegment2] Second line segment
[list_end]

[para]
|







 







|







 







|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>







1
2
3
4
5
6
7
8
9
..
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
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
...
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin math::geometry n 1.1.3]
[keywords angle]
[keywords distance]
[keywords line]
[keywords math]
[keywords {plane geometry}]
[keywords point]
[copyright {2001 by Ideogramic ApS and other parties}]
................................................................................
[copyright {2004 by Arjen Markus}]
[copyright {2010 by Andreas Kupries}]
[copyright {2010 by Kevin Kenny}]
[moddesc   {Tcl Math Library}]
[titledesc {Geometrical computations}]
[category  Mathematics]
[require Tcl [opt 8.3]]
[require math::geometry [opt 1.1.3]]

[description]
[para]
The [package math::geometry] package is a collection of functions for
computations and manipulations on two-dimensional geometrical objects,
such as points, lines and polygons.

................................................................................
[para]

[para]

[call [cmd ::math::geometry::calculateDistanceToPolyline] [arg P] [arg polyline]]

Calculate the distance of point P to the polyline and
return the result. Note that a polyline needs not to be closed.

[list_begin arguments]
[arg_def list P] List of two numbers, the coordinates of the point

[arg_def list polyline] List of numbers, the coordinates of the
vertices of the polyline
[list_end]

[para]

[call [cmd ::math::geometry::calculateDistanceToPolygon] [arg P] [arg polygon]]

Calculate the distance of point P to the polygon and
return the result. If the list of coordinates is not closed (first and last
points differ), it is automatically closed.

[list_begin arguments]
[arg_def list P] List of two numbers, the coordinates of the point

[arg_def list polygon] List of numbers, the coordinates of the
vertices of the polygon
[list_end]

[para]

[call [cmd ::math::geometry::findClosestPointOnLine] [arg P] [arg line]]

Return the point on a line which is closest to a given point.

[list_begin arguments]
................................................................................
[list_end]

[para]

[call [cmd ::math::geometry::lineSegmentsIntersect] [arg linesegment1] [arg linesegment2]]

Check if two line segments intersect or coincide. Returns 1 if that is
the case, 0 otherwise (in two dimensions only). If an endpoint of one segment lies on
the other segment (or is very close to the segment), they are considered to intersect

[list_begin arguments]
[arg_def list linesegment1] First line segment
[arg_def list linesegment2] Second line segment
[list_end]

[para]

Changes to modules/math/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded math                    1.2.5 [list source [file join $dir math.tcl]]
package ifneeded math::geometry          1.1.2 [list source [file join $dir geometry.tcl]]
package ifneeded math::fuzzy             0.2.1 [list source [file join $dir fuzzy.tcl]]
package ifneeded math::complexnumbers    1.0.2 [list source [file join $dir qcomplex.tcl]]
package ifneeded math::special           0.2.2 [list source [file join $dir special.tcl]]
package ifneeded math::constants         1.0.1 [list source [file join $dir constants.tcl]]
package ifneeded math::polynomials       1.0.1 [list source [file join $dir polynomials.tcl]]
package ifneeded math::rationalfunctions 1.0.1 [list source [file join $dir rational_funcs.tcl]]
package ifneeded math::fourier           1.0.2 [list source [file join $dir fourier.tcl]]

|







1
2
3
4
5
6
7
8
9
10
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded math                    1.2.5 [list source [file join $dir math.tcl]]
package ifneeded math::geometry          1.1.3 [list source [file join $dir geometry.tcl]]
package ifneeded math::fuzzy             0.2.1 [list source [file join $dir fuzzy.tcl]]
package ifneeded math::complexnumbers    1.0.2 [list source [file join $dir qcomplex.tcl]]
package ifneeded math::special           0.2.2 [list source [file join $dir special.tcl]]
package ifneeded math::constants         1.0.1 [list source [file join $dir constants.tcl]]
package ifneeded math::polynomials       1.0.1 [list source [file join $dir polynomials.tcl]]
package ifneeded math::rationalfunctions 1.0.1 [list source [file join $dir rational_funcs.tcl]]
package ifneeded math::fourier           1.0.2 [list source [file join $dir fourier.tcl]]