All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Logic
Red, White, Blue and Green (Posted on 2008-01-14) Difficulty: 3 of 5
    A   B   C   D   E   F   G   H
  +---+---+---+---+---+---+---+---+
 1|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 2|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 3|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 4|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 5|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 6|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 7|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
 8|   |   |   |   |   |   |   |   |
  +---+---+---+---+---+---+---+---+
Place two reds, two whites, two blues and two greens in every row, column and long diagonal.

The following clues will help!

1. Each blue is immediately right of each green.
2. There are no reds in cells E, F, G or H; there are no blues in cells
A, B, C or D.
3. The blues are adjacent.
4. No clue needed.
5. No clue needed.
6. The pattern of colours takes the form abccdadb.
7. The pattern of colours takes the form aabcbcdd.
8. The pattern of colours takes the form abbccdad.

A. No clue needed.
B. The blues are separated by five cells.
C. There are no reds in cells 5, 6, 7 or 8.
D. No clue needed.
E. The blues are separated by six cells.
F. The whites are separated by six cells; the reds by two cells.
G. There are no reds or greens in cells 1, 2, 3 or 4.
H. The whites are separated by five cells; the greens by two cells.

This is similar to Red, White and Blue

See The Solution Submitted by Josie Faulkner    
Rating: 3.5000 (2 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
Solution computer/human collaboration | Comment 2 of 11 |

The program below doesn't work on rows 4 and 5, leaving that to be filled in by the human.  The clues included in the programming narrow the solutions down to 19. Within the program colors red, white, blue, green are kept as 1, 2, 3, 4 respectively.

Dim bd(8, 8), col$, solCt, solCtPart
Dim ctCol(4, 8) ' colors r,w,b,g; columns

Private Sub cmdStart_Click()
 col$ = ".rwbg"
 
 ' start with row 8
 x$ = "1234": h$ = x$
 Do
  CurrentX = 1: CurrentY = 1: Print x$;
  clr = Val(Mid(x$, 1, 1)): bd(8, 1) = clr: bd(8, 7) = clr: ctCol(clr, 1) = 1: ctCol(clr, 7) = 1
  clr = Val(Mid(x$, 2, 1)): bd(8, 2) = clr: bd(8, 3) = clr: ctCol(clr, 2) = 1: ctCol(clr, 3) = 1
  clr = Val(Mid(x$, 3, 1)): bd(8, 4) = clr: bd(8, 5) = clr: ctCol(clr, 4) = 1: ctCol(clr, 5) = 1
  clr = Val(Mid(x$, 4, 1)): bd(8, 6) = clr: bd(8, 8) = clr: ctCol(clr, 6) = 1: ctCol(clr, 8) = 1
 
  good = 1
  If bd(8, 3) = 1 Then good = 0
  If bd(8, 5) <> 3 Then good = 0
  If bd(8, 6) <> 2 Then good = 0
  If bd(8, 7) <> 1 And bd(8, 7) <> 4 Then good = 0
 
  If good Then
   placeRow7
  End If
  
  clr = Val(Mid(x$, 1, 1)): bd(8, 1) = clr: bd(8, 7) = clr: ctCol(clr, 1) = 0: ctCol(clr, 7) = 0
  clr = Val(Mid(x$, 2, 1)): bd(8, 2) = clr: bd(8, 3) = clr: ctCol(clr, 2) = 0: ctCol(clr, 3) = 0
  clr = Val(Mid(x$, 3, 1)): bd(8, 4) = clr: bd(8, 5) = clr: ctCol(clr, 4) = 0: ctCol(clr, 5) = 0
  clr = Val(Mid(x$, 4, 1)): bd(8, 6) = clr: bd(8, 8) = clr: ctCol(clr, 6) = 0: ctCol(clr, 8) = 0
  permute x$
 Loop Until x$ = h$
 Print solCt
End Sub
Sub placeRow7()
 x$ = "1234": h$ = x$
 Do
  CurrentX = 1: CurrentY = 2: Print x$;
  DoEvents
  clr = Val(Mid(x$, 1, 1)): bd(7, 1) = clr: bd(7, 2) = clr: ctCol(clr, 1) = ctCol(clr, 1) + 1: ctCol(clr, 2) = ctCol(clr, 2) + 1
  clr = Val(Mid(x$, 2, 1)): bd(7, 3) = clr: bd(7, 5) = clr: ctCol(clr, 3) = ctCol(clr, 3) + 1: ctCol(clr, 5) = ctCol(clr, 5) + 1
  clr = Val(Mid(x$, 3, 1)): bd(7, 4) = clr: bd(7, 6) = clr: ctCol(clr, 4) = ctCol(clr, 4) + 1: ctCol(clr, 6) = ctCol(clr, 6) + 1
  clr = Val(Mid(x$, 4, 1)): bd(7, 7) = clr: bd(7, 8) = clr: ctCol(clr, 7) = ctCol(clr, 7) + 1: ctCol(clr, 8) = ctCol(clr, 8) + 1
 
  good = 1
 
  If bd(7, 2) = 3 And bd(8, 2) = 3 Then good = 0
  If bd(7, 5) = 3 And bd(8, 5) = 3 Then good = 0
  If bd(7, 6) = 2 And bd(8, 6) = 2 Then good = 0
  If bd(7, 6) = 1 And bd(8, 6) = 1 Then good = 0
  If bd(7, 8) = 2 And bd(8, 8) = 2 Then good = 0
  If bd(7, 8) = 4 And bd(8, 8) = 4 Then good = 0
  If bd(7, 3) = 1 Then good = 0
  If bd(7, 7) <> 1 And bd(7, 7) <> 4 Then good = 0
 
  If good Then
   placeRow6
  End If
  
  clr = Val(Mid(x$, 1, 1)): bd(7, 1) = clr: bd(7, 2) = clr: ctCol(clr, 1) = ctCol(clr, 1) - 1: ctCol(clr, 2) = ctCol(clr, 2) - 1
  clr = Val(Mid(x$, 2, 1)): bd(7, 3) = clr: bd(7, 5) = clr: ctCol(clr, 3) = ctCol(clr, 3) - 1: ctCol(clr, 5) = ctCol(clr, 5) - 1
  clr = Val(Mid(x$, 3, 1)): bd(7, 4) = clr: bd(7, 6) = clr: ctCol(clr, 4) = ctCol(clr, 4) - 1: ctCol(clr, 6) = ctCol(clr, 6) - 1
  clr = Val(Mid(x$, 4, 1)): bd(7, 7) = clr: bd(7, 8) = clr: ctCol(clr, 7) = ctCol(clr, 7) - 1: ctCol(clr, 8) = ctCol(clr, 8) - 1
  permute x$
 Loop Until x$ = h$
 
End Sub
Sub placeRow6()
 x$ = "1234": h$ = x$
 Do
   CurrentX = 1: CurrentY = 3: Print x$; solCtPart; solCt
  DoEvents
  clr = Val(Mid(x$, 1, 1)): bd(6, 1) = clr: bd(6, 6) = clr: ctCol(clr, 1) = ctCol(clr, 1) + 1: ctCol(clr, 6) = ctCol(clr, 6) + 1
  clr = Val(Mid(x$, 2, 1)): bd(6, 2) = clr: bd(6, 8) = clr: ctCol(clr, 2) = ctCol(clr, 2) + 1: ctCol(clr, 8) = ctCol(clr, 8) + 1
  clr = Val(Mid(x$, 3, 1)): bd(6, 3) = clr: bd(6, 4) = clr: ctCol(clr, 3) = ctCol(clr, 3) + 1: ctCol(clr, 4) = ctCol(clr, 4) + 1
  clr = Val(Mid(x$, 4, 1)): bd(6, 5) = clr: bd(6, 7) = clr: ctCol(clr, 5) = ctCol(clr, 5) + 1: ctCol(clr, 7) = ctCol(clr, 7) + 1
 
  good = 1
 
  For colm = 1 To 8
   For colr = 1 To 4
    If ctCol(colr, colm) > 2 Then good = 0: Exit For
   Next
  Next
  If bd(6, 2) = 3 And (bd(7, 2) = 3 Or bd(8, 2) = 3) Then good = 0
  If bd(6, 3) = 1 Then good = 0
  If bd(6, 5) = 3 Or bd(7, 5) = 3 Then good = 0
  If bd(6, 6) = 2 Or bd(7, 6) = 2 Then good = 0
  'If bd(6, 6) <> 1 And bd(8, 6) = 1 Then good = 0
  If bd(6, 8) = 2 And (bd(7, 8) = 2 Or bd(8, 8) = 2) Then good = 0
  'If bd(6, 8) <> 4 And bd(8, 8) = 4 Then good = 0
  If bd(7, 2) <> 3 And bd(8, 2) <> 3 Then good = 0
  If bd(7, 8) <> 2 And bd(8, 8) <> 2 Then good = 0
  If bd(6, 8) = 4 And (bd(7, 8) = 4 Or bd(8, 8) = 4) Then good = 0
  If bd(6, 7) <> 1 And bd(6, 7) <> 4 Then good = 0

  If good Then
    placeRow3
  End If
 
  clr = Val(Mid(x$, 1, 1)): bd(6, 1) = clr: bd(6, 6) = clr: ctCol(clr, 1) = ctCol(clr, 1) - 1: ctCol(clr, 6) = ctCol(clr, 6) - 1
  clr = Val(Mid(x$, 2, 1)): bd(6, 2) = clr: bd(6, 8) = clr: ctCol(clr, 2) = ctCol(clr, 2) - 1: ctCol(clr, 8) = ctCol(clr, 8) - 1
  clr = Val(Mid(x$, 3, 1)): bd(6, 3) = clr: bd(6, 4) = clr: ctCol(clr, 3) = ctCol(clr, 3) - 1: ctCol(clr, 4) = ctCol(clr, 4) - 1
  clr = Val(Mid(x$, 4, 1)): bd(6, 5) = clr: bd(6, 7) = clr: ctCol(clr, 5) = ctCol(clr, 5) - 1: ctCol(clr, 7) = ctCol(clr, 7) - 1
  permute x$
 Loop Until x$ = h$

End Sub
Sub placeRow3()
  x$ = "1122344": h$ = x$
  Do
   DoEvents
   colm = 1
   For i = 1 To 7
    bd(3, colm) = Val(Mid(x$, i, 1))
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) + 1
    If bd(3, colm) = 3 Then
     colm = colm + 1: bd(3, colm) = 3
     ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) + 1
    End If
    colm = colm + 1
   Next
  
   good = 1
   For colm = 1 To 8
    For colr = 1 To 4
     If ctCol(colr, colm) > 2 Then good = 0: Exit For
    Next
   Next
   If bd(3, 2) = 3 Then good = 0
   If bd(3, 5) = 3 Then good = 0
   If bd(3, 6) = 2 Then good = 0
   If bd(3, 7) = 1 Or bd(3, 7) = 4 Then good = 0
   If bd(3, 6) = 1 And bd(6, 6) <> 1 Or bd(3, 6) <> 1 And bd(6, 6) = 1 Then good = 0
   If bd(3, 8) = 4 And bd(6, 8) <> 4 Or bd(3, 8) <> 4 And bd(6, 8) = 4 Then good = 0

   If good Then
     placeRow1
   End If
  
   colm = 1
   For i = 1 To 7
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) - 1
    If bd(3, colm) = 3 Then
     colm = colm + 1
     ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) - 1
    End If
    colm = colm + 1
   Next
  
   permute x$
  Loop Until x$ = h$
End Sub
Sub placeRow1()
  x$ = "112244": h$ = x$
  Do
   colm = 1
   For i = 1 To 6
    bd(1, colm) = Val(Mid(x$, i, 1))
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) + 1
    If bd(1, colm) = 4 Then
     colm = colm + 1: bd(1, colm) = 3
     ctCol(3, colm) = ctCol(3, colm) + 1
    End If
    colm = colm + 1
   Next
  
   good = 1
   For colm = 1 To 8
    For colr = 1 To 4
     If ctCol(colr, colm) > 2 Then good = 0: Exit For
    Next
    If good = 0 Then Exit For
   Next
   If bd(1, 2) = 3 And bd(7, 2) <> 3 Or bd(1, 2) <> 3 And bd(7, 2) = 3 Then good = 0
   If bd(1, 5) = 3 And bd(8, 5) <> 3 Or bd(1, 5) <> 3 And bd(8, 5) = 3 Then good = 0
   If bd(1, 6) = 2 And bd(8, 6) <> 2 Or bd(1, 6) <> 2 And bd(8, 6) = 2 Then good = 0
   'If bd(1, 6) = 1 And bd(3, 6) <> 1 Then good = 0
   'If bd(3, 6) = 1 And bd(1, 6) <> 1 And bd(5, 6) <> 1 Then good = 0
   If bd(1, 7) = 1 Or bd(1, 7) = 4 Then good = 0
   If bd(1, 8) = 2 And bd(7, 8) <> 2 Or bd(1, 8) <> 2 And bd(7, 8) = 2 Then good = 0
   'If bd(1, 8) = 4 And bd(3, 8) <> 4 Then good = 0
  
  
   If good Then
    placeRow2
   End If

   colm = 1
   For i = 1 To 6
    bd(1, colm) = Val(Mid(x$, i, 1))
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) - 1
    If bd(1, colm) = 4 Then
     colm = colm + 1: bd(1, colm) = 3
     ctCol(3, colm) = ctCol(3, colm) - 1
    End If
    colm = colm + 1
   Next
  
   permute x$
  Loop Until x$ = h$

End Sub
Sub placeRow2()
  x$ = "11223344": h$ = x$
  Do
   colm = 1
   For i = 1 To 8
    bd(2, colm) = Val(Mid(x$, i, 1))
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) + 1
    colm = colm + 1
   Next
  
   good = 1
   For colm = 1 To 8
    For colr = 1 To 4
     If ctCol(colr, colm) > 2 Then good = 0: Exit For
    Next
    If good = 0 Then Exit For
   Next
   If InStr(x$, "3") < 5 Then good = 0
   If InStr(Mid(x$, 5), "1") > 0 Then good = 0
   If bd(2, 2) = 3 And bd(8, 2) <> 3 Or bd(2, 2) <> 3 And bd(8, 2) = 3 Then good = 0
   If bd(2, 5) = 3 Then good = 0
   If bd(2, 6) = 2 Then good = 0
   If bd(8, 8) = 2 And bd(2, 8) <> 2 Then good = 0
   'If bd(2, 6) = 1 And bd(4, 6) <> 1 Then good = 0
   'If bd(4, 6) = 1 And bd(2, 6) <> 1 And bd(6, 6) <> 1 Then good = 0
   If bd(2, 7) = 1 Or bd(2, 7) = 4 Then good = 0
   If bd(2, 8) = 2 And bd(8, 8) <> 2 Or bd(2, 8) <> 2 And bd(8, 8) = 2 Then good = 0
   'If bd(2, 8) = 4 And bd(4, 8) <> 4 Then good = 0
   If bd(2, 8) = 2 And (bd(1, 8) = 2 Or bd(3, 8) = 2) Then good = 0
   If bd(1, 8) <> 4 And bd(2, 8) <> 4 And bd(3, 8) <> 4 And bd(6, 8) <> 4 And bd(7, 8) <> 4 And bd(8, 8) <> 4 Then good = 0
   'If bd(1, 6) <> 1 And bd(3, 6) <> 1 And bd(3, 6) <> 1 And bd(6, 6) <> 1 And bd(7, 6) <> 1 And bd(8, 6) <> 1 Then good = 0
  
   If good Then
     ReDim ctc(4)
     For i = 1 To 8
      ctc(bd(i, i)) = ctc(bd(i, i)) + 1
      If bd(i, i) > 0 And ctc(bd(i, i)) > 2 Then
       good = 0: Exit For
      End If
     Next
     ReDim ctc(4)
     For i = 1 To 8
      ctc(bd(i, 9 - i)) = ctc(bd(i, 9 - i)) + 1
      If bd(i, 9 - i) > 0 And ctc(bd(i, 9 - i)) > 2 Then
       good = 0: Exit For
      End If
     Next
     If good Then
      Open "Red White Blue Green alt.txt" For Append As #2
     
      For r = 1 To 8
       For c = 1 To 8
        Print #2, Mid(col$, bd(r, c) + 1, 1);
       Next
       Print #2,
      Next
      Print #2,
     
      Close 2
     
      solCt = solCt + 1
     End If
     solCtPart = solCtPart + 1
   End If

   colm = 1
   For i = 1 To 8
    ctCol(Val(Mid(x$, i, 1)), colm) = ctCol(Val(Mid(x$, i, 1)), colm) - 1
    colm = colm + 1
   Next
   permute x$
  Loop Until x$ = h$

End Sub
Sub permute(a$)
 x$ = ""
 For i = Len(a$) To 1 Step -1
  l$ = x$
  x$ = Mid$(a$, i, 1)
  If x$ < l$ Then Exit For
 Next

 If i = 0 Then
  For j = 1 To Len(a$) \ 2
   x$ = Mid$(a$, j, 1)
   Mid$(a$, j, 1) = Mid$(a$, Len(a$) - j + 1, 1)
   Mid$(a$, Len(a$) - j + 1, 1) = x$
  Next
 Else
  For j = Len(a$) To i + 1 Step -1
   If Mid$(a$, j, 1) > x$ Then Exit For
  Next
  Mid$(a$, i, 1) = Mid$(a$, j, 1)
  Mid$(a$, j, 1) = x$
  For j = 1 To (Len(a$) - i) \ 2
   x$ = Mid$(a$, i + j, 1)
   Mid$(a$, i + j, 1) = Mid$(a$, Len(a$) - j + 1, 1)
   Mid$(a$, Len(a$) - j + 1, 1) = x$
  Next
 End If
End Sub


The potential solutions identified by the program:

gbrgbwwr             gbrgbwwr                gbrgbwwr                  gbrgbwwr
grgrwbbw             rrgwgbbw                rrggwbbw                  rrgwgbbw
rwrwggbb             wwrgrgbb                wgrwrgbb                  gwrrwgbb
........             ........                ........                  ........
........             ........                ........                  ........
brwwgbgr             brwwgbgr                brwwgbgr                  brwwgbgr
bbwrwrgg             bbwrwrgg                bbwrwrgg                  bbwrwrgg
rggbbwrw             rggbbwrw                rggbbwrw                  rggbbwrw
gbrgbwwr             gbrgbwwr                gbrgbwwr                  gbrgbwwr
wrgrgbbw             rwgrgbbw                rwgrgbbw                  rrggwbbw
rwrgwgbb             wwrgrgbb                wgrwrgbb                  gwrwrgbb
........             ........                ........                  ........
........             ........                ........                  ........
brwwgbgr             brwwgbgr                brwwgbgr                  brwwgbgr
bbwrwrgg             bbwrwrgg                bbwrwrgg                  bbwrwrgg
rggbbwrw             rggbbwrw                rggbbwrw                  rggbbwrw
gbrgbwwr             gbrgbwwr                gbrgbwwr                  gbrgbwwr
wrgrgbbw             wrgrgbbw                wrgrgbbw                  rwgrgbbw
rgrwwgbb             wwrgrgbb                wgrwrgbb                  gwrwrgbb
........             ........                ........                  ........
........             ........                ........                  ........
brwwgbgr             brwwgbgr                brwwgbgr                  brwwgbgr
bbwrwrgg             bbwrwrgg                bbwrwrgg                  bbwrwrgg
rggbbwrw             rggbbwrw                rggbbwrw                  rggbbwrw
gbrgbwwr             gbrgbwwr                gbrgbwwr                  gbrgbwwr
rwgrgbbw             grgrwbbw                grgrwbbw                  wrgrgbbw
wrrgwgbb             wwrgrgbb                wgrwrgbb                  gwrwrgbb
........             ........                ........                  ........
........             ........                ........                  ........
brwwgbgr             brwwgbgr                brwwgbgr                  brwwgbgr
bbwrwrgg             bbwrwrgg                bbwrwrgg                  bbwrwrgg
rggbbwrw             rggbbwrw                rggbbwrw                  rggbbwrw
gbrgbwwr             gbrgbwwr                gbrgbwwr
rrggwbbw             rrgwgbbw                rwgrgbbw
wwrrggbb             wgrrwgbb                grrwwgbb
........             ........                ........
........             ........                ........
brwwgbgr             brwwgbgr                brwwgbgr
bbwrwrgg             bbwrwrgg                bbwrwrgg
rggbbwrw             rggbbwrw                rggbbwrw

The bolded template is the only one that can be worked into a full solution:

gbrgbwwr
rwgrgbbw
wgrwrgbb

grbbwrwg
wwbgrgrb
brwwgbgr
bbwrwrgg
rggbbwrw


  Posted by Charlie on 2008-01-14 18:59:19
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (4)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information