Тексты программ на Бейсике
' Программа решения задачи об 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)
Содержание