Tcl Library Source Code

Subject. Quadratic Equation Solution, 2 reals from Muller's method
5af6381a8be0d5a87505d7e28203fe69fa2b3019
Title:	Quadratic Equation Solution, 2 reals from Muller's method
 Request real solutions from 2nd order quadratic equation in TCLLIB. Proc should return  the real solution 1 or real solutions 1&2 from quadratic coefficients. Looking for real roots only here, discriminant => 0. Boiled down from evaluating discriminant, there are three possible real outcomes from 2nd order quadratic equation as follows: 1) discriminant $discriminant_2 > 0 has two real roots. 2) discriminant $discriminant_2 == 0 has one real root. 3) discriminant $discriminant_2 < 0 has two complex non-real roots. There are some 2nd order solutions that have no real solutions. Note that Muller's method or rearranged 2C formula avoids significant figure problem (somewhat). TCL may use math ops to eval rational fractions as inputs to subroutine for more significant figures. First argument is 3 execution options. option == 1 , return positive solution, option == 2 , return negative and positive solutions , option == 3 , return negative and positive solutions with diagnostics. 

Possible sources of error in numerical analysis. References reported potential error in significant figures from subtracting nearly equal quantities in formula. Also, when the two real roots are very close, cancellation may occur between the terms b2 and 4ac of the discriminant. Possibly diagnostics in subroutine should flag when these conditions are approached? With entry in agruments $args, it appears that multiple successive 2nd order quadratic equations could be solved with a few code switches.

If we put code for the real solutions for the 2nd order quadratic equations in the TCLLIB library. Maybe somebody will donate the code for the possible complex solutions, cubic solutions, quartic solutions, and diagnostics.  Thank you.

References.
********
https://wiki.tcl-lang.org/page/Ask%2C+and+it+shall+be+given+%23+13
Quadratic equations using TCLLIB
*******
But I am looking at the files in TCLLIB math and don't recognize the quadratic solution proc section. Thank you.
****** 
(AM) There is none, if you mean to solve a second-degree equation. The references to "quadratic" in the math module are all for very different entities.
*****
 7/2/2012. I'll write a small proc to solve reals in quadratic equations and put a ticket in the TCLLIB que. There was an interesting note on the quadratic equation in Wikipaedia. Thank you.
https://wiki.tcl-lang.org/page/Math+proc+templates+for+Prime+Number+generation+and+TCL+demo+example%2C+numerical+analysis?V=167
http://www.tcl-lang.org/community/tcl2015/assets/talk9/xra-slides.pdf
https://rosettacode.org/wiki/Roots_of_a_quadratic_function
https://wiki.tcl-lang.org/page/Seaching+for+Babylonian+Triplets+Slot+Calculator+Example
https://en.wikipedia.org/wiki/Quadratic_equation
https://en.wikipedia.org/wiki/Quadratic_function
https://en.wikipedia.org/wiki/Polynomial
https://en.wikipedia.org/wiki/Cubic_equation
https://en.wikipedia.org/wiki/Quartic_equation
Since the 16th century, similar formulas (using cube roots in addition to square roots), but much more complicated are known for equations of degree three and four (see cubic equation and quartic equation)
----
*** Subroutine Template 6,  Quadratic Equation Solution, Muller's method***
----
======
        # pretty print from autoindent and ased editor
        # quadratic_solution for math::stats? package
        # working under TCL version 8.6
        # console program written on Windows 10 on TCL
        # gold on TCL Club, 2Mar2021
        # note rearranged 2C formula avoids significant figure problem
        package require Tk
        console show
        package require math::numtheory
        namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
        set tcl_precision 17
        # adapted from tcl-wiki Stats 2011-05-22, arithmetic mean  [RLE]
        #
        # ::math::quadratic_solution  
        #
        # Return the possible real solutions of quadratic equation from 3 coefficients
        #
        # Arguments:
        #    val  first value is option
        #    args other values are 3 coefficients of quadratic equation
        #
        # Results: 2 solutions, positive and negative
        #    looking for real roots only here, discriminant => 0  
        # option == 1 , return positive solution   
        # option == 2 , return negative and positive solutions 
        # option == 3 , return negative and positive solutions with diagnostics
        # there are some quadratic equations that have no real solutions.
        proc ::math::quadratic_solution {option args} {
            set N [ expr { [ llength $args ] + 1 } ]
            if { $N == 1  } { return 0 }
            set option_1 $option
            set answer [list ]
            set a [lindex  $args 0 ]
            set b [lindex  $args 1 ]
            set c [lindex  $args 2 ]         
            set denom_term_1 [ expr { $b*$b-4.*$a*$c } ] 
            set discriminant_2 [ expr { sqrt ($denom_term_1) } ]  
            ;# looking for real roots only here, discriminant => 0 
            if { $discriminant_2 < 0  } { return 0 }
            set solution_negative [ expr { ( 2.*$c)/( $discriminant_2 - $b) } ]
            set solution_positive [ expr { ( 2.*$c)/( -1.*$discriminant_2 - $b) } ]
            if { $option_1 == 1  } { lappend answer $solution_positive }
            if { $option_1 == 2  } { lappend answer  $solution_negative $solution_positive } 
            if { $option_1 == 3  } {
            lappend answer  $solution_negative $solution_positive
            puts " printout  diagnostics "
            puts " option number $option_1 ???  =? 3 returns  diagnostics "
            puts " a [lindex   $args 0  ] "
            puts " b  [lindex   $args 1  ] "
            puts " c [lindex   $args 2  ]  " 
            puts " discriminant_2 $discriminant_2 "
            if { $discriminant_2 > 0  } {
            puts "discriminant $discriminant_2 > 0 has two real roots "}
            if { $discriminant_2 == 0  } {
            puts "discriminant $discriminant_2 > 0 has one real root "}
            if { $discriminant_2 < 0  } {
            puts "discriminant $discriminant_2 < 0 has two complex non-real roots  "}                          }  
            return $answer          
        }
        # end of working deck
        # add cosmetics below to bottom of file 
        console show
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        console eval {wm title . "  Console wrapper for quadratic_solution  proc"}
        console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
        puts "  Console wrapper for quadratic_solution proc"
        puts " Return the quadratic_solution 1 or 1&2  from   quadratic coefficients"
        puts " for  ::math::quadratic_solution  1 1 1.5 -1. returns  [ ::math::quadratic_solution  1 1 1.5 -1. ] "  
        puts " for  ::math::quadratic_solution 2 1 1.5 -1.  returns  [ ::math::quadratic_solution 2 1 1.5 -1.] "
        puts " for  ::math::quadratic_solution  1 1 2.66666 -1 returns [ ::math::quadratic_solution 1 1 2.66666 -1  ] "
        puts " for  ::math::quadratic_solution  2 1 2.66666 -1 returns [ ::math::quadratic_solution 2 1 2.66666 -1  ] "
        puts " for  ::math::quadratic_solution  1 200. -1.5e-12 -1 returns [ ::math::quadratic_solution 1 1 200. -1.5e-12  ] "
        puts " for  ::math::quadratic_solution  2 200. -1.5e-12 -1 returns [ ::math::quadratic_solution 2 1 200. -1.5e-12  ] "
        puts " for  ::math::quadratic_solution 1  returns zero returns [ ::math::quadratic_solution 1 ]  " 
        puts " option 3 prints out quadratic diagnostics  " 
        puts " for  ::math::quadratic_solution  3 200. -1.5e-12 -1 & diagnostics returns [ ::math::quadratic_solution 3 1 200. -1.5e-12  ] "
        puts "  TCL may use math ops to eval rational fractions as inputs to subroutine for more significant figures. "
        puts " for  ::math::quadratic_solution  3 1 <3./2.> -1. returns  [ ::math::quadratic_solution  3 1 [/ 3. 2.] -1. ] "
        puts " for  ::math::quadratic_solution  3 1 <8./3.> -1 returns [ ::math::quadratic_solution 3 1 [/ 8. 3.] -1  ] "
        #end of deck
======
----
*** Printout for Subroutine Template 6,  Quadratic Equation Solution, Muller's method***
======
Console wrapper for quadratic_solution proc
 Return the quadratic_solution 1 or 1&2  from   quadratic coefficients
 for  ::math::quadratic_solution  1 1 1.5 -1. returns  0.5 
 for  ::math::quadratic_solution 2 1 1.5 -1.  returns  -2.0 0.5 
 for  ::math::quadratic_solution  1 1 2.66666 -1 returns 0.3333340000012 
 for  ::math::quadratic_solution  2 1 2.66666 -1 returns -2.9999940000012004 0.3333340000012 
 for  ::math::quadratic_solution  1 200. -1.5e-12 -1 returns 7.4999999999999996e-15 
 for  ::math::quadratic_solution  2 200. -1.5e-12 -1 returns -105.553116266496 7.4999999999999996e-15 
 for  ::math::quadratic_solution 1  returns zero returns 0  
 option 3 prints out quadratic diagnostics  
 printout  diagnostics 
 option number 3 ???  =? 3 returns  diagnostics 
 a 1 
 b  200. 
 c -1.5e-12  
 discriminant_2 200.00000000000003 
discriminant 200.00000000000003 > 0 has two real roots 
 for  ::math::quadratic_solution  3 200. -1.5e-12 -1 & diagnostics returns -105.553116266496 7.4999999999999996e-15 
  TCL may use math ops to eval rational fractions as inputs to subroutine for more significant figures. 
 printout  diagnostics 
 option number 3 ???  =? 3 returns  diagnostics 
 a 1 
 b  1.5 
 c -1.  
 discriminant_2 2.5 
discriminant 2.5 > 0 has two real roots 
 for  ::math::quadratic_solution  3 1 <3./2.> -1. returns  -2.0 0.5 
 printout  diagnostics 
 option number 3 ???  =? 3 returns  diagnostics 
 a 1 
 b  2.6666666666666665 
 c -1  
 discriminant_2 3.3333333333333335 
 discriminant 3.3333333333333335 > 0 has two real roots 
 for  ::math::quadratic_solution  3 1 <8./3.> -1 returns -2.9999999999999987 0.33333333333333331 
(System32) 1 % 
======
----