KBK [L1 ] says:
I liked RS's fraction procedures in Bag of algorithms, but I didn't like the comment that "precision must be specified." I saw it as a challenge to come up with something that would do:
% num2fract 0.125 1/8 % num2fract 0.44 11/25 % num2fract 0.3333333333 1/3 % num2fract 0.5714285714 4/7
In short, I wanted to come as close as possible to converting ANY float to a fraction. This actually isn't as hard as might seem. The following code does it reasonably well. One thing that might interest Tcl'ers about it is the way that catch is used as a control structure. The throw inside the quotient_rep procedure is used as a convenient way of breaking out of the 'for' and 'while' loops simultaneously.
It's interesting to walk through the code when quotient_rep is given an integer as a parameter. It gets a division by zero, which gets caught and handled. In fact, if integer overflow threw an error, there would be no need for any termination test in the while { 1 } loop at all!
# Convert a floating point number to a mixed number, e.g.,
# 3.75 -> 3 3/4. The optional arg "maxint" is the largest
# integer that will appear in the denominator.
proc num2mixed { float { maxint 2147483647 } } {
set numer [expr { int( $float ) }]
set denom [expr { $float - $numer }]
return [list $numer [num2fract $denom $maxint]]
}
# Convert a floating point number to a fraction, e.g.,
# 3.375 -> 27/8. The optional arg "maxint" is the largest
# integer that will appear in the fraction, e.g.,
# [num2fract 3.14159 1000] -> 355/113
proc num2fract { float { maxint 2147483647 } } {
return [join [quotient_rep $float $maxint] "/"]
}
# Convert a floating point number to a pair of integers
# that are the numerator and denominator of its fractional
# representation. The optional arg "maxint" is the largest
# integer that will appear in the fraction, e.g.,
# [quotient_rep 3.14159 1000] -> {355 113}
proc quotient_rep { num { maxint 2147483647 } } {
set i [expr { int( $num ) }]
set f [expr { $num - $i }]
set retval [list $i 1]
set clist {}
set stop 0
catch {
while { 1 } {
set clist [linsert $clist 0 $i]
set n 0
set d 1
foreach c $clist {
if { ( 1.0 * $c * $d + $n ) > $maxint } {
throw "break two loops at once!"
} else {
set newd [expr { $c * $d + $n }]
set n $d
set d $newd
}
}
set retval [list $d $n]
# the following calculations can overflow or
# zero divide, but the outer catch does the
# right thing!
set num [expr { 1.0 / $f }]
set i [expr { int( $num ) }]
set f [expr { $num - $i }]
}
}
return $retval
}RS: Good job, as far I've seen it under time pressure. But just to justify why I had the mandatory denominator: I wanted to emulate the behavior on fractions of e.g. inches or stock quotes, where denominator was always a power of two. I think 2-1/3" is not really idiomatic ;-)
DKF: Just fixed a minor documentation typo in num2fract.
Now that we've got code to convert arbitrary decimal expansions to fractions, we can put together some simple quotient arithmetic code. Note that it tries to give you the same kind of fractions out as you put in. Cannot handle negative numbers, decimal input or very large quotients. Take this and build on it!
namespace eval quotientmath {
# First, some code to handle "p q/r" and "p/q" input and output
# formats. I'll use a list format internally.
proc Qscan {fraction} {
set bits [split $fraction " "]
if {[llength $bits] < 1 || [llength $bits] > 2} {
return -code error "\"$fraction\" is not a fraction"
} elseif {[llength $bits] == 1} {
set int 0
set kind 0
} elseif {![string is integer [lindex $bits 0]]} {
return -code error "\"$fraction\" is not a fraction"
} else {
set int [lindex $bits 0]
set fraction [lindex $bits 1]
set kind 1
}
set bits [split $fraction "/"]
if {
[llength $bits] != 2 ||
![string is integer [lindex $bits 0]] ||
![string is integer [lindex $bits 1]]
} then {
return -code error "\"$fraction\" is not a fraction"
}
set numer [lindex $bits 0]
set denom [lindex $bits 1]
list $kind [list [expr {$numer+$int*$denom}] $denom]
}
proc Qformat {kind fraction} {
foreach {numer denom} $fraction {}
if {$kind && $numer>$denom} {
set int [expr {$numer/$denom}]
set numer [expr {$numer%$denom}]
return [format "%d %d/%d" $int $numer $denom]
} else {
return [format "%d/%d" $numer $denom]
}
}
# Now the basic arithmetic operators.
proc Qmult {a b} {
foreach {an ad} $a {}; foreach {bn bd} $b {}
list [expr {$an*$bn}] [expr {$ad*$bd}]
}
proc Qdiv {a b} {
foreach {an ad} $a {}; foreach {bn bd} $b {}
list [expr {$an*$bd}] [expr {$ad*$bn}]
}
proc Qadd {a b} {
foreach {an ad} $a {}; foreach {bn bd} $b {}
list [expr {$an*$bd+$bn*$ad}] [expr {$ad*$bd}]
}
proc Qsub {a b} {
foreach {an ad} $a {}; foreach {bn bd} $b {}
list [expr {$an*$bd-$bn*$ad}] [expr {$ad*$bd}]
}
# A normalisation function
proc Qnorm {x} {
foreach {p q} $x {}
# Handle canonical forms
if {$p == 0} {return [list 0 1]}
if {$q == 0} {return [list 1 0]}
# Calculate GCD
while {1} {
if {$q == 0} {
# Termination case
break
} elseif {$p>$q} {
# Swap p and q
set t $p
set p $q
set q $t
}
set q [expr {$q%$p}]
}
# Divide both numerator and denominator by the GCD
foreach {xn xd} $x {}
list [expr {$xn/$p}] [expr {$xd/$p}]
}
# The public functions
proc add {x y} {
foreach {kx x} [Qscan $x] {}
foreach {ky y} [Qscan $y] {}
Qformat [expr {$kx||$ky}] [Qnorm [Qadd $x $y]]
}
proc sub {x y} {
foreach {kx x} [Qscan $x] {}
foreach {ky y} [Qscan $y] {}
Qformat [expr {$kx||$ky}] [Qnorm [Qsub $x $y]]
}
proc mult {x y} {
foreach {kx x} [Qscan $x] {}
foreach {ky y} [Qscan $y] {}
Qformat [expr {$kx||$ky}] [Qnorm [Qmult $x $y]]
}
proc div {x y} {
foreach {kx x} [Qscan $x] {}
foreach {ky y} [Qscan $y] {}
Qformat [expr {$kx||$ky}] [Qnorm [Qdiv $x $y]]
}
namespace export add sub mult div
}