Posted to tcl by kbk at Fri Jul 04 17:18:54 GMT 2008view raw

  1. namespace path {::tcl::mathop ::tcl::mathfunc}
  2.  
  3. # Take a decimal number and convert it to a rational. Return a two
  4. # element list of numerator and denominator
  5.  
  6. proc to-rational {n} {
  7. if {![regexp {^([-+]?[0-9]*)(?:[.]([0-9]*))?$} $n -> integer fraction]} {
  8. return -code error "$n is not a number"
  9. }
  10. set denom [** 10 [string length $fraction]]
  11.  
  12. # TODO - Reduce to lowest terms
  13.  
  14. return [list $integer$fraction $denom]
  15. }
  16. puts [to-rational 6.25]
  17.  
  18. # Take a decimal number representing a percentage and convert it to a
  19. # rational. Return a two element list of numerator and denominator
  20.  
  21. proc percent {n} {
  22. lassign [to-rational $n] num denom
  23.  
  24. # TODO - Reduce to lowest terms
  25.  
  26. return [list $num [* 100 $denom]]
  27. }
  28.  
  29. puts [percent 6.25]
  30.  
  31. # Multiply two rationals
  32.  
  33. proc rat-times {m n} {
  34. set result {}
  35. foreach x $m y $n {
  36. lappend result [* $x $y]
  37. }
  38. return $result
  39. }
  40.  
  41. # What is 6.25% of 19.45?
  42.  
  43. set val [rat-times [percent 6.25] [to-rational 19.45]]
  44. puts $val
  45.  
  46. # Take the integer part of a rational, with banker's rounding
  47.  
  48. proc rat-int {n} {
  49. lassign $n num denom
  50. set ipart [/ $num $denom]
  51. set fpart [% $num $denom]
  52. if {$fpart < 0} {
  53. incr ipart -1
  54. incr fpart $denom
  55. }
  56. if {2 * $fpart < $denom} {
  57. return $ipart
  58. } elseif {2 * $fpart > $denom} {
  59. return [+ $ipart 1]
  60. } else {
  61. return [+ $ipart [% $ipart 2]]
  62. }
  63. }
  64.  
  65. # How many pennies is 6.25% times 19.45?
  66.  
  67. set resultCents [rat-int [rat-times {100 1} $val]]
  68. puts $resultCents
  69.  
  70. # Convert an integer count of pennies to standard notation
  71.  
  72. proc penniesToDollars {cents} {
  73. # TODO - Doesn't handle + and - signs correctly
  74. if {[string length $cents] < 3} {
  75. set cents [string repeat [- 3 [string length $cents]] 0]$cents
  76. }
  77. return [string range $cents 0 end-2].[string range $cents end-1 end]
  78. }
  79. puts \$[penniesToDollars $resultCents]