Version 344 of Oneliner's Pie in the Sky

Updated 2020-09-09 21:00:28 by gold

One Liner Pie in the Sky

This page is under development. Constructive comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 12Dec2018



Introduction


gold Here are some one line procedures using pi (3.14...) and associated series or functions. I have modified a slot calculator in eTCL to handle these one liner procedures in the script at bottom of page. The user can add new algorithms by adding a new procedure in the code and adding a number line to the if statement that controls the algorithm selection The one liner procedures for generating PI can also be pasted into the eTCL console easily. There are some series for 1/N*N and 1/N*N*N*N which gives fractions of pi. Other functions for testing include eulers double prime probability ,the Monte Carlo random algorithm, and the strip integral of a quadrant. The accuracy of these individual solutions varies with the number of trials and the algorithms used are fairly slow, even glacial closers.


gold 21Jul2020. Important Note. This page were largely developed under the earlier TCL4 and ETCL versions. This page is not a replacement for the current TCL core and TCCLIB with much improvement since TCL4 and other <faster> language constructs. See better routines and current methods for angle reduction, sin, cos, pi, etc in the TCL core distribution and TCLLIB. As of Jul2018, the TCLLIB has developed code for trig angles in degrees, trig inverse, and hyper functions in degrees, and angle reduction in radians and degrees. This supplemental trig.tcl, trigtest.tcl, and trig.man code is posted on the TCLLIB website. This math::trig.tcl seems really exciting work, which will keep TCL in pace with some of the other brand name languages (math oriented, I mean). Some of the TCL library code is posted as pending on the TCLLIB website, and sometimes not really in the main TCL distribution yet, so its worthwhile to investigate and run searches on the pending TCLLIB code also.


Because the calculator is checking the accuracy of the answers in the reporting bins, most of the oneliner procedures call for the number of terms or iterations along with the initial values. 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. ] 

In the script, the exact answer is considered to be the pi constant stored in the TCL interpreter. If an algorithm reported pi to be 3.35 and greater than the exact answer as 3.141592 , the error formula would be (3.35/3.141592-1.)*100 or 6.6 per cent. If an algorithm reported pi to be 3.03 and less than the exact answer as 3.141592 , the error formula would be (1-3.03/3.141592)*100 or 3.3 per cent. Two comparison if statements in the TCL code select the proper error formula.


Experience in running the PI series calculator allows several observations. For example in selecting trials, the algorithm using ratio of gcd pairs to N trials needs about a million random pairs for 3 significant figures of pi. The Monte Carlo (random process) algorithm, as derived from the TCL random function, the x and y pairs that are digital fractions bounding a quadrant from 0 to 1 units height.


As might be expected, the algorithm based on random numbers do not return the same value of pi each time.


The successive prime in pairs algorithm is based on a variant to Euler's rule, testing if the ratio of one prime number found in successive N:N+1 pairs to N trials is about pi squared over 6. The user picks N as the number of trials on the list on positive integers. In the successive N:N+1 pairs, selecting N>70 might take considerable time checking for prime numbers.


The successive prime in pairs 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).

The strip integral area integrates the area of a quarter unit circle or quadrant from zero to X (1.0) to find pi. Since the area of a circle is pi*r*r, the quadrant for the unit circle would be pi*1*1/4 or pi/4. Given N as the number of strips, the width of each strip $ww would be 1 unit /N. The height of each strip would be sqrt(1-$ww*$ww), which in the unit circle procedes from one to near zero on the y axis. The area of each individual strip would be the product of the width ww and the height. The TCL script sums the individual strips to estimate the area of the quadrant. The strip integral algorithm is limited by the number of strips and it takes about 10,000 strips to find a reasonable pi. The user can select the N as the number of strips over the interval of zero to one units. However, selecting over 1000 strip intervals will take some processing time. The arctangent formula as atan(1/57)... seemed to give the best results and was selected as the default solution for pi.


A tally of microseconds has been added to the calculator under test.


The isprime procedure was posted DKF script by SKB and the gcdE procedure was posted by RS. See Buffon's Needle. DKF script on Sample Math Programs The genesis of the DKF Monte Carlo algorithm is found in Sample Math Programs.


            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]"}
 

GWM time your results:

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

at least 2.5 times faster than the braced version of code.

Note that the first pass through the code requires the byte code compiler to compile (takes some time) so use the 2nd or subsequent run of the proc for accurate time dependence measurement.

    # 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))]}

AMG: What's the subst for? I would have done it this way:

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

Also, there's no need for a temporary variable in [box1]. If you insist, be aware that it's perfectly legal for a proc and a variable to have the same name; you could have said "set pi [pi]". For safety and efficiency, always be sure to brace your expr-essions! Heh, I neglected to brace my expression in [pi], but that's one of the extremely rare cases where it won't matter: no spaces, no substitutions. Bracing does two things: One, when the entire expression is a single word (single argument), it can be bytecode-compiled. Two, if substitutions are performed by [expr] only and not Tcl itself, injection attacks are prevented.

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

gold Your solution is more concise.


AMG: The return value of a Tcl procedure is inherited from the return value of the last command to execute within that procedure. Therefore, many uses of the [return] command are redundant. For example, this procedure:

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

can be written more simply:

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

Also, the conditional arguments to [if], [while], [for] are already expr-essions, so there's no need to nest a call to [expr]. For example,

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

can be simplified quite a lot:

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

RLE (2011-06-25) Most of the ......... procs are already provided as part of Tcl 8.5 (with the one exception that if one wants a floating point answer, at least one input has to be a floating point number):


gold 7/21/2020. We agree to some extent. These one line procedures were developed mostly on older versions of TCL4 and eTCL. I do not doubt that alternate solutions, better and more elegant solutions exist on the later elaborate TCL releases. Mostly I use the expired eTCL on an older personal computer. Some of these single line procedures are easier to patch as an older TCL procedure rather than learn a new TCL grammar and pull the TCLLIB library. Naming no names as the language versions and associated libraries get ever larger, one or two of these one liner procedures were implemented on some smaller homebrew compilers without using the current massive TCL language. Of course, a very good feature of TCL is that new variables as number types do not have to be initialized prior to use and no subroutine RETURN and END statements are necessary, vis the older Fortran and Basic dogmas in moldy textbooks. Repeating, setting a new number variable to 0 or 1 is not necessary prior to using the variable. I confess that habits brought from prior learned languages and dogmas in moldy textbooks of 50 years ago are hard to change.


Screenshots Section


Figure 1


One Liner


Comments Section

Please place any comments here, Thanks.


gold 30Jun2010,Changes. Added microssecond tally to calculator under test. Also added brackets to some of the expr statements.


gold 8/17/2020 Added some subtitles and pointers to current TCL core and TCLLIB library.


References:


Appendix Code

appendix TCL programs and scripts


Fortran Like "Call" Procedure


gold Here are one line procedures for fortran like "call" in eTCL, mostly altered proc from LV on Wiki page of Salt and Sugar. See also Call Procedure Like Fortran Example


  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]


Circle Area and Law of Cosines


gold Here are some one line procedures for circle area and law of cosines. See tcl::mathfunc cos pi constants Functions ::math::constants::constants and ::math::fibonacci are available in the TCLLIB. Most of these one liner programs were revamped on the advice of AMG. Most one liners should be pastable into the TCL console for further testing.

   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] ] ]]}
  

"Chance of" and rand() Conditions


gold Here are some one liners for "chance of" conditions. The "chance of" procedures make use of the random function and do not return the same answer everytime. The random function was used in the Random Walk Equation Slot Calculator Example. Chances of weather and other conditionals were used in Game Kingdom of Strategy. Weather and other conditionals are especially important in games and military strategy. See also rand random tcl::mathfunc.

  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   } ]

Grabbing Mantissas


gold Here are some one liner procedures grabbing mantissas, either with zero point or without. A format statement can hide some artifacts of binary computer arithmetic. Once defined in the computer, these routines can be doubled up, [ mac [ mak 4.666 ]. And proc Macomma with regexp {.,(\d+)} will cure the European comma decimal syndrome.


     proc mac {aa} { regexp {.(\d+)} $aa -> bb;return $bb }
     proc macomma {aa} { regexp {.,(\d+)} $aa -> bb;return $bb }
    console session
    3% proc mac {aa} { regexp {.(\d+)} $aa -> bb;return $bb }
    4% mac 4.55555
    55555
    6%  proc mic {aa} { return [expr { fmod($aa,1.)   } ] }
    7% mic 4.222
    0.22200000000000042


    10% proc mak {aa} { return [ expr { $aa - int($aa) } ] }
    11% mak 4.666
    0.6660000000000004


   8% proc mak {aa} { return [format "%12f" [ expr { $aa - int($aa) } ]] }
   9% mak  4.666
    0.666000

Simple Error as Percentage


gold Here is one liner procedure developing simple error as percentage.


  #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.}}

     console session
     9% errorx 3.1 3.14
        1.2903225806451646
     10% errorx 3.14 3.1
        1.2903225806451646
     11% errorx 3.03 3.141592
        3.6829042904290565

Error Function Approximations


gold Here is some one liner procedures for various error function approximations, though "not ready for the mars shot" and dependent on helper procs. Functions ::math::special::erf and ::math::special::erfc are available in the TCCLIB math library. See TCLLIB.

      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] .

See factorial for discussion.



Sum of Infinite Geometric Series



gold Here is a one liner procedure for sum of infinite geometric series, though the explanation and examples take up more than one line.

      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".     

AM This can be compacted even more:

      proc geoseries {aa bb} {expr {abs($bb)<1? $aa/(1.0-$bb) : 0.0}

(What is cc in the original?)

gold $cc is number of terms for partial sum. Count your braces {odd or even ?}.


gold These one line procedures were developed on older versions of TCL4. I do not doubt that alternate solutions or better solutions exist on the later elaborate TCL releases. Mostly I use etcl on an older personal computer. Some of these single line procedures are easier to patch a TCL procedure rather than learn a new grammar. Usually the procedure are called with a set statement like

  set examplenumber  [parresistor2 { 25 35 } ]

or

  set examplestring [ whitelist examplestring ]

Reference FW and RS on Plain string substitution in Bag of algorithms, also Example Scripts Everybody Should Have


            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.


Age of the Earth from Lord Kelvin, history of science


gold Here is the one liner procedure on the age of the earth.

      #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

Historical Kelvin Earth Cooling and eTCL Slot Calculator Demo Example , numerical analysis edit


One Liner Approach to the Fibbonaci series



gold Here is the one liner approach to the Fibbonaci series. However, the algorithms are limited to positive numbers only. Performance may suffer degradation due to lengthy calls and limits on the number of procedure recursion calls. See Fibonacci numbers and math::constants. Functions ::math::constants::constants and ::math::fibonacci are available in the TCLLIB.

      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 

AMG: Here's another implementation, using expr's ?: operator instead of if:

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

gold Here is mathops & mathlib follow-on to the one liner approach to the Fibbonaci series, using Binet formula for fibonacci (N). See Fibonacci numbers. The library call is ::math::Fibonacci (N).

    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

Area of Cyclic Quadrilateral


gold Here is the one liner approach to area of cyclic quadrilateral, using mathops & mathlib calls. The four sides are aa, bb, cc, and dd, ref Brahmagupta Area of Cyclic Quadrilateral and eTCL demo example calculator. .

            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 ]]] }                   


Decimal Equivalents to some Babylonian Math Tables



gold Following one liners are decimal equivalents to some Babylonian math tables, using mathop here from Babylonian Cubic Equation Problem and eTCL demo example calculator, numerical analysis. Mostly, the TCL Procs are returning lists of numbers.

    #   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

Some fragmented Babylonian tables known as n*n*(n+1) tables were used in solving some cubic equations, ref Joran Friberg. The equations were of the form n*n*(b*n+1) = c. The eTCL calculator could generate the expected tables of n*n*(n+1). Other Babylonian tables known as n*(n + 1)*(n + 2) and n*n*(n – 1) tables have been identified, but no abundant use has been cited from the known Babylonian math problems. Although not clear, tables of the n*(n + 1) might have existed. From modern theory, n · (n + 1)/2 = sum of integers (1,2,3,4...) and n*(n + 1)*(n + 2) /6 = sum of squares (1,4,9....). Possibly, the Seleucid math problem used an n*(n + 1)*(n + 2) table. Possibly, the tables for n*(n + 1)*(n + 2) and n*n*(n – 1) could have been used for cubic equations. The Seleucid method for sum of squares can be factored for sum of integers term and can be restated as a quasi_cube, ((1/3)(1+2 *n) ) * ( n(n+1)/2.) = (1/6)* n(n+1)(2n+1) = (1/6)*quasi_cube term. Another possible form for the quasi_cube (1/6)* n(n+1)(2n+1) with 2 factored out is expression 2*(1/6)* n(n+1)(n+(1/2)) . Problems for sum of squares and sum of rectangles go far back through the Selucid and Old Babylonian math, although Old Babylonian math may not demonstrate complete knowledge. At least in referring to TCL procs, the Babylonian table known as n*(n + 1)*(n + 2) is not that far from the sum of squares and triangular numbers as n*(n + 1)*(n + 2)/6.


    # 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 Numbers


Functions ::math::constants::constants, ::math::random, math::combinatorics, math::specialfunctions, and ::math::fibonacci are available in the TCLLIB. See also Triangular Number Multiplication Study and demo example TCL calculator, numerical analysis

   # 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 ... ?

One Line procedures for the eTCL console


gold 8/17/2020. Note. Code here was developed on the earlier TCL4 and eTCL versions. Suggest check the current TCL core and TCLLIB math library before use. Functions ::math::constants::constants, ::math::random, math::specialfunctions, and ::math::fibonacci are available in the TCLLIB.


gold Here is an TCL program using one line procedures for the eTcl console. This modifies the sum of list procedure from RS in the Zen of Tcl and Elegance vs. performance and see reference Math Operators as Commands. The recursive multiplication seems a useful procedure for the TCL calculators, as well as the reciprocal procedure (!1/ below). Assuming at least two arguments, the reciprocal procedure !1/ 1 2 would give the sum of 1/1 and 1/2 or 1.5. Checked some of the trivial arguments, but not all (eg. !* 0 = 0, !- 0 = 0, !/ 0 = 0,!1/ 1 = 1,!+ 1 = 1,!* 1= 1 )


    # 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

RLE (2011-06-25) Most of the directly above procs are already provided as part of Tcl 8.5 (with the one exception that if one wants a floating point answer, at least one input has to be a floating point number):

% 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

SECOND VERSION V2 WITH ADDED HACKS

        #!/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
        

Timing Draft Code for Improvement, suggestion from older ASK8


answered question: from Ask no8.

gold 23Jun2010,


I have loaded a wiki page called Oneliner's Pie in the Sky, which has a small calculator for PI series. The Gregory-Leibnez series for the arctan has alternating powers of negative one.


The oneliner below is working somewhat, but I've got a mental blank on this. Can someone improve this code?

   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 one - brace your expressions. set aa expr {$aa+$ee} - reduces execution time by a factor of 100. Really. two - the intermediate output to console "puts $ee" is also slowing response.

Original timing (with puts $ee removed) and 100 times as many iterations so that time can actually measure the time!:

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

Braced expr {}:

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

This version is about 3 times faster, by omitting intermediate evaluation of pow() and use of incr to calculate dd (which is now an int, so expr uses -1./$dd or 1./$dd to evaluate as a real number).

  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];}

Time for liebniz2:

 % time {puts "[liebniz2 1 50000]"}
  3.141612653189785
  16000 microseconds per iteration

Test of Ased editor autoindent on above files

gold 12Dec2018, cleaning up some files above.




Electrical Procs


        # 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.


Proc Titles into lists


       # 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 Session is Dependent on TCLLIB Math library


        # 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

Timing Equivalent One Liners V2

        # 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        

Table of Timing 4 Procs

table printed inTCL format
session proc & mean value elements in list comment, if any
0 ladd_1 52.0 1 2 4 5 6 7 8 9 10 0.0 proc timer 2.3273999999999999 microseconds per iteration
0 ladd_2 52.0 1 2 4 5 6 7 8 9 10 0.0 proc timer 5.6311999999999998 microseconds per iteration
0 ladd_3 52.0 1 2 4 5 6 7 8 9 10 0.0 proc timer 4.3941999999999997 microseconds per iteration
0 mean_1 5.2000000000000002 1 2 4 5 6 7 8 9 10 0.0 proc timer 13.053599999999999 microseconds per iteration
0 mean_2 5.2000000000000002 1 2 4 5 6 7 8 9 10 0.0 proc timer 3.0369999999999999 microseconds per iteration
0 mean_3 5.2000000000000002 1 2 4 5 6 7 8 9 10 0.0 proc timer 2.3805999999999998 microseconds per iteration
0 ::math::mean 5.2000000000000002 1 2 4 5 6 7 8 9 10 0.0 proc timer 22 microseconds per iteration
1 ladd_1 55.141592653589797 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 1.7847999999999999 microseconds per iteration
1 ladd_2 55.141592653589797 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 7.3037999999999998 microseconds per iteration
1 ladd_3 55.141592653589797 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 1.7285999999999999 microseconds per iteration
1 mean_1 5.5141592653589795 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 8.3374000000000006 microseconds per iteration
1 mean_2 5.5141592653589795 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 2.2898000000000001 microseconds per iteration
1 mean_3 5.5141592653589795 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 2.1674000000000002 microseconds per iteration
1 ::math::mean 5.5141592653589795 1 2 4 5 6 7 8 9 10 3.1415926535897931 proc timer 6 microseconds per iteration
2 ladd_1 58.283185307179586 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 1.7618 microseconds per iteration
2 ladd_2 58.283185307179586 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 6.6627999999999998 microseconds per iteration
2 ladd_3 58.283185307179586 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 4.0709999999999997 microseconds per iteration
2 mean_1 5.8283185307179588 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 8.5307999999999993 microseconds per iteration
2 mean_2 5.8283185307179588 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 2.1261999999999999 microseconds per iteration
2 mean_3 5.8283185307179588 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 2.3512 microseconds per iteration
2 ::math::mean 5.8283185307179588 1 2 4 5 6 7 8 9 10 6.2831853071795862 proc timer 5 microseconds per iteration
3 ladd_1 61.424777960769376 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 1.9702 microseconds per iteration
3 ladd_2 61.424777960769376 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 7.1285999999999996 microseconds per iteration
3 ladd_3 61.424777960769376 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 2.6114000000000002 microseconds per iteration
3 mean_1 6.1424777960769372 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 8.5581999999999994 microseconds per iteration
3 mean_2 6.1424777960769372 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 2.1989999999999998 microseconds per iteration
3 mean_3 6.1424777960769372 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 2.4533999999999998 microseconds per iteration
3 ::math::mean 6.1424777960769372 1 2 4 5 6 7 8 9 10 9.4247779607693793 proc timer 5 microseconds per iteration
4 ladd_1 64.566370614359172 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 1.7842 microseconds per iteration
4 ladd_2 64.566370614359172 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 10.103400000000001 microseconds per iteration
4 ladd_3 64.566370614359172 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 1.9608000000000001 microseconds per iteration
4 mean_1 6.4566370614359174 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 8.8523999999999994 microseconds per iteration
4 mean_2 6.4566370614359174 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 2.0948000000000002 microseconds per iteration
4 mean_3 6.4566370614359174 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 2.2736000000000001 microseconds per iteration
4 ::math::mean 6.4566370614359174 1 2 4 5 6 7 8 9 10 12.566370614359172 proc timer 5 microseconds per iteration
5 ladd_1 67.707963267948969 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 3.6421999999999999 microseconds per iteration
5 ladd_2 67.707963267948969 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 10.6218 microseconds per iteration
5 ladd_3 67.707963267948969 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 2.3553999999999999 microseconds per iteration
5 mean_1 6.7707963267948967 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 8.4225999999999992 microseconds per iteration
5 mean_2 6.7707963267948967 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 2.1343999999999999 microseconds per iteration
5 mean_3 6.7707963267948967 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 2.1093999999999999 microseconds per iteration
5 ::math::mean 6.7707963267948967 1 2 4 5 6 7 8 9 10 15.707963267948966 proc timer 5 microseconds per iteration

Time on One Liner programs


See Time


   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

Philosophy On Perl and One Liners


I remember when my teenage sister would ask about a math problem. I would lead up and carefully explain this and that. But my sister would say " I just want the answer!" When I worked on a UNIX system, a number of my TCL programs had key exec lines written in Perl. Ref www.rexegg.com .


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

Sample of Printout in TCL Wiki format


        # 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

Table of Scaled Angles

table printed inTCL format
angle units elements in list comment, if any
angle of 0 degrees scaled 0.0
angle of 1 degrees scaled 10.0
angle of 2 degrees scaled 20.0
angle of 3 degrees scaled 30.0
angle of 4 degrees scaled 40.0
angle of 5 degrees scaled 50.0
angle of 6 degrees scaled 60.0
angle of 7 degrees scaled 70.0
angle of 8 degrees scaled 80.0
angle of 9 degrees scaled 90.0
angle of 10 degrees scaled 100.0


One Liner programs on Primes, Twin Primes, and Primes separated by Even Numbers


Here is the one liner program approach for various primes, although dependent on helper procs, math ops, and TCLLIB isprime proc. This section is not a replacement for the current TCL core and TCCLIB with much improvement since TCL4 and other <faster> language constructs. See better routines and current methods for primes in the TCL core distribution and TCLLIB. There are pros and cons to one liner programs. Working with recursion, primes, and timing the procedures will quickly show the warts on the one liner programs. To gain speed and shorter computation times, one will generally have to access the TCL core distribution and TCLLIB. Functions math::numtheory::isprime, math::numtheory::firstNprimes, and math::numtheory::primesLowerThan are available in the TCCLIB math library. See TCLLIB & Tcllib Contents & math::numtheory Category Numerical Analysis. Gauss Approximate Number of Primes and eTCL demo example calculator


The Legendre approximation for number of primes was approx_legendre_primes2 = N1 / (ln (N1)-1), 2 percent average error beyond 1E4. A variant of the Legendre equation was modified_legendre_primes3 = N1 / (ln (N1)-1.08366). In the modified Legendre error covering E6, no particular trends are seen leading from zero level, but there are some sawtooth patterns at intervals. Also the prime counting function is reported to have gaps between the primes, which might be difficult to see on some dense charts.


            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


Table Results on Twin Primes for 2,4,6,10 Separators


table Twin Primes for 2,4,6,10 Separators printed inTCL format
result lower limit upper limit separator integer comment, if any
elements in list lower limit upper limit separator integer comment, if any
3 5 5 7 11 13 17 19 3 25 2
3 7 7 11 13 17 19 23 3 25 4
5 11 7 13 11 17 13 19 17 23 23 29 3 25 6
3 13 7 17 13 23 19 29 3 25 10

Gold Mine of One Liner Programs


There is a Gold Mine of One Liner Programs and content in the current TCL core distribution, TCL manual pages, and TCLLIB library that can be adapted or recast into brief one liner programs. The author usually uses the return statement, return $value, or return 1 from long habit and mercy to the reading public, but many TCL programmers just rely on the last computation being returned by the program. There is some room in the Wiki publications for programming style differences. It usually best to put usage, credits, or wiki references on separate comment lines. The random and and "chance of" procedures make use of the random function and do not return the same answer every time. Dependence on helper procs, math ops, and special libraries and functions should be noted.


     # 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

Credits on One Liner Programs

  • WIKI BOOKS, Tcl_Programming_Introduction
  • license https://creativecommons.org/licenses/by-sa/3.0/legalcode
  • creativecommons.org/licenses/by-sa/3.0/
  • en.wikibooks.org/wiki/Tcl_Programming_Introduction
  • www.tcl-lang.org/man/tcl8.6/TclCmd/for
  • Sample Math Programs, item 2, RS
  • TCLLIB math::mean is quicker by a third over some homebrew code.
  • Additional math functions
  • en.wikipedia.org One-liner_program
  • One liners of Basic and history, 10_PRINT_121114.pdf
  • Summing a list
  • Tcllib Contents
  • another list comprehension & reference one liner comments
  • stackoverflow.com/questions 36832927 using-globs-in-perl-replace-one-liner-in-tcl-script
  • www.rexegg.com regex-perl-one-liners
  • Regular Expressions Cookbook, Second Edition
  • Learning Regular Expressions
  • Beyond Regular Regular Expressions
  • Mastering Regular Expressions, 3e
  • # credit Tcl and Tk Programming for the Absolute Beginner by KURT WALL
  • bbcmicro.co.uk on Commodore Basic
  • Acorn User One-Line Games (Escape From Voros, Lexxias, Race To Varpon,
  • Storm Clouds Over Zaqqit, Zander (AKA Lurch))". bbcmicro.co.uk on Commodore Basic
  • blog.eduonix.com, perl_programming,learn-one-liners-perl-programming
  • en.wikipedia.org , One-liner_program
  • RUN magazine issue 35 on Basic language
  • Richard Socher, Perl Scripts And One Liners
  • Introduction to Perl One-Liners (PDF), Peteris Krumins
  • Perl one-liner if else logic - Stack Overflow
  • How to Match Multiple Lines using Regex in Perl One-liners
  • By Eric Ma , In Programming, Tutorial
  • Time
  • How to Measure Performance
  • timers
  • Category Performance
  • see www.altparty.org archive/invi.tcl Setok ref.
  • Why Tcl is so much slower than Perl, pros and cons
  • Playing with recursion
  • Category Numerical Analysis
  • TCLLIB numtheory section
  • Gauss Approximate Number of Primes and eTCL demo example calculator
  • math::numtheory::isprime
  • math::numtheory::firstNprimes
  • math::numtheory::primesLowerThan
  • math::numtheory::primeFactors
  • math::numtheory::numberPrimesGauss
  • math::numtheory::numberPrimesLegendre
  • math::numtheory::numberPrimesLegendreModified
  • math::numtheory::differenceNumberPrimesLegendreModified
  • On-Line Encyclopedia of Integer Sequences , OEIS
  • Andrew Granville, Primes in intervals of bounded length, Joint Math Meeting, Jan 17 2014.
  • J. C. Evard, Twin primes and their applications, archived Pdf
  • James Maynard, Small gaps between primes, arXiv:1311.4600 , 2013, Annals of Mathematics,

gold This page is copyrighted under the TCL/TK license terms, this license .

Hidden Comments Section

Please place any comments here, Thanks.