Index: installer.tcl
==================================================================
--- installer.tcl
+++ installer.tcl
@@ -292,16 +292,22 @@
if {[string match [info nameofexecutable]* [info library]]} {
# Starkit
set libdir [file join [file dirname [file dirname [info nameofexecutable]]] lib]
} else {
+ puts "$::auto_path"
# Unwrapped.
- if {[catch {set libdir [lindex $::tcl_pkgPath end]}]} {
- set libdir [file dirname [info library]]
+ foreach path $::auto_path {
+ puts $path
+ if {[string match "*zipfs:*" $path]} {
+ continue
+ }
+ set libdir $path
+ break
}
}
-
+ puts "libdir is $libdir"
set basedir [file dirname $libdir]
set bindir [file join $basedir bin]
if {[string compare $tcl_platform(platform) windows] == 0} {
set mandir {}
Index: modules/math/ChangeLog
==================================================================
--- modules/math/ChangeLog
+++ modules/math/ChangeLog
@@ -1,5 +1,16 @@
+2025-02-09 Arjen Markus
+ * combinatoricsExt.tcl: Fix a typo (ticket e99fe133e61b7868a4c2f7d9c2e6cb2f164a7246)
+
+2025-01-04 Arjen Markus
+ * filtergen.tcl: Replace the existing implementation by one based on an MIT license, add Chebyshev filters
+ * filtergen.man: Document the new Chebyshev filters
+ * filtergen.test: Added tests for the Chebyshev filters
+
+2024-11-19 Arjen Markus
+ * statistics.tcl: Check if the x and y values for the linear model show variation
+
2024-11-15 Arjen Markus
* elliptic.tcl: Correct the description of dn (pers.comm. K. Koehler)
2024-01-21 Arjen Markus
* statistics.test: Correct mistake with srand function (pers.comm. A. Kupries)
Index: modules/math/combinatoricsExt.tcl
==================================================================
--- modules/math/combinatoricsExt.tcl
+++ modules/math/combinatoricsExt.tcl
@@ -8,11 +8,11 @@
#
# Several parts based on: https://wiki.tcl-lang.org/page/Permutations and other Wiki pages
#
package require Tcl 8.6 9
package require TclOO
-package provide math::combinatorics 2.1
+package provide math::combinatorics 2.1.1
# ::math::combinatorics --
# Encompassing namespace and auxiliary variables
#
namespace eval ::math::combinatorics {
@@ -48,11 +48,11 @@
if { $n < [llength $factorial] } {
return [lindex $factorial $n]
}
- set newfactorial [lindex $$factorial end]
+ set newfactorial [lindex $factorial end]
for {set k [llength $factorial]} { $k <= $n} {incr k} {
set newfactorial [expr {$newfactorial * $k}]
lappend factorial $newfactorial
}
Index: modules/math/filtergen.man
==================================================================
--- modules/math/filtergen.man
+++ modules/math/filtergen.man
@@ -1,7 +1,7 @@
[comment {-*- tcl -*- doctools manpage}]
-[vset VERSION 0.3]
+[vset VERSION 0.4]
[manpage_begin math::filters n [vset VERSION]]
[keywords digital]
[keywords filtering]
[copyright {2020 by Arjen Markus}]
[moddesc {Tcl Math Library}]
@@ -12,13 +12,19 @@
[require math::filters [opt [vset VERSION]]]
[description]
[para]
The [package math::filters] package implements digital filters,
-notably Butterworth low-pass and high-pass filters. The procedures
+notably Butterworth and Chebyshev low-pass and high-pass filters. The procedures
allow to filter an entire data series as well as filter data one
by one.
+
+Note: [uri https://en.wikipedia.org/wiki/Digital_filter] and other pages on Wikipedia describe
+the principles and design considerations of these digital filters.
+
+Note: This is a reimplementation compared to version 0.3, which was based on GPL-licensed code.
+One possible incompatibility with that version is that the order now needs to be even.
[section "PROCEDURES"]
The package defines the following public procedures:
@@ -25,23 +31,43 @@
[list_begin definitions]
[call [cmd ::math::filters::filterButterworth] [arg lowpass] [arg order] [arg samplefreq] [arg cutofffreq]]
-Determine the coefficients for a Butterworth filter of given order. The coefficients are returned as
-a list of the x-coefficients, the y-coefficients and the scale. The formula is (n is the filter order):
-[example {
- n n
- scale * y_k = sum x_(k-i) + sum y_(k-i)
- i=0 i=1
-}]
+Determine the coefficients for a Butterworth filter of given (even) order. The coefficients are returned as
+a nested list, suitable for the [term filter] command or method,
+
+[list_begin arguments]
+[arg_def bool lowpass] Generate a low-pass filter (1) or a high-pass filter (0)
+[arg_def integer order] The order of the filter to be generated - it must be even
+[arg_def double samplefreq] Sampling frequency of the data series
+[arg_def double cutofffreq] Cut-off frequency for the filter (at most half the sampling frequency)
+[list_end]
+
+
+[call [cmd ::math::filters::filter] [arg coeffs] [arg data]]
+
+Filter the entire data series based on the filter coefficients.
+
+[list_begin arguments]
+[arg_def list coeffs] List of coefficients as generated by [emph filterButterworth] (or in fact any similar list of coefficients)
+[arg_def list data] Data to be filtered
+[list_end]
+
+
+[call [cmd ::math::filters::filterChebyshev] [arg lowpass] [arg order] [arg samplefreq] [arg cutofffreq] [opt [arg epsilon]]]
+
+Determine the coefficients for a Chebyshev filter of given (even) order. The coefficients are returned as
+a nested list, suitable for the [term filter] command or method, For this type of filters an extra parameter
+can be given, the so-called ripple factor. This controls the smoothness of the gain factor.
[list_begin arguments]
[arg_def bool lowpass] Generate a low-pass filter (1) or a high-pass filter (0)
-[arg_def integer lowpass] The order of the filter to be generated
+[arg_def integer order] The order of the filter to be generated - it must be even
[arg_def double samplefreq] Sampling frequency of the data series
-[arg_def double cutofffreq] Cut-off frequency for the filter
+[arg_def double cutofffreq] Cut-off frequency for the filter (must be less than half the sampling frequency)
+[arg_def double epsilon] Ripple factor, defaults to 0.1
[list_end]
[call [cmd ::math::filters::filter] [arg coeffs] [arg data]]
@@ -51,11 +77,11 @@
[arg_def list coeffs] List of coefficients as generated by [emph filterButterworth] (or in fact any similar list of coefficients)
[arg_def list data] Data to be filtered
[list_end]
-[call [cmd ::math::filters::filterObj] new [arg coeffs] [arg yinit]]
+[call [cmd ::math::filters::filterObject] new [arg coeffs] [arg yinit]]
Create a filter object. The initial x data are taken as zero. The initial y data can be prescribed. If they are not given,
they are taken as zero as well.
[list_begin arguments]
Index: modules/math/filtergen.tcl
==================================================================
--- modules/math/filtergen.tcl
+++ modules/math/filtergen.tcl
@@ -1,39 +1,23 @@
# filtergen.tcl --
# Package for digital filters
# filterButterworth:
# Generate the coefficients for a low-pass or high-pass Butterworth filter
+# filterChebyshev:
+# Generate the coefficients for a low-pass or high-pass Chebyshev filter
# filter:
# Filter an entire series of data
# filterObject:
# Class to create filters
#
-# Derived from: https://www.meme.net.au/butterworth.html
-#
-# Here is the license notice from this webpage:
-#
-# @licstart The following is the entire license notice for the
-# JavaScript code in this page.
-#
-# Copyright (C) 2013 Glenn McIntosh
-#
-# The JavaScript code in this page is free software: you can
-# redistribute it and/or modify it under the terms of the GNU
-# General Public License (GNU GPL) as published by the Free Software
-# Foundation, either version 3 of the License, or (at your option)
-# any later version. The code is distributed WITHOUT ANY WARRANTY;
-# without even the implied warranty of MERCHANTABILITY or FITNESS
-# FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-#
-# As additional permission under GNU GPL version 3 section 7, you
-# may distribute non-source (e.g., minimized or compacted) forms of
-# that code without the copy of the GNU GPL normally required by
-# section 4, provided you include this license notice and a URL
-# through which recipients can access the Corresponding Source.
-#
-# @licend The above is the entire license notice
-# for the JavaScript code in this page.
+# Derived from: https://github.com/adis300/filter-c, which has an MIT license
+# (Note: the original code had a small error, this has been corrected here)
+#
+# More information on Chebyshev filters: https://en.wikipedia.org/wiki/Chebyshev_filter
+#
+# Note:
+# We can implement band pass/stop filters from the same source.
#
package require Tcl 8.6 9
package require TclOO
namespace eval ::math::filters {}
@@ -46,71 +30,102 @@
# order Order of the filter
# samplefreq Sample frequency
# cutofffreq Cut-off frequency (3 dB point)
#
# Returns:
-# List (nexted list) of coefficients for x and y and the scale factor
+# List (nested list) of coefficients for x and y and the scale factor
#
proc ::math::filters::filterButterworth {lowpass order samplefreq cutofffreq} {
##nagelfar ignore
- if { ![string is integer $order] || $order <= 0 } {
- return -code error "The order must be a positive integer"
+ if { ![string is integer $order] || $order <= 0 || $order % 2 != 0 } {
+ return -code error "The order must be an even positive integer"
+ }
+ if { $samplefreq <= 0.0 || $cutofffreq <= 0.0 } {
+ return -code error "The frequencies must be positive"
+ }
+ if { $samplefreq < 2.0 * $cutofffreq } {
+ return -code error "The cutoff frequency must be higher than half the sample frequency"
+ }
+
+ set pi [expr {acos(-1.0)}]
+
+ set a [expr {tan($pi * $cutofffreq / $samplefreq)}]
+ set a2 [expr {$a**2}]
+
+ set s [expr {1.0 * $samplefreq}]
+ set order [expr {$order / 2}]
+
+ for {set i 0} {$i < $order} {incr i} {
+ set r [expr {sin($pi * (2.0 * $i + 1.0) / (4.0 * $order))}]
+ set s [expr {$a2 + 2.0 * $a * $r + 1.0}]
+ lappend A [expr {$a2 / $s}]
+ lappend d1 [expr {2.0 * (1.0 - $a2) / $s}]
+ lappend d2 [expr {-($a2 - 2.0 * $a * $r + 1.0) / $s}]
+ }
+
+ set coeffw1 [expr {$lowpass ? 2.0 : -2.0}]
+ set scale [expr {1.0}]
+
+ return [list $coeffw1 $scale $A $d1 $d2]
+}
+
+# filterChebyshev --
+# Generate the coefficients for a low-pass/high-pass Chebyshev filter
+#
+# Arguments:
+# lowpass Low-pass if 1, high-pass if 0
+# order Order of the filter
+# samplefreq Sample frequency
+# cutofffreq Cut-off frequency (3 dB point)
+# epsilon Ripple factor (defaults to 0.1)
+#
+# Returns:
+# List (nested list) of coefficients for x and y and the scale factor
+#
+proc ::math::filters::filterChebyshev {lowpass order samplefreq cutofffreq {epsilon 0.1}} {
+
+ ##nagelfar ignore
+ if { ![string is integer $order] || $order <= 0 || $order % 2 != 0 } {
+ return -code error "The order must be an even positive integer"
}
if { $samplefreq <= 0.0 || $cutofffreq <= 0.0 } {
return -code error "The frequencies must be positive"
}
- if { $samplefreq < $cutofffreq } {
- return -code error "The cutoff frequency must be lower than the sample frequency"
+ if { $samplefreq < 2.0 * $cutofffreq } {
+ return -code error "The cutoff frequency must be higher than half the sample frequency"
+ }
+ if { $epsilon <= 0.0 } {
+ return -code error "The ripple factor should be positive"
}
set pi [expr {acos(-1.0)}]
- set cutoff [expr {-$cutofffreq / double($samplefreq) * 2.0 * $pi}]
-
- set yf0 [lrepeat [expr {$order+1}] 0.0]
- set yf1 $yf0
- set xf $yf0
-
- lset yf0 0 -1.0
- lset yf1 0 0.0
- lset xf 0 1.0
-
- set scale 1.0
- set invert [expr {$lowpass == 1? 1.0 : -1.0}]
-
- for {set i 1} {$i <= $order} {incr i} {
- set angle [expr {($i-0.5) / $order * $pi}]
- set sinsin [expr {1.0 - sin($cutoff) * sin($angle)}]
- set rcof0 [expr {-cos($cutoff) / $sinsin}]
- set rcof1 [expr { sin($cutoff) * cos($angle) / $sinsin}]
-
- lset yf0 $i 0.0
- lset yf1 $i 0.0
-
- for {set j $i} {$j > 0} {incr j -1} {
- set yf0jm1 [lindex $yf0 [expr {$j-1}]]
- set yf1jm1 [lindex $yf1 [expr {$j-1}]]
- set yf0j [lindex $yf0 $j]
- set yf1j [lindex $yf1 $j]
-
- lset yf0 $j [expr {$yf0j + $rcof0 * $yf0jm1 + $rcof1 * $yf1jm1}]
- lset yf1 $j [expr {$yf1j + $rcof0 * $yf1jm1 - $rcof1 * $yf0jm1}]
- }
-
- set scale [expr {$scale * $sinsin * 2.0 / (1.0 - cos($cutoff) * $invert)}]
- set xfim1 [lindex $xf [expr {$i-1}]]
- lset xf $i [expr {$xfim1 * $invert * ($order-$i+1)/double($i)}]
- }
-
- set scale [expr {sqrt($scale)}]
-
- for {set i 1} {$i <= $order} {incr i} {
- set yf0i [lindex $yf0 $i]
- lset yf0 $i [expr {$yf0i * $scale}]
- }
-
- return [list $xf [lrange $yf0 1 end] $scale]
+
+ set a [expr {tan($pi * $cutofffreq / $samplefreq)}]
+ set a2 [expr {$a**2}]
+
+ set s [expr {1.0 * $samplefreq}]
+ set order [expr {$order / 2}]
+
+ set u [expr {log((1.0 + sqrt(1.0 + $epsilon**2)) / $epsilon)}]
+ set cu [expr {cosh($u / (2.0 * $order))}]
+ set su [expr {sinh($u / (2.0 * $order))}]
+
+ for {set i 0} {$i < $order} {incr i} {
+ set b [expr {sin($pi * (2.0 * $i + 1.0) / (4.0 * $order)) * $su}]
+ set c [expr {cos($pi * (2.0 * $i + 1.0) / (4.0 * $order)) * $cu}]
+ set c [expr {$b**2 + $c**2}]
+ set s [expr {$a2 * $c + 2.0 * $a * $b + 1.0}]
+ lappend A [expr {$a2 / (4.0 * $s)}]
+ lappend d1 [expr {2.0 * (1.0 - $a2 * $c) / $s}]
+ lappend d2 [expr {-($a2 * $c - 2.0 * $a * $b + 1.0) / $s}]
+ }
+
+ set coeffw1 [expr {$lowpass ? 2.0 : -2.0}]
+ set scale [expr {2.0 / $epsilon}]
+
+ return [list $coeffw1 $scale $A $d1 $d2]
}
# filter --
# Filter the data series based on the given coefficients
#
@@ -123,38 +138,33 @@
#
# Note:
# The initial part of the filtered data is a list of zeroes
#
proc ::math::filters::filter {coeff data} {
- lassign $coeff xcoeff ycoeff scale
+ lassign $coeff coeffw1 scale list_A list_d1 list_d2
set filtered {}
- set yv [lrepeat [llength $ycoeff] [expr {0.0}]]
-
- set noxcoeff [llength $xcoeff]
- set xcoeff [lreverse $xcoeff]
- set ycoeff [lreverse $ycoeff]
-
- for {set i 0} {$i <= [llength $data]-$noxcoeff} {incr i} {
- set xv [lrange $data $i [expr {$i+$noxcoeff-1}]]
-
- set f [expr {0.0}]
-
- foreach x $xv c $xcoeff {
- set f [expr {$f + $c * $x}]
- }
-
- foreach y $yv c $ycoeff {
- set f [expr {$f + $c * $y}]
- }
-
- set f [expr {$f / $scale}]
-
- lappend filtered $f
-
- set yv [concat [lrange $yv 1 end] $f]
+ set n [llength $list_A]
+ set list_w0 [lrepeat $n [expr {0.0}]]
+ set list_w1 $list_w0
+ set list_w2 $list_w0
+
+ for {set j 0} {$j < [llength $data]} {incr j} {
+ set x [lindex $data $j]
+
+ set i 0
+ foreach A $list_A d1 $list_d1 d2 $list_d2 w1 $list_w1 w2 $list_w2 {
+ set w0 [expr {$d1 * $w1 + $d2 * $w2 + $x}]
+ set x [expr {$A * ($w0 + $coeffw1 * $w1 + $w2)}]
+ lset list_w0 $i $w0
+ lset list_w2 $i $w1
+ lset list_w1 $i $w0
+ incr i
+ }
+
+ lappend filtered [expr {$scale * $x}]
}
return $filtered
}
@@ -161,11 +171,13 @@
# filterObject --
# Create an object that can filter incoming data
#
# Arguments:
# coeff Filter coefficients, as generated by filtergen
-# yinit (Optional) initial y-values
+#
+# Note:
+# Dropping the optional initial values
#
::oo::class create ::math::filters::filterObject {
variable xcoeff
variable ycoeff
variable yv
@@ -173,79 +185,69 @@
variable xv_org
variable yv_org
#
# Constructor:
- # - the arguments coeff and, optionally, yinit
+ # - the arguments coeff as provided by the filter generator
# - prepare everything
#
- constructor {coeff {yinit {}}} {
- variable xcoeff
- variable ycoeff
+ constructor {coeff} {
+ variable coeffw1
variable scale
- variable yv
- variable xv
- variable yv_org
- variable xv_org
-
- lassign $coeff xcoeff ycoeff scale
-
- set xcoeff [lreverse $xcoeff]
- set ycoeff [lreverse $ycoeff]
-
- if { $yinit eq {} } {
- set yv [lrepeat [llength $ycoeff] [expr {0.0}]]
- } else {
- if { [llength $yinit] != [llength $ycoeff] } {
- return -code error "Length of initial y-values must be equal to the number of y coefficients"
- }
- set yv $yinit
- }
- set xv [lrepeat [llength $xcoeff] [expr {0.0}]]
-
- set xv_org $xv
- set yv_org $yv
+ variable list_A
+ variable list_d1
+ variable list_d2
+ variable list_w0
+ variable list_w1
+ variable list_w2
+
+ lassign $coeff coeffw1 scale list_A list_d1 list_d2
+
+ set n [llength $list_A]
+ set list_w0 [lrepeat $n [expr {0.0}]]
+ set list_w1 $list_w0
+ set list_w2 $list_w0
}
method filter {x} {
- variable xcoeff
- variable ycoeff
- variable scale
- variable yv
- variable xv
-
- set xv [concat [lrange $xv 1 end] $x]
- set f [expr {0.0}]
-
- foreach x $xv c $xcoeff {
- set f [expr {$f + $c * $x}]
- }
-
- foreach y $yv c $ycoeff {
- set f [expr {$f + $c * $y}]
- }
-
- set f [expr {$f / $scale}]
-
- set yv [concat [lrange $yv 1 end] $f]
-
- return $f
+ variable coeffw1
+ variable scale
+ variable list_A
+ variable list_d1
+ variable list_d2
+ variable list_w0
+ variable list_w1
+ variable list_w2
+
+ set i 0
+ foreach A $list_A d1 $list_d1 d2 $list_d2 w1 $list_w1 w2 $list_w2 {
+ set w0 [expr {$d1 * $w1 + $d2 * $w2 + $x}]
+ set x [expr {$A * ($w0 + $coeffw1 * $w1 + $w2)}]
+ lset list_w0 $i $w0
+ lset list_w2 $i $w1
+ lset list_w1 $i $w0
+ incr i
+ }
+
+ return [expr {$scale * $x}]
}
method reset {} {
- variable yv
- variable xv
- variable xv_org
- variable yv_org
+ variable list_A
+ variable list_w0
+ variable list_w1
+ variable list_w2
- set xv $xv_org
- set yv $yv_org
+ set n [llength $list_A]
+ set list_w0 [lrepeat $n [expr {0.0}]]
+ set list_w1 $list_w0
+ set list_w2 $list_w0
}
}
# Publish the package
namespace eval ::math::filters {
namespace export filterButterworth filter filterObject
}
-package provide math::filters 0.3
+package provide math::filters 0.4
Index: modules/math/filtergen.test
==================================================================
--- modules/math/filtergen.test
+++ modules/math/filtergen.test
@@ -4,12 +4,12 @@
# RCS: @(#) $Id: geometry.test,v 1.13 2010/04/06 17:02:25 andreas_kupries Exp $
# -------------------------------------------------------------------------
source [file join \
- [file dirname [file dirname [file join [pwd] [info script]]]] \
- devtools testutilities.tcl]
+ [file dirname [file dirname [file join [pwd] [info script]]]] \
+ devtools testutilities.tcl]
testsNeedTcl 8.6
testsNeedTcltest 1.0
support {
@@ -65,29 +65,38 @@
# Butterworth filter coefficients
test butterworth-1.1 {low-pass, second order} -match numbers -body {
set coeffs [::math::filters::filterButterworth 1 2 100 20]
set result [concat {*}$coeffs]
-} -result {1.0 2.0 1.0 1.78885 -0.94793 4.84093}
+} -result {2.0 1.0 0.20657 0.36953 -0.195816}
test butterworth-1.2 {high-pass, second order} -match numbers -body {
set coeffs [::math::filters::filterButterworth 0 2 100 20]
set result [concat {*}$coeffs]
-} -result {1.0 -2.0 1.0 0.94427 -0.50038 2.55535}
+} -result {-2.0 1.0 0.20657 0.36953 -0.195816}
+
+test chebyshev-1.1 {low-pass, second order} -match numbers -body {
+ set coeffs [::math::filters::filterChebyshev 1 2 100 20]
+ set result [concat {*}$coeffs]
+} -result {2.0 20.0 0.022604 -0.566099 -0.251249}
+
+test chebyshev-1.2 {high-pass, second order} -match numbers -body {
+ set coeffs [::math::filters::filterChebyshev 0 2 100 20]
+ set result [concat {*}$coeffs]
+} -result {-2.0 20.0 0.022604 -0.566099 -0.251249}
# Actually filter data
-# 20 data, second-order filter, so 18 data returned
-test filter-1.0 {low-pass, second order, uniform series} -match numbers -body {
+test filter-1.0 {low-pass, second order, uniform series, Butterworth} -match numbers -body {
set coeffs [::math::filters::filterButterworth 1 2 100 20]
set data [lrepeat 20 1.0]
set filtered [::math::filters::filter $coeffs $data]
set result [list [llength $filtered] [lindex $filtered end]]
-} -result {18 1.0}
+} -result {20 1.0}
-test filter-1.1 {low-pass, second order, sine series} -match numbers -body {
+test filter-1.1 {low-pass, second order, sine series, Butterworth} -match numbers -body {
set coeffs [::math::filters::filterButterworth 1 2 100 20]
set twopi [expr {2.0 * acos(-1.0)}]
set period 100
@@ -97,10 +106,42 @@
lappend data [expr {cos($twopi * ($i/1.0) / double($period))}]
}
set filtered [lrange [::math::filters::filter $coeffs $data] end-7 end]
} -result {0.845195 0.877086 0.905515 0.930371 0.951555 0.968984 0.982588 0.992315}
+
+test filter-2.1 {low-pass, second order, sine series, Chebyshev} -match numbers -body {
+ set coeffs [::math::filters::filterChebyshev 1 2 100 20]
+
+ set twopi [expr {2.0 * acos(-1.0)}]
+ set period 50
+
+ set data {}
+
+ for {set i 0} {$i < $period} {incr i} {
+ lappend data [expr {cos($twopi * ($i/1.0) / double($period))}]
+ }
+
+ set filtered [lrange [::math::filters::filter $coeffs $data] end-7 end]
+} -result {0.488962 0.593742 0.68916 0.773708 0.846055 0.905059 0.94979 0.979541}
+
+
+test filter-2.2 {high-pass, second order, sine series, Chebyshev} -match numbers -body {
+ set coeffs [::math::filters::filterChebyshev 0 2 500 200]
+
+ set twopi [expr {2.0 * acos(-1.0)}]
+ set period 50
+
+ set data {}
+
+ for {set i 0} {$i < $period} {incr i} {
+ lappend data [expr {cos($twopi * ($i/1.0) / double($period))}]
+ }
+
+ set filtered [lrange [::math::filters::filter $coeffs $data] end-7 end]
+} -result {-0.00144136 -0.0025429 -0.0031529 -0.00260315 -0.004107 -0.0029269 -0.00449589 -0.00327216}
+
# The object interface
test filterobj-1.0 {low-pass, second order, sine series} -match numbers -body {
set coeffs [::math::filters::filterButterworth 1 2 100 20]
Index: modules/math/pkgIndex.tcl
==================================================================
--- modules/math/pkgIndex.tcl
+++ modules/math/pkgIndex.tcl
@@ -30,6 +30,6 @@
package ifneeded math::PCA 1.1 [list source [file join $dir pca.tcl]]
package ifneeded math::figurate 1.1 [list source [file join $dir figurate.tcl]]
package ifneeded math::filters 0.3 [list source [file join $dir filtergen.tcl]]
package ifneeded math::probopt 1.1 [list source [file join $dir probopt.tcl]]
package ifneeded math::changepoint 0.2 [list source [file join $dir changepoint.tcl]]
-package ifneeded math::combinatorics 2.1 [list source [file join $dir combinatoricsExt.tcl]]
+package ifneeded math::combinatorics 2.1.1 [list source [file join $dir combinatoricsExt.tcl]]
Index: modules/math/statistics.tcl
==================================================================
--- modules/math/statistics.tcl
+++ modules/math/statistics.tcl
@@ -1000,25 +1000,34 @@
set sumy 0.0
set sumx2 0.0
set sumy2 0.0
set sumxy 0.0
set df 0
+ set minx [expr {Inf}]
+ set miny [expr {Inf}]
+ set maxx [expr {-Inf}]
+ set maxy [expr {-Inf}]
foreach x $xdata y $ydata {
if { $x != "" && $y != "" } {
set sumx [expr {$sumx+$x}]
set sumy [expr {$sumy+$y}]
set sumx2 [expr {$sumx2+$x*$x}]
set sumy2 [expr {$sumy2+$y*$y}]
set sumxy [expr {$sumxy+$x*$y}]
incr df
+
+ set minx [expr {min($x,$minx)}]
+ set miny [expr {min($y,$miny)}]
+ set maxx [expr {max($x,$maxx)}]
+ set maxy [expr {max($y,$maxy)}]
}
}
if { $df <= 2 } {
return -code error -errorcode ARG "$TOOFEWDATA: too few valid data"
}
- if { $sumx2 == 0.0 } {
+ if { $minx == $maxx || $miny == $maxy } {
return -code error -errorcode ARG "$TOOFEWDATA: independent values are all the same"
}
#
# Calculate the intermediate quantities
Index: modules/tar/tar.man
==================================================================
--- modules/tar/tar.man
+++ modules/tar/tar.man
@@ -1,7 +1,7 @@
[comment {-*- mode: tcl ; fill-column: 80 -*- doctools manpage}]
-[vset PACKAGE_VERSION 0.13]
+[vset PACKAGE_VERSION 0.14]
[manpage_begin tar n [vset PACKAGE_VERSION]]
[keywords archive]
[keywords {tape archive}]
[keywords tar]
[moddesc {Tar file handling}]
Index: modules/tar/tar.tcl
==================================================================
--- modules/tar/tar.tcl
+++ modules/tar/tar.tcl
@@ -10,11 +10,11 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.5 9
-package provide tar 0.13
+package provide tar 0.14
# # ## ### ##### ######## ############# #####################
##
# Gzip support
#
@@ -136,11 +136,11 @@
foreach x {name type linkname} {
set $x [string trim [set $x] "\x00"]
}
foreach x {uid gid size mtime cksum} {
- set $x [format %d 0[string trim [set $x] " \x00"]]
+ set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
set mode [string trim $mode " \x00"]
if {$magic eq "ustar "} {
# gnu tar
@@ -147,19 +147,19 @@
# not fully supported
foreach x {uname gname prefix} {
set $x [string trim [set $x] "\x00"]
}
foreach x {devmajor devminor} {
- set $x [format %d 0[string trim [set $x] " \x00"]]
+ set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
} elseif {$magic eq "ustar\x00"} {
# posix tar
foreach x {uname gname prefix} {
set $x [string trim [set $x] "\x00"]
}
foreach x {devmajor devminor} {
- set $x [format %d 0[string trim [set $x] " \x00"]]
+ set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
} else {
# old style tar
foreach x {uname gname devmajor devminor prefix} { set $x {} }
if {$type eq ""} {
Index: modules/tar/tar.test
==================================================================
--- modules/tar/tar.test
+++ modules/tar/tar.test
@@ -124,16 +124,28 @@
} -cleanup {
cleanup-tkt-9f4c0e3e95
unset tarfile
} -result {zero-two}
-test tar-tkt-9f4c0e3e95-1.1 {Ticket 9f4c0e3e95, B, } -setup {
+test tar-tkt-9f4c0e3e95-1.1 {Ticket 9f4c0e3e95, B} -setup {
set tarfile [setup-tkt-9f4c0e3e95]
} -body {
tar::get $tarfile 0b10
} -cleanup {
cleanup-tkt-9f4c0e3e95
unset tarfile
} -returnCodes error -result {Tar "tartest/t.tar": File "0b10" not found}
+
+# -------------------------------------------------------------------------
+
+test tar-tkt-b01462dff7-1.0 {Ticket b01462dff7} -setup {
+ set tarfile [localPath tests/b01462dff7.tar]
+} -body {
+ tar::untar $tarfile ; set _ "" ;# squash and ignore untar result
+} -cleanup {
+ # remove the extracted files
+ file delete cp.html fields.c grammar.lsp sum xargs.1
+ unset tarfile _
+} -result {}
# -------------------------------------------------------------------------
testsuiteCleanup
ADDED modules/tar/tests/b01462dff7.tar
Index: modules/tar/tests/b01462dff7.tar
==================================================================
--- /dev/null
+++ modules/tar/tests/b01462dff7.tar
cannot compute difference between binary files