Much like the
third Pumpkins puzzle six pumpkins, each having a different weight, are weighed two at a time in all 15 sets of two. This time exactly four pairs of duplicate values occurred. Those four values are 60, 100, 110, and 120 pounds.
How much did each individual pumpkin weigh?
The following set of weights works:
35 45 75 85 25 15
The counts of the numbers of weighings that come out to the various totals are, by total:
40 1
50 1
60 2
70 1
80 1
90 1
100 2
110 2
120 2
130 1
160 1
The logic is based on the fact that any one of the duplicated totals involves four of the pumpkins, so in going from one of these duplicated totals to another, either two or three of the pumpkins are shared between the two totals. I chose to use 120 and 60 to base this upon.
To cover all bases I had the program choose each of the 6 possible pairs within any possibility for the 120 totals to check out as being a possible set for inclusion in the pumpkins for the totals of 60. The possibility of a third would be included in the trials of the other numbers in the 60 set.
The two chosen weights from the 120 set could possibly be one of the pair that add up to 60, if they are in the lower weight part of each of the weighings that add to 120. The other possibility is that each is part of a separate weighing each of which has a total of 60.
There's a final check for duplicate weights and proper counts for totals of 100 and 110.
DefDbl AZ
Dim crlf$, wgt(6), t1, t2, totct()
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
t1 = 120: t2 = 60
For a = 1 To Int((t1  1) / 2)
d = t1  a
wgt(1) = a: wgt(4) = d
For b = a + 1 To Int((t1  1) / 2)
c = t1  b
wgt(2) = b: wgt(3) = c
For i = 1 To 3
For j = i + 1 To 4
try wgt(i), wgt(j)
Next
Next
Next
Next
Text1.Text = Text1.Text & crlf & " done"
End Sub
Sub try(tr1, tr2)
DoEvents
If tr1 < t2 And tr2 < t2 Then
If tr1 + tr2 = t2 Then
For x = 1 To Int((t1  1) / 2)
y = t2  x
wgt(5) = x: wgt(6) = y
check
Next
Else
wgt(5) = t2  tr1: wgt(6) = t2  tr2
check
End If
End If
End Sub
Sub check()
good = 1
For i = 1 To 5
For j = i + 1 To 6
If wgt(i) = wgt(j) Then good = 0
Next
Next
If good Then
ReDim totct(600)
For i = 1 To 5
For j = i + 1 To 6
totct(wgt(i) + wgt(j)) = totct(wgt(i) + wgt(j)) + 1
Next
Next
If totct(100) <> 2 Or totct(110) <> 2 Then good = 0
If good Then
For i = 1 To 6
Text1.Text = Text1.Text & Str(wgt(i))
Next
Text1.Text = Text1.Text & crlf
For i = 1 To 600
If totct(i) > 0 Then
Text1.Text = Text1.Text & i & Str(totct(i)) & crlf
End If
Next
Text1.Text = Text1.Text & crlf
End If
End If
End Sub

Posted by Charlie
on 20160122 15:26:29 