Тексты программ на Бейсике


 ' Программа решения задачи об 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)

Литература, Содержание