The numbers 1, 2, 3, 4, 5, 6, 7, 8, 9 and 10 are randomly written on the faces of a regular dodecahedron so that each face contains a different number.
Find the probability, in the form M/N, that no two consecutive numbers are written on faces that share an edge (10 and 1 are considered to be consecutive).
We can assume that one of the blank faces is on top. The probabilities will be the same regardless of which of the two blank faces is on top.
The remaining 11 faces are permuted as a string with the ascii values representing the numbers, so that 10 occupies only one byte; the other blank is ascii 32 decimal -- larger than any of the actual numbers represented.
To speed processing, evaluation of hit or miss takes place only in the dodecahedron's orientation such that position 1 of the string (the first of five in the top row surrounding the top face) is the lowest numbered (counting the blank as 32) within that ring of five, and the face to the right of that is lower in value than the face to the left of the first.
The unreduced denominator, then is 11! / 5 / 2 = 39916800 / 10 and the answer is
8456/3991680 = 151/71280 ~= 0.002118406285072952 or about 1 in 472.
DefDbl A-Z
Dim crlf$, faces$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
faces$ = " " ' only one blank as a blank is assumed on top
For i = 1 To 10
faces = faces + Chr$(i)
Next
h$ = faces
Do
If Mid(faces, 1, 1) < Mid(faces, 2, 1) And Mid(faces, 1, 1) < Mid(faces, 3, 1) And Mid(faces, 1, 1) < Mid(faces, 4, 1) And Mid(faces, 1, 1) < Mid(faces, 5, 1) Then
If Mid(faces, 2, 1) < Mid(faces, 5, 1) Then
good = 1
For i = 1 To 4
If check(i, i + 1) = 0 Then good = 0: Exit For
Next
If check(1, 5) = 0 Then good = 0
For i = 6 To 9
If check(i, i + 1) = 0 Then good = 0: Exit For
Next
If check(10, 6) = 0 Then good = 0
If good Then
For i = 1 To 5
j = i + 5
If check(i, j) = 0 Then good = 0: Exit For
j = i + 4
If j < 6 Then j = 10
If check(i, j) = 0 Then good = 0: Exit For
Next
For i = 6 To 10
If check(i, 11) = 0 Then good = 0: Exit For
Next
If good Then
goodct = goodct + 1
q = goodct / 100
If q = Int(q) Then
For i = 1 To 5
If Mid(faces, i, 1) = " " Then
Text1.Text = Text1.Text & " -"
Else
Text1.Text = Text1.Text & mform(Asc(Mid(faces, i, 1)), "#0") & " "
End If
Next
Text1.Text = Text1.Text & crlf & " "
For i = 6 To 10
If Mid(faces, i, 1) = " " Then
Text1.Text = Text1.Text & " -"
Else
Text1.Text = Text1.Text & " " & mform(Asc(Mid(faces, i, 1)), "#0")
End If
Next
Text1.Text = Text1.Text & crlf
If Mid(faces, i, 1) = " " Then
Text1.Text = Text1.Text & " -" & crlf & crlf
Else
Text1.Text = Text1.Text & " " & Asc(Mid(faces, 11, 1)) & crlf & crlf
End If
End If
End If
End If
totct = totct + 1
DoEvents
End If
End If
DoEvents
permute faces
Loop Until faces = h
Text1.Text = Text1.Text & crlf & goodct & Str(totct) & " done"
End Sub
Function check(a, b)
If Mid(faces, a, 1) = " " Or Mid(faces, b, 1) = " " Then check = 1: Exit Function
x = Asc(Mid(faces, a, 1))
y = Asc(Mid(faces, b, 1))
If Abs(x - y) = 1 Then check = 0: Exit Function
If Abs(x - y) = 9 Then check = 0 Else check = 1
End Function
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
showing a sampling of every 100th success (hit):
Remember that every top face is blank and there's another blank besides (the additional blank is shown as a hyphen):
1 3 5 8 6
7 10 - 4 9
2
1 3 5 10 -
6 9 7 4 8
2
1 3 6 8 4
9 - 2 10 7
5
1 3 7 4 6
8 10 2 9 -
5
1 3 7 10 6
5 9 4 8 -
2
1 3 8 4 9
7 10 6 - 5
2
1 3 8 10 5
9 6 4 - 7
2
1 3 9 4 8
- 5 7 2 6
10
1 3 10 4 6
7 5 8 - 9
2
1 3 10 7 4
8 5 - 9 6
2
1 3 - 4 9
8 5 7 2 6
10
1 4 2 5 9
8 10 7 3 6
-
1 4 2 9 7
6 10 5 - 3
8
1 4 6 3 8
9 2 10 5 -
7
1 4 7 3 9
6 2 10 5 -
8
1 4 8 3 5
9 2 6 10 7
-
1 4 9 2 7
8 - 6 10 5
3
1 4 10 3 7
6 8 5 9 -
2
1 4 - 3 8
9 7 5 10 6
2
1 5 2 9 -
3 7 4 6 8
10
1 5 3 10 8
7 - 6 2 4
9
1 5 7 4 9
- 10 2 6 3
8
1 5 8 4 6
9 3 10 2 -
7
1 5 9 3 6
8 2 7 - 4
10
1 5 10 2 9
8 3 7 4 6
-
1 5 - 2 9
8 3 7 4 6
10
1 6 2 8 -
9 4 10 3 5
7
1 6 3 - 9
8 10 5 7 4
2
1 6 4 10 7
9 2 8 3 -
5
1 6 8 4 9
3 - 10 2 5
7
1 6 10 3 7
8 4 - 9 5
2
1 6 - 3 9
8 4 10 7 5
2
1 7 3 5 9
4 - 8 2 6
10
1 7 5 2 9
3 - 10 4 6
8
1 7 10 3 -
9 5 8 6 4
2
1 8 2 7 9
6 4 - 5 3
10
1 8 5 2 9
3 10 7 4 6
-
1 8 10 3 9
6 2 5 7 4
-
1 9 4 8 -
5 7 2 6 3
10
2 4 6 8 10
7 1 3 - 5
9
2 4 6 - 5
9 1 8 10 7
3
2 4 7 9 6
8 1 5 - 10
3
2 4 8 6 10
9 1 - 3 5
7
2 4 9 3 10
7 - 6 8 5
1
2 4 9 7 10
8 1 5 - 6
3
2 4 10 6 8
7 - 3 1 5
9
2 4 - 7 5
10 6 9 1 8
3
2 5 3 8 6
7 10 - 1 9
4
2 5 7 3 8
10 - 9 1 4
6
2 5 8 3 10
9 1 6 - 7
4
2 5 9 4 6
10 7 - 1 8
3
2 5 10 6 8
9 - 3 1 4
7
2 6 3 5 9
10 8 1 7 4
-
2 6 4 9 -
8 10 7 1 5
3
2 6 8 5 10
4 - 1 3 7
9
2 6 9 5 8
4 1 3 10 -
7
2 6 10 5 7
4 8 3 9 -
1
2 7 3 5 9
4 10 8 1 6
-
2 7 4 6 -
5 10 8 1 9
3
2 7 5 8 -
9 1 3 10 4
6
2 7 9 5 10
4 1 - 3 6
8
2 7 - 5 9
10 4 1 3 6
8
2 8 4 9 -
10 6 1 7 5
3
2 8 6 -10
5 3 1 4 7
9
2 9 4 6 10
5 7 1 - 8
3
2 9 6 4 -
7 3 1 8 10
5
2 10 3 9 -
5 8 6 4 7
1
3 5 7 4 10
8 1 9 2 -
6
3 5 8 6 10
1 - 2 4 7
9
3 5 10 4 7
1 - 8 2 9
6
3 5 10 - 6
8 2 7 9 1
4
3 6 4 9 -
8 10 2 7 1
5
3 6 9 4 10
8 1 7 2 -
5
3 6 10 7 9
8 4 2 5 1
-
3 7 5 10 8
1 - 2 4 6
9
3 7 10 5 9
1 - 8 2 6
4
3 8 5 7 9
- 10 2 4 1
6
3 8 10 7 -
1 5 2 4 6
9
3 9 7 5 -
1 4 10 2 6
8
4 6 9 5 8
2 - 1 3 10
7
4 7 5 - 9
10 3 1 6 2
8
4 8 6 -10
1 3 9 2 7
5
4 10 6 9 -
8 3 1 7 2
5
5 9 6 8 -
2 4 1 3 10
7
8456 3991680 done
|
|
Posted by Charlie
on 2016-10-20 15:13:11 |
solution for puzzle as originally given
