[ expr { 1 -(estimated)/( ideal & exact ) } ] or 
       if negative and not greater than one,    
       set error as [ expr   ( ideal & exact ) /   (estimated) -1. ] 

            proc pietry {aa bb} {for {set i 1} {$i<=$bb} {incr i} { set aa [expr $aa +6./($i*$i) ]  } ;return [expr sqrt($aa)] }
            #usage  [ pietry 0 1000] answer is 3.14063
            proc piefourth {aa bb} {for {set i 1} {$i<=$bb} {incr i 2} { set aa [expr $aa +8./($i*$i) ]  } ;return [expr sqrt($aa)] }
            #usage; $t insert 1.0 " piefourth  [ piefourth  0 5000 ]     "  answer is 3.14146
            proc pitofourover90 {aa bb} {for {set i 1} {$i<=$bb} {incr i} { set aa [expr $aa +1./($i*$i*$i*$i) ]  } ;return $aa }
            # set answer [ pitofourover90 0 10 ];answer is pi**4/90. or 1.08013
            proc pietry4 {aa bb} {for {set i 1} {$i<=$bb} {incr i 1} { set aa [expr $aa +90./($i*$i*$i*$i) ]  } ;set aa [expr sqrt($aa)];return [expr sqrt($aa)] }
            #usage:pietry4 0 100,  answer is 3.141592
            proc atan5 {aa }  { return [expr {(1.*$aa)-(pow($aa,3)/3.)+(pow($aa,5)/5.)-(pow($aa,7)/7.)+(pow($aa,9)/9.)-(pow($aa,11)/11.) } ]  } 
            proc pietanic { } { return [expr 4.*44.*[atan5 [expr 1./57]]+4.*7.*[atan5 [expr 1./239]] -4.*12*[atan5 [expr 1./682]]+4.*24*[atan5 [expr 1./12943]] ]}
            #usage [pietanic ], returns 3.1415926535897922; appears to be accurate to 14 decimal places.
            proc isprime x {expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]}}
            #[SMH] returns 1 if prime and zero if not.,usage [isprime 23] has answer of 1 (one) [isprime 20] has answer of 0 (zero)
            proc primepi {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} { if { [isprime $i] || [isprime [expr $i+1] ]} {incr cc;}}; expr {sqrt(6./((1.*$cc)/($n*1)))}}
            #Usage:$t.text insert 1.0 " primepi   [primepi 50]   "  3.2163, not bad for a prime number algorithm
            # Here n is the nth positive integer from zero.
            # This algorithm was easier to code, but is a little suspect 
            #because the integer numbers were not randomly chosen
            # (as specified by the Euler rule for paired primes).
            proc ran {} {return [expr rand()]};
            proc montepi {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} {set x [ran ]; set y [ran]; if {($x*$x + $y*$y) < 1} {incr cc;}}; expr {4e0*$cc/$n}}#
            #usage: montepi 90, answer is 3.1555,
            # not bad for a Monte Carlo (random process) algorithm.
            # derived from the TCL random function, the x and y pairs that are digital fractions from 0 to 1.
            proc gcdE {a b} {expr {$b==0? $a: [gcdE $b [expr {$a%$b}]]}} #RS
            proc montepithon {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} {set x [expr {int(10000*[ran ])}];set y [expr {int(10000*[ran ])}] ;if {[gcdE $x $y]<2} {incr cc}; }; return  [expr {sqrt(6.*$n/$cc)}]  }
            #usage:[ montepithon  50 ], n is the number of trials or number of interger pairs tested.
            #answer varies from 2.97 to 3.27 on small trial of 50 integer pairs.
            # This ratio of gcd pairs to N trials needs
            # about a million pairs for 3 significant figures of pi.
            # This algorithm is based on Euler's rule
            # that ratio of trials to found gcd pairs is about pi squared over 6.
            proc listnumbers { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend booboo [ expr 1.* $i] };return $booboo}
            #returns list of integer numbers from aa to bb as reals with decimals,usage [listnumbers 1 5] , answwer is 1.0 2.0 3.0 4.0 5.0  
            proc listnumbersodd { aa bb} { for {set i 1} {$i<=$bb} {incr i 2} {lappend booboo [expr 1.*$i] };return $booboo}
            #returns list of odd numbers from aa to bb as reals with decimals, usage [ listnumbersodd 0 10],answer is 1.0 3.0 5.0 7.0 9.0
            proc listprimes { aa bb} { for {set i 1} {$i<=$bb} {incr i 2} { if {[isprime $i] } {lappend booboo [expr 1.*$i]   } };return $booboo}
            #returns list of prime numbers  from aa to bb, usage [listprimes 0 25],answer is 3.0 5.0 7.0 11.0 13.0 17.0 19.0 23.0
            proc euler4 {aa bb} {for {set i 1} {$i<=$bb} {incr i 1} { set aa [expr $aa+1./([fac $i]) ]  } ;return [expr (1.*$aa)] ; }
            #usage: $t insert 1.0 "euler number [ euler4 1 100 ]"; answer is 2.71828, procedure fac above should be loaded too.
            #The Gregory-Leibnez series for the arctan  has alternating powers of negative one.
            # arctan series = x - x^3/3 + x^5/5 - x^7/7 + ...
            # arctan(1)=pi/4 = x - x^3/3 + x^5/5 - x^7/7 + ...
            # substituting 1 for x
            # pi = 4.-4./3+4/5+4./7
            proc liebniz {aa bb} {console show;set i 1;while {$i <= $bb} {set dd [expr {2.*$i+1}];set ee [expr { (1.*pow(-1,$i)*1.)/ $dd }] ; puts $ee;set aa    [expr $aa + $ee];incr i;};return [expr 4.*$aa];}
            puts " [ liebniz 1 500 ]"
            GWM time your results:
            time {puts "[liebniz 1 50000]"}
 

time {puts "[liebniz 1 50000]"}
3.141612653189785
16297000 microseconds per iteration

remove the puts $ee - 8 times faster:

proc liebniz {aa bb} {console show;set i 1;while {$i <= $bb} {set dd [expr {2.*$i+1}];set ee [expr { (1.*pow(-1,$i)*1.)/ $dd }] ; set aa    [expr $aa + $ee];incr i;};return [expr 4.*$aa];}
time {puts "[liebniz 1 50000]"}
3.141612653189785
2359000 microseconds per iteration

Brace your expr for 40 times faster still:

proc liebniz {aa bb} {console show;set i 1;while {$i <= $bb} {set dd [expr {2.*$i+1}];set ee [expr { (1.*pow(-1,$i)*1.)/ $dd }] ; set aa    [expr { $aa + $ee } ];incr i;};return [expr 4.*$aa];}
(Michel.GANDC9200) 7 % time {puts "[liebniz 1 50000]"}
3.141612653189785
63000 microseconds per iteration

Note that this timing is limited by my cpu clock to 16 ms accuracy (all my timings were multiples of 16 ms), so use ten times as many iterations:

time {puts "[liebniz 1 500000]"}
3.1415946535856922
531000 microseconds per iteration

OR use this version after removal of redundant operations (pow(-1,N) is bound to be slower than a simple choice:

  proc liebniz2 {aa bb} {console show;set i 1; set dd 1;while {$i <= $bb} {incr dd 2 ; set aa    [expr {$aa + ($i%2?-1.:1.)/ $dd}];incr i;};return [expr 4.*$aa];}

Again ten times the number of iterations:

time {puts "[liebniz2 1 500000]"}
3.1415946535856922
203000 microseconds per iteration

    # arctan5 passes value in radians, aa is initial value, bb is number of terms or iterations.
    # needs at least 1000 iteratios to return a recognizable value of pi.
    proc arctan5 {aa bb} {console show;set i 1;set tt $aa;while {$i <= $bb} {set dd [expr {2.*$i+1}];set ee [expr { (1.*pow (-1,$i)*1.)*(pow($tt,$dd))/   $dd }] ; puts $ee;set aa [expr $aa + $ee];incr i;};return [expr 1.*$aa];}
    puts " [ arctan5 .5 10000 
    proc pi {args} [subst -novariable {expr [expr {atan2(0,-1)}] $args}]
    #finds equivalent diameter of circle that has same area of box or rectangle:aa and bb are sides of rectangle.
    #usage: set hexxx [box1 5 5];answer=5.6418
    proc box1 {aa bb } { set pie [pi]  ;return [ expr sqrt(($aa *  $bb*4 )/ ($pie))]}

proc pi {} {expr acos(-1)}

proc box1 {aa bb} {expr {sqrt(($aa * $bb * 4) / [pi])}}

proc anglecosa {a b c} {return [expr {($b*$b+$c*$c-$a*$a)/(2.*$b*$c)}]}

proc anglecosa {a b c} {expr {($b*$b+$c*$c-$a*$a)/(2.*$b*$c)}}

proc emmy2 {} {if {[expr {rand()}] <= 0.9} {return 1}}

proc emmy2 {} {if {rand() <= 0.9} {return 1}}

  console show
  proc pie {} {expr acos(-1)}
  proc writer {args } { puts $args }
  proc call {args} {uplevel catch [list $args]}
  call writer "jack" "&" "jill"
  call writer jack & jill went up the hill with [pie]

   console show
   proc pi {} {expr {acos(-1)}}  
   # proc pi from AMG see below
   proc degtoradiansconst {} { expr {180./ [pi] }}
   proc degz {} { expr {180./ [pi] }}
   proc degx {aa} { expr { degz *acos($aa)}}
   proc inrad {a b c} { expr {(sqrt(($a+$b+$c)*($a+$b-$c)*($a-$b+$c)*($b+$c-$a)))/(2.*($a+$b+$c))}}
   proc circlediameter {radius} { expr { 2.* $radius }}
   proc circlearea {radius} { expr { [pi] *($radius**2)}}
   proc circlecircumference   {radius} { expr {2.* [pi]  *$radius }}
   proc spherediameter {radius} { expr { 2.* $radius }}
   proc spherevolume {radius} { expr { (4./3.)* [pi]  *($radius**3)}}
   proc spheresurface {radius} { expr { 4.* [pi]  *($radius**3)}}
   proc cubevolume {aa}  { expr { 1.*$aa*$aa*$aa }}
   proc squarearea  {aa}  { expr { 1.*$aa*$aa }}
   proc ellipsoidvolume {aa bb cc} { expr { 1.*(4./3.)* [pi] *$aa*$bb*$cc }}
   proc ellipsearea1 { aa bb } { expr { 1.* [pi]  *$aa*$bb  }}
   proc ellipseperimeterx {aa bb} { set tt [ expr { ($aa*$aa+$bb*$bb)/2.}];return [ expr { 2.*[pi]*sqrt($tt)} ] }
   proc spherevolumex {aa } { expr { 1.*(4./3.)* [pi]  *$aa*$aa*$aa }}
   proc spheroidvolumex {aa cc } { expr { 1.*(4./3.)* [pi]  *$aa*$aa*$cc }}
   proc torusvolumex {aa bb } { expr {(1./4.) * [pi] * [pi] * ($aa + $bb) * ($aa - $bb)*2.}}
   proc torussurfacex {aa bb } { expr { [pi] * [pi] * ($aa*$aa - $bb*$bb)}} 
   proc conesurfacex {aa rr } { expr { [pi]  *$rr*$aa}}
   proc cylindersurfacesidex {aa rr } { expr {2.* [pi] *$rr*$aa}}   
   proc cylinderwholesurfacesidex {aa rr } { expr {2.* [pi] *$rr*$aa +2.* [pi]  *$rr*$rr}}   
   proc cylindervolumesidex {aa rr } { expr { [pi] *$rr*$rr*$aa}} 
   proc conevolumex {aa rr }  { expr { (1./3.)* [pi] *$rr*$rr*$aa}} 
   proc pyramidvolumex {aa bb cc } { expr {(1./3.)*$aa*$bb*$cc }} 
   proc rectangularprismvolumex {aa bb cc } { expr { $aa*$bb*$cc }} 
   proc triangularprismvolumex {aa bb cc } { expr { $aa*$bb*$cc*.5 }} 
   proc polygonperimeterx {aa bb } { expr { $aa*$bb}} 
   proc rectangleperimeterx {aa bb } { expr {2.*( $aa+$bb)}} 
   proc parallelogramperimeterx {aa bb } { expr {2.*( $aa+$bb)}} 
   proc triangleperimeterx {aa bb cc} { expr { $aa+$bb+$cc }} 
   proc triangletrapezoidx {aa bb cc} { expr { $aa*($bb+$cc)*(1./2.)}}
   #law of cosines, aa bb cc are three sides of right triangle, here ordered 
   #as aa small side , bb middle side, cc largest side.
   # inrad is radius of cirle inscribed in right triangle,
   # use sides as inrad aa bb cc 
   proc anglecosa  { aa bb cc } { expr {($bb*$bb+$cc*$cc-$aa*$aa)/(2.*$bb*$cc)}}
   proc anglecosb { aa bb cc } { expr {($cc*$cc+$aa*$aa-$bb*$bb)/(2.*$aa*$cc)}}
   proc anglecosc { aa bb cc } { expr {($aa*$aa+$bb*$bb-$cc*$cc)/(2.*$aa*$bb)}}
   #with examples
   #for radius of 1
   #circlediameter 1 
   #circlearea 1  
   #circlecircumference 1  
   #spherediameter 1   
   #spherevolume 1 
   #spheresurface 1 
   #inrad 3 4 5 
   #anglecosa 3 4 5 
   #anglecosb 3 4 5  
   #anglecosc 3 4 5
   # following include redundant TCL one liner procedures for  sqrt of sum of squares
   #   sqrt of sum of squares and diagonal using expr 
   proc diagonal_1  {aa bb} { expr { sqrt($aa * $aa + $bb * $bb)}}
   # Usage diagonal 1 1  s  1.4142135623730951
   # diagonal using math ops
   proc diagonal_2 {aa bb} {[sqrt [+ [* $aa $aa]  [* $bb  $bb] ] ]}
   # Usage  diagonal_2 1 1 returns 1.4142135623730951
   # diagonal using math hypot function
   proc diagonal_3{aa bb} {[ hypot $aa $bb ]}
   # Usage  diagonal_3 1 1 returns 1.4142135623730951
   # time one liners, but sticking >> [ time { set qq  [ diagonal_1  1 1 ] }  ]
   proc diagonal_1x {aa bb} { [ time [sqrt [+ [* $aa $aa]  [* $bb  $bb] ] ]]}
  

  proc emmy  aa  {expr {rand()<.9? 1 : 0 }}
  proc emmy2 aa { if { [ expr { rand() } ] <= .90 } {return 1 }}
  if { [ expr { rand() } ] <= .90 } {set immigrantyear  1 }
  proc plaguex  aa  {expr {rand()<.15? 1 : 0 }}
  if { [ expr { rand() } ] <= .15 } {set plaguethisyear 1 }
  # There is a 15 percent chance of plague this year
  # with random casualities up to 10 percent of population.
  proc plaguelossx aa {expr {rand()<.15? int($aa*.1*rand()) : 0 }}
  proc ratx  aa  {expr {rand()<.41? 1 : 0 }}
  if { [ expr { rand() } ] <= .41 } {set ratinfestthisyear 1 }
  set ratliters  [ expr { $liters*.1*rand()   } ]
  set ratliters [ expr { int($ratliters) } ] 
  set sumariansstarved [ expr { $sumarians*.02*rand()   } ]
  set sumariansgain aa {expr {rand()<.15? $aa*.1*rand() : 0 }}
  set sumariansgain   [ expr {  $sumarians  * .10 * rand() } ]  
  set sumariansgain   [ expr {  int($sumariansgain) } ] 
  set sumarians [ expr { $sumarians + $sumariansgain   } ]

     proc mac {aa} { regexp {.(\d+)} $aa -> bb;return $bb }
     proc macomma {aa} { regexp {.,(\d+)} $aa -> bb;return $bb }

  #proc errorx always returns a positive error. 
  #Normally assume $aa is human estimate,
  #assume $bb is divinely exact. 
        proc errorx  {aa bb} {expr { $aa > $bb ?   (($aa*1.)/$bb -1.)*100. : (($bb*1.)/$aa -1.)*100.}}

      proc erffunc { xx } { return [ expr { (2 / [ piesq  ]) * ((1)*(pow($xx,9))/([facx 4]*9)+(-1)*(pow($xx,7))/([facx 3]*7)+(1)*(pow($xx,5))/([facx 2]*5)+(-1)*(pow($xx,3))/([facx 1]*3) + $xx  ) }  ]};# large terms only
      #proc erffunc_1st_term { xx } { return [ expr { (2 / [ piesq ]) * ( $xx ) }  ]};# first term only on this line
      #proc erffunc_large_terms { xx } { return [ expr { (2 / [ piesq  ]) * ((1)*($xx*$xx*$xx*$xx*$xx)/(2*5)+ (-1)*($xx*$xx*$xx*$xx*$xx*$xx*$xx)/(6*7)+(-1)*($xx*$xx*$xx)/(1*3) + $xx  ) }  ]};# large terms only
      # usage, set test5 [ erffunc ];# test5 ~~ 0.5205
      #gold, 27Apr2007, working on etcl and windows xp
      proc facx n {expr {$n<2? 1:$n>20? $n*($n-1): $n * [facx [incr n -1]]}}
      # stopped at factorial greater than 20
      proc gm {args} { return [expr [expr .5*(1+sqrt(5))] $args]}
      #gold, golden mean, usage [gm] [gm /4]
      proc pi {args} [subst -novariable {
     expr [expr {atan2(0,-1)}] $args
     }]
      #wdb,usage [pi] [pi /4]
      proc piesq {args} { set pie [pi] ; return [ expr sqrt($pie) ]}
      proc degrad {argx} {return [expr 180 / [ pi ]]}; 
      proc raddeg {argx} {return [ expr [ pi ] / 180 ]}; 
      #Used to have a whole set of engr math functions in
      #javascript, based on subformulas/procs like RS's [factorial]
      #and wdb's proc for [constant] .

      proc geoseries1 {aa bb cc} { if {$bb <= -1||$bb >= 1} { return 0} ;return [ expr $aa / ( 1 - $bb ) ]};
      # 27Apr2007,gold,works with etcl
      # convergent geometric series if $a != 0 and -1 > $r < 1
      # $a is constant multiplier, $r is fraction under exp.
      # Series is undefined if r< -1 or r > 1
      # Holding $cc open for number of terms in partial sum.
      # If divergent, proc returns zero,
      #usage,set test5 [ geoseries1 15 .2857 1 ];#test5~~21
      #usage,set test5 [ geoseries1 15 -1.2857 1 ];#test5~~zero
      #usage,set test5 [ geoseries1 15 1.2857 1 ];#test5~~zero
      #Lets adapt AM's more concise procedure from below 
      #for the partial sum of a geometric series.
      proc geoseries3 {aa bb {cc -1}} {expr {abs($bb)<1? ($aa/(1.0-$bb))-([expr {$cc>0}]*$aa*pow($bb,$cc))/(1-$bb) : 0.0}}
      #usage,set test5 [ geoseries3 15 .2857 1 ];#test5~~15
      #usage,set test5 [ geoseries3 15 .2857 4 ];#test5~~20.8597
      # Now, lets define and pseudocode an error formula as
      # [ expr { 1 -(estimated)/( ideal & exact ) } ] or 
      # [ expr {1 - (partial sum of n terms)/(total sum of infinite terms) } ]  
      #set error [expr {1-[ geoseries3 15 .2857 5 ] / [ geoseries3 15 .2857 ] }];# using default args on later.
      # error with 5 terms approaches .002;# error with 7 terms approaches .00015
      # Vola, more than 7 terms exceeds "slide rule accuracy".     

            proc plainsub {text item replacewith} {
            set text [string map [list $item $replacewith] $text]
            }
            proc %+ {a  } {return [string toupper $a]; #%+ tree >TREE }
            proc %- {a  } {return [string tolower $a]; #%+ Tree >tree  }
            proc %++ {a b} {return $a$b;#%+* tree root  >treeroot }
            proc %-- {a b} {regsub $b $a "" a; return $a;#%-- 5 7>5 }
            proc %% {a b} {regsub -all $b $a "";#%% tree root  >tree }
            proc %1 {a b} {regsub $b $a "" a; return $a;#%1 tree root>tree }
            proc %2 {a b} {regsub $b $a "" a;regsub $b $a "" a; return $a;#%2 tree root>tree }
            proc %3 {a b} {regsub $b $a "" a;regsub $b $a "" a;regsub $b $a "" a; return $a;#%3 tree root>tree}
            proc %2x  {a} {return $a$a;#%2x tree>treetree}
            proc %3x  {a} {return $a$a$a;#%3x tree>treetreetree}
            proc %4x  {a} {return "$a,$a,$a";#%5x tree>tree,tree,tree }
            proc %5x  {a} {return "$a $a $a";#%5x tree>tree tree tree } 
            proc repeat {n body} {while {$n} {incr n -1; uplevel $body}}
            proc random n {expr {round($n*rand())}}
            proc whitelist {a} {return [lreplace $a 0 -1];#take string,return list without blanks}
            set k [split {abcdefghijklmnopqrstuvwxyz} {}]
            # eraser procedures for positive and negative numbers
            proc eggy {bb} {if {$bb <= 0 } { return 0} ;return  $bb  };# deletes negative numbers
            proc neggy {bb} {if {$bb >= 0 } { return 0} ;return  $bb  };#deletes positive numbers
            proc zergy {bb} {if {$bb == 0 } { return 0} ;return  $bb  };#deletes zero numbers
            proc  neggabs {bb} {if {$bb <= 0} { return [ expr $bb * -1]} ;return  0  };
            #deletes positive numbers and returns absolute value of negatves
            # formula for two parallel resistors of resistance aa and bb ohms.
            proc parresistor2 {aa bb } { return [ expr (($aa *  $bb )/ ($aa + $bb))]}
            #usage: set resistor [ parresistor 100 100  ];answer is 50.
            # formula for three parallel resistors of resistance aa, bb,  and cc ohms.
            proc parresistor {aa bb cc } { return [ expr (($aa *  $bb * $cc)/ ($aa*$bb+$aa*$cc+$bb*$cc))]}
            #usage: set resistor [ parresistor 100 100 100 ];answer is 33
            # formula for fet transistor of volttage 0.009 volts and resistance bb ohms.
            proc fetvolts {aa bb } { return [ expr ($aa *  $bb )]}
            # fet transistor load usage: set fetvolts [ .009 2500 ];answer is 22.5
            # formula for fet transistor of volttage 0.009 volts, resistance bb ohms, cc and dd volts.
            proc fetdrainvolts {aa bb cc dd } { return [ expr ($aa *  $bb + $cc +  $dd)]}
            # fet transistor usage: set fetdrainvolts [ .009 2500 7 5 ];answer is 34.5
            # thin film resistor of dimension aa length and ww width, and sheet resistance cc
            proc thinfilmresistor {aa ww cc } { return [ expr (($aa * $cc)/ ($ww*1.))]}
            #usage ;thinfilmresistor of length 0.8 cm,   width 0.2 cm, and sheet resistance of 150 ohms
            # set resistance2 [ thinfilmresistor {.8 .2 100 } ] ;#answer is 600 ohms
            # efficiency and output of electric motor with one horsepower for 746 watts.
            proc electrichorsepower  {aa bb cc } { return [ expr (($aa *  $bb * $cc)* (1./746.))]};#horsepower
            # efficiency as 0.8 no_units, voltage as 25 volts, and input current as 10 amps
            # The scale factor would be (1./746.) horsepower per watt.
            #usage:append  details " [ electrichorsepower  .8 25 10  ]  " ;#answer is 0.268 horsepower
            # formula for cascaded efficiency for n1 *n2 * n3 
            proc   cascadedefficiency  {aa bb cc } { return [ expr (($aa *  $bb * $cc)* (100./1.))]};# 
            #example for n1 = 85 percent, n2 equals 90 percent,and n3 equals 73 percent and scale factor 100./1.
            # set  exampleproblem [ cascadedefficiency   .85 .90 .73    ] #answer is 56 percent.

      #Lord Kelvin calculated the age of the earth by approximating the cooling of an molten iron sphere.
      # heating of radioactive elements in earth's crust was not considered.
      # following assumptions crust thermal defusivity $cc is 1.5E-6 meters/sec*sec,
      # As a alternate defusivity estimate, Sandstone is about 1.1E-6 meters/sec*sec. 
      # alpha $dd is 0.04 degrees centigrade per meter
      # initial temperature $aa was 2500 centgrade degrees ,
      # final temperature $bb was near zero degrees centigrade.$ee was number seconds in year was 3156000 seconds.
      proc kelvinearthtempage {aa bb cc dd ee} { return [ expr (($aa -  $bb)*($aa -  $bb)/ ( $cc * [pi]*  $dd* $dd*$ee))]}
      # Kevin estimated a low and high age estimate of 25 million years and 100 million years, respectively.
      #usage: low estimate: set age_of_earth " [  kelvinearthtempage 2500 .1 .0000015 .04  31536000.  ] ";#answer 26 million years
      #usage: high estimate could be:  set age_of_earth " [  kelvinearthtempage 5100 .1 .0000015 .04  31536000.  ] ";#answer 110 million years

      proc fib {n} { if {$n < 2} then {expr {$n}} else {expr {[fib [expr {$n-1}]]+[fib [expr {$n-2}]]} }}
      #usage: $x.text insert 1.0 " goo  [  fib 8  ] " or answewr is 21
      # usage     set xat [fib 10] or answwer is 55
      # usage     set zat [fib 11] or answer is 89
      # Now, lets define and pseudocode for formula of golden section as
      # fib N+1 / fib Nth  and substitute fib 11 / fib 10
      # for rough estimate of golden section: set gat [ expr {    ($zat*1.)   /   ($xat*1.)   } ]
      # answer was 1.6181818 whereas the exact value was (1+sqrt(5))/2 (approx 1.6180339887)

      # from the procedure with the exact formula.
      proc gm {args} { return [expr [expr .5*(1+sqrt(5))] $args]}
      #gold, golden mean, usage [gm] [gm /4]
      
       
     # Now, lets define and pseudocode an error formula either by
      # [ expr { 1 -(estimated)/( ideal & exact ) } ] or 
      # if negative and not greater than one,    
      # set error as [ expr   ( ideal & exact ) /   (estimated) -1. ] 
      
     
        set dat [ expr { (( ($zat*1.) / ($xat*1.)) / [ gm *1. ] -1.) } ]or 0.0000913
       # Meaning the ratio of the 10 and 11th terms approach the limit by 0.0000913 error 

       proc fib {n} {expr {$n < 2 ? $n : [fib [expr {$n - 1}]] + [fib [expr {$n - 2}]]}}

    proc listfib { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend booboo [ int [ binet $i] ] };return $booboo} 
    proc binet { n} {set n [int $n ]; return [int [*  [/ 1 [sqrt 5]]  [- [**  [/   [+ 1 [sqrt 5]] 2 ] $n ]  [** [/   [- 1 [sqrt 5]] 2 ]  $n ] ] ] ] } 
    # usage,  set binet1  [ binet 8]  # answer 21,   removing int's will return real numbers
    # usage,  set fibno  [ listfib 1 8 ], answer 1 1 2 3 5 8 13 21 
    proc fibonacci_approx_for_large_N {n} { set phi [/   [+ 1 [sqrt 5]] 2 ]  ; return [round [/  [** $phi  $n   ] [sqrt 5 ]]] } ;# test only, not sure for all N
    listfib 1 20
    1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765

            proc perimeter {aa bb cc dd } {return [+ $aa $bb $cc $dd ]}
            proc semip {aa bb cc dd } {return  [* [+ $aa $bb $cc $dd ] .5] }
            set semip [ semip ]
            proc reference_factor {aa bb cc dd } {return [/ [+ [* $aa $aa ] [* $bb $bb ]] [+ [* $cc $cc ] [* $dd $dd ]]]}
            proc cyclic_quad_area {aa bb cc dd } {return [sqrt [* [- $semip $aa ] [- $semip $bb ] [- $semip $cc ] [- $semip $dd ]]] }                   

    #   following one liners are decimal equivalent to some Babylonian tables
    #   possible cubic problem instances include separate tables for  cubes n*n*n and quasi_cubes
    #   quasi_cube n*n*(n-1), quasi_cube n*(n + 1)*(n + 2), quasi_cube  n*n*(n + 1), quasi_square n*(n+1)   
    #   list_integers is list of positive integers, 1 2 3 4 ... n
    proc list_integers { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  1.]};return $boo}  
    # usage, list_integers 1 10
    # 1.0  1.0 2.0 2.0 3.0 3.0 4.0 4.0 5.0 5.0 6.0 6.0 7.0 7.0 8.0 8.0 9.0 9.0 10.0 10.0
    #  list_reciprocals is list of 1/1 +1/2 1/3 1/4 ... 1/n
    proc list_reciprocals { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [/  1. $i  ]};return $boo}
    # usage, list_reciprocals 1 10    
    # 1.0 1.0 2.0 0.5 3.0 0.333 4.0 0.25 5.0 0.2 6.0 0.166 7.0 0.142 8.0 0.125 9.0 0.11 10.0 0.1
    # list_squares is list of integer squares, 
    proc list_squares { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  $i  ]};return $boo}
    # usage, list_squares 1 10  
    # 1.0 1 2.0 4 3.0 9 4.0 16 5.0 25 6.0 36 7.0 49 8.0 64 9.0 81 10.0 100
    # quasi_cube2 is n*(n)*(n-1)
    proc list_quasi_cube2 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  $i [- $i 1]]};return $boo}
    # usage, list_quasi_cube2  1 10   
    # 1.0 0 2.0 4 3.0 18 4.0 48 5.0 100 6.0 180 7.0 294 8.0 448 9.0 648 10.0 900
    # quasi_cube3 is n*(n+1)*(n+2)
    proc list_quasi_cube3 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  [+ $i 1] [+ $i 2]]};return $boo}
    # usage list_quasi_cube3   1 10
    # 1.0 6 2.0 24 3.0 60 4.0 120 5.0 210 6.0 336 7.0 504 8.0 720 9.0 990 10.0 1320
    # quasi_cube4 is n*(n)*(n+1)
    proc list_quasi_cube4 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  $i [+ $i 1]]};return $boo}
    # usage, list_quasi_cube4 1 10
    # 1.0 2 2.0 12 3.0 36 4.0 80 5.0 150 6.0 252 7.0 392 8.0 576 9.0 810 10.0 1100
    # quasi_square2 is  n*(n+1), 
    proc list_quasi_square2 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  [+ $i 1]]};return $boo}
    # usage, list_quasi_square2 1 10
    # 1.0 2 2.0 6 3.0 12 4.0 20 5.0 30 6.0 42 7.0 56 8.0 72 9.0 90 10.0 110
    # list_sum_integers 
    proc list_sum_integers { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [/  [*  $i  [+ $i 1] ] 2. ]};return $boo}
    # usage, list_sum_integers 1 10
    #1.0 1.0 2.0 3.0 3.0 6.0 4.0 10.0 5.0 15.0 6.0 21.0 7.0 28.0 8.0 36.0 9.0 45.0 10.0 55.0
    # list_sum_squares 
    proc list_sum_squares { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [/ [*  $i  [+ $i 1.] [+ [* $i 2.]  1.]] 6.]};return $boo}
    # usage list_sum_squares 1 10
    # 1.0 1.0 2.0 5.0 3.0 14.0 4.0 30.0 5.0 55.0 6.0 91.0 7.0 140.0 8.0 204.0 9.0 285.0 10.0 385.0

    # Auxiliary math series used along side B. math problems.
    # B. math used <x+1/x> as initial square root estimate in some square root algorithms.
    proc list_bab_sqrt { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [- [* 1. $i] [/ 1. $i]] };$boo}
    # Usage  list_bab_sqrt 0 10, bb is upper limit, aa is lower limit as set i $aa
    # output 0.0 1.5 2.666 3.75 4.8 5.83 ...
    proc list_sqrt { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [sqrt $i ] };$boo}
    # Usage  list_sqrt  0 10, bb is upper limit, aa is lower limit as set i $aa
    # output 1.0 1.414 1.732 2.0 2.236 2.449 ... standard square roots
    proc list_bab_reciprocal_formula2 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* .5 [- [* 1. $i] [/ 1. $i]]] };$boo}
    # Usage  list_reciprocal_formula2  0 10, bb is upper limit, aa is lower limit as set i $aa
    # output 0.0 0.75 1.33  1.875 2.4 2.916  3.42857  ...
    proc list_bab_reciprocal_formula3 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* .5 [+ [* 1. $i] [/ 1. $i]]] };$boo}
    # Usage  list_reciprocal_formula3  0 10, bb is upper limit, aa is lower limit as set i $aa
    # output 1.0 1.25 1.66  2.125 2.6 3.083 ...

   # triangular_number_ref_quasi_square3 is  n*(n+1)/2,
    proc triangular_numbers_ref_quasi_square3 { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend boo [* 1. $i ] [*  $i  [+ $i 1]  .5 ]};return $boo}
    # usage, list_quasi_square2 1 10
    # 1.0 2 2.0 6 3.0 12 4.0 20 5.0 30 6.0 42 7.0 56 8.0 72 9.0 90 10.0 110
    #usage  < triangular_numbers_ref_quasi_square3 1 10 >
    # formula for triangular number is  n(n+1)/2 
    proc triangular_number_2 {nn} { return [ expr { $nn*($nn+1.)/2. } ]}
    proc sum_triangular_number {nn} { return [ expr { $nn*($nn+1.)*($nn+2.)/6. } ]}
    # usage  < sum_triangular_number 2 >
    # sum_triangular_number series 1,4,10,20,35,56,
    # OEIS A000217 reports triangular numbers as
    #  1, 3, 6, 10, 15, 21, 28, 36, 45, 55 ... ?
    # OEIS A000292 reports  Tetrahedral (or triangular pyramidal) numbers:
    # a(n) = C(n+2,3) = n*(n+1)*(n+2)/6.
    #  0, 1, 4, 10, 20, 35, 56, 84, 120, 165 ... ?

    # working under TCL version 8.5.6 and eTCL 1.0.1
    # gold on TCL WIKI , 24may2011
    console show
    set lister { 1 2 3 }
    proc sum list {expr [join $list +]} ;#RS
    proc !+ args { expr [join $args +] }
    proc !* args { expr [join $args *] }
    proc !- args { expr [join $args -] }
    proc !/ args { expr [join $args *1./] }
    proc !1/ args { expr [ join $args  +1./ ]}
    proc %+ lister {expr [join $lister +]}
    proc %* lister {expr [join $lister *]}
    proc %- lister {expr [join $lister -]}
    proc %/ lister {expr [join $lister *1./]}
    puts " args cmds take form of !+ 1 2 3 or !/ 1 2 3"
    puts " list cmds take form of %+ \$lister"
    puts " or %* \$lister  or %- \$lister or %/ \$lister " 
 #console output
 3% !* 1 2 3
 6
 4% !/ 1 2 3
 0.16666666666666666
 5% !- 1 2 3
 -4
 6%  !1/ 1 2 
 1.5
 7% %/ $lister
 0.16666666666666666
 8% %- $lister
 -4
 9% %* $lister
 6
 10% %+ $lister
 6

% namespace path {::tcl::mathop ::tcl::mathfunc}
% + 1 2 3
6
% / 1.0 2 3 
0.16666666666666666
% - 1 2 3 
-4
% set lister [ list 1.0 2 3 ]
1.0 2 3
% / {*}$lister
0.16666666666666666
% - {*}$lister
-4.0
% * {*}$lister
6.0
% + {*}$lister
6.0

        #!/usr/bin/env wish
        # finding PI from series notation V2
        # code from TCL Club  Slot_Calculator_Demo
        # 5Jan2009, gold
        # following comment from gold 12dec2018
        # pretty print from autoindent and ased editor
        # finding PI from series notation V2
        # written on Windows XP on eTCL
        # working under TCL version 8.6
        # Revamping older program from 5Jan2009.
        # One of my early programs,
        # but I believe the pie routines
        # and pie content might have some interest (to me).
        # gold on TCL Club, 12dec2018
        package require Tk
        set reportcard "ready"
        set reportcard2 "zero entry detected !!! "
        label .title -text "PI Series Calculator" -font {Times 15 bold} -relief raised -fg blue -bg seashell3
        frame .puzzle -bg aquamarine4
        frame .f1
        frame .f2
        frame .f3
        frame .f4
        frame .f5
        set colorgrd seashell4
        set colorback bisque
        set colorwarning tomato1
        label .l1 -text "initial N or Nth" -background seashell1 -width 25 -anchor w
        entry .e1 -textvariable side1  -background $colorback
        pack .l1 .e1 -in .f1 -side left
        label .l2 -text "upper N2 terms" -background seashell2  -width 25 -anchor w
        entry .e2 -textvariable side2  -background $colorback
        pack .l2 .e2 -in .f2 -side left
        label .l3 -text "algorithm 1,2,3,...7  " -background seashell3 -width 25 -anchor w
        entry .e3 -textvariable side3  -background $colorback
        pack .l3 .e3 -in .f3 -side left
        label .l4 -text "answer  " -background seashell2 -width 25 -anchor w
        entry .e4 -textvariable answer2  -background $colorback
        pack .l4 .e4 -in .f5 -side left
        pack .f1 .f2 .f3 .f5 -in .puzzle -side top -expand 1
        frame .answer -bd 2 -relief ridge -bg aquamarine4
        proc Scrolled_Text { f args } {
            frame $f
            eval {text $f.text -wrap word \
                        -xscrollcommand [list $f.xscroll set] \
                        -yscrollcommand [list $f.yscroll set]} $args
            scrollbar $f.xscroll -orient horizontal  \
                    -command [list $f.text xview]
            scrollbar $f.yscroll -orient vertical  \
                    -command [list $f.text yview]
            grid $f.text $f.yscroll -sticky news
            grid $f.xscroll -sticky news
            grid rowconfigure $f 0 -weight 1
            grid columnconfigure $f 0 -weight 1
            return $f.text
        }
        global t x
        set t [Scrolled_Text .eval -width 20 -height 5 -bg bisque]
        set x [Scrolled_Text .eval2 -width 20 -height 5 -bg bisque]
        pack .eval .eval2 -fill both -expand true -side left -in .answer
        $t insert end  " identified1 !!![ winfo children . ]"  ;
        $x insert end  " identified2 !!! [ winfo children . ]"  ;
        focus $t
        focus $x
        pack .answer  -in .puzzle -side bottom -pady {10 0}
        frame .buttons -bg aquamarine4
        ::ttk::button .calculater -text "Solve" -command { calculate  side1 side2 side3 }
        ::ttk::button .test2 -text "Testcase1" -command {testcasexxxx 0 100 1 3.14}
        ::ttk::button .test3 -text "Testcase2" -command {testcasexxxx 50 1000 2 3.14}
        ::ttk::button .test4 -text "Testcase3" -command {testcasexxxx 100 1000000 3 3.14}
        ::ttk::button .clearallx -text clear -command {clearall  }
        ::ttk::button .about -text About -command About
        ::ttk::button .self_help -text self_help -command { self_help }
        ::ttk::button .exit -text exit -command {exit}
        pack .calculater  -in .buttons -side top -padx 10 -pady 5
        pack  .clearallx .about .self_help .exit .test4 .test3  .test2   -side bottom -in .buttons
        grid .title - -pady 10 -padx 10 -ipadx 10
        grid .puzzle .buttons -sticky ns -pady {0 10}
        proc testcasexxxx { de1 de2 de3 wer } {
            # testcase is side of 5 units and 30 units
            # result or product is 150 units
            global side1 side2 side3 answer2 x t
            set answer2 ""
            set answer5 ""
            set side1 $de1
            set side2 $de2
            set side3 $de3
            set answer2 " testcase, ans=$wer "
            $x insert 1.0 " testcase entered, answer = $wer "
            $t insert 1.0 " testcase entered, answer = $wer "
        }
        proc clearall {} {
            global colorwarning
            global colorback
            global side1 side2 side3 answer2 x t
            set side1 ""
            set side2 ""
            set side3 ""
            set answer2 ""
        }
        proc sumsquares { args } {
            set sum 0
            foreach item  $args  {
                if {$item == ""} {set item "0"}
                incr sum [ expr { $item * $item } ]
            }
            return [ expr { sqrt($sum) }   ]
        }
        proc pietanic2 { side1  side2  side3} {
            if {$side3 == "1"} { return [  pietry4  $side1 $side2]}
            if {$side3 == "2"} { return [  montepi $side1 ]}
            if {$side3 == "3"} { return [  montepithon  $side1 ]}
            if {$side3 == "4"} { return [  pietanic  ]}
            if {$side3 == "5"} { return [  primepi $side1  ]}
            if {$side3 == "6"} { return [  pietry  $side1 $side2]}
            if {$side3 == "7"} { return [  leibniz5  $side1 $side2]}
            # default to pietanic if not 1,2,3
            return [ pietanic  ]
        }
        proc binfactory  { side1  side2  side3} {
            global t x
            set algo1 { arctangent terms algorithm, best N=0,  30<N2<80 * }
            set algo2 { monte carlo algorithm, best 100<N<1000, N2 locked * }
            set algo3 { ratio of gcd pairs to N trials algorithm, best 10<N<1000, N2 locked *}
            set algo4 { specified terms of x in leibiniz series, all entries locked * }
            set algo5 { pairs of successive N and N+1 primes to Nth term, best 10<N<50, N2 locked * }
            set algo6 { euler series, 6/n*n, best N==0, 50<N2<1000 * }
            set algo7 {  gregory-leibniz series at initial x= 1, N locked to 1,best 200<N2<1000 * }
            set algo8 {  strip area of quarter circle,best 100<N<500, N2 locked  * }
            if {$side3 == "1"} { $t insert 1.0 "fm 1, $algo1 pi series ";$x insert 1.0 "fm 1, $algo1 pi series "}
            if {$side3 == "2"} { $t insert 1.0 "fm 2, $algo2 pi series ";$x insert 1.0 "fm 2, $algo2 pi series  " }
            if {$side3 == "3"} { $t insert 1.0 "fm 3, $algo3 pi series ";$x insert 1.0 "fm 3, $algo3 pi series "}
            if {$side3 == "4"} { $t insert 1.0 "fm 4, $algo4 pi series ";$x insert 1.0 "fm 4, $algo4 pi series "}
            if {$side3 == "5"} { $t insert 1.0 "fm 5, $algo5 pi series ";$x insert 1.0 "fm 5, $algo5 pi series " }
            if {$side3 == "6"} { $t insert 1.0 "fm 6, $algo6 pi series ";$x insert 1.0 "fm 6, $algo6 pi series " }
            if {$side3 == "7"} { $t insert 1.0 "fm 7, $algo7 pi series ";$x insert 1.0 "fm 7, $algo7 pi series " }
            if {$side3 == "8"} { $t insert 1.0 "fm 8, $algo8 pi series ";$x insert 1.0 "fm 8, $algo8 pi series " }
            # default to pietanic if not 1,2,3
            if {$side3 >= 8} { $t insert 1.0 "fm 1,defaulted pi series ";$x insert 1.0 "fm 1,defaulted pi series " }
            if {$side3 <= 0} { $t insert 1.0 "fm 1,defaulted pi series ";$x insert 1.0 "fm 1,defaulted pi series " }
            return
        }
        proc calculate {  ide1  ide2  ide3  } {
            global colorwarning
            global colorback
            global answer2 x t
            global side1 side2 side3
            set answer2 ""
            set xside1 $side1
            set xside2 $side2
            set xside3 $side3
            #set answer2 [ sumsquares $side1 $side2 $side3 ]
            binfactory $side1 $side2 $side3
            set answer2 [ pietanic2 $side1 $side2 $side3]
            $x insert 1.0 "$side1 $side2 $side3, answer = $answer2 "
            $t insert 1.0 "$side1 $side2 $side3, answer = $answer2 "
        }
        proc About {} {
            set msg "Calculator for pi series.
            testing on series accuracy."
            tk_messageBox -title "About" -message $msg
        }
        proc self_help {} {
            set msg " finding PI from series notation V2
            from TCL ,
            # self help listing
            # problem, finding PI from series notation V2
            # 3 givens follow.
            1) initial N or Nth:
            2) upper N2 terms:
            3) algorithm 1,2,3,...6:
            # Recommended procedure is push testcase
            # and fill frame,
            # change first three entries etc,
            # and then push report.
            # >>> copyright notice <<<
            # This posting, screenshots, and TCL source code is
            # copyrighted under the TCL/TK license terms.
            # Editorial rights and disclaimers
            # retained under the TCL/TK license terms
            # and will be defended as necessary in court.
            # algorithm list, 7 algorithms_subroutines so far.
            # number subroutine_name
            # 1  pietry4
            # 2  montepi
            # 3  montepithon
            # 4  pietanic
            # 5  primepi
            # 6  pietry
            # 7  leibniz5
            # default to pietanic if algorithm not entered.
            # Each algorithm has individual conditions and
            # defaults, and may use entries in alternate ways.
            # The intent was to be flexible to user selection.
            # 12Dec2018. Revamping older program fm 9Jan2009.
            # One of the
            # first and early TCL programs that
            # I wrote on wiki, but believe the pie routines
            # and pie content might have some interest (to me).
            # gold on  TCL Club, 12Dec2018 "
            tk_messageBox -title "Self_Help" -message $msg }
        # algorithms for test
        proc atan5 {aa }  { return [expr {(1.*$aa)-(pow($aa,3)/3.)+(pow($aa,5)/5.)-(pow($aa,7)/7.)+(pow($aa,9)/9.)-(pow($aa,11)/11.) } ]  }
        proc pietanic { } { return [expr 4.*44.*[atan5 [expr 1./57]]+4.*7.*[atan5 [expr 1./239]] -4.*12*[atan5 [expr 1./682]]+4.*24*[atan5 [expr 1./12943]] ]}
        proc ran {} {return [expr rand()]};
        proc montepi {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} {set x [ran ]; set y [ran]; if {($x*$x + $y*$y) < 1} {incr cc;}}; expr {4e0*$cc/$n}}
        #usage: montepi 90, answer is 3.1555,
        # not bad for a Monte Carlo (random process) algorithm.
        # derived from the TCL random function, the x and y pairs that are digital fractions from 0 to 1.
        # montepi will hardly fire on less than 10 cases.
        #montepi answer varies from 2.97 to 3.27 on small trial of 50
        proc gcdE {a b} {expr {$b==0? $a: [gcdE $b [expr {$a%$b}]]}};#RS
        proc montepithon {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} {set x [expr {int(10000*[ran ])}];set y [expr {int(10000*[ran ])}] ;if {[gcdE $x $y]<2} {incr cc}; }; return  [expr {sqrt(6.*$n/$cc)}]  }
        #usage:[ montepithon  50 ], n is the number of trials or number of interger pairs tested.
        #answer varies from 2.97 to 3.27 on small trial of 50 integer pairs.
        # This ratio of gcd pairs to N trials needs
        # about a million pairs for 3 significant figures of pi.
        # This algorithm is based on Euler's rule
        # that ratio of trials to found gcd pairs is about pi squared over 6.
        # montepithon will hardly fire on less than 10 cases.
        proc pietry4 {aa bb} {for {set i 1} {$i<=$bb} {incr i 1} { set aa [expr $aa +90./($i*$i*$i*$i) ]  } ;set aa [expr sqrt($aa)];return [expr sqrt($aa)] }
        #usage:pietry4 0 100,  answer is 3.141592
        proc isprime x {expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]}}
        proc primepi {n} { set cc 0; for {set i 1} {$i <= $n} {incr i} { if { [isprime $i] || [isprime [expr $i+1] ]} {incr cc;}}; expr {sqrt(6./((1.*$cc)/($n*1)))}}
        #Usage:$t.text insert 1.0 " primepi   [primepi 50]   "  3.2163, not bad for a prime number algorithm
        # Here n is the nth positive integer from zero.
        # This algorithm was easier to code, but is a little suspect
        # because the integer numbers were not randomly chosen
        # (as specified by the Euler rule for paired primes).
        # primepi will hardly fire on less than 30 cases.
        proc pietry {aa bb} {set aa 0;for {set i 1} {$i<=$bb} {incr i} { set aa [expr $aa +6./($i*$i) ]  } ;return [expr sqrt($aa)] }
        #usage  [ pietry 0 1000] answer is 3.14063
        #7
        proc leibniz5 {aa bb} {set aa 1;set i 1;while {$i <= $bb} {set dd [expr {2.*$i+1}];set ee [expr { (1.*pow(-1,$i)
                    *1.)/ $dd }] ; set aa    [expr $aa + $ee];incr i;};return [expr 4.*$aa];}
        #puts " [ leibniz 1 500 ]"
        $t insert 1.0 "test trial "
        $x insert 1.0 "test trial "
        . configure -borderwidth 10 -highlightthickness 2 -relief raised -highlightcolor DarkOliveGreen -background aquamarine4
        console hide
        

        # formula for two parallel resistors of resistance aa and bb ohms.
        proc parresistor2 {aa bb } { return [ expr (($aa *  $bb )/ ($aa + $bb))]}
        #usage: set resistor [ parresistor 100 100  ];answer is 50.
        # formula for three parallel resistors of resistance aa, bb,  and cc ohms.
        proc parresistor {aa bb cc } { return [ expr (($aa *  $bb * $cc)/ ($aa*$bb+$aa*$cc+$bb*$cc))]}
        #usage: set resistor [ parresistor 100 100 100 ];answer is 33
        # formula for fet transistor of volttage 0.009 volts and resistance bb ohms.
        proc fetvolts {aa bb } { return [ expr ($aa *  $bb )]}
        # fet transistor load usage: set fetvolts [ .009 2500 ];answer is 22.5
        # formula for fet transistor of volttage 0.009 volts, resistance bb ohms, cc and dd volts.
        proc fetdrainvolts {aa bb cc dd } { return [ expr ($aa *  $bb + $cc +  $dd)]}
        # fet transistor usage: set fetdrainvolts [ .009 2500 7 5 ];answer is 34.5
        # thin film resistor of dimension aa length and ww width, and sheet resistance cc
        proc thinfilmresistor {aa ww cc } { return [ expr (($aa * $cc)/ ($ww*1.))]}
        #usage ;thinfilmresistor of length 0.8 cm,   width 0.2 cm, and sheet resistance of 150 ohms
        # set resistance2 [ thinfilmresistor {.8 .2 100 } ] ;#answer is 600 ohms
        # efficiency and output of electric motor with one horsepower for 746 watts.
        proc electrichorsepower  {aa bb cc } { return [ expr (($aa *  $bb * $cc)* (1./746.))]};#horsepower
        # efficiency as 0.8 no_units, voltage as 25 volts, and input current as 10 amps
        # The scale factor would be (1./746.) horsepower per watt.
        #usage:append  details " [ electrichorsepower  .8 25 10  ]  " ;#answer is 0.268 horsepower
        # formula for cascaded efficiency for n1 *n2 * n3
        proc   cascadedefficiency  {aa bb cc } { return [ expr (($aa *  $bb * $cc)* (100./1.))]};#
        #example for n1 = 85 percent, n2 equals 90 percent,and n3 equals 73 percent and scale factor 100./1.
        # set  exampleproblem [ cascadedefficiency   .85 .90 .73    ] #answer is 56 percent.

       # wish to grab title of TCL  procs into lists
       # TCL code into flowchart diagram.
       # Can one break on the braces?
       # need to get rid of braces in print out
       string map {\{ "" \} ""} $item ;# from Abel Vian, TCL Club

        # following proc session invoke TCLLIB math & math::trig library
        proc pyramid_d {hh bb} { [ acotand [expr (.5*$bb/$hh)  ]]  }
        proc pyra_d {hh bb} { [ acotand [* .5 [/ $bb $hh]  ]]  }
        # pyramid_degrees 57.692 106.346  answer 47.334157521261254
        # seked =  (7 * .5 * 360 cubits) / 250 cubits = 5.04 decimal palms
        proc seked_d {hh bb} {  [/ [* 7. .5 $bb ] $hh ] }
        # usage seked 250. 360. equals 5.04
        # end TCLLIB

        # pretty print from autoindent and ased editor
        # Timing Equivalent One Liners V2
        # written on Windows 10 on  TCL
        # working under TCL version 8.6
        # gold on TCL Club , 8/20/2020
        # Ref. WIKI BOOKS, Tcl_Programming_Introduction
        # Book Section  contrasts one liners
        # versus  traditional procedural  approach
        # below contains redundant procs
        package require Tk
        package require math::numtheory
        package require math::constants
        package require math::trig
        package require math
        namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory math::trig math::constants }
        set tcl_precision 17
        proc pie {} {return [expr acos(-1)]}
        console show
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        #  uses join, but computer time on some?
        proc mean_1  list {expr double([join $list +])/[llength $list]}
        # math operators exposed as commands, and the expand operator
        proc mean_2  list {expr {[tcl::mathop::+ {*}$list]/double([llength $list])}}
        #  import the tcl::mathop operators
        proc mean_3 list {expr {[+ {*}$list]/double([llength $list])}}
        #  import the tcl::mathop operators from <Summing a list>
        # list add ladd or summing a list
        proc ladd_1 {listx} {::tcl::mathop::+ {*}$listx}
        # using join in ladd_2 from RS
        proc ladd_2 {listx} {expr [join $listx +]+0} ;# RS
        # using expr including non integers from PYK 2016-04-13
        proc ladd_3 {listx} {set total 0.0; foreach nxt $listx {set total [expr {$total + $nxt}]}; return $total}
        set limit 12
        puts "%|table| | printed in|TCL format |% "
        puts "&| session| proc &  mean value| elements in list  | comment, if any|& "
        for { set i 0 } { $i <= $limit }  { incr i } {
            set lister { 1 2 4 5 6 7 8 9 10 }
            lappend lister  [* $i [pie]]
            puts "&|$i | ladd_1   [ ladd_1  $lister ] |  $lister | proc timer [ time { set qq  [ ladd_1  $lister ]} 5000 ]  |&"
            puts "&|$i | ladd_2   [ ladd_2  $lister ] |  $lister | proc timer [ time { set qq  [ ladd_2  $lister ]} 5000 ]  |&"
            puts "&|$i | ladd_3   [ ladd_3  $lister ] |  $lister | proc timer [ time { set qq  [ ladd_3  $lister ]} 5000 ]  |&"
            puts "&|$i | mean_1   [ mean_1  $lister ] |  $lister | proc timer [ time { set qq  [ mean_1  $lister ]} 5000 ]  |&"
            puts "&|$i | mean_2   [ mean_2  $lister ] |  $lister | proc timer [ time { set qq  [ mean_2  $lister ]} 5000 ]  |&"
            puts "&|$i | mean_3   [ mean_3  $lister ] |  $lister | proc timer [ time { set qq  [ mean_3  $lister ]} 5000 ]  |&"
            puts "&|$i | ::math::mean  [::math::mean  1  2  4  5  6  7  8  9  10 [* $i [pie]]] |  $lister | proc timer [ time { set qq    [ ::math::mean  1  2  4  5  6  7  8  9  10 [* $i [pie]] 5000 ]}  ]  |&"
        }
        #end        

   proc timex2  aa { time {puts Hello} $aa } ;# [RS]
    #  Usage   timex2  10
    # usage timex2  4 returns Hello Hello Hello Hello 751.75 microseconds per iteration
    proc timex2  aa { time {puts Hello} $aa }
    time { expr { 4+5 } } 1000  ;#   returns 0.268 microseconds per iteration
    time {expr 4+5 } 1000  ;#  returns 0.104 microseconds per iteration
    # Need to preserve spaces
    time {  [ + 4 5 ] } 1000  ;#  should be 0.104 microseconds per iteration
    time {  [ + 4 5 ] } 1000  ;#  returns 9
    set t0 [clock clicks -millisec]; puts [expr { 1+2 ]; puts stderr "[expr {([clock clicks -millisec]-$t0)/1000.}] sec" ;# RS
    time {  for {set i 0} {$i<1000} {incr i} { # empty body}} ;# TCL 8.5 TclCmd Manual
    # returns 512 microseconds per iteration on machine here

    proc timex2  aa { time {puts Hello} $aa } ;# [RS]
    # output   for  timex2  4
    Hello
    Hello
    Hello
    Hello
    751.75 microseconds per iteration
    # See Playing with recursion on TCL WIKI
    proc ++   x {incr x }  ;# [RS]
    proc -+   x  {incr x -1 }
    proc = {m n} {string equal $m $n}  ;# [RS]
    # Usage   = 1 2 returns 0
    # Usage    ++ 2  returns 3
    # works for strings
    # Usage = cat cat returns    1
    # Usage  = cat dog returns  0   
    proc -+   x  {incr x -1 }
    proc ++   x {incr x }  ;# [RS]
    #Usage -+ 5 returns 4
    #Usage -+    [++ 1 ]  returns  1

exec perl -i -pe {s/SUBSTRING/REPLACING_STRING/g} testFile;# used Perl one liner

        # Sample of Printout in TCL Wiki Formats V2
        # written on Windows 10 on TCL
        # working under TCL version 8.6
        # gold on TCL Club , 8/20/2020
        # Ref. WIKI BOOKS, Tcl_Programming_Introduction
        # Book Section  contrasts one liners
        # versus  traditional procedural  approach
        # below contains redundant One Liner procs
        console show
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        namespace path {::tcl::mathop ::tcl::mathfunc}
        puts "%| table| | printed in|TCL format |% "
        puts "%| angle| units | elements in list  | comment, if any|% "
        # contains redundant procs for testing
        # proc  table_out { aa } { for {set i 0} {$i <= $aa} {incr i} {puts "&| angle of $i | degrees | sine [expr sin($i)] |&"} }
        # credit Tcl and Tk Programming for the Absolute Beginner by KURT WALL
        # adapting one liner for scaling angles
        proc  table_out_1 { aa } { for {set i 0} {$i <= $aa} {incr i} {puts "&| angle of $i | degrees | scaled [expr { $aa * $i }] | |&"} }
        #redundant proc using math ops
        proc  table_out_2 { aa } { for {set i 0} {$i <= $aa} {incr i} {puts "&| angle of $i | degrees | scaled [* 1. $aa  $i ] | |&"} }
        table_out_2 10

            proc isprime_wiki x {expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]}} ;# SMH
            # [SMH] returns 1 if prime and zero if not.,usage [isprime 23] has answer of 1 (one) [isprime 20] has answer of 0 (zero)
            proc list_numbers { aa bb} { for {set i 1} {$i<=$bb} {incr i} {lappend booboo [* 1. $i] };return $booboo}
            #returns list of integer numbers from aa to bb as reals with decimals,usage [listnumbers 1 5] , answer is 1.0 2.0 3.0 4.0 5.0  
            #returns list of odd numbers from aa to bb as reals with decimals, usage [ listnumbersodd 0 10],answer is 1.0 3.0 5.0 7.0 9.0
            proc list_numbers_odd { aa bb} { for {set i 1} {$i<=$bb} {incr i 2} {lappend booboo [* 1. $i ] };return $booboo}
            #  returns list of odd numbers from aa to bb as reals with decimals
            # Usage  list_numbers_odd 0 10 ,  answer is 1.0 3.0 5.0 7.0 9.0
            proc list_numbers_odd_2 { aa bb} { for {set i $aa} {$i<=$bb} {incr i 2} {lappend booboo [* 1. $i ] };return $booboo}
            # Usage  list_numbers_odd 13 10 , set i $aa in proc,  answer is 13.0 15.0 17.0 19.0 21.0 23.0 25.0
            #  doctored $aa,   list_numbers_odd 13 26  returns  13.0 15.0 17.0 19.0 21.0 23.0 25.0
            proc list_numbers_even { aa bb} { for {set i 2} {$i<=$bb} {incr i 2} {lappend booboo [* 1. $i ] };return $booboo}
            # Usage list_numbers_even 0 10   returns   2.0 4.0 6.0 8.0 10.0
            # following statements can be pasted into TCL console
            set project 1.0
            set tclprecision 17
            proc gaussian_primes {n} { return [/ $n [log $n] ]    }
            puts "gaussian_primes [ gaussian_primes 100   ] " #  answer 21.71472409516259 
            proc legendre_primes2 {n} { return [/ $n [- [log $n] 1.] ]   }
            puts "legendre_primes2 [ legendre_primes2 100   ] " #  answer 27.73794157864211 
            proc modified_legendre_primes3 {n} { return [/ $n [- [log $n] 1.08366] ]   }
            puts "modified_legendre_primes3 [ modified_legendre_primes3 100   ] "  #  answer 28.39690778061494 
            #  answer 25 prime_counting_functionx for 100   is    25         #  answer 25
            # nth prime f(x) =~~ 1.13*log(x)
            proc mod_percent {n} { set aa [/ $n [- [log $n] 1.08366] ] ;return [* [/ $aa $n ] 100. ]  }
            # percentage of primes at given number n from modified_legendre_primes3
            # shows increasing rarity of primes as n increases beyond 1E12
            # Riemann Hypothesis Equivalent, For all x => 2.01,abs {prime_pi(x) − Li(x)} =< sqrt(x) * log(x).
            # prime number theorem,  Li(x)=∼~ prime_pi(x) 
            # using TCLLIB isprime here
            proc list_primes { aa bb} { for {set i 1} {$i<=$bb} {incr i 2} { if {[isprime $i] } {lappend boo [expr 1.*$i]   } };return $boo}
            #returns list of prime numbers  from aa to bb, usage [list_primes 0 25],answer is 3.0 5.0 7.0 11.0 13.0 17.0 19.0 23.0
            # average gap approximate in near field, from Gauss in 1792/3 CE
            proc gaussian_prime_density_approx {aa} {[/ 1.  [log $aa]]}
            proc gaussian_prime_average_gap_approx {aa} { [log $aa]}
            proc pg {aa} { [log $aa]}
            # check from  prime number series 3,5,7,  near 5
            #  [- 5 3] =2  ,  [- 7 5] =2 ,   pg 5 > 1.6
            # check from  prime number series  23, 29, 31, 37,  near 30
            # [- 29 23]=6, [- 31 29]=2,.[- 37 31]= 6
            #   pg 30 = 3.401, (6+2+6)/3= 4.666  
            # list_twin_primes proc  under test, list_twin_primes and isprime procs are recursion limited, using TCLLIB isprime here
            proc list_twin_primes { aa bb cc} { for {set i $aa} {$i<=$bb} {incr i 1} { if {[isprime $i] && [isprime [+ $i $cc ] ] } {  lappend  boo  $i  [+ $i $cc ]   } } ; return $boo}
            # aa is start number, bb is upper limit, cc is separator number, usually even 2
            # contains redundant commands for testing
            puts "[list_twin_primes 3 25 2 ]"
            puts "[list_twin_primes 3 25 4 ]"
            puts "[list_twin_primes 3 25 6 ]"
            puts "[list_twin_primes 3 25 10 ]"
            # The original Dickson conjecture has separator even numbers 2,4,6 ... ?
            # list_twin_primes 0 25 2 returns 3 5 5 7 11 13 17 19 
            # The sets <13 15> and <15 17> are separated by a even 2,
            # but left out of answer.
            # Note the 15 is not a prime number and has factors <3 5>.
            # The set <13 17> has two primes, but separated by an even 4.
            # reference On-Line Encyclopedia of Integer Sequences website
            # OEIS A077800 discussed that the twin prime sets <p,p+2> are
            # (3, 5), (5, 7), (11, 13), (17, 19), 
            # (29, 31), (41, 43), (59, 61), (71, 73),
            # (101, 103), (107, 109), (137, 139)...
            # OEIS A275021 has  samples of <p,p+4> and omits pairs of <p,p+2>
            # 79, 83, 127, 131, 163, 167, 379, 383, 397, 401, 439, 443,...
            # list_twin_primes 75 135 4 returns 79 83 103 107 127 131
            # OEIS A023201 has some samples of <p,p+6> 
            # 5, 7, 11, 13, 17, 23, 31, 37, 
            # 41, 47, 53, 61, 67, 73, 83, 97, 101

    # compute the doubing time constant in years for money
    #  using interest rate in percent
    proc rule_72 {percent } {  expr { log( 2. )/ log (1. + $percent/100.)    } }  
    # Usage rule_72 10  returns 7.27253 years,
    # 7.27 years to double money at 10 percent interest
    # setting the doubling constant at 10* 7.27253 percent rounds to 72,
    # example 1,  72/10   approximates 7.2 years
    # example 2,  72/4  approximates 18 years,
    # money at 4 percent doubles about 18 years
    # random integer in the range  zero to $nn 
    # one liner uses the expr calculation method
    proc  random_number_less_than nn { expr { int($nn * rand()) } }
    # Usage  random_number_less_than 10
    # may return 3, 8, 9  or other random number
    # following one liners use math operator notation
    # degrees Centigrade to degrees  Fahrenheit 
    proc  Fahrenheit cc {  [+ [* 1.8 $cc]  32.  ] }
    # Usage Fahrenheit 20 returns 68. degrees  Fahrenheit 
    # degrees Fahrenheit to degrees  Centigrade 
    proc centigrade ff  {  [/  [-  $ff 32. ] 1.8  ] }
    # Usage centigrade 68 returns 20 degrees centigrade

     # Reference Tcl 8.4 Built-In Commands - expr manual page
     # random integer in the range 0. zero to $nn 
     proc  random_number_less_than nn { expr { int($nn * rand()) } }
     # Usage  random_number_less_than 10
     # may return 3 or other random number
     # random_number_less_than 0 returns 0
     # random_number_less_than 1 returns 0, on clipping $nn
     # Reference Tcl 8.4 Built-In Commands - expr manual page
     # convert cartesian coordinates into polar coordinates:
     # convert from ($x,$y)
     proc radius {y x} { expr { hypot($y, $x) } }
     proc angle  {y x} { expr { atan2($y, $x) } }
     # Usage radius 1 1 returns 1.414 or square root 2
     # Usage angle 1 1  returns 0.785
     # Reference Tcl 8.4 Built-In Commands - while manual page
     proc print_out nn {set x 0; while {$x<$nn} { puts " number $x"; incr x}} 
     # Usage print_out 2 returns number 0, number 1
     # Reference Tcl 8.4 Built-In Commands - foreach manual page
     proc list_numbers {} { set lister {}; foreach {i j} {1 2 3 4 5} { lappend lister $j $i}; return $lister}
     # list_numbers returns 2 1 4 3 {} 5
     # Tk8.6.10 Documentation > Tcl Commands > for
     # www.tcl-lang.org/man/tcl8.6/TclCmd/for
     proc powers_of_two nn { for {set x 1} {$x<=$nn} {set x [expr {$x * 2}]} { puts "x is $x"}}
     # Usage powers_of_two 2 returns x is 1; x is 2
     # Usage powers_of_two 1024 returns x is 1; x is 2;..... x is 1024
     # following use math ops
     # degrees Centigrade to degrees  Fahrenheit 
     proc  fahrenheit cc {  [+ [* 1.8 $cc]  32.  ] }
     # Usage fahrenheit 20 returns 68. degrees  Fahrenheit 
     # degrees Fahrenheit to degrees  Centigrade 
     proc centigrade ff  {  [/  [-  $ff 32. ] 1.8  ] }
     # Usage centigrade 68 returns 20 degrees centigrade