Message Boards Message Boards

Symbolically solve a 2012 CMO problem

Posted 8 years ago

Write a list of 2012 numbers a[k] with a[k]=1/k on a white board

(1/Range[2012])//Short
{1,1/2,1/3,1/4,1/5,1/6,1/7,1/8,1/9,<<1999>>,1/2009,1/2010,1/2011,1/2012}

Erase any two numbers, $a$ and $b$, in the list and append $a + b + a \times b$ to the end of the list. Repeat this step for 2011 times.

Question: What is the number left?


  • Example: Use a shorter list with 4 items

    example=1/Range[4] (*{1,1/2,1/3,1/4}*)
    

Step 1: Choose two numbers a, b

    RandomSample[example,2]
    (*{1,1/3}*)

Step 2: Remove a and b and append a+b+a*b

    l1={1/2,1/4,a+b+a*b}/.{a->1,b->1/3} (* {1/2,1/4,5/3}*)

Repeat step 1

    RandomSample[l1,2] (*{1/2,1/4}*)

Repeat step 2

    l2 = {5/3, a + b + a*b} /. {a -> 1/2, b -> 1/4} (* {1/2,1/4,5/3}*)

Now we only have two numbers left. Compute a+b+a*b yields

      a + b + a*b /. {a -> 5/3, b -> 7/8} (* result is 4*)

Let's try some code to solve it!

Brutal Force is never a bad choice on small sample size

pad[{a_, b_}] = a + b + a*b;
runTest[n_] := Module[{res = 1/Range[n], old, erase, , temp, grid},
  old = {};
  While[Length[res] >= 2,
   erase = 
    RandomSample[Range[Length[res]], 
     2];(*choose two unique numbers to be removed*)
   old = res;
   res[[erase]] = {Missing[], 
     Missing[]};(*make the chosen number missing!*)

   res = Append[DeleteMissing[res], pad[old[[erase]]]];
   Print["Remove: ", old[[erase]], " Add: ", pad[old[[erase]]], 
    " New list: ", res]
   ];
  Framed[Row@{"Result is ", res[[1]]}]
  ]

simulation

You can run the code above you will find the that runTest[n] always yields n. Therefore the solution to the problem here is $\boxed{2012}$.


Use the strong symbolic nature of Wolfram language to prove this result

Well lets take a look at this problem from a very mechanical way. Assume we have two numbers only:

pad[{a,b}]
a+b+a b

For list with 3 items, any choice of the two items to be removed will yield the same thing:

threeItems=pad[{c,pad[{a,b}]}]//Expand
==>a+b+a b+c+a c+b c+a b c

pad[{b,pad[{a,c}]}]//Expand
==>a+b+a b+c+a c+b c+a b c

pad[{a,pad[{b,c}]}]//Expand
==>a+b+a b+c+a c+b c+a b c

Hard to see the pattern here?

Take look at the result closely:

Cases[threeItems,p_/;Length[p]==#]&/@{0,2,3}(*items in the sum*)
==> {{a,b,c},{a b,a c,b c},{a b c}}

Use this Case function to all expanded expression above yields the same list we just obtained. The pattern of the list above is called rotational symmetry, meaning the order of the three items does not affect the result of the sum. Lets add a fourth item here:

pad[{d,pad[{a,pad[{b,c}]}]}]//Expand
===> a+b+a b+c+a c+b c+a b c+d+a d+b d+a b d+c d+a c d+b c d+a b c d

Separate the terms by its exponential/order from the the sum .The terms below also shows its invariance regarding to the permutation of the tuple {a,b,c,d}.

fourItems=Cases[%,p_/;Length[p]==#]&/@{0,2,3,4}
==> {{a,b,c,d},{a b,a c,b c,a d,b d,c d},{a b c,a b d,a c d,b c d},{a b c d}}

Now lets carefully count the number of items in each list above and prepend 1 to this list:

{1}~Join~(Length/@%)
{1,4,6,4,1}

Lets try again with the list {a,b,c,d,e} with 5 items

pad[{e,pad[{d,pad[{a,pad[{b,c}]}]}]}]//Expand
a+b+a b+c+a c+b c+a b c+d+a d+b d+a b d+c d+a c d+b c d+a b c d+e+a e+b e+a b e+c e+a c e+b c e+a b c e+d e+a d e+b d e+a b d e+c d e+a c d e+b c d e+a b c d e

Again, we group the items by their order and extract the length of each group:

fiveItems=Cases[%,p_/;Length[p]==#]&/@{0,2,3,4,5}
{{a,b,c,d,e},{a b,a c,b c,a d,b d,c d,a e,b e,c e,d e},{a b c,a b d,a c d,b c d,a b e,a c e,b c e,a d e,b d e,c d e},{a b c d,a b c e,a b d e,a c d e,b c d e},{a b c d e}}

{1}~Join~(Length/@fiveItems)
==> {1,5,10,10,5,1}

If you are familiar with Pascal's triangle or the binomial triangle, you should know immediately how to generate the sums we have shown so far:

var=x+{a,b,c,d}
==> {a+x,b+x,c+x,d+x}

Times@@var
==> (a+x) (b+x) (c+x) (d+x)

res1=%//Expand
==> a b c d+a b c x+a b d x+a c d x+b c d x+a b x^2+a c x^2+b c x^2+a d x^2+b d x^2+c d x^2+a x^3+b x^3+c x^3+d x^3+x^4  

The sum that we are looking for is

 res1/.x->1
 ==> 1+a+b+a b+c+a c+b c+a b c+d+a d+b d+a b d+c d+a c d+b c d+a b c d

given that the list contains 4 items. We can use the following functions to count the number of coefficient with pattern match (CountItem[ele_] is an enhanced version of this function ):

coefList=Coefficient[res1,x,#]&/@Range[0,Length[var]]
==> {a b c d,a b c+a b d+a c d+b c d,a b+a c+b c+a d+b d+c d,a+b+c+d,1}

countItem[ele_]:=Switch[ele,_Times, 1 ,_Plus,Length[List@@ele],_,1]

countItem/@coefList
==> {1,4,6,4,1}

Therefore, we know that we can calculate the result simply with the this expression:

prod

We don't have to expand the product to compute the result. For example, given a list of 10 items, each factor is simply:

prod2

The denominator of one item cancels the numerator of the predecessor. Thus the result of the given product is $11$, aka the numerator of the last item. Do not forget to subtract 1 from the product to calculate the sum in the problem.

POSTED BY: Shenghui Yang

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

POSTED BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract