Tcl Library Source Code

Artifact [3e24b68d67]
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Artifact 3e24b68d6703df82cc9990b3761eef8958fa5bebd04d30abac5202cd73e99250:

Attachment "zip6.txt" to ticket [21fef042b9] added by gold 2017-12-31 15:12:33. (unpublished)
        # pretty print from autoindent and ased editor
        # testing pade integer quotient coeffs into TCLLIB math::polynomials
        # written on Windows XP
        # working under TCL version 8.6.6
        # gold on TCL WIKI , 30dec2017
        package require Tk
        package require math::numtheory
        package require math::constants
        #package require math::bigfloat
        namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory  math::constants }
        namespace path {::tcl::mathop ::tcl::mathfunc}
        #namespace import ::math::bigfloat::*
        #set tclprecision 17
        wm title . "Taylor/ Pade trig conversion into TCLLIB::math::polynomial"
        console show
        package require math::polynomials
        namespace path {::tcl::mathop math::polynomials}
   if {0} {proc ::math::polynomials::restorePolyn {polyn} {
   # modified  ::math::polynomials::
   #  for "splitting" and evaling  integer quotients
   #  tan x = x + 1/3 x^3 + 2/15 x^5 + 17/315 x^7 + 62/2835 x^9
   #  tan x = x + 1.3 x^3 + 2.15 x^5 + 17.315 x^7 + 62.2835 x^9
   #  wrote routine to load quotient poly constants of form 1.3 to 1./3.
   # can't get the first coeff (1. here) to materialize     
    if { [lindex $polyn 0] != "POLYNOMIAL" } {
        return -code error "Not a polynomial"
    }
    set coeffs [lindex $polyn 1]
    set new_coeffs {}
    set idx        [degreePolyn $polyn]
    foreach c [lrange $coeffs 0 end-1] {
       #lappend new_coeffs [expr {$idx*$c}]
        set aa [ expr { 1.* int($c) } ]
        set bb [ expr { $c - [ expr { int($c) } ] } ]
        set bb [ expr { $bb * (10 ** $idx ) } ]
        puts " $c $aa $bb [expr { $aa/$bb } ] "
        lappend new_coeffs [expr { $aa/$bb}]
        # can't get the first coeff (1. here) to materialize
        #if { $c  == 1. } {lappend new_coeffs 1. ] }
        incr idx -1
    }
    return [list POLYNOMIAL $new_coeffs]
   } } 
        if { 1 } {
            set prec $::tcl_precision
            if {![package vsatisfies [package provide Tcl] 8.5]} {
                set ::tcl_precision 17
            } else {
                set ::tcl_precision 0
            }
            #  tan x = x + 1/3 x^3 + 2/15 x^5 + 17/315 x^7 + 62/2835 x^9
            #  tan x = x + 1.3 x^3 + 2.15 x^5 + 17.315 x^7 + 62.2835 x^9     
            set f4    [::math::polynomials::polynomial {1  1.3  2.15 17.315} ]
            set cmdf1 [::math::polynomials::polynCmd {1 2 3}]
            foreach x {0 1 2 3 4 5} {
                puts "[::math::polynomials::evalPolyn $f4 $x] -- \
                        [expr {1.0+.33333*$x*$x*$x+0.1333333*$x*$x*$x*$x*$x+0.053968*$x*$x*$x*$x*$x*$x*$x}] -- \
                        [$cmdf1 $x] -- [::math::polynomials::evalPolyn $f4 $x]"
            }
            puts "All coefficients = [::math::polynomials::allCoeffsPolyn $f4]"
            puts "test All coefficients = [::math::polynomials::allCoeffsPolyn $f4]"
            # test
            set f4 [ ::math::polynomials::restorePolyn $f4 ]
            set coeffs [::math::polynomials::allCoeffsPolyn $f4]
            puts "test Coefficients: $coeffs"
            puts " begin eval "
            foreach x {0 1 2 3 4 8} {
                if { $x > 0 } { #set x [/ $::math::constants::pi $x ]}
                puts "[   ::math::polynomials::evalPolyn $f4 $x] -- \
                        [expr {1.0+.33333*$x*$x*$x+0.1333333*$x*$x*$x*$x*$x+0.053968*$x*$x*$x*$x*$x*$x*$x}] -- \
                        [$cmdf1 $x] -- [::math::polynomials::evalPolyn $f4 $x]"
            }
            set ::tcl_precision $prec
        }
if { 1 } {
set prec $::tcl_precision
if {![package vsatisfies [package provide Tcl] 8.5]} {
    set ::tcl_precision 17
} else {
    set ::tcl_precision 0
}

set f1    [::math::polynomials::polynomial {1 2 3}]
set f2    [::math::polynomials::polynomial {1 2 3 0}]
set f3    [::math::polynomials::polynomial {0 0 0 0}]
set f4    [::math::polynomials::polynomial {5 7}]
set cmdf1 [::math::polynomials::polynCmd {1 2 3}]

foreach x {0 1 2 3 4 5} {
    puts "[::math::polynomials::evalPolyn $f1 $x] -- \
[expr {1.0+2.0*$x+3.0*$x*$x}] -- \
[$cmdf1 $x] -- [::math::polynomials::evalPolyn $f3 $x]"
}

puts "Degree: [::math::polynomials::degreePolyn $f1] (expected: 2)"
puts "Degree: [::math::polynomials::degreePolyn $f2] (expected: 2)"
foreach d {0 1 2} {
    puts "Coefficient $d = [::math::polynomials::coeffPolyn $f2 $d]"
}
puts "All coefficients = [::math::polynomials::allCoeffsPolyn $f2]"

puts "Derivative = [::math::polynomials::derivPolyn $f1]"
puts "Primitive  = [::math::polynomials::primitivePolyn $f1]"

puts "Add:       [::math::polynomials::addPolyn $f1 $f4]"
puts "Add:       [::math::polynomials::addPolyn $f4 $f1]"
puts "Subtract:  [::math::polynomials::subPolyn $f1 $f4]"
puts "Multiply:  [::math::polynomials::multPolyn $f1 $f4]"

set f1    [::math::polynomials::polynomial {1 2 3}]
set f2    [::math::polynomials::polynomial {0 1}]

puts "Divide:    [::math::polynomials::divPolyn $f1 $f2]"
puts "Remainder: [::math::polynomials::remainderPolyn $f1 $f2]"

set f1    [::math::polynomials::polynomial {1 2 3}]
set f2    [::math::polynomials::polynomial {1 1}]

puts "Divide:    [::math::polynomials::divPolyn $f1 $f2]"
puts "Remainder: [::math::polynomials::remainderPolyn $f1 $f2]"

set f1 [::math::polynomials::polynomial {1 2 3}]
set f2 [::math::polynomials::polynomial {0 1}]
set f3 [::math::polynomials::divPolyn $f2 $f1]
set coeffs [::math::polynomials::allCoeffsPolyn $f3]
puts "Coefficients: $coeffs"
set f3 [::math::polynomials::divPolyn $f1 $f2]
set coeffs [::math::polynomials::allCoeffsPolyn $f3]
puts "Coefficients: $coeffs"
set f1 [::math::polynomials::polynomial {1 2 3}]
set f2 [::math::polynomials::polynomial {0}]
set f3 [::math::polynomials::divPolyn $f2 $f1]
set coeffs [::math::polynomials::allCoeffsPolyn $f3]
puts "Coefficients: $coeffs"

set ::tcl_precision $prec
}