11
$\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$

$\endgroup$
  • 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 '17 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 '17 at 8:03
  • $\begingroup$ I wonder about finding the subsequent taxicab numbers? $2, 1729, 87539319, 6963472309248, 48988659276962496$ OEIS A011541 $\endgroup$ – dr.blochwave Jan 11 '17 at 8:03
  • $\begingroup$ @CarlWoll nice function. Too many functions, too little time :) $\endgroup$ – Nasser Jan 11 '17 at 8:18
8
$\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

$\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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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