Any octahedron with randomly placed digits 1 - 8 can be oriented so the 1 is on top, and we can consider the three faces adjacent to that one starting with the highest numbered and proceding left to right (counterclockwise seen from the top). Also, mirror images are not counted, as the probability is the same for those, by requiring the number to the right of the highest, immediately below the top face, to be higher than the one to the left. There are 840 equally likely number placements (7!/3!), 10 of which satisfy the criterion looked for in the probability.  Those 10 are shown here:

1

5 4 3

 7 6 8

2

1

5 4 3

 8 6 7

2

1

6 4 3

 2 7 8

5

1

6 5 3

 2 7 8

4

1

7 4 3

 2 6 5

8

1

7 5 4

 3 8 2

6

1

7 6 4

 3 8 2

5

1

7 6 5

 4 2 3

8

1

7 6 5

 4 3 2

8

1

7 6 3

 4 8 5

2

10 840 0.01190476190

The probability thus is 10/840 = 1/84 ~= 0.01190476190.

DefDbl A-Z

Dim crlf$, adj$(7), good, o$

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

 DoEvents

 

'    1

' 2  4  6

'   3  5  7

'      8

 adj$(1) = "246"

 adj$(2) = "37"

 adj$(3) = "48"

 adj$(4) = "5"

 adj$(5) = "68"

 adj$(6) = "7"

 adj$(7) = "8"

 

 

 remain$ = "2345678": h$ = remain$

 Do

  o$ = "1" + remain$

  If Mid(o$, 2, 1) > Mid(o$, 4, 1) And Mid(o$, 2, 1) > Mid(o$, 6, 1) Then

   If Mid(o$, 4, 1) > Mid(o$, 6, 1) Then

    good = 1

    For i = 1 To 7

      checkFace i

    Next

    If good Then

      goodct = goodct + 1

      Text1.Text = Text1.Text & Mid(o$, 1, 1) & crlf

      Text1.Text = Text1.Text & Mid(o$, 2, 1) & " " & Mid(o$, 4, 1) & " " & Mid(o$, 6, 1) & crlf

      Text1.Text = Text1.Text & " " & Mid(o$, 3, 1) & " " & Mid(o$, 5, 1) & " " & Mid(o$, 7, 1) & crlf

      Text1.Text = Text1.Text & Mid(o$, 8, 1) & crlf & crlf

    End If

    ct = ct + 1

   End If

  End If

  permute remain$

 Loop Until remain$ = h$

 Text1.Text = Text1.Text & goodct & Str(ct) & mform(goodct / ct, " 0.00000000000") & crlf

End Sub

Sub checkFace(wh)

  For i = 1 To Len(adj$(wh))

    wh2 = Val(Mid(adj$(wh), i, 1))

    v1 = Val(Mid(o$, wh, 1))

    v2 = Val(Mid(o$, wh2, 1))

    diff = Abs(v2 - v1)

    If diff = 1 Or diff = 7 Then good = 0: Exit For

  Next

End Sub