10
$\begingroup$

How to find Hardy-Ramanujan Numbers by using Mathematica?

Definition: Taxicab number is defined as the smallest number that can be expressed as a sum of two positive cubes in $n$ distinct ways.

For instance, The two different ways are:

$1729 = 1^3 + 12^3 = 9^3 + 10^3$

Improve this question
$\endgroup$
4
  • 2
    $\begingroup$ FindInstance[a^3+b^3==c^3+d^3==1729&&a!=c&&a!=d,{a,b,c,d},Integers] returns in an instant. FindInstance can be surprisingly powerful. $\endgroup$
    – Bill
    Jan 11, 2017 at 7:43
  • 4
    $\begingroup$ PowersRepresentations might be useful, e.g., PowersRepresentations[1729, 2, 3] returns {{1, 12}, {9,10}}. $\endgroup$
    – Carl Woll
    Jan 11, 2017 at 8:03
  • $\begingroup$ I wonder about finding the subsequent taxicab numbers? $2, 1729, 87539319, 6963472309248, 48988659276962496$ OEIS A011541 $\endgroup$
    – dr.blochwave
    Jan 11, 2017 at 8:03
  • $\begingroup$ @CarlWoll nice function. Too many functions, too little time :) $\endgroup$
    – Nasser
    Jan 11, 2017 at 8:18

2 Answers 2

Reset to default
7
$\begingroup$

I found the answer in Wolfram Mathworld

Taxicab[n_, max_] := {#[[1, 1]], First /@ Rest /@ #} & /@ 
Select[Split[
Sort[{Plus @@ #, #} & /@ Subsets[Range[Floor[max^(1/3)]]^3, {2}]],
First[#1] == First[#2] &], Length[#] == n &]

Taxicab[2, 10^5]

{{1729, {{1, 1728}, {729, 1000}}}, {4104, {{8, 4096}, {729, 3375}}}, {13832, {{8, 13824}, {5832, 8000}}}, {20683, {{1000, 19683}, {6859, 13824}}}, {32832, {{64, 32768}, {5832, 27000}}}, {39312, {{8, 39304}, {3375, 35937}}}, {40033, {{729, 39304}, {4096, 35937}}}, {46683, {{27, 46656}, {19683, 27000}}}, {64232, {{4913, 59319}, {17576, 46656}}}, {65728, {{1728, 64000}, {29791, 35937}}}}

First /@ %

${1729, 4104, 13832, 20683, 32832, 39312, 40033, 46683, 64232, 65728}$

ListPlot[First /@ Taxicab[2, 10^10], PlotStyle -> Red]

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

One way might be

n = 1729;
m = Floor[N[n^(1/3)]]
o[1] = Subsets[Range[m], {2}]
Cases[o[1], {x_, y_} /; x^3 + y^3 == n]

Mathematica graphics

Another way

o[2] = Total[#^3] & /@ o[1]
Extract[o[1],Position[o[2], n]]

Mathematica graphics

Here are the 2 taxi numbers found up to 10000

   o[3] = Last@Reap@Do[m = Floor[N[n^(1/3)]];
            o[1] = Subsets[Range[m], {2}];
            o[2] = Cases[o[1], {x_, y_} /; x^3 + y^3 == n];
            If[o[2] =!= {} && Length[o[2]] >= 2,
                 Sow[{n, o[2]}]
            ],
            {n, 1729, 10000, 1}
            ]

Grid[Flatten[o[3], 1], Frame -> All]

Mathematica graphics

Verify

Mathematica graphics

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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