Assume an old-fashioned scale balance in which weights can be placed on either side. The associated set of weights (each of which is greater than zero) is 'complete' for some W if it is capable of measuring all integer weights from 1 to W.

Clearly it is possible for such sets to exist even if no combination of the weights themselves can be balanced against any combination of the remaining weights - the set {1,2,4,8..} is just one such example.

On the other hand, the set {1,1,2,4} is also 'self-measuring', because, assuming that one of the weights were unmarked, a stranger could neverthless establish its value by weighing it in the scales with the others.

Question: You are allowed 5 weights. They must form a set which is complete, and also self-measuring.

What is the largest possible value of W, given these constraints?

Bonus: What is the largest possible value of W, if 8 weights are allowed?

I used the following Mathematica code to search for optimal sets
the initial search is with the maximum weight of 20, this gives the maximum of w=49 with {2,11,12,17,18}
I will now expand my search to a maximum weight of 100 and see what it gives in the morning, then I will repeat the same search for 8 weights.

GetW[vec2_]:=(

vsubs2=Subsets[vec2];

slng2=Length[vsubs2];

lst={};

For[i1=1,i1<slng2,++i1,

For[i2=i1+1,i2„Tslng2,++i2,

x=Total[vsubs2[[i1]]];

y=Total[vsubs2[[i2]]];

z=Abs[x-y];

If[z>0 && !MemberQ[lst,z],

AppendTo[lst,z];

];

];

];

i=1;

tbl={i};

While[Intersection[tbl,lst]ƒútbl,

++i;

AppendTo[tbl,i];

];

Return[i-1];

);

IsSelfMeasure[vec_]:=(

vlng=Length[vec];

slng=Length[vsubs];

fail=False;

j=1;

While[!fail && j„Tvlng,

If[GetW[Delete[vec,j]]<vec[[j]],

fail=True;

];

++j;

];

Return[!fail];

);

ProgressIndicator[Dynamic[w1/lmt]]

max=0;

maxw={};

lmt=20;

Dynamic[weights]

Dynamic[max]

Dynamic[maxw]

For[w1=1,w1„Tlmt,++w1,

For[w2=w1,w2„Tlmt,++w2,

For[w3=w2,w3„Tlmt,++w3,

For[w4=w3,w4„Tlmt,++w4,

For[w5=w4,w5„Tlmt,++w5,

weights={w1,w2,w3,w4,w5};

If[IsSelfMeasure[weights],

w=GetW[weights];

If[w>max,

max=w;

maxw=weights;

];

];

];];];];];

Posted by Daniel on 2010-11-24 05:30:22