Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Tweeker
0 / 0 / 1
Регистрация: 15.03.2015
Сообщений: 66
1

Неправильно строит граф

22.06.2015, 10:39. Просмотров 249. Ответов 0
Метки нет (Все метки)

Всем привет.
Нужно найти кратчайший путь по методу Дейкстры.
Данные беру из файла:
5
50 150
250 50
190 250
400 70
440 250
0 150 150 10000000 10000000
100 0 100 50 200
150 100 0 10000000 110
10000000 50 10000000 0 50
10000000 200 110 50 0

Должен путь проходить через верхние ребра,а у меня как на крине.
Может кто посмотреть мой код и указать на мои ошибки,почему неправильно рисует.
Неправильно строит граф

Вот сам код
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Screen: TImage;
    procedure Button1Click(Sender: TObject);
    procedure LoadGraph;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type Vertex = record                                {Вершина графа}
Marked  : Boolean;                              {индикатор состояния}
DistFromStart :Integer;                         {расстояние от с тартовой вершины}
PrevVertex :Integer;                                {предыдущая вершина}
id : Integer;
x, y : Integer;
end;
 
const StartVertex = 0;                              {стартовая вершина}
      FinishVertex = 7;                             {финишная вершина}
 
var
  Form1: TForm1;
  M : array of array of Integer;
  N : Integer;
  V : array of Vertex;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var i         :Integer;                             {счетчик цикла}
    NotMarked :Integer;                             {кол-во неотмеченных вершин}
    vm, pv    :Integer;                             {индекс вершин}
    MinDist   :Integer;                             {текущее минимальное расстояние}
begin
    LoadGraph;                              {загрузить граф}
    Form1.Screen.Canvas.Brush.Color := clWhite;             {очистить экран}
    Form1.Screen.Canvas.FillRect(Rect(0,0,600,400));
 
    for i := 0 to N - 1 do
    begin
      V[i].Marked := false;                         {ни одна вершина не отмечена}
      V[i].DistFromStart :=M[StartVertex,i];                {начальное расстояние}
end;
 
V[StartVertex].Marked :=true;                           {отметить стартовую вершину}
V[StartVertex].PrevVertex := -1;                        {у стартовой вершины нет предыдущей}
NotMarked := N - 1;                             {начальное кол-во неотмеченных вершин}
 
while NotMarked <> 0 do                             {пока есть неотмеченные вершины}
begin
    MinDist := 10000000;
    for i := 0 to N - 1 do
    if not V[i].Marked and (V[i].DistFromStart < MinDist) then
    begin                                   {найти неотмеченную вершину}
      vm := i;                              {С мин. значением DistFromStart}
      MinDist := V[i].DistFromStart;
    end;
    V[vm].Marked := true;                           {отметить её}
    NotMarked := NotMarked - 1;
 
    for i := 0 to N - 1 do
      if not V[i].Marked then                       {цикл по всем неотмеченным вершинам}
        if V[i].DistFromStart > V[vm].DistFromStart + M[vm,i] then
        begin
        V[i].DistFromStart := V[vm].DistFromStart + M[vm,i];
        V[i].PrevVertex := vm;
        end;
end;
 
 
Form1.Screen.Canvas.MoveTo(V[FinishVertex].x, V[FinishVertex].y);
 
pv := V[FinishVertex].PrevVertex;                       {ввод полученного маршрута}
repeat
    Form1.Screen.Canvas.LineTo(V[pv].x, V[pv].y);
    pv := V[pv].PrevVertex;
until pv = -1;
 
 
Form1.Screen.Canvas.Brush.Color := clRed;                   {ввод вершин графа}
for i := 0 to N - 1 do
    Form1.Screen.Canvas.FillRect(Rect(V[i].x - 5, V[i].y - 5,
                      V[i].x + 5, V[i].y + 5));
end;
 
procedure TForm1.LoadGraph;
var F    : TextFile;
    i, j : Integer;
begin
  AssignFile(F, 'graph.txt');
  FileMode := 0;
  Reset(F);
 
  ReadLn(F, N);
  SetLength(M, N, N);
  SetLength(V, N);
  for i := 0 to N - 1 do
    ReadLn(F, V[i].x, V[i].y);
  for i := 0 to N - 1 do
      for j := 0 to N - 1 do
      Read(F, M[i,j]);
      CloseFile(F);
end;
 
 
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
22.06.2015, 10:39
Ответы с готовыми решениями:

Не строит график
не хочет строить график, подскажите пожалуйста где ошибка тема лабы:...

Не строит прямую в Chart
Добрый день, столкнулся с такой проблемой, нужно чтоб используя 2 точки с...

Не строит прямую в Chart с файла тхт
Доброе утро, обращаюсь снова со своей программкой к Вам... суть программы:...

Напишите программу, которая строит график функции y=tg(x)
Ребята помогите пожалуйста справится с задачей. Напишите программу, которая...

Разработать программу, которая строит логический вектор L по заданному правилу
Заданная матрица Х (n, n), n &lt;= 15. Разработать программу, которая строит...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
22.06.2015, 10:39

Написать программу, которая строит график функции: x=C1*(t-1/2*sin2t)+C2, y=C1*sin^2t
Здравствуйте! помогите пожалуйста написать программу которая строит график...

Разработать программу, которая строит логический вектор по заданному правилу
Заданная матрица x (n, n), n &lt;= 15. Разработать программу, которая строит...

Списки: Описать процедуру, которая по списку L строит два новых списка
Помогите!!! :cry: Описать процедуру, которая по списку L строит два...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru