Futurama episode 1ACV06 (The Lesser of Two Evils)

Bender: Hey robot, what's your serial number?

Flexo: 3370318.

Bender: No way, mine's 2716057!

(robot laughter)

Fry: I don't get it.

Bender: We're both expressible as the sum of two cubes!

Flexo: 3370318.

Bender: No way, mine's 2716057!

(robot laughter)

Fry: I don't get it.

Bender: We're both expressible as the sum of two cubes!

Well that should be easy enough to test with Mathematica. Let's just use a brute force method to check each pair of numbers {i, j} that adds up to number n where i is in the range of 0 to the cube root of n and j is in the range of 0 to i.

flexo = 3370318;

bender = 2716057;

bender = 2716057;

SumOfTwoCubes[n_Integer] :=

Catch@Do[

If[i^3 + j^3 == n, Throw[{i, j}]],

{i, n^(1 / 3)},

{j, i}

];

Catch@Do[

If[i^3 + j^3 == n, Throw[{i, j}]],

{i, n^(1 / 3)},

{j, i}

];

SumOfTwoCubes[flexo]

{119, 119}

SumOfTwoCubes[bender]

So this test found the two numbers whose cubes add up to Flexo's serial number, but it did not find the two numbers whose cubes add up to Bender's serial number. Interesting. This problem must be trickier than I first thought. Indeed it is. A coworker pointed out that the first test only searches half of the possible numbers--it completely excludes negative numbers!

Okay, let's rewrite the test to include negative numbers. The absolute value of i must no longer be constrained to the cube root of n since one of the terms can be negative. We must instead search all values between -∞ and ∞. Hmm. That might take a while. Okay, instead we'll just deal with numbers whose cubes are expressible as a 32-bit signed machine integer and we'll stop the search as soon as we find the answer. Additionally, we'll have to add an additional test where the smaller of the two values (in this case j) is negative. We know it must be the smaller of the two since their sum is positive.

BetterSumOfTwoCubes[n_Integer] :=

Catch@Do[

Which[

i^3 + j^3 == n, Throw[{i, j}],

i^3 + ( - j)^3 == n, Throw[{i, - j}]

],

{i, (2^31 - 1)^(1 / 3)},

{j, i}

];

Catch@Do[

Which[

i^3 + j^3 == n, Throw[{i, j}],

i^3 + ( - j)^3 == n, Throw[{i, - j}]

],

{i, (2^31 - 1)^(1 / 3)},

{j, i}

];

BetterSumOfTwoCubes[flexo]

{119, 119}

BetterSumOfTwoCubes[bender]

{952, - 951}

Tricky television writers.

Update: Paul Abbott points out in the comments that there's a far better way to solve this problem:

Reduce[i^3 + j^3==3370318, Integers]

i==119&&j==119

Reduce[i^3 + j^3==2716057, Integers]

(i== - 951&&j==952)||(i==952&&j== - 951)

I must admit that I've never used the Reduce function before so this was a bit of a surprise to me, but a welcome one at that.

## 3 comments:

Reduce[i^3 + j^3 == 3370318, Integers]

Reduce[i^3 + j^3 == 2716057, Integers]

Even better. Given that I'm more interested in computer science than math I've never actually used the Reduce function before.

I had never heard of mathematica, or even seen this kind of computer-friendly notation, before finding this article.

Bender's comment mystified me. I tried to figure out the cubed roots myself using estimation and was amazed at how difficult it was.

I gave up and Googled, which led me here. I'm so glad it did. I'm downloading the trial version of mathematica as I type this.

Post a Comment