8皇后问题.txt

解决8皇后问题的小程序

DECLARE SUB POut ()    '此函数用于显示结果，就不作详细介绍了
DECLARE FUNCTION Place! (kk AS INTEGER)        '此函数用于判断是否可以放置一个新皇后
DIM SHARED k AS INTEGER
DIM SHARED n AS INTEGER
CLS

getn:
PRINT "There is N*N space and N Queens,Please enter N=";
INPUT n
PRINT "While program is running,you can press [Esc] to stop."
PRINT "Press [G] to run without stop."
PRINT "Any other key to start..."
stops = 1
start:
key$ = INKEY$
IF LCASE$(key$) = "g" THEN
        stops = 0
ELSEIF key$ = "" THEN
        GOTO start
END IF

IF n < 1 THEN
        CLS
        PRINT "N must be an integer bigger than 0"
        GOTO getn
END IF
'==================================
'前面都是说明性文字，与核心算法无关
'==================================
DIM SHARED x(1 TO n) AS INTEGER
x(1) = 0: k = 1        'k是当前行，x(k)是当前列
outs = 0
DO    '对所有的行执行以下语句
        IF NOT k > 0 THEN EXIT DO
        x(k) = x(k) + 1    '移动到下一行
        DO    '判断当前行是否能够放置皇后
                IF NOT (x(k) <= n AND Place(k) = 0) THEN EXIT DO
                x(k) = x(k) + 1
        LOOP
        IF x(k) <= n THEN    '找到位置
                IF k = n THEN    '是完整解吗？
                        POut    '打印出当前解。后面到goon标签处，都不是核心，不做讲解了
                        outs = outs + 1
                        IF stops = 0 THEN GOTO goon
                        PRINT "[Esc] to Stop,Any other key to find next..."
waiting:
                        check$ = INKEY$
                        IF check$ = CHR$(27) THEN
                                PRINT "User Stoped."
                                PRINT "Untill now, Finds"; outs; "kinds places to set."
                                END
                        ELSEIF check$ = "" THEN
                                GOTO waiting
                        END IF
goon:
                ELSE
                        k = k + 1    '转向下一行
                        x(k) = 0
                END IF
        ELSE
                k = k - 1        '回溯（这也就是最关键的地方了！！）
        END IF
LOOP
PRINT "There's all"; outs; "kinds places to set."

FUNCTION Place (kk AS INTEGER)
        DIM ii AS INTEGER
        ii = 1
        DO
                IF NOT ii < kk THEN EXIT DO
                IF x(ii) = x(kk) OR ABS(x(ii) - x(kk)) = ABS(ii - kk) THEN
'                  同一列两个皇后    统一斜线上两个皇后
                        Place = 0    '返回值为0
                        GOTO fin
                END IF
                ii = ii + 1
        LOOP
        Place = 1
fin:
END FUNCTION

SUB POut
        FOR lines = 1 TO n
                PRINT "==";
        NEXT
        PRINT "="
       
        FOR lines = 1 TO n
           IF x(lines) > 1 THEN
                FOR outspc = 1 TO x(lines) - 1
                        PRINT " *";
                NEXT
                PRINT " Q";
                FOR outspc = 1 TO n - x(lines)
                        PRINT " *";
                NEXT
                PRINT
           ELSEIF n > 1 THEN
                PRINT " Q";
                FOR outspc = 1 TO n - 1
                        PRINT " *";
                NEXT
                PRINT
           ELSE
                PRINT " Q"
           END IF
                
        NEXT
       
        FOR lines = 1 TO n
                PRINT "==";
        NEXT
        PRINT "="
END SUB