' Программа решения задачи об n ферзях перебором с возвратом ' Процедура печати решения SUB WriteSolution FOR i = 1 TO n PRINT queen(i); NEXT i PRINT END SUB ' Функция проверки совместимости m-го ферзя с предыдущими FUNCTION Check(m) Check = 1 FOR i = 1 TO m-1 ' совпадают горизонтали, нисходящие диагонали IF (queen(i) = queen(m)) Or (i+queen(i) = m+queen(m)) _ Or (i-queen(i) = m-queen(m)) THEN ' восходящие диагонали Check = 0: EXIT FOR END IF NEXT i END FUNCTION ' Процедура, осуществляющая перебор SUB Backtrack(m) IF m > n THEN ' найдено решение CALL WriteSolution ELSE FOR i = 1 TO n queen(m) = i IF Check(m) = 1 THEN ' m-ый ферзь не бьёт предыдущих CALL Backtrack(m+1) END IF NEXT i END SUB DIM SHARED n ' размер доски INPUT "Размер доски? ",n DIM SHARED queen(n) ' массив положений ферзей CALL Backtrack(1) ' Программа решения задачи об n ферзях перебором ' с распостранением ограничений и просмотром вперёд ' Процедура печати решения SUB WriteSolution FOR i = 1 TO n PRINT queen(i); NEXT i PRINT END SUB ' Процедуры сокращения пространства перебора SUB ExcludeField(nq,qu,m) IF qu >= 1 And qu <= n THEN IF space(nq,qu) = 0 THEN cases(nq) = cases(nq)-1: space(nq,qu) = m END IF END IF END SUB SUB Prune(qm,qu,m) FOR i = m+1 TO n nq = vstep(i) CALL ExcludeField(nq,qu,m) ' на той же горизонтали CALL ExcludeField(nq,qu+nq-qm,m) ' на той же диагонали CALL ExcludeField(nq,qu-nq+qm,m) NEXT i END SUB ' Процедуры восстановления пространства перебора SUB IncludeField(nq,qu,m) IF qu >= 1 And qu <= n THEN IF space(nq,qu) = m THEN cases(nq) = cases(nq)+1: space(nq,qu) = 0; END IF END IF END SUB SUB Restoring(qm,qu,m) FOR i = m+1 TO n nq = vstep(i) CALL IncludeField(nq,qu,m) ' на той же горизонтали CALL IncludeField(nq,qu+nq-qm,m) ' на той же диагонали CALL IncludeField(nq,qu-nq+qm,m) NEXT i END SUB SUB Propagate(m) IF m > n THEN CALL WriteSolution ELSE ' Выбирается ферзь с наименьшим количеством вариантов minq = n+1 FOR i = m TO n IF cases(vstep(i)) < minq THEN l = i: qm = vstep(l): minq = cases(qm) END IF NEXT i vstep(l) = vstep(m): vstep(m) = qm FOR i = 1 TO n IF space(qm,i) = 0 THEN queen(qm) = i CALL Prune(qm,i,m) CALL Propagate(m+1) CALL Restoring(qm,i,m) END IF NEXT i END IF END SUB DIM SHARED n ' размер доски INPUT "Размер доски? ",n DIM SHARED queen(n) ' массив положений ферзей DIM SHARED space(n,n) ' пространство перебора DIM SHARED vstep(n) ' порядок выбора ферзей DIM SHARED cases(n) ' количество вариантов FOR i = 1 TO n FOR j = 1 TO n space(i,j) = 0 NEXT j vstep(i) = i: cases(i) = n NEXT i CALL Propagate(1)