Puzzle 2: Sum-Till Forty (Something Funny)

Question

I am learning Mathematica because I love it. I also love solving puzzles so I think it would be a nice way to learn Mathematica through puzzles. This is the second puzzle in a series I intend to solve. The first puzzle is here.

A shopkeeper has five weights to weigh things and he can weigh anything from 1 to 121 accurately (integers only) can. How do you write a program that finds those weights?

Example: The shopkeeper can weigh up to four kilos with a one-kilo weight and a three-kilo weight. If he'd put the one-kilo weight and the three-kilo weight on different sides of the scale, he could measure two kilos worth of goods. If he'd put both of the weights on the same side he can measure four kilos worth of goods.

The name of the puzzle is a pun, not a good one though as I primarily intended the shopkeeper to weight 40KG only.

---

Question was inspired by this question: How do I generate a set of n-tuples containing integral solutions to a linear equation provided certain constraints?

Answer 1

Here is an example of brute forcing this problem through enumeration and numerical optimization.

OK, I realize my example was unnecessarily brute; I could at least order and bound the terms.

ClearAll[enum, count, a, b, c, d, e];

enum[s_] := Tr /@ Tuples @ Thread[{-s, 0, s}] // Abs // Union

mem : count[w__Integer] := mem = LengthWhile[Differences @ enum @ {w}, # == 1 &]

NMaximize[
  {count[a, b, c, d, e], 1 <= a <= b <= c <= d <= e <= 121},
  {a, b, c, d, e},
  Integers
  , MaxIterations -> 1000
] // AbsoluteTiming

{7.75791, {121., {a -> 1, b -> 3, c -> 9, d -> 27, e -> 81}}}

---

You remarked about saving time. That's not really how brute force works. There is probably a way to tune the search but it's not how I would approach the problem. Instead solve smaller examples and look for a pattern.

NMaximize[{count[a, b], 1 <= a <= b <= 121}, {a, b}, Integers, 
 MaxIterations -> 1000]

NMaximize[{count[a, b, c], 1 <= a <= b <= c <= 121}, {a, b, c}, Integers, 
 MaxIterations -> 1000]

NMaximize[{count[a, b, c, d], 1 <= a <= b <= c <= d <= 121}, {a, b, c, d}, Integers, 
 MaxIterations -> 1000]

{4., {a -> 1, b -> 3}}
{13., {a -> 1, b -> 3, c -> 9}}
{40., {a -> 1, b -> 3, c -> 9, d -> 27}}

That should be enough to implement an intelligent solution that scales as needed.

Answer 2

This is verification of answer: I will type code in am:

(*the weights*)
r = PowerRange[81, 1, 1/3];  
(*generate possible positive weighings*)
tu[n_] := Cases[Tuples[{-1, 0, 1}, n], {1, ___}]
w = PadLeft[Catenate[tu /@ Range[5]]];
(*the weighings and the sum*)
ans = {##, Style[{##}.r, Red, Bold]} & @@@ w;
(*presentation*)
tf = TableForm[#, TableHeadings -> {None, r~Join~{"Sum"}}] & /@ 
   Partition[ans, 11];
Grid[Partition[tf~Join~{""}, 4]]