__ __ __
/A \__/H \__/O \
\__/E \__/L \__/
/B \__/I \__/P \
\__/F \__/M \__/
/C \__/J \__/Q \
\__/G \__/N \__/
/D \__/K \__/R \
\__/ \__/ \__/
Shown above is a diagram representing a patchwork quilt consisting of 18 hexagonal patches. The quilt has been nailed to a blank white wall in five places, with the patches lettered A,E,H,L and O at the top.
 There are five red patches, five yellow patches, four green patches and four blue patches.
 No two adjacent patches are the same color and no green patch has a nail through it.
 No patch which is adjacent to only four other patches is blue and no patch which is adjacent to only two other patches is green.
 Of the five vertical column of patches, there is a yellow patch and a red patch in each column, no green patch in the second from the left and no blue patch in the second column from the right.
 No blue patch is directly below a red patch, and each of the four patches which are adjacent to another six patches are different colors.
From the information given, what color is each of the 18 patches?
DECLARE SUB populate (which!)
CLEAR , , 25000
DIM SHARED clrsupp(4), name$, grid(18), cname$
clrsupp(1) = 5: clrsupp(2) = 5: clrsupp(3) = 4: clrsupp(4) = 4
' sequence is red,yellow, green,blue
cname$ = "rygb"
name$ = "abcdefghijklmnopqr"
DIM SHARED neibr$(18)
DATA be,aefc,bfgd,cg,abfih,beijgc,dcfjk,eil,ehlmhf
DATA imnkgf,gjn,himpo,ilpqnj,kjmqr,lp,olmq,pmnr,nq
FOR nbr = 1 TO 18
READ nb$
neibr$(nbr) = ""
FOR i = 1 TO LEN(nb$)
ix = INSTR(name$, MID$(nb$, i, 1))
neibr$(nbr) = neibr$(nbr) + CHR$(ix)
NEXT
FOR i = 1 TO LEN(neibr$(nbr))
PRINT ASC(MID$(neibr$(nbr), i, 1));
NEXT: PRINT
NEXT
populate 1
SUB populate (which)
FOR clr = 1 TO 4
goodc = 1
IF which = 1 OR which = 5 OR which = 8 OR which = 12 OR which = 15 THEN
IF clr = 3 THEN goodc = 0
ELSE
IF clr = 4 AND grid(which  1) = 1 THEN goodc = 0
END IF
FOR i = 1 TO LEN(neibr$(which))
n = ASC(MID$(neibr$(which), i, 1))
IF grid(n) = clr THEN goodc = 0
NEXT
IF clrsupp(clr) = 0 THEN goodc = 0
adj = LEN(neibr$(which))
IF adj = 4 AND clr = 4 OR adj = 2 AND clr = 3 THEN goodc = 0
IF which > 4 AND which < 8 AND clr = 3 THEN goodc = 0
IF which > 11 AND which < 15 AND clr = 4 THEN goodc = 0
hadred = 0: hadyellow = 0
IF clr = 1 THEN hadred = 1: IF clr = 2 THEN hadyellow = 1
SELECT CASE which
CASE 4
FOR i = 1 TO 3
IF grid(i) = 1 THEN hadred = 1
IF grid(i) = 2 THEN hadyellow = 1
NEXT
CASE 7
FOR i = 5 TO 6
IF grid(i) = 1 THEN hadred = 1
IF grid(i) = 2 THEN hadyellow = 1
NEXT
CASE 11
FOR i = 8 TO 10
IF grid(i) = 1 THEN hadred = 1
IF grid(i) = 2 THEN hadyellow = 1
NEXT
CASE 14
FOR i = 12 TO 13
IF grid(i) = 1 THEN hadred = 1
IF grid(i) = 2 THEN hadyellow = 1
NEXT
CASE 18
FOR i = 15 TO 17
IF grid(i) = 1 THEN hadred = 1
IF grid(i) = 2 THEN hadyellow = 1
NEXT
CASE ELSE
hadred = 1: hadyellow = 1
END SELECT
IF hadred = 0 OR hadyellow = 0 THEN goodc = 0
IF which = 9 AND clr = grid(6) THEN good = 0
IF which = 10 AND (clr = grid(6) OR clr = grid(9)) THEN good = 0
IF which = 13 AND (clr = grid(6) OR clr = grid(9) OR clr = grid(10)) THEN good = 0
IF goodc THEN
grid(which) = clr
clrsupp(clr) = clrsupp(clr)  1
IF which = 18 THEN
FOR fcol = 1 TO 4
PRINT " /";
FOR gp = fcol TO fcol + 14 STEP 7
PRINT MID$(cname$, grid(gp), 1); " \_/";
NEXT
PRINT
IF fcol < 4 THEN
PRINT " \_/";
FOR gp = fcol + 4 TO fcol + 11 STEP 7
PRINT " "; MID$(cname$, grid(gp), 1); "\_/";
NEXT
END IF
PRINT
NEXT
PRINT
ELSE
populate which + 1
END IF
clrsupp(clr) = clrsupp(clr) + 1
grid(which) = 0
END IF
NEXT
END SUB
A little tweeking of the format of the output by hand gives these two solutions:
__ __ _
/r \_/r \__/r\
\_/ y\__/ y\_/
/g \_/g \__/g\
\__/b\__/ r\_/
/y \_/y \__/y\
\__/r\__/ g\_/
/b \_/b \__/b\
\_ / \__/ \_/
__ __ _
/r \__/r \__/b\
\__/ y\__/ y\_/
/g \__/g \__/g\
\__/ b\__/ r\_/
/y \__/y \__/y\
\__/ r\__/ g\_/
/b \__/b \__/r\
\_ / \__/ \_/

Posted by Charlie
on 20130719 13:15:28 