Show that a 6x6 square tiled with dominoes will always have at least one fault line.

(In reply to ...through the most grievous faults by Charlie)

In VB 5.0:

Dim board(6, 6), ct, fct, hst$(2000), rptCt
Private Sub cmdStart_Click()
Open "domfault.txt" For Output As #2
board(1, 1) = 1: board(1, 2) = 1

place 2, 1, 3

Print ct, fct

Close

 

End Sub

Sub place(domNo, row, col)
 If board(row, col) = 0 Then
   board(row, col) = domNo
   If col < 6 Then
     If board(row, col + 1) = 0 Then
       board(row, col + 1) = domNo

       GoSub checkRest
     
       board(row, col + 1) = 0
     End If
   End If
   If row < 6 Then
     If board(row + 1, col) = 0 Then
       board(row + 1, col) = domNo

       GoSub checkRest
    
       board(row + 1, col) = 0
     End If

   End If
   board(row, col) = 0
 End If
 Exit Sub

checkRest:
  If domNo = 18 Then
    h1$ = "": ttbl$ = ""
    For r = 1 To 6
     For c = 6 To 1 Step -1
       p2 = board(r, c): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h1$ = h1$ + v$
     Next c
    Next r
  
    h2$ = "": ttbl$ = ""
    For r = 6 To 1 Step -1
     For c = 1 To 6
       p2 = board(r, c): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h2$ = h2$ + v$
     Next c
    Next r

    h3$ = "": ttbl$ = ""
    For r = 6 To 1 Step -1
     For c = 6 To 1 Step -1
       p2 = board(r, c): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h3$ = h3$ + v$
     Next c
    Next r

    h4$ = "": ttbl$ = ""
    For r = 1 To 6
     For c = 6 To 1 Step -1
       p2 = board(c, r): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h4$ = h4$ + v$
     Next c
    Next r
 
    h5$ = "": ttbl$ = ""
    For r = 6 To 1 Step -1
     For c = 1 To 6
       p2 = board(c, r): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h5$ = h5$ + v$
     Next c
    Next r

    h6$ = "": ttbl$ = ""
    For r = 6 To 1 Step -1
     For c = 6 To 1 Step -1
       p2 = board(c, r): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h6$ = h6$ + v$
     Next c
    Next r

    h7$ = "": ttbl$ = ""
    For r = 1 To 6
     For c = 1 To 6
       p2 = board(c, r): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h7$ = h7$ + v$
     Next c
    Next r
 
    h8$ = "": ttbl$ = ""
    For r = 1 To 6
     For c = 1 To 6
       p2 = board(r, c): p$ = Mid$("123456789abcdefghij", p2, 1)
       If InStr(ttbl$, p$) Then
        v$ = Mid$("123456789abcdefghij", InStr(ttbl$, p$), 1)
       Else
        v$ = Mid$("123456789abcdefghij", (Len(ttbl$) + 1), 1)
        ttbl$ = ttbl$ + p$
       End If
       h8$ = h8$ + v$
     Next c
    Next r

    good = 1
    For i = 1 To ct
     If h1$ = hst$(i) Then good = 0: Exit For
     If h2$ = hst$(i) Then good = 0: Exit For
     If h3$ = hst$(i) Then good = 0: Exit For
     If h4$ = hst$(i) Then good = 0: Exit For
     If h5$ = hst$(i) Then good = 0: Exit For
     If h6$ = hst$(i) Then good = 0: Exit For
     If h7$ = hst$(i) Then good = 0: Exit For
    Next

    If good Then
      ct = ct + 1
      hst$(ct) = h8$
      ReDim cfault(6): cf = 0
      For c = 1 To 5
        cfault(c) = c
        For r = 1 To 6
         If board(r, c) = board(r, c + 1) Then cfault(c) = 0
        Next
        If cfault(c) Then cf = 1
      Next
      ReDim rfault(6): rf = 0
      For r = 1 To 5
        rfault(r) = r
        For c = 1 To 6
         If board(r, c) = board(r + 1, c) Then rfault(r) = 0
        Next
        If rfault(r) Then rf = 1
      Next

      If cf Or rf Then fct = fct + 1
    
       
      If cf Then
        For r = 1 To 5
         If cfault(r) Then Print #2, "|"; Else Print #2, " ";
        Next
        Print #2,
      End If
      For r = 1 To 6
        For c = 1 To 6
         Print #2, Mid$("123456789abcdefghijklmnopqrstuvwxyz", board(r, c), 1);
        Next
        If rfault(r) Then Print #2, "_";
        Print #2,
      Next
      Print #2,
    Else
     rptCt = rptCt + 1
    End If
  Else
    r = row: c = col
    Do
      If c = 6 Then
        r = r + 1: c = 1
      Else
        r = r: c = c + 1
      End If
    Loop Until r > 6 Or board(r, c) = 0
    If r <= 6 Then
      place domNo + 1, r, c
    End If
  End If

 Return
End Sub

Posted by Charlie on 2007-03-23 11:32:10