WOLFRAM

News, Views & Insights

Related Topics
Related Posts

Mathematica Q&A: Four Ways to Sum Integer Digit Blocks

Got questions about Mathematica? The Wolfram Blog has answers! We’ll regularly answer selected questions from users around the web. You can submit your question directly to the Q&A Team using this form.

This week’s question comes from Craig, a hobbyist:

For each six-digit number in a list, how can I check whether the sums of the first and last three digits are equal?

For example, the sums of the first and last three digits of the number 123,222 are equal because 1 + 2 + 3 == 2 + 2 + 2.

There are several different ways of solving this straightforward programming problem in Mathematica, and it’s instructive to compare them. In this post you’ll see four methods demonstrating various combinations of built-in Mathematica functions for working with lists and digits of integers.

Let’s start with a list of random six-digit numbers:

nums=RandomInteger[{100000,999999}, 8]

{757152, 641829, 753103, 643832, 498866, 874382, 805382, 148871}

Method 1. Using the built-in function IntegerDigits, you can define a handy function to compute the sum of the digits of an integer:

Compute the sum of the digits of an integer

To separate the first and last three digits of a six-digit number, you could use the Quotient and the remainder (Mod) when dividing by 1,000:

{Quotient[757152, 1000], Mod[757152, 1000]}

{757, 152}

Using these two functions with DigitSum, you have the first solution:

Table[DigitSum[Quotient[n, 1000]] == DigitSum[Mod[n, 1000]], {n, nums}]

{False, False, False, True, False, False, True, False}

Table was used to tabulate the result (in this case, either True or False) for each value of n drawn from the list nums.

Method 2. Getting both the quotient and remainder together is such a common operation that there is a built-in function for it:

QuotientRemainer[757152, 1000] input

QuotientRemainder output

If you think about it, this is also the same as finding the base 1,000 digits of a number. You can do this using the two-argument form of IntegerDigits:

IntegerDigits[757152, 1000]

{757, 152}

Either of these methods of splitting the six-digit number returns a list of two three-digit numbers. To proceed from there, you need to use DigitSum on each element of the list:

QuotientRemainder[757152, 1000]

{19, 8}

The notation f /@ list is shorthand for Map[f, list].

To test whether the elements in a list are equal, you need to use them as arguments to the Equal function. This is exactly what the built-in function Apply is for:

Apply[Equal, {19, 8}]

False

Apply[f, list] uses list as the arguments to the function f. In this example it returns Equal[19,8], which evaluates to False.

Putting it all together, here is the second solution:

Table[Apply[Equal,DigitSum/@QuotientRemainder[n,1000]],{n, nums}]

{False, False, False, True, False, False, True, False}

Method 3. Instead of splitting the number into two three-digit numbers and using DigitSum, you could begin by getting all six digits as a list and then using Partition to break it into sublists of length three:

Partition[IntegerDigits[757152], 3]

{{7, 5, 7}, {1, 5, 2}}

You can use Total on each sublist:

Total /@{{7,5,7}, {1,5,2}}

{19,8}

Now you can apply Equal as before to get the third solution:

Table[Apply[Equal, Total /@Partition[IntegerDigits[n], 3]], {n, nums}]

{False, False, False, True, False, False, True, False}

Method 4. So far Table has always been used to operate over the list nums. (You also could have used Map for that.) A different approach is to take advantage of the fact that many built-in Mathematica functions automatically operate on lists of arguments, giving a list of results (see Listable).

You can get the QuotientRemainder of all the numbers at once:

QuotientRemainder[nums, 1000]

{{757, 152}, {641, 829}, {753, 103}, {643, 832}, {498, 866}, {874, 382}, {805, 382}, {148, 871}}

Likewise for IntegerDigits (operating on a matrix of numbers and getting a matrix of results):

IntegerDigits[QuotientRemainder[nums, 1000]]

{{{7, 5, 7}, {1, 5, 2}}, {{6, 4, 1}, {8, 2, 9}}, {{7, 5, 3}, {1, 0, 3}}, {{6, 4, 3}, {8, 3, 2}}, {{4, 9, 8}, {8, 6, 6}}, {{8, 7, 4}, {3, 8, 2}}, {{8, 0, 5}, {3, 8, 2}}, {{1, 4, 8}, {8, 7, 1}}}

The optional second argument of Total totals a nested list specifically at depth three:

Total[IntegerDigits[QuotientRemainder[nums, 1000]], {3}]

{{19, 8}, {11, 19}, {15, 4}, {13, 13}, {21, 20}, {19, 13}, {13, 13}, {13, 16}}

Now you can apply Equal to each of these lists of two arguments. There is a special built-in notation, @@@, for this common operation. This yields the fourth solution:

Equal @@@ Total[IntegerDigits[QuotientRemainder[nums, 1000]], {3}]

{False, False, False, True, False, False, True, False}

(The @@@ is shorthand for Apply[f, expr, {1}], which means “Apply f to each item at depth 1 in expr.”)

Method 4 is the most concise solution in this post. Can you find a shorter one? How about any fundamentally different approaches?

If you have a question you’d like answered in this blog, you can submit it to the Q&A Team using this form.

Download the Computable Document Format (CDF) file

Andrew Moylan, Technical Content Specialist, Technical Communication and Strategy Group

Comments

Join the discussion

!Please enter your comment (at least 5 characters).

!Please enter your name.

!Please enter a valid email address.

16 comments

  1. It is slightly shorter to use IntegerDigits[nums,1000] rather than QuotientRemainder[nums,1000] since we can take the number in base 1000 (there aren’t enough digits to give this properly, so Mathematica just gives the decimal equivalent). Therefore, the slightly shorter version would be:
    Equal @@@ Total[IntegerDigits[IntegerDigits[nums, 1000]], {3}]

    Reply
    Patrick
    May 3, 2011 at 2:10 pm 05/03/2011 at 2:10 pm

  2. I came up with a couple more, and also some code for the timings:

    Clear[DigitSum,m1,m2,m3,m4,m5,m6,m7]
    DigitSum[n_]:=Total[IntegerDigits[n]]
    m1[nums_List]:=Table[DigitSum[Quotient[n,1000]]==DigitSum[Mod[n,1000]],{n,nums}]
    m2[nums_List]:=Table[Apply[Equal,DigitSum/@QuotientRemainder[n,1000]],{n,nums}]
    m3[nums_List]:=Table[Apply[Equal,Total/@Partition[IntegerDigits[n],3]],{n,nums}]
    m4[nums_List]:=Equal@@@Total[IntegerDigits[QuotientRemainder[nums,1000]],{3}]
    m5[nums_List]:=Equal@@@Total[Partition[IntegerDigits[nums],{1,3}],{4}]
    m6[nums_List]:=Equal@@@(({Total[Part[#,;;3]],Total[Part[#,4;;]]}&/@IntegerDigits[nums]))
    m7[nums_List]:=Equal@@@Map[Total,(({Part[#,;;3],Part[#,4;;]}&/@IntegerDigits[nums])),{2}]

    Clear[GetTimings,GetAverageTimings]
    GetTimings[n_Integer]:=Module[{tmp,t1,t2,t3,t4,t5,t6,t7},tmp=RandomInteger[{10^5,10^6-1},n];
    t1=AbsoluteTiming[m1[tmp];][[1]];
    t2=AbsoluteTiming[m2[tmp];][[1]];
    t3=AbsoluteTiming[m3[tmp];][[1]];
    t4=AbsoluteTiming[m4[tmp];][[1]];
    t5=AbsoluteTiming[m4[tmp];][[1]];
    t6=AbsoluteTiming[m4[tmp];][[1]];
    t7=AbsoluteTiming[m4[tmp];][[1]];
    {t1,t2,t3,t4,t5,t6,t7}]

    GetAverageTimings[n_Integer,m_Integer]:=Mean[Table[GetTimings[n],{m}]]
    timings=Outer[List,{#},GetAverageTimings[#,4]]&/@Round[(10^Range[1,5,1/2])];
    timings=timings[[All,1]]\[Transpose];
    ListLogLogPlot[timings,Joined->True,Mesh->All,PlotStyle->(ColorData[“Rainbow”]/@Range[0,1,1/6])]

    t=timings[[All,All,2]]\[Transpose];
    n=timings[[1,All,1]];
    TableForm[Ordering/@t,TableHeadings->{n,{}}]

    It is quite clear that your method 1,2, and 3 are the worst, and that the others are out-performing these.

    Reply
    Sander Huisman
    May 3, 2011 at 2:45 pm 05/03/2011 at 2:45 pm

  3. My approach to define a function that tests whether the sum of the first three digits and the last three digits is similar:

    In[1]:= list = {123222, 123456, 123321, 135630, 111000}

    Out[1]= {123222,123456,123321,135630,111000}

    In[2]:= digitSumTest[integer_] :=
    Total[IntegerDigits[integer][[1 ;; 3]]] ==
    Total[IntegerDigits[integer][[4 ;; 6]]]

    But Select seems like a nice way to generate a list of integers that satisfy this pattern. It seems useful to see the actual integers rather than the True / False statements.

    In[3]:= Select[list, digitSumTest]

    Out[3]= {123222,123321,135630}

    With pure functions, the Select statement can contain the function definition:

    In[4]:= Select[list,
    Total[IntegerDigits[#][[1 ;; 3]]] == Total[IntegerDigits[#][[4 ;; 6]]] &]

    Out[4]= {123222,123321,135630}

    Reply
    Kelvin Mischo
    May 3, 2011 at 2:47 pm 05/03/2011 at 2:47 pm

  4. Nicely done! I prefer InterDigits as well.

    I recently used InterDigits to work through the middle-square method of pseudo-random number generation. You can then look at the output to see how random it really is. Might be one to try for the next topic!

    http://en.wikipedia.org/wiki/Middle_square_method

    Reply
    David Guarneri
    May 3, 2011 at 3:05 pm 05/03/2011 at 3:05 pm

  5. Matrix manipulation would be a different approach. This approach has more bytes, but it doesn’t play with the digits twice before adding. Does it make sense?

    Equal @@@ (IntegerDigits[
    nums].{{1, 0}, {1, 0}, {1, 0}, {0, 1}, {0, 1}, {0, 1}})

    There might be a more concise way to create the matrix with 1s and 0s.

    I’m still new to this, but IntegerDigits[IntegerDigits[num,1000] makes me think of Fold. Is there a way to use Fold that would be more efficient?

    Reply
    Dan
    May 3, 2011 at 4:53 pm 05/03/2011 at 4:53 pm

  6. In Russian culture this problem has a practical sense — it is belived that if your bus ticket number has such a “lucky” property, you should eat it to have luck ;-) If you can read in Russian, you may read more about it at http://ru.wikipedia.org/wiki/%D0%A1%D1%87%D0%B0%D1%81%D1%82%D0%BB%D0%B8%D0%B2%D1%8B%D0%B9_%D0%B1%D0%B8%D0%BB%D0%B5%D1%82

    By the way, the total number of 6-digit “lucky” tickets from 000000 to 999999 is calculated by … integral 1/\[Pi] NIntegrate[(Sin[10 x]/Sin[x])^6, {x, 0, \[Pi]}]

    If you want to find all such numbers, it’s better not to create a test function, but generate the full list. Here is approach I use:

    (*Take all 3-digit numbers from 1 to 998 + sum their digits, 0 and 999 are not neccesary — they correspond to tickets 000000 and 999999 which can be added manually*)
    {#, Total[IntegerDigits[#]]} & /@ Range[1, 998];

    (*Group them by total sum of digits (001,010,100), (002,020,200),…,(899,989,998)*)
    Split[SortBy[%, Last], #1[[2]] == #2[[2]] &];

    (*This is the technical step — transform numbers to 3-digit strings*)
    (#[[;; , 1]] & /@ %) /. x_?NumberQ :> IntegerString[x, 10, 3];

    (*For each group generate the Outer list (Cartesian product of the list), e.g. (001,001),(001,010),…,(100,100) and join the numbers in each pair + add 000000 and 999999*)
    result=Join[{“000000”}, StringJoin /@ Flatten[Outer[List, #, #] & /@ %, 2], {“999999”}]

    This code works quicker than when using Select.

    Reply
    Kiryl
    May 4, 2011 at 11:37 am 05/04/2011 at 11:37 am

  7. I like Dan’s (May 3) though fundamentally different it is not, digitizing, summing again. Here’s a variation with a scalar product.

    Inner[#1 #2 &, IntegerDigits[#],
    {1, 1, 1, -1, -1, -1}, Plus] == 0 & /@ nums

    Reply
    Bo
    May 5, 2011 at 3:43 am 05/05/2011 at 3:43 am

  8. P.S. #1 #2& … that’s Times, cleaner I think, a letter less also. :)

    Reply
    Bo
    May 5, 2011 at 3:45 am 05/05/2011 at 3:45 am

  9. #.{1, 1, 1, -1, -1, -1} == 0 & /@ IntegerDigits[nums]

    Reply
    Bo
    May 5, 2011 at 4:05 am 05/05/2011 at 4:05 am

  10. How about:

    #[[;; 3]] == #[[-3 ;;]] & /@ IntegerDigits[nums]

    J

    Reply
    Jonathan
    May 5, 2011 at 4:08 am 05/05/2011 at 4:08 am

  11. Your last method using Dot is very concise Bo! Here is a variant on yours using a single call to Dot and Listability of PossibleZeroQ:

    PossibleZeroQ[IntegerDigits[nums].{1, 1, 1, -1, -1, -1}]

    Reply
    Andrew Moylan
    May 6, 2011 at 4:22 am 05/06/2011 at 4:22 am

  12. Good job Bo! I like that dot solution.

    Reply
    Samuel Chen
    May 6, 2011 at 5:56 am 05/06/2011 at 5:56 am

  13. ah, sorry, didn’t see it was the sum. Need a total around my solution:

    Total[#[[;; 3]]] == Total[#[[-3 ;;]]] & /@ IntegerDigits[nums]

    Reply
    Jonathan
    May 6, 2011 at 8:52 am 05/06/2011 at 8:52 am

  14. Thanks, Kiryl, for your interesting information !

    By the way, your first 3 steps can be completed using Reap/Sow and thus run even faster in Mathematica. ( Note: no algorithmic difference )

    s = Reap[Sow[ IntegerString[#, 10, 3], Total@IntegerDigits[#]] & /@
    Range[1, 998];][[2]];
    result = Join[{“000000”},
    Flatten@Outer[StringJoin, #, #] & /@ s, {“999999”}];

    Reply
    Jack
    May 6, 2011 at 11:58 pm 05/06/2011 at 11:58 pm

  15. The language “APL” was capable of a similar density of expression. It would be interesting to compare the number of primitives it is necessary to memorise in order to be “Fluent” (ie not having to keep looking into the “Manual”) in each of these “Languages”.
    One cannot reasonably assert that: “StringJoin /@ Flatten[Outer[List, #, #] & /@ %, 2], {”999999″}]” is an immediately comprehensible “Statement” to the neophyte.
    (eg: why need a space between @ and Flatten and not between / and @ ? etc etc.

    Reply
    Pete Dewar
    June 2, 2011 at 4:51 pm 06/02/2011 at 4:51 pm

  16. Using the Pick function, with the excellent solution given:

    n=RandomInteger[{100000,999999},100];

    Pick[n,IntegerDigits[n].{1,1,1,-1,-1,-1},0]
    {844781, 637790, 760580, 901442, 659596}

    = = = = = = =
    I originally started to go this route prior to the above solution.
    When using QuotientRemainder…

    num = {991083, 185437, 329911, 861615, 259693, 487950, 352094, 276653,
    780303};

    qr = QuotientRemainder[num, 1000];

    The only possible chance the two sides are equal is if the ‘Rule of 9’s are equal.

    Mod[qr, 9]

    {{1, 2}, {5, 5}, {5, 2}, {6, 3}, {7, 0}, {1, 5}, {1, 4}, {6, 5}, {6, 6}}

    Meaning that only #2, and the last, had a chance of being equal.

    Extract[qr, Position[Mod[qr, 9], {x_, x_}]]

    {{185, 437}, {780, 303}}

    By only testing these two solutions, we see that the first is valid, but the second is not.
    Again, this turned out to be a slow solution.

    Reply
    Dana D
    June 26, 2011 at 7:41 pm 06/26/2011 at 7:41 pm