PROGRAMMING  TIPS

A Challenge from Leningrad

Having a program produce a grid box is the way to get nice displays of tabular data.

by Stan Wagon

Tabular output often looks nicest when it is presented using a GridBox object. This column shows how to create such output under program control, using a challenging problem from a Leningrad math contest to illustrate the method.

1. A Challenging Puzzle

The following problem appeared on a 1991 Leningrad math contest [Fomin and Kirichenko 1994, p. 49]:

Show that it is possible to reduce any integer in base-10 to a single digit by combinations of the following two steps.
     1. Delete any zero digits that occur.
     2. Multiply by any integer you like.

This is not an easy problem and the solution presented by the contest committee is complicated. Michael Schweitzer, of Gottingen, Germany, recently found a solution which, though still complicated, is a little simpler. The reader should pause here and consider the problem, so as to get an appreciation for the difficulties. In this column I will present Schweitzer's solution, implement it in Mathematica,  and show how to present the output by creating a grid box under program control

2. A Solution

Here is Schweitzer's solution, where we illustrate by showing what happens to 13.

1. Reduce n to m which is relatively prime to 10. This can be done by multiplying by a combination of 2's and 5's and erasing 0s.

2. Multiply m by s to get a number r of the form 999999. In the case of 13, multiply by 76923.

3. Multiply r by 111111 to get a number of the form 111110888889.

4. Delete the 0: 11111888889.

5. Multiply by 9 to get 100007000001.

6. Cancel the zeros to get 171.

7. Multiply by 5848 to get 1000008.

8. Cancel the zeros and multiply by 5 to get 90, which reduces to 9.

Of course, one will wonder how Schweitzer came up with this sequence! Certain steps are not so hard. For example, to reduce 171 he looked at a few powers of 10 (mod 171).

PowerMod[10, Range[10], 171]

The fact that (10^6)≡ 163 ≡ –8 (mod 171) means that 171 divides 1000008, and that explains step 7 of his method.

We wish to implement the method so that we get output as follows.

LeningradProblem[13]

3. Implementing  Schweitzer’s Method

The implemention can be broken into several steps. First, we will want to delete the zeros from an integer. Here is a function that does that by deleting 0s from the characters making up the integer, and then pasting the remainder together via StringJoin and ToExpression.

\(deleteZeros[n_]\  := \ 
\ \ \ 
      ToExpression[
        StringJoin\ @@\ 
\ \ \ \ \ 
          DeleteCases[Characters[ToString[n]], "0"]]\)

deleteZeros[100300506]

Another key step is going from m, which is relatively prime to 10, to a number of the form (10^e)  -  1. This requires finding the order of 10 modulo m: the least integer e for which (10^e)  ≡  1 (mod m). A standard result in number theory states that the order divides ϕ(m), so we can find it by checking the divisors of EulerPhi[m]. The code that follows returns the order or the empty set if the order does not exist. Select's third argument, 1, tells it to stop when it has found one divisor that works.

OrderMod[a_, m_] := 
      Select[Divisors[EulerPhi[m]], PowerMod[a, #, m] == 1 &, 1] /. {x_} 
          :> x

OrderMod[3,  172]

OrderMod[10,  13]

This tells us where 76923 comes from when the starting value is 13.

((10^6) - 1)/13

Next let us assume that n, after deletion of any zeros, is relatively prime to 10, and does not already consist of a single digit. Schweitzer[n]  produces the sequence of numbers defined by Schweitzer's method. The replacement applied to ans at the end takes care of the case when the input has repeated 9's, for otherwise the answer would have a repeated entry.

\(Schweitzer[n_] := 
      Module[{ans = {}, m = n, add}, 
		\ \ 
          add[x_] := \(ans = Flatten[{ans, x}]\); 
	\ \ 	add[m]; 
		\ \ 
          If[n ≠ \((m = deleteZeros[n])\), add[m]]; 
		\ \ 
          e = OrderMod[10, m]; 
\ \ 		add[m = 10\^e - 1]; 
		\ \ 
          add[m = m\ \((m/9)\)]; 
		\ \ add[m = deleteZeros[m]]; 
		\ \ 
          add[m = 9\ m]; 
		\ \ add[m = deleteZeros[m]]; 
		\ \ 
          add[m = \ m\ \((10\^6 + 8)\)/171]; 
		\ \ 
          add[m = deleteZeros[m]]; 
		\ \ add[m = 5\ m]; 
		\ \ 
          add[m = deleteZeros[m]]; 
\ \ \ \ \ \ \ 
          ans\  /. \ {b___, a_, \ a_, \ c___}\  :> \ {b, a, c}] /; 

        		\ \ \ \ \ \ 
        GCD[deleteZeros[n], 10] == 1 && deleteZeros[n] ≥ 10\)

Schweitzer[13]

Schweitzer[567]

Now we need to deal with the case that n is not coprime to 10. We do this by figuring out the power of 2 or 5 it is necessary to multiply by and then, when that has been done, we call the main Schweitzer routine. Before doing that we deal with two simpler cases, when n is already a single digit or becomes such after zero-cancellation.

Schweitzer[n_]  :=  {n}  /;  n  <  10Schweitzer[n_]  := 
       {n,  deleteZeros[n]}  /;  deleteZeros[n]  <  10

\(Schweitzer[n_]\  := \ 
\ \ 
      Module[{ans\  = \ {n}, \ m\  = \ n, \ a}, \ 
\ \ \ \ 
          If[m\  != \ \((m = deleteZeros[m])\), \ AppendTo[ans, \ m\ ]]; \ 

          \ \ \ \ \ a\  = \ FactorInteger[m]; \ 
\ \ \ \ \ 
          AppendTo[ans, \ 
            If[EvenQ[m], \ 
\ \ \ \ \ \ \ 
              n\ *\ 5^Last[First[Cases[a, \ {2, \ _}]]], \ 
\ \ \ \ \ \ \ 
              n\ *\ 2^Last[First[Cases[a, \ {5, \ _}]]]]]; \ 
\ \ \ \ \ 
          Join[ans, \ Rest[Schweitzer[Last[ans]]]]]\  /; \ 
\ \ \ 
        GCD[deleteZeros[n], \ 10]\  != \ 1\  && \ deleteZeros[n]\  >= \ 10\)

So far, so good. The routine now successfully solves the problem.

Schweitzer[65]

4. Programming Grid Boxes

Grid boxes can be constructed from the menus (Input:Create Table), but it is much more useful to create and customize them under program control. The argument to GridBox should be a matrix and DisplayForm shows the resultant grid (analagous to Graphics and Show).

DisplayForm[GridBox[{{1, 2, 3},  {4, 5, 6}}]]

There are many options. Here, for example, is how to customize a grid box with lines and headings. A setting such as {2, 1} for RowLines causes the first line between rows to be a 2-point line and all the others to be 1-point lines.

\(DisplayForm[
      GridBox[
		{{"a", "b", "c"}, {1, 2, 3}, {4, 5, 6}, {7, 
            8, 9}}, GridFrame -> 2, RowLines -> 1, 
        RowSpacings -> {3, 1}, ColumnLines -> 0.5, 
        GridFrameMargins -> {{0.5, 0.5}, {0.5, 2}}, 
        RowLines -> {2, 1}]]\)

To customize the fonts, StyleBox must be used. It is easiest to define a function to set the font style.

f[a_] := 
      StyleBox[a, FontSize -> 14, FontWeight -> "Bold"]

\(DisplayForm[
      GridBox[{{f["a"], f["b"], f["c"]}, {1, 2, 3}, {4, 5, 6}, {
            7, 8, 9}}, GridFrame -> 2, RowLines -> 1, 
        RowSpacings -> {3, 1}, 
		ColumnLines -> 0.5, 
        GridFrameMargins -> {{0.5, 0.5}, {0.5, 2}}, 
        RowLines -> {2, 1}]]\)

So here is code that takes the output of Schweitzer, computes the multipliers, and presents the whole thing in an informative grid box. The multipliers are computed by checking to see whether a quotient of consecutive members of the Schweitzer sequence are rational or integer; this is done in the line 

Apply[Divide, Map[Reverse, Partition[x, 2, 1]], {1}] /.
    _Rational :>"delete"

\(f[a_] := 
      StyleBox[a, FontSize -> 12, FontFamily -> "Times", 
        FontWeight -> "Bold"]
\)\(LeningradProblem[n_] := 
      Module[
		{x = Schweitzer[n]}, 
		
        DisplayForm[
          StyleBox[
            GridBox[Transpose[{Prepend[x, f["The sequence:"]], 
                  Prepend[
                    Append[Apply[Divide, 
                          Map[Reverse\ , \ Partition[x, 2, 1]], {1}]
                           /. _Rational :> "delete", ""], 
                    f["The multipliers:"]]}], 
			\ \ \ \ \ 
              ColumnAlignments -> Left, 
			\ \ \ \ \ 
              GridFrame -> 2, ColumnSpacings -> 2, 

              		\ \ \ \ \ \ \ \ 
              GridFrameMargins -> {{0.8, 0.4}, {0.4, 1.2}}, 

              			\ \ \ \ \ RowSpacings -> {2, 1.5}, 
					
              RowAlignments -> Bottom, 
			\ \ \ \ \ 
              RowLines -> 1, ColumnLines -> 1], 
		
            Background -> GrayLevel[0.9], FontSize -> 9]]]\)

LeningradProblem[34]

LeningradProblem[99]

One can go farther with this by writing a general function, ShowTable, that takes data and options and produces a grid box. Options such as RowHeading and ColumnHeading would be useful so that the user need not fuss with appending various strings to lists. And the function can take options such as RowLines (a GridBox option) and FontFamily or FontSize or Background (StyleBox options) and assign them to the right place under program control. And of course one can add options such as HeadingFontStyle and the like. In other words, such a function will be most useful if it is designed to accept all the reasonable-sounding options and takes over the job of assigning them to their proper functions.

Reference

D. Fomin and A. Kirichenko, Leningrad Mathematical Olympiads, 1887–1991, MathPro Press, Westford, Mass. 1994.

ABOUT THE AUTHOR

Stan Wagon uses Mathematica extensively in his research, teaching, and exposition and is especially appreciative of the new ways in which Mathematica allows us to look at mathematical objects. He is author or coauthor of several books, including Mathematica in Action, Animating Calculus, VisualDSolve, and Which Way Did the Bicycle Go?. He also teaches a high-altitude Mathematica course every July in the mountains of Colorado.

Stan Wagon
Department of Mathematics and Computer Science
Macalester College
St. Paul, MN 55105
wagon@macalester.edu