4
$\begingroup$

I was trying to build a function that finds the first decimal place difference between two decimal numbers of same sign. An example:

FirstDecimalPlaceDifference[0.00000456,0.00000478]

Out:10^-7

Any ideas?

$\endgroup$
  • 1
    $\begingroup$ Can you be a little more specific about your requirements? We have plenty of ideas, but we're not sure which ones you want! $\endgroup$ – 2012rcampion Mar 9 '15 at 18:18
5
$\begingroup$

This function returns the location of the first place at which the decimal representations of the given numbers differ.

firstDecimalPlaceDifference[x__] := 
 If[Equal @@ SetPrecision[{x}, Infinity], 0, 
  10^NestWhile[# - 1 &, Floor[Log10@Max[Abs[{x}]]], 
    Equal @@ RealDigits[{x}, 10, 1, #] &]]

Not the fastest method, but guaranteed to get correct results.

First we find the largest number (Max[Abs[{x}]]) then we get the location of its first digit (Floor[Log10@ % ]). Then we repeatedly move right one digit (#-1 &), stopping when the digits of the numbers in that place (RealDigits[{x}, 10, 1, #] &) are not equal. If the numbers are equal to start with, then we just return 0 (otherwise we'll loop forever).

Note that the above method considers 5 and 4.999999 to differ in the ones place (returns 1). This function looks at the rounded representations:

firstDecimalPlaceDifference[x__] := 
 If[Equal @@ SetPrecision[{x}, Infinity], 0, 
  NestWhile[#/10 &, 10^Floor[Log10@Max[Abs[{x}]]], 
   Equal @@ Round[{x}, #] &]]

This method considers 5 and 4.999999 to differ at the seventh place (returns 1/10000000).

Update

I've reworked my method to take advantage of the fact that if we know the difference between two numbers is larger than $10^{-n}$, then we only need to compare up to the $n$th decimal place. This allows use to generate all the digits we could need at once, instead of repeatedly generating them in a loop. When comparing numbers with many digits in common, this function is faster. However, it's slower when comparing numbers that all have more than a few digits in common. (The breakeven point is somewhere around 30 digits on my laptop.)

firstDecimalPlaceDifference2[x__] :=
 With[{y = SetPrecision[{x}, Infinity]}, 
  If[Equal @@ y, 0, 
   Block[{$MaxExtraPrecision = Infinity}, 
    With[{offset = Floor[Log10@Max[Abs[y]]], 
      accuracy = 1 - Floor[Log10[Max[y] - Min[y]]]}, 
     10^(1 + offset - 
        First@FirstPosition[
          Equal @@@ 
           Transpose[
            First /@ 
             RealDigits[{x}, 10, offset + accuracy + 1, offset]], 
          False, {Infinity}, {1}])]]]]
$\endgroup$
  • $\begingroup$ Note that these functions work for any number of arguments! They return the first place at which any of the arguments differ. $\endgroup$ – 2012rcampion Mar 9 '15 at 18:24
  • $\begingroup$ as I interpret the question he literally wants to know where the digits differ so the result of 5,4.9999 should be zero. (though it is good to show both results ) $\endgroup$ – george2079 Mar 9 '15 at 22:02
  • $\begingroup$ @george2079 Do you mean 10^0 (1)? $\endgroup$ – 2012rcampion Mar 9 '15 at 22:16
1
$\begingroup$

This worked for the simple cases i checked:

FirstDecimalPlaceDifference[x_, y_] :=Floor[Log[10, Abs[x - y]]]

?

$\endgroup$
  • $\begingroup$ Try firstDecimalPlaceDifference[1, 0.1]. Gives -1, should give 0. $\endgroup$ – 2012rcampion Mar 9 '15 at 18:12
1
$\begingroup$

Something along the lines of...

f[a_, b_] := Round[a - b, Power[10, N[IntegerPart[Round[Log[10, Abs[a - b]]]]]]]

Using Log10 to get the scale of the difference and rounding the difference to this Precision.

Following discussion with 2012rcampion a tidied up version only giving the scale and handling the zero case...

Clear[f];
f[a_?NumberQ, b_?NumberQ] /; a - b == 0 := 0;
f[a_?NumberQ, b_?NumberQ] := Power[10, N[IntegerPart[Round[Log[10, Abs[a - b]]]]]];
$\endgroup$
  • $\begingroup$ f[0.1, -0.1] returns 0.2, not 0.1. Also, you should use Abs on the result (f[1,2] returns -1.) so that when you take the log, you don't get imaginary numbers (in this case 0. + 1.36438 I). $\endgroup$ – 2012rcampion Mar 9 '15 at 17:26
  • $\begingroup$ On your first point its not clear the OP does't want that given the (current admittedly somewhat vague) spec. On the second, I am using Abs down there in the Log, where will it go complex? $\endgroup$ – Ymareth Mar 9 '15 at 17:31
  • $\begingroup$ Try Log10[f[1,2]], you end up with 0. + 1.36438 I. Also, pretty sure he wants a power of 10 as the result. $\endgroup$ – 2012rcampion Mar 9 '15 at 17:38
  • $\begingroup$ No question about your example there but I don't get why you want to do it. The result the OP quotes is 10^-7 (0.0000001) not -7? $\endgroup$ – Ymareth Mar 9 '15 at 17:57
  • $\begingroup$ Fair point. I guess a better way to phrase it is that he's probably expecting a positive number later (e.g. 10^-7, not -10^-7). Trying to find the magnitude with Log10 is just one example of how negative numbers might break downstream code. $\endgroup$ – 2012rcampion Mar 9 '15 at 18:01
0
$\begingroup$

second try, restrict to number input:

 firstDecimalPlaceDifference[a_?NumberQ, b_?NumberQ] := 
       Module[{aa, bb, base},
         {aa, bb} = RealDigits /@ {a, b} ;
         base = Max[aa[[2]], bb[[2]] ];
         If[aa[[2]] != bb[[2]] ,
         10^(base-1),
         {aa, bb} = Reverse@SortBy[{aa[[1]], bb[[1]]}, Length];
         If[Union[#] == {0}, 0,
         10^(base - Position[ #,
             Except[0], {1}, Heads -> False][[1, 1]])] &@
             (aa - Join[bb, ConstantArray[-1, Length[aa] - Length[bb]]]) ]]
                   /; Max[Precision /@ {a, b}] != Infinity

now a wrapper to handle exact input:

 firstDecimalPlaceDifference[a_?NumericQ, b_?NumericQ] := Module[{p},
 p = If[# == Infinity , 1000 , # ] &@Min[Precision /@ {a, b}] ;
 firstDecimalPlaceDifference @@ (If[ Precision[#] == Infinity, 
          N[#, p], #] & /@ {a, b})  ]

 firstDecimalPlaceDifference[Pi, 267/85] // N
 firstDecimalPlaceDifference[0.00000456, 0.00000478] // N
 firstDecimalPlaceDifference[5, 4.9999] // N
 firstDecimalPlaceDifference[5, 5] // N

0.0001

1.*10^-7

1.

0.

 firstDecimalPlaceDifference @@ Convergents[Pi, 20][[-2 ;;]] // 
     N // Timing

{0., 1.*10^-19}

note the -1 argument in ConstantArray limits the agreement based on the precision of the input,

 firstDecimalPlaceDifference[1.`20, 1.`3] // N

0.0001

making that a 0 extends the low precision value with zeros causing these things to be considered equal.

$\endgroup$
  • $\begingroup$ This function is faster than mine for numbers that are close (although it fails on numbers equal to more than 1000 places). However, it has some strange behavior comparing exact and approximate numbers. For example, f[1,1.] returns 1/10, since the exact form has only one digit! When comparing approximate numbers of different precisions the behavior is also a little unexpected, e.g. f[1`1,1`2], f[1`2,1`2], and f[1`3,1`2] return 1/100, 0, and 1/1000 (I would have expected 1/10, 1/100 and 1/1000). $\endgroup$ – 2012rcampion Mar 10 '15 at 15:52
  • $\begingroup$ This one also has the same bug with Equal that mine had. Try f[1., 1 + $MachineEpsilon] (returns 0, should be 10^-16). Use SetPrecision[_, Infinity] to get around this one. $\endgroup$ – 2012rcampion Mar 10 '15 at 16:18
  • $\begingroup$ RealDigits gives you the nearrest number representable in whole powers of ten, so anything less than ~1+10^-15 or ~1+5$MachineEpsilon gets truncated to 1. This fine point seems beyond the scope of the question though. $\endgroup$ – george2079 Mar 10 '15 at 17:55
  • $\begingroup$ bitwise equality check: Equal @@ (RealDigits[#, 2] & /@ {1., 1. + $MachineEpsilon }) (*False*) $\endgroup$ – george2079 Mar 10 '15 at 17:58
  • $\begingroup$ Here is a much simpler version of yours that doesn't need a wrapper function or the padding logic: f[a_, b_] := With[{m = Floor@Log10[Max[Abs[{a, b}]]]}, 10^(1 + m - First@FirstPosition[SameQ @@@ Transpose[First /@ RealDigits[{a, b}, 10, 1000, m]], False, {\[Infinity]}])]. As far as I can tell it behaves identically. $\endgroup$ – 2012rcampion Mar 10 '15 at 18:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.