I was shown a 4x4 matrix whose entries are distinct positive integers below
32, whose row sums are the same (say S), and whose column products are the same (P).
I believe that there are numerous solutions fitting the above definition, and challenge the solvers to find as many as possible - the values of S and P are up to you.
Rem : It is possible to find a solution or two without a computer, but listing all possible solutions is IMHO a hard nut even for a software-based approach.
(In reply to
computer solution by Charlie)
Thirteen of these use only numbers from 1 - 27:
1 2 18 24 45
8 15 10 12
20 16 4 5
27 9 6 3
4320
1 2 18 24 45
8 15 10 12
20 16 6 3
27 9 4 5
4320
1 4 16 24 45
8 10 15 12
20 18 2 5
27 6 9 3
4320
1 2 15 27 45
9 12 16 8
20 18 3 4
24 10 6 5
4320
1 2 18 24 45
10 12 8 15
16 20 5 4
27 9 6 3
4320
1 2 18 24 45
10 12 8 15
16 20 6 3
27 9 5 4
4320
1 8 12 24 45
10 18 2 15
16 5 20 4
27 6 9 3
4320
1 8 12 24 45
10 18 2 15
16 6 20 3
27 5 9 4
4320
1 9 15 20 45
10 5 24 6
16 8 3 18
27 12 4 2
4320
1 9 15 20 45
10 5 12 18
16 24 3 2
27 4 8 6
4320
1 9 15 20 45
10 5 18 12
16 24 2 3
27 4 8 6
4320
1 9 15 20 45
10 8 24 3
16 5 6 18
27 12 2 4
4320
1 9 15 20 45
10 24 8 3
16 5 18 6
27 4 2 12
4320
DefDbl A-Z
Dim crlf$, colprod, rowtot, grid(4, 4), used(100), thiscol(4), maxnum, upperleft
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
Open "equal products and sums.txt" For Output As #2
maxnum = 27
For upperleft = 1 To maxnum
Text1.Text = Text1.Text & upperleft & crlf
used(upperleft) = 1
grid(1, 1) = upperleft: colprod = upperleft
chooseFor 2, 1
used(upperleft) = 0
Next
Text1.Text = Text1.Text & crlf & " done"
Close 2
End Sub
Sub chooseFor(row, col)
DoEvents
st = upperleft + 1
If col = 1 Then
st = grid(row - 1, col) + 1
Else
If row = 1 Then
st = grid(row, col - 1) + 1
End If
End If
If row = 3 And col = 1 Then Text2.Text = grid(1, 1) & Str(grid(2, 1)) & crlf
For choice = st To maxnum
If used(choice) = 0 Then
used(choice) = 1
grid(row, col) = choice
If col = 1 Then colprod = colprod * choice
good = 1
If col > 1 Then
If row = 1 Then
thiscol(col) = choice
Else
thiscol(col) = thiscol(col) * choice
End If
q = Int(colprod / thiscol(col))
r = colprod - q * thiscol(col)
If r > 0 Then good = 0
If row = 4 And thiscol(col) <> colprod Then good = 0
End If
If good Then
If col = 4 And row = 1 Then
rowtot = grid(1, 1) + grid(1, 2) + grid(1, 3) + grid(1, 4)
r2 = rowtot - grid(2, 1) - grid(2, 2) - grid(2, 3)
r3 = rowtot - grid(3, 1) - grid(3, 2) - grid(3, 3)
r4 = rowtot - grid(4, 1) - grid(4, 2) - grid(4, 3)
If choice * r2 * r3 * r4 <> colprod Then good = 0
If r2 < upperleft Or r3 < upperleft Or r4 < upperleft Then good = 0
If good Then
If r2 > maxnum Or r3 > maxnum Or r4 > maxnum Then good = 0
If good Then
If used(r2) Or used(r3) Or used(r4) Then good = 0
If r2 = r3 Or r3 = r4 Or r2 = r4 Then good = 0
If good Then
grid(2, 4) = r2
grid(3, 4) = r3
grid(4, 4) = r4
For r = 1 To 4
For c = 1 To 4
Text1.Text = Text1.Text & Str(grid(r, c))
Print #2, mform(grid(r, c), "##0");
Next
If r = 1 Then
Text1.Text = Text1.Text & " " & mform(rowtot, "###0") & crlf
Print #2, " "; mform(rowtot, "###0")
Else
Text1.Text = Text1.Text & crlf
Print #2,
End If
Next
Text1.Text = Text1.Text & colprod & crlf
Text1.Text = Text1.Text & crlf
Print #2, colprod
Print #2,
End If
End If
End If
Else
r = row: c = col
r = r + 1
If r > 4 Then
c = c + 1: r = 1
End If
chooseFor r, c
End If
End If
If col = 1 Then colprod = colprod / choice Else thiscol(col) = thiscol(col) / choice
used(choice) = 0
End If
Next
End Sub
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
|
|
Posted by Charlie
on 2016-02-17 20:19:11 |
re: computer solution -- a specific subset and the program
