§ Иллюстрация

9dc452903094f4e67d50cc912096e383.png

§ Код

DECLARE SUB DrawCircles (VSel!, VSeek!)
SCREEN 13

CONST n = 6

'    1 2 3 4 5 6
DATA 0,9,0,2,4,0 : REM 1 -> 2,4,5
DATA 0,0,4,0,0,1 : REM 2 -> 3,6
DATA 0,0,0,7,0,0 : REM 3 -> 4
DATA 0,0,0,0,1,3 : REM 4 -> 5,6
DATA 0,0,0,0,0,1 : REM 5 -> 6
DATA 0,0,0,0,0,0 : REM 6 -> 4

' Graphs point
'    Y   X
DATA 4,  20 : REM 1
DATA 9,  11 : REM 2
DATA 9,  29 : REM 3
DATA 16, 11 : REM 4
DATA 16, 29 : REM 5
DATA 21, 20 : REM 6

DIM SHARED G(n, n) AS INTEGER
DIM SHARED W(n) AS INTEGER
DIM SHARED PG(n, 2) AS INTEGER
DIM SHARED VIS(n) AS INTEGER
DIM SHARED Best(n) AS INTEGER

' Чтение матрицы весов
FOR i = 1 TO n: FOR j = 1 TO n: READ G(i, j): NEXT: NEXT
FOR i = 1 TO n: READ PG(i, 1): READ PG(i, 2): W(i) = -1: VIS(i) = 0: NEXT

' Назначение нулевого веса
W(1) = 0

' Первая отрисовка
DrawCircles 0, 0: SLEEP 0

DO

  ' Выбор следующей вершины
  NextVertex = 0
  FOR i = 1 TO n

    IF VIS(i) = 0 AND W(i) >= 0 THEN
      NextVertex = i
      EXIT FOR
    END IF

  NEXT

  IF NextVertex THEN

    DrawCircles NextVertex, 2

    ' Просмотр прилегающих вершин
    FOR j = 1 TO n

      ' Проверка не посещенной вершины только
      IF G(NextVertex, j) AND VIS(j) = 0 THEN

        DrawCircles NextVertex, j: SLEEP 0

        ' Проверка ребра
        CW = G(NextVertex, j)

        ' Если вершина не взвешена или ее значение больше
        IF W(j) = -1 OR W(j) > CW THEN

          ' Увеличиваем значение ребра
          W(j) = W(NextVertex) + CW

          ' Выбор лучшей точки
          Best(j) = NextVertex

          ' Снова нарисовать выбранную точку
          DrawCircles NextVertex, j: SLEEP 0

        END IF

      END IF

    NEXT

    ' Отметка, что вершина посещена
    VIS(NextVertex) = 1

  END IF

LOOP WHILE NextVertex > 0

SUB DrawCircles (VSel, VSeek)

  CLS
  COLOR 7

  ' Нарисовать линии от кружков
  FOR i = 1 TO n
  FOR j = 1 TO n

    IF G(i, j) THEN

      x1 = PG(i, 2) * 8 - 5: y1 = PG(i, 1) * 8 - 5
      x2 = PG(j, 2) * 8 - 5: y2 = PG(j, 1) * 8 - 5

      xr = x1 * .2 + x2 * .8
      yr = y1 * .2 + y2 * .8

      xm = (x1 + x2) \ 2
      ym = (y1 + y2) \ 2
      LOCATE ym \ 8 + 1, xm \ 8
      PRINT G(i, j);

      LINE (x1, y1)-(x2, y2), 8
      LINE (xr, yr)-(x2, y2), 14

    END IF

  NEXT
  NEXT

  ' Кружки и подписи к ним
  FOR i = 1 TO n

    x% = PG(i, 2)
    y% = PG(i, 1)
    LOCATE y%, x%

    ' Рисуется кружок
    xs% = x% * 8 - 5
    ys% = y% * 8 - 5

    cl = 15
    IF VSel = i THEN cl = 12 ELSE cl = 15
    IF VSeek = i THEN cl = 13
    IF VIS(i) THEN cl = 6

    CIRCLE (xs%, ys%), 9, cl
    PAINT (xs%, ys%), 0, cl

    IF VIS(i) THEN COLOR 6 ELSE COLOR 10
    PRINT LTRIM$(STR$(i));

    COLOR 9
    IF i <= 3 THEN y% = y% - 2 ELSE y% = y% + 2
    LOCATE y%, x% - 1: PRINT W(i)

  NEXT

  ' Таблица рекордов
  COLOR 3
  FOR i = 1 TO n
    LOCATE i, 1: PRINT i; CHR$(27); Best(i);
  NEXT

END SUB