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).
Using the numbers 1 through 12 instead of 1 through 10 and basically the same program, assuming the digit 1 is placed on the top face, the other faces are permuted.
I get 5600/3991680 = 5/3564 ~= 0.00140291806958474.
A sample of every 100th hit:
In each instance a 1 is assumed at the top:
3 5 7 10 8
9 11 2 6 12
4
3 5 8 4 7
9 11 6 10 12
2
3 5 8 10 12
9 2 6 4 7
11
3 5 9 6 11
12 7 2 4 8
10
3 5 9 12 8
7 11 6 4 10
2
3 5 10 7 11
12 8 4 2 9
6
3 5 11 4 8
12 9 7 10 6
2
3 5 11 8 10
9 7 4 12 6
2
3 5 12 7 11
8 10 4 9 6
2
3 6 4 7 11
12 8 10 5 9
2
3 6 4 11 7
8 12 9 2 10
5
3 6 8 5 9
10 4 11 7 12
2
3 6 9 5 8
12 4 11 2 10
7
3 6 10 5 7
11 8 2 12 9
4
3 6 11 5 8
10 4 9 2 12
7
3 6 12 7 10
8 4 9 2 5
11
3 7 4 10 12
9 2 6 8 5
11
3 7 5 11 9
12 10 8 4 6
2
3 7 9 6 10
11 4 12 8 5
2
3 7 10 5 11
9 12 8 2 6
4
3 7 11 4 12
10 5 9 6 8
2
3 7 12 4 11
9 5 10 8 6
2
3 8 4 7 11
6 10 2 5 9
12
3 8 5 12 9
6 2 10 7 11
4
3 8 6 11 9
10 12 4 7 5
2
3 8 10 7 11
12 6 4 2 5
9
3 8 12 5 11
10 2 7 9 6
4
3 9 4 8 12
7 11 6 10 5
2
3 9 6 8 12
5 11 2 4 10
7
3 9 11 5 12
6 2 7 10 8
4
3 10 4 8 11
12 6 2 5 7
9
3 10 7 4 11
12 5 9 6 8
2
3 10 12 9 11
5 8 6 4 7
2
3 11 9 6 12
5 7 2 4 8
10
4 6 8 12 7
9 11 3 10 2
5
4 6 9 11 8
12 2 7 3 10
5
4 6 10 12 9
11 2 8 3 7
5
4 6 11 9 12
10 2 7 3 8
5
4 7 5 9 11
2 10 12 3 6
8
4 7 9 5 10
12 3 11 8 2
6
4 7 10 6 11
9 3 12 8 2
5
4 7 11 6 12
10 3 9 2 8
5
4 8 5 7 11
12 10 3 9 2
6
4 8 10 6 9
12 5 3 11 2
7
4 8 12 6 10
11 2 9 3 7
5
4 9 6 12 10
11 3 8 2 7
5
4 9 11 7 12
2 6 3 5 8
10
4 10 6 9 11
8 12 3 7 2
5
4 11 7 5 12
2 9 3 8 10
6
5 7 10 6 9
12 2 4 11 3
8
5 7 12 9 11
2 4 6 3 8
10
5 8 11 6 12
2 4 9 3 10
7
5 9 11 6 12
7 4 2 8 3
10
5 10 12 7 11
8 3 9 4 2
6
6 9 11 7 10
12 3 5 2 4
8
7 11 8 10 12
5 3 6 4 2
9
5600 3991680 done
DefDbl A-Z
Dim crlf$, faces$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
faces$ = ""
For i = 2 To 12
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
If InStr(faces, Chr(2)) > 5 Then
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 ' if good
End If ' if 2 is not on top row
totct = totct + 1
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) = 11 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
|
|
Posted by Charlie
on 2016-10-20 15:30:10 |
For 1 - 12
