gold changing page name to One Liners Programs Pie in the Sky. Original name not pulling on internet search engines with same subject and other programming languages.
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 6/8/2021
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 7/5/2021 update. Important Note. This page were largely developed under the earlier TCL4, ETCL, and TCL8.~~ versions on an outdated personal computer. This page is not a replacement for the current TCL core and TCLLIB 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, the SourceForge bins, and [L1 ] locations also. The TCLLIB math library is generally quicker and more accurate by a third over some homebrew code, see math::mean , Additional math functions, [L2 ]. The numerous examples on this wiki page include code lines that might be incompatible, inefficient, dead_weights, or redundant if installed in the same program. As discussed below, the local math procedures in scripts and one-line procedures may not be as fast and efficient as importing mathop , mathfunc, and math from TCLLIB and SourceForge, so check with the precompiled code in the TCL core and TCLLIB libraries >> first <<, then homebrew your one liners programs and scripts in TCL.
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.
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.
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]
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] ] ]]}
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 } ]
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
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
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.
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.
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
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
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 ]]] }
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 ...
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 ... ?
gold 6/6/2021 update. These one liners programs were developed from articles and research on Old Babylonian Interest Rates [L3 ]. Also [L4 ] [L5 ] [L6 ] [L7 ] [L8 ]
;# These statements should be pastable into the easy eye console. ;# ***** simple interest problems in TCL one liners procedures ***** ;# find simple interest amount from 3 entries as < principal interest years > proc simple_interest_amount { principal interest years } { expr { ($principal*1.)*(1.+$years*$interest )}} ;# Usage simple_interest_amount 5000. .05 7. returns 6750.0 ;# find simple interest principal from 3 entries as < amount interest years > proc simple_interest_principal { amount interest years } { expr { ($amount*1.)/(1.+$years*$interest )}} ;# Usage simple_interest_principal 6750.0 .05 7. returns 5000.0 ;# find simple interest rate from 3 entries as < amount principal years > proc simple_interest_rate { amount principal years } { expr { ((($amount*1.)/$principal)-1.)/$years }} ;# Usage simple_interest_rate 6750.0 5000. 7. returns 0.05 ;# find years of simple interest from 3 entries as < amount principal interest > proc simple_interest_years { amount principal interest } { expr { ((($amount*1.)/$principal)-1.)/$interest }} ;# Usage simple_interest_years 6750.0 5000. .05 returns 7.0 ;# ****** compound interest problems in TCL one liners procedures ****** ;# find compound interest amount from 4 entries as < principal interest years compounding_times_per_year > ;# cd is compounding times per year, usually 4 quarters or 12 months proc compound_interest_amount { principal interest years cd } { expr { ($principal*1.)*((1.+( $interest /$cd))**($years*$cd))}} ;# Usage compound_interest_amount 5000 .05 7 12 retuRns 7090.180 ;# find compound interest principal from 4 entries as < amount interest years cd > ;# cd is compounding times per year, usually 4 quarters or 12 months proc compound_interest_principal { amount interest years cd } { expr { $amount*( 1. +(($interest*1.)/$cd ) )**(-1.*$cd*$years)}} ;# Usage compound_interest_principal 7090.180 0.05 7 12 returns 4999.997, rounds to 5000. ;# find interest in compound interest from 4 entries as < amount principal years cd > ;# cd is compounding times per year, usually 4 quarters or 12 months proc compound_interest_interest { amount principal years cd } { expr { $cd*((($amount*1.0)/$principal)**(1./($cd*$years))-1.)}} ;# Usage compound_interest_interest 7090.180 5000. 7 12 returns 0.049, rounds to 0.05 ;# find years of compound interest from 4 entries as < amount principal interest cd> proc compound_interest_years { amount principal interest cd } { expr { (log10 (($amount*1.0)/$principal)) / ($cd*log10(1.+(($interest*1.)/$cd) ) ) }} ;# Usage compound_interest_years 7090.180 5000. 0.05 12 returns 6.99, rounds to 7 years ;# ******** continuous_compounding ******* based on exponential formulas and natural log. proc amount_continuous_compounding { principal interest years } { expr { $principal* exp ( $interest*$years*1. ) }} ;# Usage amount_continuous_compounding 5000. 0.05 7 returns 7095.3377 proc principal_continuous_compounding { amount interest years } { expr { $amount * exp ( $interest*$years* -1. ) }} ;# Usage principal_continuous_compounding 7095.33 0.05 7. returns 4999.994, rounds to 5000. proc interest_continuous_compounding { amount principal years } { expr { (log ( ($amount*1.) /$principal )) / ($years * log (exp(1.) ) ) }} ;# Usage interest_continuous_compounding 7095.33 5000. 7 returns 0.04999, rounds to 0.05 proc years_continuous_compounding { amount principal interest } { expr { (log ( ($amount*1.) /$principal )) / ($interest * log (exp(1.) ) ) }} ;# Usage years_continuous_compounding 7095.33 5000. 0.05 returns 6.999, rounds to 7 years proc eckart–mchale_69p3 {rate} { return [expr {(69.3/$rate) * (200./(200.-$rate))} ] } ;# 2nd order eckart–mchale, 20 percent interest rate doubles money in how many years? ;# Usage eckart–mchale_69p3 20.0 ;# returns 3.85 ;# 2nd order solution, should be not that far from exact 3.802. proc pade_rule_69.3 { rate } { return [ (69.3/$rate) * (600.+4.* $rate)/(600.+$rate) ] } ;# pade_rule 20 percent interest rate doubles money in how many years? ;# Usage pade_rule_69p3 20.0 ;# returns 3.8 ;# 3ird order solution, should be not that far from exact 3.802 ;# following exact doubling rule etc in TCL using natural logarithms. ;# Denominator term < log (1.+ $rate/100.)> represents Principle and Interest P&I ;# Manipulating log term in nominator, log (2) for doubling, ;# and log (3) for tripling, log (1.5) for 50% (factor >.5<) rise. ;# extensions log (5) for 5X, log (10) for 10X, log (16) for 16X, etc. proc exact_doubling_rule { rate } { return [ expr { log (2.) / log (1.+ $rate/100.)}] } ;# what is computation times (years here), ;# to double amount at interest rate of 20 percent ;# Usage <exact_doubling_rule 20. > returns 3.8017 years proc exact_tripling_rule { rate } { return [ expr { log (3.) / log (1.+ $rate/100.)}] } ;# what is computation times (years here), ;# to triple amount at interest rate of 20 percent ;# Usage <exact_tripling_rule 20 > ;# returns 6.0256 years proc exact_rise_rule { rate } { return [ expr { log (1.5) / log (1.+ $rate/100.)}] } ;# what is computation times (years here), ;# to rise amount 50 percent (>.5< factor below) ;# at interest rate of 20 percent ;# Usage <exact_rise_rule 20. > ;# returns 2.2239 years
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
#!/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
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
gold 12Dec2018, cleaning up some files above.
# 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
table | printed in | TCL 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 |
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
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 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 | printed in | TCL 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 |
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 | Twin Primes for 2,4,6,10 Separators | printed in | TCL 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 5/13/2021. See for more hacks on this issue. Gauss Approximate Number of Primes [L9 ]. Monster Prime Predicting Formula. Search on wiki search engine for twin prime Gauss Monster
closer: arjenmarkus AM
Emailed icomment from AM: I used the sample code to create two new procedures:
listPrimePairs listPrimeProgressions
The first proc listPrimePairs returns a list of pairs of primes that differ by a given number and the second proc listPrimeProgressions returns a list of arithmetic progressions of primes that differ by the given number.
Wikipedia submission: Tool Control language TCL One Liner Programs
$$ There is a gold mine of One Liner Programs and content in the Tool Control language TCL 8.6 core distribution, TCL manual pages, and TCLLIB library that can be adapted or recast into brief one liners programs. These one liner programs or procedures can be pasted into the TCL 8.6 console for quick results, reference the TCL Wiki. Some one liners programs use the return statement, return $value, or return 1 to return the results to the program line. Although many TCL programmers just rely on the last computation being returned by the TCL procedure in the console window. There is some room in the Wiki publications for programming style differences. But it is usually best to put usage, credits, or TCL documentation references for the one liner procedures on separate comment lines. The random procedures make use of the random function and do not return the same answer every time. Dependence on math operator notation, helper procedures, math check examples, and special library functions should be noted in the comment lines.
$$ There are pros and cons to one liner programs. One may contrast one liners programs approach to problem solving versus the traditional procedural approach. There are better routines and methods in faster language constructs in the current TCL core distribution and TCLLIB. Working with recursion, primes, text search, 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.
# 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
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.
# 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
Please place any comments here, Thanks.
X
Category Numerical Analysis | Category Toys | Category Calculator | Category Mathematics | Category Example | Toys and Games | Category Games | Category Application | Category GUI |