Version 757 of gold

Updated 2020-09-14 17:08:59 by gold

User Page for Gold


This page is under development. 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 12AUG2020


Introduction and Greetings

gold Hi, I'm an old Fortran programmer trying to retread. I actually served time on the IBM punch card machines. I collect old Fortran books as a hobby. A lot of guys leaving work would give me their old Fortran books. On active, i had a large Fortran collection, almost a library. Also I programmed a lot in Javascript. Mostly i work on TCL now because i am visually oriented and think that a gui can save a lot of time in engineering calculations.




gold 3Dec2018, pages i thought were gone are showing up, largely under Category Numerical Analysis. as s_ noted, i did not use underscores much in early titles. I must learn on to use the goose search engine better. thanks. i have some updates anyway. I will add self_help button. Revamped TCL programs will be listed as V2. The bulk of these files are being stored locally as OpenOffice file.odt files or rich field text files file.rtf, mainly for spellcheck and larger stored fonts for bad eyes. My understanding is that backup on older files are available through the Internet Archive. Like the example of the Wikipedia, i think that an automated PDF dump of the individual TCL/WIKI pages would be a useful storage item, especially if the PDF included a rack of end attachment of the original unix/ascii text data for the unique WIKI table format and the TCL programs. I am scared i will lose formatted tables copy and I have a bunch.

gold 20Mar2020, Message to Middle Eastern Linguist(s) and museum curators on clay tablets. Have made replica clay tokens and published computer programs using the Sumerian math algorithms on clay tablets. Can contribute some to your museum, if interested???? Some ancient and historic algorithms were loaded into the TCLLIB library for the Tool Control Language (TCL).


Revamped Projects under Nikit, actions post 1Dec2018


Projects under old wiki

 >>>>>>  if can't find or link, look older files under category numerical analysis <<<<<<<<
 >>>>>>  for some unk reason, wiki search engine does not push these files to top <<<<<<<<

test below

Babylonian Sexagesimal Notation for Math on Clay Tablets in Console Example
Binomial Probability Slot Calculator Example
Biruni Estimate of Earth Diameter Slot Calculator eample
Chinese Fortune Casting Example Demo
Chinese Sun Stick Accuracy for Console Example
Command Line Calculator in Namespace Package Example
Crater Production Power Law Slot Calculator Example
Drake Intelligent Life Equation Slot Calculator Example
Easy Eye Calculator and eTCL Slot Calculator Demo Example, Numerical Analysis 
Ellipse Properties Slot Calculator Example
Fuel Cost Estimate Log Slot Calculator Example
Generic Calculator Namespace Package Example
Heat Engine Combustion and Calculator Demo Example
Human Language Root Words & Lexicostatistics Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Mahjong_Style_Deletion
Oil Molecule Length Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Oneliner's Pie in the Sky
Paper & Felt Rolls and eTCL Slot Calculator Demo Example
Penny Packing Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Piece wise Profits and eTCL Slot Calculator Demo Example 
Planet Mass Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Poker Probability and Calculator Demo Example
Random Walk Equation Slot Calculator Example
Rectangular Radio Antenna and etcl Slot Calculator Demo Example
Sanskrit Number Words Handling in Formulas and Demo Calculator Example
Sea Island Height Slot Calculator Example
Seaching for Babylonian Triplets Slot Calculator Example
Simple Reliability Slot Calculator Example
Slot_Calculator_Demo
Stonehenge Circle Accuracy Slot Calculator Example
Stratographic Years Slot Calculator Example, Age of Earth
Sumerian Equivalency Values, Ratios, and the Law of Proportions with Demo Example Calculator
Sumerian Beveled Bowl Volume and eTCL Slot Calculator Demo Example 
Sumerian Circular Segment Coefficients and Calculator Demo Example
Sumerian Coefficients at the Bitumen Works and eTCL Slot Calculator Demo Example edit
Sumerian Coefficients at the Weavers Factory and eTCL Slot Calculator Demo Example 
Sumerian Coefficients in the Pottery Factory and Calculator Demo Example
Sumerian Construction Rates and eTCL Slot Calculator Demo Example
Sumerian Paint & Bitumen Coating and eTCL Slot Calculator Demo Example 
Sumerian Population Density and eTCL Slot Calculator Demo Example 
Tonnage of Ancient Sumerian Ships and Slot Calculator Demo Example

Projects to be updated

Sumerian Pottery Vessel Mass Calculator, can not find in new wiki system
Babylonian Square rule for Trapezoid Area and eTCL demo example calculator, numerical analysis
Indian Math Bhaskara (1) Sine formula and extensions, history of math
Kahan compensated summation algorithm and Neumaier variant summation algorithm, numerical analysis
Sumerian Counting Boards, multiplication operation placement strategy, and eTCL demo example, numerical analysis
Babylonian Combined Work Norm Algorithm and eTCL Slot Calculator Demo Example, numerical analysis 
Stonehenge Circle Accuracy Slot Calculator Example
Drake Intelligent Life Equation Slot Calculator Example
Sumerian Equivalency Values, Ratios, and the Law of Proportions with Demo Example Calculator
Piece wise Profits and eTCL Slot Calculator Demo Example
Sumerian Sheep and Herd Animal Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Electronic Failure Rate FITS and eTCL Slot Calculator Demo Example
Sumerian Seeding Rates and eTCL Slot Calculator Demo Example , numerical analysis 
Command Line Calculator in Namespace Package Example
Example Linear Interpolation Calculator
Sumerian Equivalency Values, Ratios, and the Law of Proportions with Demo Example Calculator
Sumerian Beveled Bowl Volume and eTCL Slot Calculator Demo Example 
Population Density Rectangular City Calculator and eTCL Slot Calculator Demo Example
Sales Optimal Lot Order Size and eTCL Slot Calculator Demo Example
Over-21 Game Shell and eTCL Slot Calculator Demo Example , numerical analysis
Sumerian Beer Ingredients and eTCL Slot Calculator Demo Example , numerical analysis
Easy Eye Calculator and eTCL Slot Calculator Demo Example, Numerical Analysis
Paper & Felt Rolls and eTCL Slot Calculator Demo Example
Human Language Root Words & Lexicostatistics Calculator and eTCL Slot Calculator Demo Example, numerical analysis
Sumerian Workday Time & Account Calculator and eTCL Slot Calculator Demo Example, numerical analysis 
Old Babylonian Interest Rates and eTCL demo example calculator
Capsule Surface Area & Volume and eTCL demo example calculator
Babylonian Square rule for Trapezoid Area and eTCL demo example calculator, numerical analysis
Sumerian Coefficients at the Weavers Factory and eTCL Slot Calculator Demo Example
Sumerian Population Density and eTCL Slot Calculator Demo Example

Use of Global Variables in TCL GUIS


gold 12Dec2018. Global variables, regular expressions, and namespaces are considered advanced features of the Tool Control Language (TCL), according to Brent Welch in Practical Programming in TCL and TK. If global variables are an advanced feature of TCL, as indexed and taught after the beginner TCL topics in most TCL textbooks, then reasonably the use of global variables should be explored and discussed on the wiki. After a number of searches on the wiki and reference books, the topics of regular expressions and namespaces are adequately explored on the wiki and available textbooks. In opinion, the use of global variables in TCL programs should not be restricted to a narrow viewpoint, and the use of global variables could be a very rich vein of interest for the advanced student of programming. As an engineer with 35 years experience in Fortran, Basic, Javascript, and other computer languages, the author is familiar with self-appointed gatekeepers and the other anonymous ad hominem methods of NDH. NDH means “not done here”, “not done here in our shop”, or “not done here in my programming style”. Global variables in TCL are equivalent to the common variable statements in Fortran and Basic. The use of global variables might be called “sideloading" for data subroutines. Ref Fortran77, the large number crunching programs with 2E5+ statements in Fortran used global variables or common variable declarations as an alternate way or “programming style” to transfer or sideload information between subroutines. The other data transfer method for subroutines was discussed by Brent Welch etc in the proc command arguments or top loading in the introductory or beginner TCL material.


gold 12Dec2018. Of course, each alternate way of data information transfer in toploading and sideloading data subroutines has its own advantages and disadvantages. As most TCL users know, TCL tends to be a more compact language than Fortran77. However, the global declarations in the small TCL graphical user interface guis written for numerical analysis on this wiki have exactly the same common variable structure and same program organization as the giant Fortran number crunchers.


gold 12Dec2018. There are two alternate methods of loading TCL subroutines, known as proc arguments (top loading) and global variables (side loading). In engineering terms, the TCL global variable methods and the Fortran common variables are an economy of scale for large programs. In other words, top loading a data subroutine for a small program with a limited number of variables and a limited number of subroutines is about as efficient as global variables (side loading). When a large program has the number of variables approaching 25 variables and the total number of subroutines approach 20 subroutines, then global variables or common variables become an more attractive alternative data transfer between subroutines and a more efficient use of the programmer's time. This principle is independent of language type, and equally true for the TCL, Fortran, and other computer languages. For example, many scientific Fortran programs had a specialized subroutine for constants, including the gravity constant, speed of light, etc. If the gravity constant was used in 15 subroutines, it was easier to declare the gravity constant as a common variable in a constants subroutine, and then make a one time change in the value of gravity constant in one subroutine of constants than making the same change for the gravity constant in 15 subroutines. If one knows than the sequence of slot variables {$side1,$side2,$side3...$side8...$side_N} and other constants are TCL global variables throughout the subroutines, one can easily refer to these global values in a specialized printout report subroutine. One can also load these global values in formulas for printout and separate calculations on the fly. For a side loading example in a new subroutine, proc newby {} {global side1 side2 side3; puts <* $side1 $side2 $side3>;return <+ $side1 $side2 $side3>}. The alternative top loading would be proc newby {side1 side2 side3} { puts <* $side1 $side2 $side3>;return <+ $side1 $side2 $side3>}. Both subroutine methods work for small TCL programs with the roughly same amount of typing. Remember in top loading, one would have to make other changes in the invoking statement or proc argument statement for the subroutine. One might point out that loading more than 25 variables in either an invoking statement or proc statement is not a trivial exercise to kept correct and cued properly. For another example, a specialized subroutine for printing out variables might use s set of global variables as proc printout {} { global side1 side2 side3; puts $side1; puts $side2; pouts <* side1 side2 side3>; puts "conversion to centimeters"; puts <* $side1_inches 2.54 >; }. A specialized printout subroutine with globals previously declared is faster in development and checking numeric formulas in experience, especially where conversion of units like inches and centimeters is useful for checking the results of the program in older textbook problems.


In opinion, a set of the same global statements in numerous routines are easier to keep organized. The condition of using global variables in method is that the user understands that not all variables are invoked over all the numerous subroutines. Therefore, in the case of multiple variables > 25 and multiple subroutines >20 in a large program, changing a constant variable in a large number of subroutines, little to do in the proc argument statements and invoking the subroutines, and the availability of the global variables throughout the program means less time spent on changes for the programmer. For terms of TCL presentation on the wiki, the slot variables could be changed inside the subroutine to recognizable names in variables for the calculations and quicker comprehension of the reader. In opinion, global variables are a more efficient use of the programmers time for a quick assembly of a working gui or installing a new working subroutine in a large TCL program.


gold 12Dec2018. The author is still learning TCL. These small TCL graphical user interface guis presented in the wiki have gone through an evolution of about twenty years, including numerous unpublished Javascript and TCL guis behind a firewall before joining the wiki. The suggestions from the wiki members have been of great help and these TCL guis have continued to improve. The guis are experimental numerical analysis in nature, and not every early TCL gui or program written over the twenty year period has the same global variable features, structured programming, or beauty spots of the TCL gui genre. The author keeps hearing that TCL is not a number crunching language or an outdated language from non-users. But in the instance of the TCL global variables, the TCL globals have the equivalence of the common statements and common variables in the data subroutines of giant Fortran number crunchers.



Maybe partially solved, trouble accessing the TCL WIKI from USA on some restaurant WIFI's?

gold 7/16/2020, Report so far, in coordination with ActiveState Support [email protected]


gold 08Jul2020. Don't know if other members of TCL Club have this problem, but the author is having great difficulty in accessing this TCL WIKI, since the TCL WIKI and other download TCL programming sites on public WIFI are blocked in the USA. Accordingly, the USA based search engines are apparently not accessing the TCL programming sites. Frantically, the blocked TCL sites will affect the availability,promulgation, and succe$$ of the TCL language. Believe that the TCL language has much to offer mankind, if the TCL language and its amazing utility are not blocked to mankind by gatekeepers, iconoclasts, and bookburners in the USA.


many thanks for help. I am still locked out from easy access to TCL Wiki. but i will report your efforts to the TCL WIKI. Is there an address to resolve issues with ATT ? . I tried to contact ATT, but there is merry-gr on that website. thanks again,gold

Sent with ProtonMail Secure Email.

‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ On Thursday, August 13, 2020 2:50 PM, ActiveState Support <[email protected]> wrote:

Hi Gold

I'm not sure if you've been able to work around this or have it fixed yet. I can still see "Error 1000" issues on Cloudflare though with the aliased tcl.activestate.com. Maybe that domain change is being detected as a cross-site redirection attempt and blocked for that.

I'm not clear why, but there is a difference between how wiki.tcl-lang.org and tcl.tk resolve. Maybe that was intended to work like a backup site, or maybe something is out of sync:

:~$ host tcl.activestate.com tcl.activestate.com is an alias for wiki.tcl-lang.org. wiki.tcl-lang.org has address 104.18.184.65 wiki.tcl-lang.org has address 104.18.183.65 wiki.tcl-lang.org has IPv6 address 2606:4700::6812:b841 wiki.tcl-lang.org has IPv6 address 2606:4700::6812:b741 :~$ host wiki.tcl-lang.org wiki.tcl-lang.org has address 104.18.183.65 wiki.tcl-lang.org has address 104.18.184.65 wiki.tcl-lang.org has IPv6 address 2606:4700::6812:b741 wiki.tcl-lang.org has IPv6 address 2606:4700::6812:b841

:~$ host www.tcl.tk www.tcl.tk has address 104.16.56.90 www.tcl.tk has address 104.16.33.94 www.tcl.tk has IPv6 address 2606:4700::6810:385a www.tcl.tk has IPv6 address 2606:4700::6810:215e

whois 104.16.56.90 and whois 104.16.33.94host reports that's Cloudflare. whois 104.18.183.65 and whois 104.18.184.65 also reports Cloudflare

Best regards,

Technical Support Engineer ActiveState Software


APN What URL are you using to access? The tcl.tk domain is problematic (from the blocking perspective), the official name is now wiki.tcl-lang.org. Do you have problems with that domain as well?

gold 7/11/2020. Thanks for feedback. Possibly problem is default security setting on browser or virus firewall security going into a WIFI proxy server. Realize the TCL CLUB is not a 9 to 5, but this item is really cutting down my production and access to TCL references. But the browsers are changing into complexity, pretty fast for a retiree. Quotes """ If you don't believe you should be using a proxy server: Go to the Dissenter menu > Settings > Show advanced settings… > Change proxy settings… > LAN Settings and deselect the "Use a proxy server for your LAN" checkbox. UNQuote"""" The strange thing is that I can see https://wiki.tcl-lang.org/welcome and https://sourceforge.net/projects/tcllib/ at Starbucks coffee and some "bar" WIFI's, but I can not see the TCL Wiki same at Mcdonalds, Wendy's, and some other quick stop WIFI's.


7/13/2020. trouble coming from Macdonald restaurant etc ATT WIFI?? https://login-mcd-cluster.prd.....snantx.attwifi.com/g error messege found after site log. SIC http://tcl.activestate.com/software/tcllib/tcl.activestate.com’s server IP address could not be found. Try:


Checking the connection Checking the proxy, firewall, and DNS configuration Running Windows Network Diagnostics ERR_NAME_NOT_RESOLVED




http://wfr.tcl-lang.org/ https://login.attwifi.com/blocked/blocked_page.html#?......&web_rep=%3Ctrustworthy-sites%3E&web_cat=%3Cshareware-and-freeware%3E


Hi,

7/16/2020. ActiveState hasn't hosted the Tcler's Wiki for a while. From what I see in that error message though, it looks like the ATT network has DNS entries that still point to tcl.activestate.com, whereas the other providers are using the official URL instead.

We might have had a redirect sending tcl.activestate.com to the new official URL, and that redirect might have gone out of service. I have asked our IT team to investigate.

Best regards,

GS. ActiveState Software

NEW! ActiveState Platform: Build - Certify - Resolve Login to get your ActivePerl/Python/Tcl builds: https://platform.activestate.com/ .

gold 7/16/2020, end of file


       #pseudocode
2m, m**2 - 1, m**2 + 1  Babylonian triplet
twin prime number.
twin prime numbers separated by 2,4,6 ...?
c**2= a**2 + b**2
c**2= a**2 + 1        normalized Babylonian triplet
a**2  = c**2 -1       normalized Babylonian triplet
some b and c are both primes.
some b and c are not both primes.
The reciprocal pair relationship.
(X+1/X)**2 - (X+1/X)**2 = 4  ,    devide equation by 4 
normalized triplet, < (1/4)* ((X+1/X)**2 ) , 1 ,(1/4)* ((X+1/X)**2) >
0 < X-1/X < 2
1< X-1/X < 1+sqrt(2)     ~~ limit of 2.4 
The Babylonian regular numbers between 0 and 60 have a limited set of triplets that
satisfy 1< X-1/X < 1+sqrt(2) which appears to be the role of Plimpton 322.
The limit 1< X-1/X < 1+sqrt(2) may explain the 1<X<2 limit on the Late  Babylonian
many place reciprocal tablets.
d=6 even number, l = divisor of d**2 with integer result, Babylonian triplet method
a=l+b
b= d+ (d**2)//(2*l)
c= d+l+(d**2)/(2*l)
# supposed to work for all even d

Possible Bias of base 2 and 3 in near field?

New report indicates that binary numbers and base 3 may a bit biased in the near field. But don't think the sample is large enough in this trial program.

                # Pretty print version from autoindent
                # and ased editor
                # Possible Bias of base 2 and 3 in near field?
                # written on Windows 10 on TCL
                # working under TCL version 8.6
                #   on TCL Club , 18aug2020
                # relative frequency of indiv. "throw" over all "throws".
                # pi mantissa used here
                # proc base and frombase by RS
                package require Tk
                console show
                # proc base by RS
                proc base {base number} {
                    set negative [regexp ^-(.+) $number -> number] ;# (1)
                    set digits {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N
                        O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p
                        q r s t u v w x y z}
                    set res {}
                    while {$number} {
                        set digit [expr {$number % $base}]
                        set res [lindex $digits $digit]$res
                        set number [expr {$number / $base}]
                    }
                    if $negative {set res -$res}
                    set res
                }
                  # proc base by RS
                proc frombase {base number} {
                    set digits {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N
                        O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p
                        q r s t u v w x y z}
                    set negative [regexp ^-(.+) $number -> number]
                    set res 0
                    foreach digit [split $number ""] {
                        set decimalvalue [lsearch $digits $digit]
                        if {$decimalvalue<0 || $decimalvalue >= $base} {
                            error "bad digit $decimalvalue for base $base"
                        }
                        set res [expr {$res*$base + $decimalvalue}]
                    }
                    if $negative {set res -$res}
                    set res
                }
                proc calculation {  facen }  {
                    # prob. subroutines for mimic sequence of bronze
                    # prob. is throw combos of eg. "7" over all possible throws
                    # set lister [split {14159265358979323846} ""] 
                    # in base 3        10111100001122100002122202221020002210001 
                    # in base 2  1100010001111111110100001101001100110010011101001101011111000110 
                    set target [ base 3 14159265358979323846 ]
                    set lister [split { 1100010001111111110100001101001100110010011101001101011111000110  } ""]                   
                    set ee [llength  $lister ]
                    set kk [ llength [ lsearch -all $lister $facen ] ]
                    set prob [ expr { ($kk*1.) / $ee  } ]
                    return $prob
                }
                set limit 12
                puts "%|table| printed in|TCL format |% "
                puts "&| quantity| value| comment, if any|& "
                for { set i 0 } { $i <= $limit }  { incr i } {
                    lappend listxxx $i
                    lappend listxxx [ calculation  $i ]
                    puts " &| $i | [ calculation  $i ] |  |&"
                }
                #end
               puts " [ base 2 14159265358979323846 ] "

table printed inTCL format
quantity value comment, if any
0 0.4461538461538462
1 0.5384615384615384
2 0.0
12 0.0 1100010001111111110100001101001100110010011101001101011111000110

binary pi in 512 places. 11. 0010010000111111011010101000100010000101101000110000100011010011 0001001100011001100010100010111000000011011100000111001101000100 1010010000001001001110000010001000101001100111110011000111010000 0000100000101110111110101001100011101100010011100110110010001001 0100010100101000001000011110011000111000110100000001001101110111 1011111001010100011001101100111100110100111010010000110001101100 1100000010101100001010011011011111001001011111000101000011011101 0011111110000100110101011011010110110101010001110000100100010111


table printed inTCL format
quantity value comment, if any
0 0.5394990366088632 binary pi in 510 digits
1 0.44701348747591524
2 0.0

  • Unexpected biases in the distribution of consecutive primes
  • Robert J. Lemke Oliver, Kannan Soundararajan ,Department of Mathematics, Stanford University
  • The Last Digit of Prime Numbers - Numberphile on Youtube
  • Lecture on “Rock, paper, scissors in probability, Tadashi Tokieda
  • Hardy-Littlewood conjectures.
  • MATHEMATICS SCIENCE, A new pattern in primes, Shubashree Desikan, Hindu Times
  • en.wikipedia.org wiki search on Tadashi_Tokieda
  • https://www.ncbi.nlm.nih.gov articles/PMC4978288/
  • Distribution of the units digit of primes, C. M. Ko, National Central University
  • www.wired.com tadashi-tokieda-finds-startling-objects-in-plain-sight/

Subroutine Template

        # adapted from tcl-wiki Stats 2011-05-22, arithmetic mean  [RLE]
        #
        # ::math::quantity_into_ratios --
        #
        # Return the division of quantity by  two or more given ratios
        #
        # Arguments:
        #    val  first value is quantity
        #    args other values are two or more given ratios
        #
        # Results: parts of quantity divided  by ratios
        #
        proc ::math::quantity_into_ratios {quantity args} {
            set sum 0.
            set N [ expr { [ llength $args ] + 1 } ]
            if { $N == 1  } { return 0 }
            foreach val $args {
                set sum [ expr { $sum + $val } ]
            }
            foreach val $args {
                lappend answer [ expr { $quantity * ($val/$sum) } ]
            }
            set answer
        }
        #puts "  ::math::quantity_into_ratios ( 84 2 2 2  )  answer 12.0 24.0 48.0    "
        #puts " [ ::math::quantity_into_ratios 84 1 2 4  ]  "
        #puts " [ ::math::quantity_into_ratios 84 ] for (::math::quantity_into_ratios 84) returns zero "

sqrt_sum_of_squares


        # adapted from tcl-wiki Stats 2011-05-22, arithmetic mean  [RLE]
        #
        #  sqrt_sum_of_squares --
        #
        # Return the sqrt_sum_of_squares by  one or more
        #
        # Arguments:
        #
        #    args other values are one or more
        #
        # Results: sqrt_sum_of_squares
        #
        proc sqrt_sum_of_squares { args} {
            set sum 0.
            set N [ expr { [ llength $args ] + 1 } ]
            if { $N == 1  } { return 0 }
            foreach val $args {
                set sum [ expr { $sum + $val*$val } ]
            }
            set answer [ expr { sqrt($sum) } ]
        }
        #puts "  ::math::sqrt_sum_of_squares (  2 2 2  )  answer [sqrt 12 ]
        #  3.4641016151377544
        #puts " [ ::math::sqrt_sum_of_squares   1 2 4  ]  "
        #puts " [ ::math::sqrt_sum_of_squares 2 ] for ( ) returns zero "
        console show
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        puts "  sqrt_sum_of_squares  2 2 2 equals [ sqrt_sum_of_squares  2 2 2 ]"
        puts "  sqrt_sum_of_squares  1 1 1 equals [ sqrt_sum_of_squares  1 1 1 ]"
        puts "  sqrt_sum_of_squares  1 1  equals [ sqrt_sum_of_squares  1 1  ]"
        puts "  sqrt_sum_of_squares  1  equals [ sqrt_sum_of_squares  1  ]"
        puts "  sqrt_sum_of_squares  0  equals [ sqrt_sum_of_squares  0  ]"

output for sqrt_sum_of_squares


  sqrt_sum_of_squares  2 2 2 equals 3.4641016151377544
  sqrt_sum_of_squares  1 1 1 equals 1.7320508075688772
  sqrt_sum_of_squares  1 1  equals 1.4142135623730951
  sqrt_sum_of_squares  1  equals 1.0
  sqrt_sum_of_squares  0  equals 0.0

Modify discrete events on tugboats_tester3


From Discrete event modelling with coroutines by Author : Arjen Markus (21 april 2009). Added easy eye console for my bad eyes.


        # coro_discrete_events.tcl --
        #     Experiment with SIMULA/DEMOS like modelling - using coroutines
        # from Discrete event modelling with coroutines
        # Author : Arjen Markus (21 april 2009) 
        # Discrete event modelling is a way of modelling all manner of systems
        package require Tcl 8.6
        # acquire --
        #     Acquire resources and wait if that does not succeed
        #
        # Arguments:
        #     name        Name of the resource
        #     amount      Amount to acquire
        #
        # Returns:
        #     None
        #
        # start modifications 
            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 tclprecision 17
            console show
            # following dresses up console output to easy eye
            console eval {.console config -bg palegreen}
            console eval {.console config -font {fixed 20 bold}}
            console eval {wm geometry . 40x20}
            console eval {.console config -background palegreen -highlightcolor tan -relief raised -border 30 }
            # changes: shifted text, removed empty lines, added easy eye console to deck.
            # changes: ran text through autoindent of ASED  TCL editor
        # end modifications
        proc acquire {name amount} {
            upvar 1  objectID ID
            upvar #0 $name resource_name
            puts "Acquiring $amount of $name for $ID ..."
            if { $resource_name >= $amount } {
                set resource_name [expr {$resource_name - $amount}]
            } else {
                puts "Waiting for $name -- $ID"
                while {1} {
                    set ::queue($name) [linsert $::queue($name) 0 $ID]
                    yield [list acquire $name $ID]
                    puts "Checking $name ..."
                    if { $resource_name >= $amount } {
                        set resource_name [expr {$resource_name - $amount}]
                        break
                    }
                    puts "Wait again - $name - $resource_name -- $amount ..."
                }
            }
            puts "Acquired $amount of $name for $ID"
        }
        # release --
        #     Release resources
        #
        # Arguments:
        #     name        Name of the resource
        #     amount      Amount to release
        #
        # Returns:
        #     None
        #
        proc release {name amount} {
            upvar 1  objectID ID
            upvar #0 $name resource_name
            set resource_name [expr {$resource_name + $amount}]
            puts "Releasing $amount of $name for $ID"
            if { [llength $::queue($name)] != 0 } {
                set hid   [lindex $::queue($name) 0]
                set ::queue($name) [lrange $::queue($name) 1 end]
                set ::events [linsert $::events 0 [list $hid acquire 0.0]]
            }
            puts "Released $amount of $name for $ID"
        }
        # resource --
        #     Create a named resource
        #
        # Arguments:
        #     name        Name of the resource
        #     amount      Amount to create
        #
        # Returns:
        #     None
        #
        proc resource {name amount} {
            upvar #0 $name resource_name
            set resource_name $amount
            set ::queue($name) {}
        }
        # hold --
        #     Advance the time for the given object in the simulation
        #
        # Arguments:
        #     delay       Time to advance
        #
        # Returns:
        #     None
        #
        proc hold {delay} {
            upvar 1 objectID object
            lappend ::events [list $object "hold" [expr {$::time+$delay}]]
            puts "Holding for $delay seconds ... $object"
            yield
            puts "Done"
        }
        # object --
        #     Create an object and schedule it's coming alive
        #
        # Arguments:
        #     procedure      Name of the procedure holding the life cycle
        #     time           Time at which it comes alive
        #
        # Returns:
        #     Structure representing the object
        #
        proc object {procedure time} {
            set obj [list $procedure $::objectno]
            lappend ::events [list $obj "init" $time]
            incr ::objectno
            return $obj
        }
        # handleEvents --
        #     Handle the events that were scheduled
        #
        # Arguments:
        #     None
        #
        # Returns:
        #     None
        #
        proc handleEvents {} {
            global time
            global events
            while { [llength $events] > 0 } {
                set count 0
                set found 0
                foreach event $events {
                    foreach {obj type eventTime} $event {break}
                    if { $eventTime <= $time } {
                        set events [lreplace $events $count $count]
                        set found  1
                        break
                    }
                    incr count
                }
                if { ! $found } {
                    foreach {obj type eventTime} [lindex $events 0] {break}
                    set events [lrange $events 1 end]
                }
                if { $time < $eventTime } {
                    set time $eventTime
                }
                if { $type == "init" } {
                    coroutine [lindex $obj 1] {*}$obj
                }
                if { $type == "hold" } {
                    puts "Releasing hold: $obj"
                    $obj
                }
                if { $type == "acquire" } {
                    puts "Continue acquiring: $obj"
                    $obj
                }
            }
        }
        # startSimulation --
        #     Start the simulation
        #
        # Arguments:
        #     None
        #
        # Returns:
        #     None
        #
        proc startSimulation {} {
            if { [llength $::events] == 0 } {
                return
            } else {
                handleEvents
            }
        }
        # boat --
        #     Simulate a boat that requires several tugs to get into the harbour
        #
        # Arguments:
        #     objectID             ID of the object (required name!)
        #
        # Returns:
        #     None
        #
        proc boat {objectID} {
            acquire tugs 2
            hold 10
            release tugs 2
        }
        # main --
        #     Simulate two objects that need the same resources
        #
        # Initialise simulation system
        set objectno 0
        set time   0.0
        set events {}
        # The simulation itself
        resource tugs 3
        set b1 [object boat 1.0]
        set b2 [object boat 4.0]
        startSimulation

gold 9/10/2020. added pix.


Discrete event modelling with coroutines screenshot tugboats moore


Equivalent One Liners V2


Beginning in the sixties, the one liner program was typed input to the command line of an operating computer system terminal so that the one line command performs some useful function in a single one line of terminal input. Some of the original one liner commands were limited to a 60 character display on especially the early Basic terminals or to a 72 characters on the Fortran punched cards. Of course, the hit return to send, terminal flashing bulbs, and automatic answer back were silently understood as part or supporting the one liner program. Some of the line lengths in some computer languages were later extended to 410 lines and so on. The definition and use of the one liner program has been widened to include program source for any language that does something useful in one line. On batch programs, controlling and setting variable statements like RETURN, STOP, END, extra terminal prompts, and setting initial variables were used in Fortran systems. 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. Since a partial and practical goal of computer programming is to produce human readable code, it is permissible on the published console batch programs here to retain some vestigial stages to aid human comprehension.


Timing Equivalent One Liners V2

        # pretty print from autoindent and ased editor
        # Timing Equivalent One Liners V2
        # written on Windows 10 on eTCL
        # 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

bits and pieces, Testing One Liner Programs


      set  strinit “123456789”
      proc string_end strin5 { string index $strin5 end}
      string_end $strinit 
      # out  9
      proc sea5 bb { set i 2;if {$i < 10} { while {$i < 5} { puts [incr i]}}}
      sea 5
      # return first character of string
      proc string_end5 bb  { string index $bb 0 }
      # return last character of string
      proc string_end5 bb  { string index $bb end }
            # Enter number num for next above power of 2, John K. Ousterhout, Tcl and the Tk Toolkit
            proc near_above_power_of_2  num {set pow 1; while {$pow<$num} {set pow [expr { $pow*2} ]}; return $pow}
            # Usage  near_above_power_of_2 7 returns 8,
            # Usage  near_above_power_of_2 9 returns 16,
            # Usage near_above_power_of_2 99999999999999 140737488355328
            # Enter number num for next below power of 2, John K. Ousterhout, Tcl and the Tk Toolkit
            proc near_below_power_of_2  num {set pow 1; while {$pow< [expr {$num - 1}] } {set pow [expr { $pow*2} ]}; return [expr { $pow*.5} ]}
            # Usage  near_below_power_of_2  7 returns 4.            

# start advice file.
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}}
#end of advice file

scratch


      proc near_above_power_of_2x  num {set pow 1; while {$pow<$num} {set pow [expr { $pow*2} ]}; return $pow}
      proc near_above_power_of_2  num {set pow 1; while {$pow<$num} {set pow [expr { $pow*2} ]}; return $pow}
      proc ld x "expr {log(\$x)/[expr log(2)]}" ;# RS
            [pow 2 [+ [int 2.8] 1]]= "8.0"
      proc zap x "[pow 2 [+ 1 [expr {log(\$x)/[expr log(2)]}]"
      proc zap x "pow 2 [+ [int 2.8] 1]"

One Liners from www.codecodex.com/wiki

        #under test from www.codecodex.com/wiki
        set lister { 1 2 4 5 6 7 8 9 10 }
        set s {starchild}
        package require struct::list
        proc reverseWords s {return [struct::list reverse [split $s]]}
        proc ! n {expr {$n<2? 1: $n*[! [incr n -1]]}}
        # usage    ! 5  returns 120
        proc average list {expr ([join $list +])/[llength $list].}
        for {set i 1} {$i <= 1000} {incr i} {pust [expr {$i*($i+1)/2}]}
        namespace import ::tcl::mathop::*
        proc average list {expr {[+ {*}$list]/double([llength $list])}}
        # works here , average $lister returns 5.777777777777778
        proc fib n {expr {$n<2? $n: [fib [incr n -1]] + [fib [incr n -1]]}}
        # not working here 
        namespace import ::tcl::mathfunc::*
        ::tcl::mathfunc::isqrt 26
        # ::tcl::mathfunc::isqrt 26  returns 5, working here        
        set date [clock format [clock scan $date] -format {%Y-%m-%d %H:%M:%S}] ;#dclaar 
        scriptEval clock format [clock scan $tDate] -format {%Y-%m-%d %H:%M:%S} ;#dclaar 
        # clock scan is your friend; it knows all sorts of formats. In 
        # case above, it converts: Oct 15 06:52:45 2009 to: 2009-10-15 06:52:45

Testing One Liner Program for list_twin_primes V2


        # pretty print from autoindent and ased editor
        # list_twin_primes 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}
        # invoking TCLLIB math::numtheory
        proc isprimex x {expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]}}
        # list_twin_primes proc  under test, list_twin_primes and isprime procs are recursion limited
        proc list_twin_primesx { aa bb cc} { for {set i $aa} {$i<=$bb} {incr i $cc} { if {[isprime $i] && [isprime [+ $i $cc ]] } {lappend  boo  $i [+ $i $cc ]  } } ; return $boo}
        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
        # 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
        # reference On-Line Encyclopedia of Integer Sequences website
        # 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
        # contains redundant procs for testing
        puts "[list_twin_primes 3 25 2 ]"
        puts "[list_twin_primes 3 25 4 ]"
        puts "[list_twin_primes 3 25 6 ]"

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

Older TCL4 reserve

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.


   proc pi {} {expr {acos(-1)}}  #from AMG see below
   proc degtoradiansconst {} {return [ expr {180./[pi]}  ]}
   proc degz {} {return [ expr {180./[pi]}  ]}
   proc degx {aa} {return [ expr { [degz]*acos($aa) }  ]}
   proc inrad {a b c} {return  [expr {(sqrt(($a+$b+$c)*($a+$b-$c)*($a-$b+$c)*($b+$c-$a)))/(2.*($a+$b+$c)) } ] }
   proc circlediameter {radius} { return [ expr { 2.* $radius } ] }
   proc circlearea {radius} { return  [  expr { [pi]*($radius**2) }]}
   proc circlecircumference   {radius} {return [ expr {2.*[pi]*$radius }]}
   proc spherediameter  {radius}  {return  [ expr { 2.* $radius }]}
   proc spherevolume   {radius}  { return [ expr { (4./3.)*[pi]*($radius**3) }]}
   proc spheresurface    {radius} { return [ expr { 4.*[pi]*($radius**3) }]}
   proc cubevolume {aa}  { return [ expr { 1.*$aa*$aa*$aa } ] }
   proc squarearea  {aa}  { return [ expr { 1.*$aa*$aa } ] }
   proc ellipsoidvolume {aa bb cc} { return [ expr { 1.*(4./3.)*[pi]*$aa*$bb*$cc } ] }
   proc ellipsearea1 { aa bb } {return [ 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  } { return [ expr { 1.*(4./3.)*[pi]*$aa*$aa*$aa } ] }
   proc spheroidvolumex {aa cc } { return [ expr { 1.*(4./3.)*[pi]*$aa*$aa*$cc } ] }
   proc torusvolumex {aa bb }  { return [ expr {(1./4.)  *[pi]*[pi] * ($aa + $bb) * ($aa - $bb)*2.}] }
   proc torussurfacex {aa bb }  { return [ expr { [pi]*[pi] *  ($aa*$aa - $bb*$bb) }] } 
   proc conesurfacex {aa rr }  { return [ expr { [pi]*$rr*$aa}] }
   proc cylindersurfacesidex {aa rr }  { return [ expr {2.* [pi]*$rr*$aa}] }   
   proc cylinderwholesurfacesidex {aa rr }  { return [ expr {2.* [pi]*$rr*$aa +2.*[pi]*$rr*$rr}] }   
   proc cylindervolumesidex {aa rr }  { return [ expr { [pi]*$rr*$rr*$aa}] } 
   proc conevolumex {aa rr }  { return [ expr { (1./3.)*[pi]*$rr*$rr*$aa}] } 
   proc pyramidvolumex {aa bb cc }  { return [ expr { (1./3.)*$aa*$bb*$cc  }] } 
   proc rectangularprismvolumex {aa bb cc }  { return [ expr { $aa*$bb*$cc  }] } 
   proc triangularprismvolumex {aa bb cc }  { return [ expr { $aa*$bb*$cc*.5  }] } 
   proc polygonperimeterx {aa bb }  { return [ expr { $aa*$bb}] } 
   proc rectangleperimeterx {aa bb }  { return [ expr {2.*( $aa+$bb)}] } 
   proc parallelogramperimeterx {aa bb }  { return [ expr {2.*( $aa+$bb)}] } 
   proc triangleperimeterx {aa bb cc}  { return [ expr { $aa+$bb+$cc }] } 
   proc triangletrapezoidx {aa bb cc}  { return [ 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 } {return [ expr {  ($bb*$bb+$cc*$cc-$aa*$aa)/(2.*$bb*$cc) }]}
   proc anglecosb { aa bb cc }  {return [ expr {  ($cc*$cc+$aa*$aa-$bb*$bb)/(2.*$aa*$cc) }]}
   proc anglecosc { aa bb cc } { return [ 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 returns  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] ] ]]}

Sample of TCL One Liner Procedures V2


        # Sample of TCL One Liner Procedures  V2
        # written on Windows 10 on TCL 8.6
        # working under TCL version 8.6
        # gold on TCL Club , 9/20/2020
        # Ref. WIKI BOOKS, Tcl_Programming_Introduction pdf
        # Book Section  contrasts one liners procedures
        # versus  traditional procedural  approach.
        # Below contains redundant One Liner procedures
        # to contrast alternate techniques and constructs
        # start modifications
        package require Tcl 8.6
        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 tclprecision 17
        console show
        # following dresses up console output to easy eye
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        puts "Admiral begins operations "
        # changes: shifted text, removed empty lines, added easy eye console to deck.
        # end modifications
        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}
        # contains redundant procs for testing one liner procedures V2
        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
        # maturity value of loan using TCL 8.6 math ops, 10Sep2020
        # similar formula for time in days divide years by 360.
        # similar formula for interest rate in percent, divide interest by 100.
        # should work with any currency and just use consistent units.
        # maintain isolating spaces in TCL math ops
        proc maturity_value_loan { principal interest years} { [*  $principal  [+ 1. [* 1. $interest $years ]]] }
        # Usage  maturity_value_loan 100. .05 1. returns 105.
        proc maturity_value_loan_percent { principal percent_i years} { [*  $principal  [+ 1. [* 1. [/  $percent_i 100.]  $years ]]] }
        # Usage  maturity_value_loan_percent 100. 5. 1. returns 105.
        proc maturity_value_loan_days { principal interest days} { [*  $principal  [+ 1. [* 1. $interest [/ $days 360. ]]]] }
        # Usage  maturity_value_loan_days 100. .05 360. returns 105.
        # following proc session invoke TCLLIB math::trig library
        proc pyramid_d {hh bb} { [ acotand [expr (.5*$bb/$hh) ]] }
        proc pyra_d {hh bb} { [ acotand [* .5 [/ $bb $hh] ]] }
        # Usage pyramid_degrees 57.692 106.346 answer 47.334157521261254
        # hh is height of pyramid, units cancel out
        # bb is base length of pyramid
        # seked = (7 * .5 * 360 cubits) / 250 cubits = 5.04 decimal palms
        proc seked_d {hh bb} { [/ [* 7. .5 $bb ] $hh ] }
        # usage seked_d 250. 360. equals 5.04
        # end TCLLIB
        # hbA1c_convert_to_average_blood_glucose mg/dl  HbA1c
        proc a1c hbA1c {  expr { 35.6*$hbA1c -77.3} }
        # convert mg/dl to mmol/L average blood glucose
        # some papers round off 18.016 to mgdl/18.
        proc mgdl_to_mmoll mgdl {  expr { $mgdl/18.0 } }
        # convert  mmol/L to mg/dl average blood glucose
        proc mmoll_to_mgdl mmoll {  expr { $mmoll*18.0 } }
        # *************************************8
        #  mean_speed_1 is defined as apparent velocity
        # of Jupiter along Zodiac in degrees per day
        # mean_speed_1 = [ expr { .5 * (velocity_1 - velocity_0 )} ]
        proc mean_speed_1 {velocity_1  velocity_0} {  expr { .5 * ($velocity_1 - $velocity_0 )}   }
        # Usage  mean_speed_1 1.5 .5 for 1.5 and 0.5 speeds in degrees per day returns 1. 
        # *******************************
        # adding_two_fractions aa/bb + cc/dd = 
        # ((aa *dd*1.))+(bb*cc*1.))/(bb*dd*1.),
        # but must insert 1. factor to return real numbers in TCL math ops
        proc adding_two_fractions { aa bb cc dd } {  [/ [+  [*  $aa $dd 1. ]  [* $bb $cc 1. ]] [* $bb $dd 1.] ] }
        # suggest maintain spaces in math ops
        # Usage adding_two_fractions 1.0 1.0 1.0 1.0 returns   2.0
        # Usage adding_two_fractions 1 1 1 1  returns   2.0
        # Usage adding_two_fractions 1. 2. 1. 2. returns   1.0 
        # subtracting_two_fractions aa/bb - cc/dd = 
        # ((aa *dd*1.))-(bb*cc*1.))/(bb*dd*1.),
        # but must insert 1. factor to return real numbers in TCL math ops
        proc subtracting_two_fractions { aa bb cc dd } {  [/ [-  [*  $aa $dd 1. ]  [* $bb $cc 1. ]] [* $bb $dd 1.] ] }
        # subtracting_two_fractions 1. 2. 1. 4. returns 0.25
        # subtracting_two_fractions 1. 1. 1. 1. returns 0.0
        # subtracting_two_fractions 1 1 1 1 returns 0.0
        # multiplying_two_fractions  
         proc multiplying_two_fractions { aa bb cc dd } { [/  [* $aa $cc 1. ]   [* $bb $dd 1. ] ] }
        # multiplying_two_fractions 1. 2. 1. 2. returns  0.25
        # multiplying_two_fractions 1. 1. 1. 1. returns 1,0 
        # multiplying_two_fractions 1 1 1 1 returns  1.0
        # dividing_two_fractions
        # but must insert 1. factor to return real numbers in TCL math ops
        proc dividing_two_fractions { aa bb cc dd } { [/  [* $aa $dd 1. ]   [* $bb $cc 1. ] ] }
        # dividing_two_fractions 1. 1. 1. 2. returns 2.  
        # dividing_two_fractions 1. 1. 1. 1. returns 1.0 
        # dividing_two_fractions 1 1 1 1 returns 1.0 
        # ********************************
        proc bodes_law_1  { nn } {  return [+ 0.4 [* 0.3 [pow 2 $nn]]] }
        # Usage bodes_law_1 1 returns   1.0 Astronomical units for planet Earth
        # Usage bodes_law_1 2 returns   0.7 AU for planet Venus
        # Usage bodes_law_1 3 returns   1.6 AU for planet Mars
        proc bodes_law_2 {} { foreach nn {0 1 2 3 4 5 6 7} { lappend planets [+ 0.4 [* 0.3 [pow 2 $nn]]]};return $planets}
        # Usage  bodes_law_2  returns  list  0.7 1.0 1.6 2.8 5.2 10.0 19.59 38.8 
        puts " out  " 

    # pretty print from autoindent and ased editor
    # One Liners Procedures V2
    # written on Windows 10 on  TCL
    # working under TCL version 8.6
    # gold on TCL Club , 10Sep2020
    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 tclprecision 17
    # following dresses up console output to easy eye
    console show
    console eval {.console config -bg palegreen}
    console eval {.console config -font {fixed 20 bold}}
    console eval {wm geometry . 40x20}
    console eval {wm title . " One Liners Report , screen grab and paste from console 2 to texteditor"}
    console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
    # blank table addition
    puts "%|table |printed in| tcl wiki format|% "
    puts "&| quantity| value| comment, if any|& "
    puts "&| testcase number:|   |&"
    puts "&| value  |quantity 1 |   |&"
    proc pi {} {expr {acos(-1)}}
    # proc pi from AMG see below
    # ******surface and area calculations ******
    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
    # *****    simple interest  section *******
    # maturity value of loan using TCL 8.6 math ops, 10Sep2020
    # similar formula for time in days divide years by 360.
    # similar formula for interest rate in percent, divide interest by 100.
    # should work with any currency and just use consistent units.
    # maintain isolating spaces in TCL math ops
    proc maturity_value_loan { principal interest years} { [*  $principal  [+ 1. [* 1. $interest $years ]]] }
    # Usage  maturity_value_loan 100. .05 1. returns 105.
    proc maturity_value_loan_percent { principal percent_i years} { [*  $principal  [+ 1. [* 1. [/  $percent_i 100.]  $years ]]] }
    # Usage  maturity_value_loan_percent 100. 5. 1. returns 105.
    proc maturity_value_loan_days { principal interest days} { [*  $principal  [+ 1. [* 1. $interest [/ $days 360. ]]]] }
    # Usage  maturity_value_loan_days 100. .05 360. returns 105.
    # ****** relative error in percent *****************************************
    #  error in percent is  < attested value>  over <calculated value>  times 100.  percent.
    #  for relative error without percent,  
    #  < attested value>  over <calculated value>  times 1.0
    #  for relative error without percent,  swap factor 100.0  to 1.0
    proc percent_errorx  {aa bb} {   expr { $aa > $bb ?   (($aa*1.)/$bb -1.)*100. : (($bb*1.)/$aa -1.)*100.}}
    # Effectively  percent_errorx is returning an absolute value of error in percent
    # Usage percent_errorx  1.2 1.0  returns 19.99 percent
    # Usage percent_errorx   1.0 1.2  returns 19.99 percent
    # Usage percent_errorx   1.5 1.0  returns  50.0 percent
    proc error_relative  {aa bb} {   expr { $aa > $bb ?   (($aa*1.)/$bb -1.)*1. : (($bb*1.)/$aa -1.)*1.}}
    proc error_relative  {aa bb} {   expr { $aa > $bb ?   (($aa*1.)/$bb -1.)*1. : (($bb*1.)/$aa -1.)*1.}}
    # Usage error_relative  1.2 1.0  returns 0.199
    # Usage error_relative  1.0 1.2  returns 0.199
    # Usage error_relative  1.5 1.0  returns 0.50
    puts " out  "

    
    # *****  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 >
    proc compound_interest_amount   { principal interest  years cd } { expr {  ($principal*1.)*((1.+( $interest /$cd))**($years*$cd))}}
    # Usage compound_interest_amount 6000 0.04 7. 12.   returns    7935.08
    # find compound interest principal from 4 entries as < amount  interest  years cd >
    # cd is compounding times per year, ususally 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 7935.08 0.04 7 12 returns  5999.997, rounds to 6000.
    # find interest in compound interest from 4 entries as < amount  principal  years cd >
    # cd is compounding times per year, ususally 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 7935.08 6000. 7 12 returns 0.039, rounds to 0.04
    # find years of  compound  interest from 4 entries as < amount  principal  interest  cd>

CREDITS ON ONE LINERS

WIKI BOOKS,  Programming_Examples pdf
WIKI BOOKS, Tcl_Programming_Introduction pdf
license https://creativecommons.org/licenses/by-sa/3.0/legalcode
creativecommons.org/licenses/by-sa/3.0/
en.wikibooks.org/wiki/Tcl_Programming_Introduction
Sample Math Programs, item 2, RS
TCLLIB math::mean is quicker by a third over some homebrew code.
Additional math functions
https://www.quora.com/What-are-the-most-useful-Swiss-army-knife-one-liners-on-Unix-That-is-what-is-your-favorite-one-liner-command-that-handles-a-task-usually-delegated-to-a-much-more-verbose-program-written-in-a-high-level-language
http://www.codecodex.com/wiki
SOURCE CODE SEARCH ENGINES, INCLUDE TCL????
Google Code Search
Koders
Krugle
Google Code Search
Koders
Krugle
Protecode
REFERENCES
http://www.codecodex.com/wiki
https://www.openhub.net/p?ref=homepage&query=tcl
https://en.wikipedia.org/wiki/Portal:Computer_programming
https://en.wikipedia.org/wiki/Portal:Free_and_open-source_software
https://en.wikipedia.org/wiki/Protecode
https://en.wikipedia.org/wiki/List_of_search_engines#Source_code
https://blog.robertelder.org/don-libes-expect-unix-automation-tool/

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



Hidden Comments Section

If urgent matter, leave comment out in plain sight, here at bottom of page. As I am more likely to see it. If the issue is resolved, I may sweep under rug later.


Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Thanks, gold 12Dec2018