0
$\begingroup$

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?

Improve this question
$\endgroup$
  • 3
    $\begingroup$ Notice that this question isn't really on topic as this site isn't about solving abstract puzzles but about e.g. implementation of solutions in Mathematica. Though the community is very forgiving when it comes to interesting questions. Just don't be surprised if next time you will get "what have you done / this is off topic here" comments :) Even this question may end up being closed if it won't receive much attention. $\endgroup$ – Kuba♦ Feb 26 '17 at 11:57
  • 2
    $\begingroup$ Solution on Puzzling.SE: puzzling.stackexchange.com/q/186 (spoiler, obviously) $\endgroup$ – Mr.Wizard Feb 26 '17 at 12:03
  • 3
    $\begingroup$ I am honestly not sure what you are seeking. Typically one would develop an "on paper" solution and then implement an algorithm in programming, but here there is little to implement unless one wishes to prove the solution by brute force. What kind of input are you hoping to give Mathematica for a puzzle like this? $\endgroup$ – Mr.Wizard Feb 26 '17 at 12:09
  • 1
    $\begingroup$ @Kuba I have to agree with you. This site is about what you have tried and how can something be possibly done, if what you have tried is not working. Any question statement of this sort is not in the spirit of the site. And as Mr.Wizard pointed this pattern of posing question statements will not help you to either evolve at solving puzzles or with the Mathematica way of programming itself. What will help is if you try yourself. $\endgroup$ – Ali Hashmi Feb 26 '17 at 13:42
  • 1
    $\begingroup$ @ubpdqn Sadly no, I was not sharp enough to realize the pun as I wrote it. My choice of words was probably subconsciously influenced by the context. $\endgroup$ – Mr.Wizard Feb 27 '17 at 13:22
4
$\begingroup$

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.

Improve this answer
$\endgroup$
  • $\begingroup$ Wow, it almost took a minute to compute the answer. @mr.wizard you are not God but you sure are saviour. $\endgroup$ – Jawad_Mansoor Feb 26 '17 at 13:01
  • $\begingroup$ Is there something that can save time as well? It almost took a minute on my core two 2.7+ghz $\endgroup$ – Jawad_Mansoor Feb 26 '17 at 13:01
  • $\begingroup$ @Jawad_Mansoor Hey like it said it is brute force; no intelligence behind the design, just figure out all sums and count them up. I am glad you found this satisfying, and hopefully you find it possible to learn from this example as well. $\endgroup$ – Mr.Wizard Feb 26 '17 at 13:03
  • $\begingroup$ I have learnt a lot in very short time. Thanks to all the supportive people on the community. And it is so interesting all the same time. I will learn elements in your answer above as well, and try to understand them if I can't I will either ask a new question or comment again. Thanks again. $\endgroup$ – Jawad_Mansoor Feb 26 '17 at 13:06
  • 1
    $\begingroup$ Apologizing for the ruckus I created yesterday which could have been avoided if had been careful in coding. Mr. Wizard's code to use brute-force is hundred 100# accurate and working but the any of the lines 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] would not work alone you need to define enum and count first. $\endgroup$ – Jawad_Mansoor Feb 27 '17 at 11:46
4
$\begingroup$

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]]

enter image description here

Improve this answer
$\endgroup$
  • $\begingroup$ Hää? Mathematica on Android?? $\endgroup$ – LLlAMnYP Feb 26 '17 at 15:12
  • $\begingroup$ @ubpdqn That is complicated for a newbie like me. However the grid in the end, man that is marvelous. Not only I am accepting your answer but also giving you a rate up because you have gone length to get the answer. I am extremely thankful as this is going to really help me in learning new commands. One problem however is that it does not begin with 1 in my computer as yours here. $\endgroup$ – Jawad_Mansoor Feb 26 '17 at 16:37
  • $\begingroup$ @LLlAMnYP Wolfram Cloud on iPhone: glitchy in my experience $\endgroup$ – ubpdqn Feb 26 '17 at 23:21
  • $\begingroup$ @Jawad_Mansoor This is just a verification of proposed solution. Ternay numbers natural fit: all numbers are-1,0,1 from a multiple of 3. So, Tuples just produces possible arrangements of weighings using specified weights.Cases selects postive ones. The rest is window dressing.The best way I have learned Mathematica is to play. Good luck :) $\endgroup$ – ubpdqn Feb 26 '17 at 23:25
  • $\begingroup$ @ubpdqn thanks man that was beautiful. :) By the way can you tell me what was the problem in the old code which prevented it to begin from 1 (it started from 2) tu[n_] := Cases[Tuples[{-1, 0, 1}, n], {1, __}] r = PowerRange[1, 81, 3] p = tu /@ Range[5]; pad = PadLeft[Catenate[p]]; res = {##, {##}.Reverse[r]} & @@@ pad; TableForm[res] $\endgroup$ – Jawad_Mansoor Feb 27 '17 at 3:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.