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?

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

abcdcd
dcabab
cbcdcd
adabda
dbdcab
bcabca

 1

 

Edited on November 26, 2006, 1:12 pm

Posted by Charlie on 2006-11-26 13:07:29