|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Рассчет полных путей
Здравствуйте! Решаю такую задачу.
Даны работы (заполняется столбец в стринггриде): 1-2 1-3 2-4 2-5 3-6 4-6 5-6 на схеме эти пути связаны для наглядности. Теперь требуется найти все полные пути, например здесь их будет три: 1-2-4-6, 1-2-5-6, 1-3-6. Я все никак не могу придумать алгоритм по которому будут находиться эти полные пути. Помогите, подскажите... |
#2
|
|||
|
|||
|
#3
|
||||
|
||||
У меня такое получилось, на концах путей алгоритм
Добавлено немного позже На случай пропажи исходника вот юнит формы Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids; type TForm1 = class(TForm) StringGrid1: TStringGrid; Memo1: TMemo; Memo2: TMemo; Button1: TButton; Button2: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; arr: array of array[0..2] of integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i: integer; begin with Memo1, StringGrid1 do // Заполнение таблицы begin RowCount:= Lines.Count; for i := 0 to Lines.Count - 1 do begin Cells[0,i]:= Copy(Lines[i], 1, Pos('-',Lines[i])-1); Cells[1,i]:= Copy(Lines[i], Pos('-', Lines[i])+1,Length(Lines[i])); end;{for i} end; {with} Button2.Enabled:= true; end; procedure TForm1.Button2Click(Sender: TObject); function lm (ds, ts: integer): integer; var i: integer; begin Result:= 0; for i := High(arr) downto Low(arr) do if (arr[i, 2] > 0) and (arr[i, 1] = ds) then begin // Помечаем данный конец пути чтоб опять по нему не пройти if ds = ts then arr[i, 2]:= 1; Result:= arr[i, 0]; Exit; end; end; var i, b, k, m: integer; pth: array of array of integer; s: string; begin with StringGrid1 do begin SetLength(arr, RowCount); for i:= 0 to RowCount-1 do // Заплонение массива begin arr[i,0]:= StrToInt(Cells[0,i]); arr[i,1]:= StrToInt(Cells[1,i]); end; end; {with} k:= 0; // Нахождение конечной точки for i:= Low(arr) to High(arr) do if arr[i,1] > k then k:= arr[i,1]; b:= 0; // Кол-во возможных путей for i:= Low(arr) to High(arr) do if arr[i,1] = k then inc(b); // Подготовка массива для путей SetLength(pth, b, Length(arr)); for i:= Low(pth) to High(pth) do begin m:= k; b:= Low(arr); while (m > 0) or (b < High(arr)) do begin pth[i,b]:= m; m:= lm(m,k); Inc(b); end; end;{for i} Memo2.Clear; Memo2.Lines.Add('Варианты: ' + IntToStr(Length(pth))); Memo2.Lines.Add(''); for i:= Low(pth) to High(pth) do begin s:= IntToStr(i + 1) + ' - '; for b:= High(arr) downto Low(arr) do if pth[i,b] > 0 then s:= s + IntToStr(pth[i,b]) + '-'; Delete(s, Length(s), 1); Memo2.Lines.Add(s); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Button2.Enabled:= false; Memo1.Text:= '1-2' +#13#10+ '1-3' +#13#10+ '2-4' +#13#10+ '2-5' +#13#10+ '3-6' +#13#10+ '4-6' +#13#10+ '5-6' +#13#10; end; end. Я не понял Вашего вопроса, но всё же Вам на него отвечу! Последний раз редактировалось Alegun, 23.02.2014 в 07:34. |