fuzzy.tcl

Go to the documentation of this file.

/*  fuzzy.tcl --*/
/* */
/*     Script to define tolerant floating-point comparisons*/
/*     (Tcl-only version)*/
/* */
/*     version 0.2: improved and extended, march 2002*/

package provide math::fuzzy 0.2

namespace ::math::fuzzy {
   variable eps3 2.2e-16

   namespace export teq tne tge tgt tle tlt tfloor tceil tround troundn

/*  DetermineTolerance*/
/*     Determine the epsilon value*/
/* */
/*  Arguments:*/
/*     None*/
/* */
/*  Result:*/
/*     None*/
/* */
/*  Side effects:*/
/*     Sets variable eps3*/
/* */
ret  DetermineTolerance ( ) {
   variable eps3
   set eps 1.0
   while { [expr {1.0+$eps}] != 1.0 } {
      set eps3 [expr 3.0*$eps]
      set eps  [expr 0.5*$eps]
   }
   #set check [expr {1.0+2.0*$eps}]
   #puts "Eps3: $eps3 ($eps) ([expr {1.0-$check}] [expr 1.0-$check]"
}

/*  Absmax --*/
/*     Return the absolute maximum of two numbers*/
/* */
/*  Arguments:*/
/*     first      First number*/
/*     second     Second number*/
/* */
/*  Result:*/
/*     Maximum of the absolute values*/
/* */
ret  Absmax ( type first , type second ) {
   return [expr {abs($first) > abs($second)? abs($first) : abs($second)}]
}

/*  teq, tne, tge, tgt, tle, tlt --*/
/*     Compare two floating-point numbers and return the logical result*/
/* */
/*  Arguments:*/
/*     first      First number*/
/*     second     Second number*/
/* */
/*  Result:*/
/*     1 if the condition holds, 0 if not.*/
/* */
ret  teq ( type first , type second ) {
   variable eps3
   set scale [Absmax $first $second]
   return [expr {abs($first-$second) <= $eps3 * $scale}]
}

ret  tne ( type first , type second ) {
   variable eps3

   return [expr {![teq $first $second]}]
}

ret  tgt ( type first , type second ) {
   variable eps3
   set scale [Absmax $first $second]
   return [expr {($first-$second) > $eps3 * $scale}]
}

ret  tle ( type first , type second ) {
   return [expr {![tgt $first $second]}]
}

ret  tlt ( type first , type second ) {
   if { [tgt $first $second] } {
      return 1
   } else {
      return [tne $first $second]
   }
}

ret  tge ( type first , type second ) {
   if { [tgt $first $second] } {
      return 1
   } else {
      return [teq $first $second]
   }
}

/*  tfloor --*/
/*     Determine the "floor" of a number and return the result*/
/* */
/*  Arguments:*/
/*     number     Number in question*/
/* */
/*  Result:*/
/*     Largest integer number that is tolerantly smaller than the given*/
/*     value*/
/* */
ret  tfloor ( type number ) {
   variable eps3

   set q      [expr {($number < 0.0)? (1.0-$eps3) : 1.0 }]
   set rmax   [expr {$q / (2.0 - $eps3)}]
   set eps5   [expr {$eps3/$q}]
   set vmin1  [expr {$eps5*abs(1.0+floor($number))}]
   set vmin2  [expr {($rmax < $vmin1)? $rmax : $vmin1}]
   set vmax   [expr {($eps3 > $vmin2)? $eps3 : $vmin2}]
   set result [expr {floor($number+$vmax)}]
   if { $number <= 0.0 || ($result-$number) < $rmax } {
      return $result
   } else {
      return [expr {$result-1.0}]
   }
}

/*  tceil --*/
/*     Determine the "ceil" of a number and return the result*/
/* */
/*  Arguments:*/
/*     number     Number in question*/
/* */
/*  Result:*/
/*     Smallest integer number that is tolerantly greater than the given*/
/*     value*/
/* */
ret  tceil ( type number ) {
   expr {-[tfloor [expr {-$number}]]}
}

/*  tround --*/
/*     Round off a number and return the result*/
/* */
/*  Arguments:*/
/*     number     Number in question*/
/* */
/*  Result:*/
/*     Nearest integer number*/
/* */
ret  tround ( type number ) {
   tfloor [expr {$number+0.5}]
}

/*  troundn --*/
/*     Round off a number to a given precision and return the result*/
/* */
/*  Arguments:*/
/*     number     Number in question*/
/*     ndec       Number of decimals to keep*/
/* */
/*  Result:*/
/*     Nearest number with given precision*/
/* */
ret  troundn ( type number , type ndec ) {
   set scale   [expr {pow(10.0,$ndec)}]
   set rounded [tfloor [expr {$number*$scale+0.5}]]
   expr {$rounded/$scale}
}

/* */
/*  Determine the tolerance once and for all*/
/* */
DetermineTolerance
rename DetermineTolerance {}

} ;/*  End of namespace*/