Finding Ramanujan's taxicab numbers

11

4

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$

vito

Posted 2017-01-11T07:22:16.277

Reputation: 8 518

2FindInstance[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. – Bill – 2017-01-11T07:43:40.103

4PowersRepresentations might be useful, e.g., PowersRepresentations[1729, 2, 3] returns {{1, 12}, {9,10}}. – Carl Woll – 2017-01-11T08:03:24.743

I wonder about finding the subsequent taxicab numbers? $2, 1729, 87539319, 6963472309248, 48988659276962496$ OEIS A011541

– dr.blochwave – 2017-01-11T08:03:44.560

@CarlWoll nice function. Too many functions, too little time :) – Nasser – 2017-01-11T08:18:57.613

Answers

8

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

vito

Posted 2017-01-11T07:22:16.277

Reputation: 8 518

5

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

Nasser

Posted 2017-01-11T07:22:16.277

Reputation: 92 661