Version 488 of One Liners

Updated 2010-06-21 20:36:16 by gold

One (possibly) long line Tcl or Tk scripts that are cute/neat/fun. Tcl is more verbose than perl, so I guess we won't see some of the brain-twisters those guys come up with, but I think some neat things can be done.

FW: These are just shortish scripts smushed into one line. A strict one-liner actually occupies one, maybe two or three lines using standard formatting, and is much harder to make anything useful out of. I dare you to try.

TV For what it is worth, I would type mine in practice actually as one line...

Mike Tuxford: Looking at some of these with procs, loops, semi-colons, etc... I have to agree with FW. After all, isn't every script a one-liner to the parser?

LES: I really dislike this page. All semi-colons in these (mostly) impostor one-liners totally ruin the poetry or challenge of the proposition. The right way to contribute to this page would have been with some of the ideas that have been contributed to Bag of algorithms. Check that page and see how it actually has more true and useful one-liners than this page, which goes to show even further how pointless this page turns out to be. The main difference between the two pages seems to be that in Bag of algorithms people seem to look for things that are actually useful regardless of size and some them just happen to be true one-liners, whereas in this page people strive to show something clever or impressive that has-to-fit-in-one-line-one-way-or-the-other-damn-it. Besides, Tcl is not Perl.


davidw:

 echo 'pack [label .x];pack [button .b -text Quit -command exit];set s "GUIs in Tk are Easy "; while 1 {set s [string range $s 1 end][string index $s 0];.x configure -text $s ; update ; after 100}' | wish

I expect to see Richard Suchenwirth come up with something brilliant for this space:-) RS: Well, first a simplification of yours, using -textvar:

 echo 'pack [label .x -textv s];pack [button .b -text Quit -comm exit];set s "GUIs in Tk are Easy ";while 1 {set s [string ra $s 1 end][string in $s 0];update;after 100}' | wish

This variation cycles through the bytes from 33 to 255, in hex and character (rs):

 echo 'pack [label .x -textv s];pack [button .b -text Quit -comm exit];while 1 {for {set i 33} {$i<256} {incr i} {set s [format %X:%c $i $i];update;after 250}}' | wish

Digital clock (rs):

 echo 'pack [label .x -textv s];pack [button .b -text Quit -comm exit];while 1 {set s [clock form [clock sec]  -form %H:%M:%S];update;after 1000}' | wish

AM I could not resist:

 echo 'pack [canvas .c -bg white] -fill both; .c create rectangle 50 50 70 70 -fill blue -tag R; eval [set M { .c move R [expr {5*(rand()-0.5)}] [expr {5*(rand()-0.5)} ] ; after 10 $M} ]' | wish

The mysterious shrinking window (RS):

 echo 'update;regexp {(.+)x.+[+](.+)[+](.+)} [wm geo .] > g x y;while {$g>0} {wm geo . [incr g -1]x[incr g -1]+$x+$y;update;after 100};exit' | wish

or

 echo 'update;regexp {(.+)x} [wm geo .] > g;while {$g>0} {wm geo . [incr g -1]x[incr g -1];update;after 100};exit' | wish

The psychedelic window (AM):

 echo 'pack [canvas .c -bg white] -fill both; eval [set M { .c configure -bg [lindex {white black red blue green orange brown purple yellow} [expr {int(rand()*9)}]]; after 20 $M}]]' | wish

Shorter, by rs:

 echo 'eval [set M { . configure -bg [lindex {white black red blue green orange brown purple yellow} [expr {int(rand()*9)}]]; after 100 $M}]]' | wish

The psychadelic window, even shorter and with more random colors. I used something similar to this as a popup alert, to get my attention when someone was trying to contact me. willdye

 echo 'eval [set M {. co -bg [format \#%06x [expr {int(rand()*0xFFFFFF)}]];after 99 $M}]'|wish

Blocks (PT):

  echo 'proc S {} {expr {int(rand()*256)}};proc C {} {format #%02x%02x%02x [S] [S] [S]} ; proc D {} {.c create rectangle [S] [S] [S] [S] -fill [C]; after 100 D}; pack [canvas .c]; D' | wish

Frightened window (PT):

  echo 'proc S {} {expr {int(rand() * 100) - 49}};pack [canvas .c] -expand 1 -fill both;frame .f -bg red -width 50 -height 50;bind .f <Enter> {.c move 1 [S] [S]};.c create window 200 200 -window .f' | wish

Uncertain polka dot (AM):

 echo 'pack [canvas .c -bg white] -fill both ;proc A x {.c move all [expr {sin(0.016*$x)}] [expr {cos(0.013*[incr x])}] ; after 10 A $x} ;.c create oval 100 100 120 120 -fill red ;A 1' | wish

Tcl-grep looping over argument-files (MSW):

 proc 1 {} {return true}; foreach f [lrange $argv 1 end] {for {set fp [open $f]} {!([eof $fp] && [close $fp;1])} {expr {[regexp [lindex $argv 0] "[set l [gets $fp]]"] && [puts $l; 1]}} {}}

List all items in the Tk hierarchy (and define ilist) TV:

   proc ilist { {begin {.}} {listf {winfo children}} {maxdepth {100}} {ident {0}} } { if {$maxdepth <1} return; set de {}; set o {}; for {set i 0} {$i < $ident} {incr i} {append de "   "}; foreach i [eval "$listf $begin"] { append o "$i "; append o [ilist $i $listf [expr $maxdepth-1] [expr $ident +1]] } ;return $o } ; ilist

List all -text containing items in an application TV (requires ilist):

   foreach i [ilist .] {if ![catch {$i cget -text} t1] {if  ![catch {$i cget -textvar} t2] {if {$t1 != "$t2"} {puts "$i [winfo class $i] [list [$i cget -text]]"} }} ; }

Enlarge all common fonts on all text containing widgets (excepting special defs) a bit TV:

   foreach i [ilist] {if ![catch {set t [$i conf -font]}] {set t [lindex $t end] ; $i conf -font "[lreplace $t 1 1 [expr int(0.5+1.2*[lindex $t 1])]]" }}

An logarithmic version could also be good. Change 1.2 to get another factor (for instance 0.8). Only works for widgets in the actual hierarchy, not for those not yet instantiated.

KBK It isn't useful, but it has quite the Perl flavor to it:

   puts [string map {a { P} b { a} c { c} d { T} e ck f cl g ha h od i th j {l } k no l {g } m in n Ju o st p er} nobkipapjgepchmlmdf]

GPS Incrementally display a string:

 set s "Hello World"; pack [button .b]; set i 1; while 1 {.b config -text [string range $s 0 $i]; after [expr {int(rand() * 3000)}] [list incr i]; tkwait variable i; if {$i >= [string length $s]} break}

GPS Print a list of packages loaded:

 proc packages.loaded? {} {foreach p [package names] { if {![catch {package present $p}]} { puts "$p loaded"}}}

RS Enumerations can be done cutely with aliases:

 interp alias {} colornum {} lsearch {red green blue black white}; interp alias {} numcolor {} lindex {red green blue black white}

GPS A variation on the enumerations above (RS and I were chatting):

 proc enum {type body} {set l [list]; set i 0; foreach arg $body { lappend l $arg $i; incr i}; interp alias {} $type {} $l}

GPS Choose a color and store what the user has selected in a label:

 set i 0; while 1 {set col [tk_chooseColor]; if {"" == $col} break; pack [label .f$i -bg $col -text $col]; incr i}

GPS A mkstemp/tmpname replacement in Tcl:

 proc get.unique.file.channel namePtr {upvar $namePtr n; while 1 {set n [file join $::env(TEMP) [clock clicks].tmp]]; if {![catch {open $n "CREAT EXCL RDWR" } fd]} { return $fd }}}

willdye Generate a unique global variable name. Note that in threaded/re-entrant environments, a name clash is still possible (albeit rare). If you're worried about threads, consider "[thread::id]_[clock seconds]_[clock clicks -milliseconds]_[clock clicks]_[expr rand()]''', but I'm not an expert on threading. See also Generating a unique name.

 proc tmpVar {{name "tmpVar"}} {while {[info exists ::$name]} {append name _[clock clicks]}; set ::$name {}; return ::$name}

willdye The answer (and question!) to Life, the Universe, and Everything:

 echo 'set Six 1+5; set Nine 8+1; set Life $Six*$Nine; puts AnswerToQuestion=[expr $Life]'|tclsh

(Note: since this wiki is intended for a wide audience, I'll risk spoiling the joke by pointing out that the above program is indeed a joke. See [L1 ] for details.)

MEd The "floating button", press it to fill the "fish tank" with water (works even with a "full-screen tank")

 set x 0.0; place [frame .f -bg blue] -rely 1 -relw 1 -anchor sw; place [button .b -text "Fill the Fish Tank" -command {while {$x < 0.85} {set x [expr $x+0.005]; place .f -relh $x;place .b -rely [expr 1-$x]; update; after 30;}}] -relx 0.5 -rely 1 -anchor s

MEd Another one liner using the place command. Quite similar to to PT's frightened window, but the button can not "run away" by leaving the window.

 place [button .b -text "Click Me" -command {tk_messageBox -message "Got me!"}] -relx 0.5 -rely 0.5 -anchor c;bind .b <Enter> {place .b -relx [expr rand()] -rely [expr rand()]}

AM Just a play with words, but the nice thing is there are no special syntactic characters, except for a semicolon in this one:

 proc proc exit exit; proc exit

(It was too early in the morning to try when I concocted this, but perhaps it is possible to make it longer and still not use ", {, [ ...)

slebetman: Here's a "real" one-liner. This doesn't cheat by using ";". A one-line slurp:

  foreach data [list [read [set f [open $filename]]]] {close $f}

Another way of doing it is:

  for {set data [read [set f [open $filename]]]} {[close $f]==2} {} {}

Yet another way without cheating:

  if {[string length [set data [read [set f [open $filename]]]]]} {close $f} {close $f}

Or in fact the most straight forward, exploiting the fact that [close] returns an empty string:

  set data [read [set f [open $filename]]][close $f]

gold Here is a one line procedure for the factorial.

proc factorial n { expr {$n < 2 ? 1 : $n * [factorial [incr n -1]]} }; #[RS] recursion limited

Here is a one line procedure for testing a prime number. (See primes)

    proc isprime x {expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]}}
    #[SMH] returns 1 if prime and zero if not.

JPT Here's a recursive one-liner that could certainly be optimized:

  proc to.binary n {expr {!$n ? 0 : "[to.binary [expr {$n>>1}]][expr {$n&1}]"} }
  # alternate notation: proc binary  n {expr {!$n ? 0 : "[binary [expr {$n>>1}]][expr {$n&1}]"} }
  # decimal number to binary examples, binary 9  results in 1001, binary 2 results in 10
  # also example of recursive procedure

Other ways of converting to binary can be found on the binary representation of numbers page.


JCE - so why not just this:

 proc sumto n {
     expr $n * ($n + 1) / 2
 }  

sum of positive numbers to N or sum( 1 2 3 4 ... N) (see Sample Math Programs)

alternate notation: proc sumit n { expr $n * ($n + 1) / 2}


gold Here is some one liner procedures for various error function approximations, though "not ready for the mars shot" and dependent on helper procs.

     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 grammer. Usually the procedure are called with a set statement like

  set examplenumber  [parresistor2 { 25 35 } ]

or

  set examplestring [ whitelist examplestring ]

.

     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 are some one line procedures using pi (3.14...) and associated series or functions. The euler series for the basil problem has the answer as the square of pi over 6. Some series notation problems call for checking fractions or multiples of pi, hence the pi/N option in proc pi below.

 proc eulerforbasil {aa bb} {for {set i 1} {$i<=$bb} {incr i} { set aa [expr $aa +1./($i*$i) ]  } ;return $aa }
 #usage set answer [ eulerforbasil 0 1000 ]#answer is 1.643; aa is floor term, bb is number of terms used
 # Exact answer is pi*pi/6


 proc gregoryleibniz {aa bb} {for {set i 1} {$i<=$bb} {incr i 2} { set aa [expr $aa -(1.*pow(-1,$i))/($i*1.) ]  } ;return $aa }#still checking 
 #usage:set answer [ gregoryleibniz 0 10 ] , aa is floor, bb is number terms carried out, exact answer is pi/4 or 0.785
 #still checking, this one is tricky with powers of minus one.code seems to be generating an extra value of one.
  #set answer [ gregoryleibniz -1 10 ],  seems to work

  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 and the Monte Carlo random algorithm. The accuracy of these soulutions vary with the number of trials
 and are fairly slow, even glacial closers.See [http://wiki.tcl.tk/8407]and [DKF] script on [http://wiki.tcl.tk/951] 



     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



     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)))}}
     $t insert 1.0 " primepi   [primepi 50]   "  3.2163, not bad for a prime number algorithm

  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.

     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.
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: gold Your solution is more concise.

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

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.

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

willdye gave us (in the chat) links to OneLiners in awk [L2 ] and sed [L3 ]. Thanks.