Create a 3x3 matrix such that:
(i) Only 9 distinct primes are used.
(ii) All the 12 absolute differences between contiguous elements
are distinct even integers.
(iii)The highest prime in your matrix is as low as possible (hint: below 70).
Inspired by Jean Brette's puzzle.
It was apparent that 2 could not be one of the primes, as all its differences would be odd. That meant that the nine primes could be any 9 of the 19 odd primes under 70. That's why the program below allows for choosing 9 out of what had originally been saved as 19 odd primes. That was changed as it was discovered that solutions existed using only the first 9 odd primes--no selection needed--but the FOR...NEXT loops were left as-is, though only one value would be used in each instance.
To make the progress run faster, and for general clarity, only those matrices with the top left corner having the smallest value for any of the corners and the top right corner being smaller than the bottom left are considered. This eliminates rotations and reflections.
The possible arrangements, each with a row showing all 12 absolute differences, are:
3 17 7
23 5 29
19 11 13
14 10 18 24 8 2 20 4 12 6 22 16
3 23 7
17 5 29
13 11 19
20 16 12 24 2 8 14 4 18 6 22 10
3 23 13
17 5 29
19 11 7
20 10 12 24 8 4 14 2 18 6 16 22
5 29 7
23 3 13
11 19 17
24 22 20 10 8 2 18 12 26 16 6 4
5 29 7
23 3 17
11 19 13
24 22 20 14 8 6 18 12 26 16 10 4
5 29 7
23 3 19
13 17 11
24 22 20 16 4 6 18 10 26 14 12 8
5 29 7
23 3 19
17 13 11
24 22 20 16 4 2 18 6 26 10 12 8
7 5 17
11 29 3
19 13 23
2 12 18 26 6 10 4 8 24 16 14 20
7 11 13
17 29 5
23 3 19
4 2 12 24 20 16 10 6 18 26 8 14
11 13 17
3 19 7
23 5 29
2 4 16 12 18 24 8 20 6 14 10 22
11 13 17
3 29 7
23 5 19
2 4 26 22 18 14 8 20 16 24 10 12
11 17 19
7 29 5
23 3 13
6 2 22 24 20 10 4 16 12 26 14 8
DefDbl A-Z
Dim crlf$, prime(9)
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
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
For i = 0 To 9
p = nxtprm(p)
If p > 2 And p < 100 Then
Text1.Text = Text1.Text & Str(p)
prime(i) = p: prmct = i
End If
Next
Text1.Text = Text1.Text & crlf & nxtprm(p) & crlf
For a = 1 To 1
For b = a + 1 To 2
For c = b + 1 To 3
For d = c + 1 To 4
For e = d + 1 To 5
For f = e + 1 To 6
For g = f + 1 To 7
For h = g + 1 To 8
For i = h + 1 To 9
s$ = Chr(prime(a)) + Chr(prime(b)) + Chr(prime(c)) + Chr(prime(d)) + Chr(prime(e)) + Chr(prime(f)) + Chr(prime(g)) + Chr(prime(h)) + Chr(prime(i))
hld$ = s
Do
If Mid(s, 1, 1) < Mid(s, 3, 1) And Mid(s, 1, 1) < Mid(s, 7, 1) And Mid(s, 1, 1) < Mid(s, 9, 1) Then
If Mid(s, 3, 1) < Mid(s, 7, 1) Then
good = 1
did$ = ""
For row = 0 To 2
For col = 1 To 2
diff = Abs(Asc(Mid(s, 3 * row + col, 1)) - Asc(Mid(s, 3 * row + col + 1, 1)))
If InStr(did, Chr(diff)) > 0 Then good = 0: Exit For
did = did + Chr(diff)
DoEvents
Next
If good = 0 Then Exit For
Next
If good Then
For col = 1 To 3
For row = 0 To 1
diff = Abs(Asc(Mid(s, 3 * row + col, 1)) - Asc(Mid(s, 3 * (row + 1) + col, 1)))
If InStr(did, Chr(diff)) > 0 Then good = 0: Exit For
did = did + Chr(diff)
DoEvents
Next
If good = 0 Then Exit For
Next
If good Then
For row = 0 To 2
For col = 1 To 3
Text1.Text = Text1.Text & mform(Asc(Mid(s, 3 * row + col, 1)), "##0")
Next
Text1.Text = Text1.Text & crlf
Next
Text1.Text = Text1.Text & crlf
For j = 1 To 12
Text1.Text = Text1.Text & mform(Asc(Mid(did, j, 1)), "##0")
Next
Text1.Text = Text1.Text & crlf & crlf & crlf
End If
End If
End If
End If
permute s
Loop Until s = hld
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub
Function prmdiv(num)
Dim n, dv, q
If num = 1 Then prmdiv = 1: Exit Function
n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
dv = 2: GoSub DivideIt
dv = 3: GoSub DivideIt
dv = 5: GoSub DivideIt
dv = 7
Do Until dv > limit
GoSub DivideIt: dv = dv + 4 '11
GoSub DivideIt: dv = dv + 2 '13
GoSub DivideIt: dv = dv + 4 '17
GoSub DivideIt: dv = dv + 2 '19
GoSub DivideIt: dv = dv + 4 '23
GoSub DivideIt: dv = dv + 6 '29
GoSub DivideIt: dv = dv + 2 '31
GoSub DivideIt: dv = dv + 6 '37
Loop
If n > 1 Then prmdiv = n
Exit Function
DivideIt:
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
prmdiv = dv: Exit Function
Else
Exit Do
End If
Loop
Return
End Function
Function nxtprm(x)
Dim n
n = x + 1
While prmdiv(n) < n Or n < 2
n = n + 1
Wend
nxtprm = n
End Function
|
|
Posted by Charlie
on 2019-02-01 16:26:57 |
computer-aided solution
