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

 ABCD (Posted on 2006-11-26)
 A 2 0 3 0 2 2 B 1 3 0 3 0 2 C 1 2 2 1 3 0 A B C D 2 1 1 2 1 2 1 1 2 2 2 2 1 1 0 1 3 2 3 1 0 2 1 2 1 2 2 2 2 0
Every cell in the 6x6 grid contains one of four letters, namely, A, B, C or D. No letter can be horizontally or vertically adjacent to itself. The tables above and to the left of the grid indicate how many times each letter appears in that column or row.

Can you complete the grid?

 See The Solution Submitted by Josie Faulkner Rating: 4.4118 (17 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
 solution unique --- and how the computer program finds it | Comment 5 of 32 |

DECLARE SUB permute (a\$)
DECLARE FUNCTION noVadj! (a\$, b\$)
DECLARE FUNCTION noHadj! (s\$)
DECLARE FUNCTION noColExcd! (s\$)
DECLARE SUB addIn (s\$)
DECLARE SUB subtOut (s\$)
DIM SHARED aMax(6), aCt(6)
DIM SHARED bMax(6), bCt(6)
DIM SHARED cMax(6), cCt(6)
DIM SHARED dMax(6), dCt(6)

DATA 2,0,3,0,2,2
DATA 1,3,0,3,0,2
DATA 1,2,2,1,3,0
DATA 2,1,1,2,1,2

CLS

FOR i = 1 TO 6: READ aMax(i): NEXT
FOR i = 1 TO 6: READ bMax(i): NEXT
FOR i = 1 TO 6: READ cMax(i): NEXT
FOR i = 1 TO 6: READ dMax(i): NEXT

s1\$ = "abccdd": h1\$ = s1\$
DO
IF noHadj(s1\$) THEN
IF noColExcd(s1\$) THEN
addIn s1\$

s2\$ = "aabbcd": h2\$ = s2\$
DO
IF noHadj(s2\$) THEN
IF noColExcd(s2\$) THEN
IF noVadj(s1\$, s2\$) THEN
addIn s2\$

s3\$ = "bcccdd": h3\$ = s3\$
DO
IF noHadj(s3\$) THEN
IF noColExcd(s3\$) THEN
IF noVadj(s2\$, s3\$) THEN
addIn s3\$

s4\$ = "aaabdd": h4\$ = s4\$
DO
IF noHadj(s4\$) THEN
IF noColExcd(s4\$) THEN
IF noVadj(s3\$, s4\$) THEN
addIn s4\$

s5\$ = "abbcdd": h5\$ = s5\$
DO
IF noHadj(s5\$) THEN
IF noColExcd(s5\$) THEN
IF noVadj(s4\$, s5\$) THEN
addIn s5\$

s6\$ = "aabbcc": h6\$ = s6\$
DO
IF noHadj(s6\$) THEN
IF noColExcd(s6\$) THEN
IF noVadj(s5\$, s6\$) THEN
addIn s6\$

col = solCt MOD 10
row = int(solCt/10)
col = col * 8 + 1
row = row * 8 + 1
LOCATE row, col: PRINT s1\$
LOCATE row + 1, col: PRINT s2\$
LOCATE row + 2, col: PRINT s3\$
LOCATE row + 3, col: PRINT s4\$
LOCATE row + 4, col: PRINT s5\$
LOCATE row + 5, col: PRINT s6\$
solCt = solCt + 1

subtOut s6\$
END IF
END IF
END IF
permute s6\$
LOOP UNTIL s6\$ = h6\$

subtOut s5\$
END IF
END IF
END IF
permute s5\$
LOOP UNTIL s5\$ = h5\$

subtOut s4\$
END IF
END IF
END IF
permute s4\$
LOOP UNTIL s4\$ = h4\$

subtOut s3\$
END IF
END IF
END IF
permute s3\$
LOOP UNTIL s3\$ = h3\$

subtOut s2\$
END IF
END IF
END IF
permute s2\$
LOOP UNTIL s2\$ = h2\$

subtOut s1\$
END IF
END IF
permute s1\$
LOOP UNTIL s1\$ = h1\$

PRINT : PRINT solCt

SUB addIn (s\$)
FOR i = 1 TO LEN(s\$)
SELECT CASE MID\$(s\$, i, 1)
CASE "a"
aCt(i) = aCt(i) + 1
CASE "b"
bCt(i) = bCt(i) + 1
CASE "c"
cCt(i) = cCt(i) + 1
CASE "d"
dCt(i) = dCt(i) + 1
END SELECT
NEXT
END SUB

FUNCTION noColExcd (s\$)
good = 1
FOR i = 1 TO LEN(s\$)
x\$ = MID\$(s\$, i, 1)
SELECT CASE x\$
CASE "a"
IF aCt(i) = aMax(i) THEN good = 0: EXIT FOR
CASE "b"
IF bCt(i) = bMax(i) THEN good = 0: EXIT FOR
CASE "c"
IF cCt(i) = cMax(i) THEN good = 0: EXIT FOR
CASE "d"
IF dCt(i) = dMax(i) THEN good = 0: EXIT FOR
END SELECT
NEXT
noColExcd = good
END FUNCTION

FUNCTION noHadj (s\$)
good = 1
FOR i = 1 TO LEN(s\$) - 1
IF MID\$(s\$, i, 1) = MID\$(s\$, i + 1, 1) THEN good = 0: EXIT FOR
NEXT
noHadj = good
END FUNCTION

FUNCTION noVadj (a\$, b\$)
good = 1
FOR i = 1 TO LEN(a\$)
IF MID\$(a\$, i, 1) = MID\$(b\$, i, 1) THEN good = 0: EXIT FOR
NEXT
noVadj = good
END FUNCTION

SUB subtOut (s\$)
FOR i = 1 TO LEN(s\$)
SELECT CASE MID\$(s\$, i, 1)
CASE "a"
aCt(i) = aCt(i) - 1
CASE "b"
bCt(i) = bCt(i) - 1
CASE "c"
cCt(i) = cCt(i) - 1
CASE "d"
dCt(i) = dCt(i) - 1
END SELECT
NEXT
END SUB

(the permute subroutine is found elsewhere on this site)

finds

`abcdcddcababcbcdcdadabdadbdcabbcabca`
` 1`

Edited on November 26, 2006, 1:12 pm
 Posted by Charlie on 2006-11-26 13:07:29

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 (8)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

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