# Find numbers with the same cross sum (sum of digits)?

Posted 5 months ago
948 Views
|
7 Replies
|
9 Total Likes
|
 Hi Guys! I hope all of you are fine :) Maybe someone can tell me here how can I find, with Wolfram Alpha or Mathematica, numbers they have the same sum of digits? For Example: 9999 = 36, now I need a method (or a search criterion for Wolfram Alpha) to find quickly other numbers with the same cross sum. I hope anyone can help me here. Kind regards and best wishes.
7 Replies
Sort By:
Posted 5 months ago
 Same sum as what? (The criterion is not at all clear to me.)
Posted 5 months ago
 if you're looking for numbers up to 111,111,111, then the code is numbersWithCrosssum[n_Integer] := Select[Range[111111111], Total@IntegerDigits[#] == n &] numbersWithCrosssum[36] or Table[If[Total@IntegerDigits[i] == 36, i, {}], {i, 1, 111111111}] // Flatten While this is the most idiomatic way of solving your problem, it is not the most efficient (re memory, time) because any implementation involving Select[ ] or Cases[ ] is horribly inefficient, but i will refuse to present a more efficient implementation. After all this solution does work and is the most idiomatic. This should be enough, bye.
Posted 5 months ago
 Hi Daniel! I want to find numbers (quickly) which have always 36 as cross sum, like 9999 or 131923179. I'm looking for a method that generates me quickly such numbers, or a method which generates me directly a list of numbers which have always 36 as cross sum, like the number 9999 or 131923179. I hope you can help me. Best regards.
Posted 5 months ago
 Hi Raspi, yeah, that's it! I don't know how to thank you. I wish you all the best and God's blessing. Thank you very much! Have a wonderful day. Best regards.
Posted 5 months ago
 If one allows non-leading zeros then there will be infinitely many solutions. Even if one excludes those, the count will be huge. I restrict further by enforcing that digits be (non-strictly) increasing. One can get all possible values from these solutions simply by reordering and, if desired, inserting zeros.The idea is to use Solve, giving restrictions on the variables as noted above, and using the Integers domain setting. Solve will then use integer linear programming under the hood and cough up a solution set in reasonable (I think) time. n = 36; vars = Array[x, n]; AbsoluteTiming[ soln = Solve[ Flatten[{Total[vars] == n, Map[0 <= # <= 9 &, vars], Table[vars[[j]] >= vars[[j + 1]], {j, Length[vars] - 1}]}], vars, Integers];] Length[soln] (* Out[71]= {32.0909, Null} Out[72]= 7657 *) Check the first and last ten. 10^Range[0, n - 1].vars /. soln[[1 ;; 10]] 10^Range[0, n - 1].vars /. soln[[-10 ;; -1]] (* Out[73]= {111111111111111111111111111111111111, \ 11111111111111111111111111111111112, \ 1111111111111111111111111111111122, \ 111111111111111111111111111111222, 11111111111111111111111111112222, \ 1111111111111111111111111122222, 111111111111111111111111222222, \ 11111111111111111111112222222, 1111111111111111111122222222, \ 111111111111111111222222222} Out[74]= {225999, 135999, 45999, 1116999, 126999, 36999, 117999, \ 27999, 18999, 9999} *) 
 I guess in this context the function IntegerPartitions should at least be mentioned. It could be used here like so: numberList[n_] := Select[IntegerPartitions[n], Max[#] < 10 &] and from this calculate the numbers, e.g.: nl = numberList[12]; FromDigits /@ Flatten[Permutations /@ nl, 1] I cannot imagine to calculate all those numbers for non small n, because the length of this list goes approximately like 0.50398 E^(0.692161 n), which e.g. for n=36 gives 3.34258*10^10 different numbers. Or am I misunderstanding the question?