Five pumpkins are weighed two at a time in all possible combinations. The results of the weighings gives nine different values, similar to the
second Pumpkins puzzle.
But this time the repeated weight is omitted from the list. The eight distinct weights are 24, 28, 30, 34, 36, 38, 44, and 50 kilograms.
Determine the weights of the pumpkins and the omitted weight.
No two pumpkins weigh the same amount, as, if that were the case, there would be at least four total weights that would be duplicated. The two equal weighings must then be among four pumpkins. As there are 5 pumpkins, one of them must not be involved in the two equal weighings, and therefore be involved with four of the shown weighing totals, and by subtraction can be used to find the other four weights. The program goes through all the possibilities for the weight that's not involved in the duplicate total, and for each of those, all the combinations of the other 7 given weights to see which set of other pumpkins produces the given set of weighings, including the duplicate pair that doesn't match any of the shown totals.
DefDbl AZ
Dim crlf$, wtTot As Variant, notListed(2), nListCt
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
wtTot = Array(0, 24, 28, 30, 34, 36, 38, 44, 50)
For p0 = 1 To 35
ReDim used(100)
used(1) = p0
For a = 1 To 5
used(2) = wtTot(a)  p0
For b = a + 1 To 6
used(3) = wtTot(b)  p0
For c = b + 1 To 7
used(4) = wtTot(c)  p0
For d = c + 1 To 8
used(5) = wtTot(d)  p0
nListCt = 0
ReDim listUsed(8)
good = 1
For i = 1 To 4
For j = i + 1 To 5
t = used(i) + used(j)
hit = 0
For ii = 1 To 8
If wtTot(ii) = t Then
If listUsed(ii) = 1 Then good = 0: Exit For
listUsed(ii) = 1
hit = 1: Exit For
End If
Next
If good = 0 Then Exit For
If hit = 0 Then
nListCt = nListCt + 1
If nListCt > 2 Then good = 0: Exit For
notListed(nListCt) = t
If nListCt = 2 And t <> notListed(1) Then good = 0: Exit For
End If
Next
If good = 0 Then Exit For
Next
If good Then
For ii = 1 To 5
Text1.Text = Text1.Text & Str(used(ii))
Next
Text1.Text = Text1.Text & " " & notListed(1) & crlf
End If
Next
Next
Next
Next
Next
Text1.Text = Text1.Text & crlf & " done"
End Sub
It finds 11, 13, 17, 23, 27 as the individual pumpkins' weights and 40 as the total that came up twice (all in kg of course).

Posted by Charlie
on 20160106 11:25:21 