Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: DigitDifferences?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg60758] Re: DigitDifferences?
  • From: Maxim <ab_def at prontomail.com>
  • Date: Tue, 27 Sep 2005 03:45:29 -0400 (EDT)
  • References: <dh2tfe$d69$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

On Sat, 24 Sep 2005 06:58:54 +0000 (UTC), Paul Abbott  
<paul at physics.uwa.edu.au> wrote:

> I would like some suggestions on good implementations of the following
> idea: suppose that you have two numbers whose floating point
> representation has many common digits, say
>
>   2`50 Sum[(-1)^(k - 1)/(2 k - 1), {k, 1, 50000}]
>
>   1.5707863267948976192313211916397520520985833146875579625874449850433
>
> and
>
>   N[Pi/2, 50]
>
>   1.5707963267948966192313216916397514420985846996875529104874722962622
>
> Although these two numbers disagree in the 5th decimal place, they still
> have a great many common digits from that point onwards.
>
> (By the way, if you are using OS X you can use the "Evaluate to Text"
> MathService under the Services menu to do inline Mathematica evaluations
> in your favourite newsreader, avoiding much of the cutting and pasting
> to and from Mathematica. I used that here for the numerical evaluations.)
>
> I would like to display the differences between these numbers a la
> Borwein Borwein and Dilcher (1989) in "Pi, Euler numbers and asymptotic
> expansions", Amer. Math. Monthly 96 (1989), 681-687. To get an idea,
> paste either cell below into a Notebook. These attempts were done by
> hand -- so automated code for their production would be nice -- and they
> have one unfortunate problem: the spacing between numbers is not
> uniform. Suggestions for a DigitDifferences function most welcome.
>
> Cheers,
> Paul
>
> Here my two attempts to display the sort of formatting required -- there
> may be other better solutions:
>
>   Cell[BoxData[
>     FormBox[
>       RowBox[{"1.5707",
>         UnderscriptBox["8",
>           UnderscriptBox["_", "1"]], "632679489",
>         UnderscriptBox[
>           UnderscriptBox["7", "_"],
>           RowBox[{"-", "1"}]], "619231321",
>         UnderscriptBox["1",
>           UnderscriptBox["_", "5"]], "9163975",
>         UnderscriptBox[
>           UnderscriptBox["205", "_"],
>           RowBox[{"-", "61"}]], "209858",
>         UnderscriptBox["3314",
>           UnderscriptBox["_", "1385"]], "6876"}],
>       TraditionalForm]], "Text"]
>
>
>
>    Cell[BoxData[
>     FormBox[
>       RowBox[{"1.5707", " ",
>         UnderscriptBox["8",
>           UnderscriptBox["_", "1"]], " ", "632679489", " ",
>         OverscriptBox[
>           OverscriptBox["7", "_"], "1"], " ", "619231321", " ",
>         UnderscriptBox["1",
>           UnderscriptBox["_", "5"]], " ", "9163975", " ",
>         OverscriptBox[
>           OverscriptBox["205", "_"], "61"], " ", "209858", " ",
>         UnderscriptBox["3314",
>           UnderscriptBox["_", "1385"]], " ", "6876"}],
>       TraditionalForm]], "Text"]
>

This is close to what you're looking for (try it with different fonts):

f[n1_, n2_, digits_: 0] := Module[
   {form, Lrd, shft, Ln, Lchunk, Mdsym, Lbox},
   form = GridBox[#, RowLines -> #2,
     ColumnSpacings -> 0., RowSpacings -> .1,
     GridBaseline -> {Baseline, {2, 1}}, RowAlignments -> Center]&;
   Lrd = If[digits == 0,
     RealDigits[{n1, n2}],
     RealDigits[{n1, n2}, 10, digits]
   ];
   (shft = Lrd[[1, 2]] - Lrd[[2, 2]];
    Which[shft > 0,
      Lrd[[2, 1]] = PadLeft[Lrd[[2, 1]], Length@ Lrd[[2, 1]] + shft],
      shft < 0,
      Lrd[[1, 1]] = PadLeft[Lrd[[1, 1]], Length@ Lrd[[1, 1]] - shft]
    ];
    Lrd[[All, 1]] = PadRight[Lrd[[All, 1]],
      {2, Max[Length /@ Lrd[[All, 1]]]}];
    Lchunk = Split[Transpose@ Lrd[[All, 1]], SameQ @@ Equal @@@ {##}&];
    Lbox =
     (Ln = FromDigits /@ Transpose@ #;
      Ln = {Ln[[1]], Subtract @@ Ln, -Subtract @@ Ln};
      Mdsym = PadLeft[Characters@ ToString@ #& /@ Ln, {4, Length@ #},
        {{" "}, {"0"}, {" "}, {" "}}];
      {form @@ Switch[Sign@ Ln[[2]],
         0, {Mdsym[[{1, 2, 1}]], False},
         -1, {Mdsym[[{1, 2, 4}]], {False, True}},
         _, {Mdsym[[{3, 2, 1}]], {True, False}}
       ],
       "\[InvisibleSpace]"}
     )& /@ Lchunk;
    Lbox = Most@ Flatten[Lbox, 1];
    Lbox = {".", Sequence @@ Lbox,
      "\[Times]", SuperscriptBox["10", ToBoxes@ Max@ Lrd[[All, 2]]]};
    StyleBox[RowBox@ Lbox,
         AutoSpacing -> False, ShowStringCharacters -> False] //
       DisplayForm
   ) /; FreeQ[Lrd, RealDigits | Indeterminate] &&
          !MemberQ[Lrd[[All, 1]], _List, {2}]
]

f @@
  {1.5707863267948976192313211916397520520985833146875579625874449850433,
   1.5707963267948966192313216916397514420985846996875529104874722962622}

The third optional argument specifies the length of the expansion we want  
to get from RealDigits.

Maxim Rytin
m.r at inbox.ru


  • Prev by Date: Re: DigitDifferences?
  • Next by Date: Re: WORD document
  • Previous by thread: Re: DigitDifferences?
  • Next by thread: Recursion problem in SymbolicSum