Индексная сортировка слиянием, Проблемка с индексами Опции

[RussoTuristo]

Сортировка слиянием работает, сортирует всё нормально, нужно добавить индексы ....
На лекции было сказано, что достаточно добавить какой-либо тип, например: tIndexArray= array [1..1000] of integer;
И, НАПРИМЕР, вместо условий if A[i]>A[j] then Swap(A[i],A[j]) написать if A[P[i]]>A[P[j]] then Swap(P[i],P[j])

А на деле всё походу сложнее(нужно менять параметры в процедурах ...) и у меня одни косяки получаются, уже запутался где что менятЬ! Если кто-нибудь может помочь или подсказать, помогите пожалуйста.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, TeEngine, Series, ExtCtrls, TeeProcs, Chart;

type

  tSortArray = array [1..1000] of integer;
  tIndexArray= array [1..1000] of integer;
  tSortType = integer;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    seElCount: TSpinEdit;
    Chart1: TChart;
    Series1: TLineSeries;
    Series2: TLineSeries;
    Button3: TButton;
    Chart2: TChart;
    Series3: TLineSeries;
    Series4: TLineSeries;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
   public
   SW:integer;
   procedure ShowVectorInList(List:TListBox; Src:TSortArray);

  end;

var
  Form1: TForm1;
  AR1,AR2: tSortArray;
  SW:integer;

implementation

{$R *.dfm}

function log(x,b: real):real;
begin
result:=ln(x)/ln(b);
end;


function CHB: integer; {определение выбранного кол-ва компонент}
begin
  Result:=Form1.seElCount.Value;
end;

function Merge({P:tIndexArray;} src: TSortArray; var Dest:TSortArray; L,M,H: integer):integer;
//выполняет слияние 2-х половин массива src от L до M - нижняя,
//от M+1 до H - верхняя в массив Dest
var i,j,k: integer;
Begin
  Result:=0;
  i:=L;   // первый элемент последовательности
  j:=M+1; // первый элемент второй половины последовательности
  k:=L;   // место, куда записываем
  //пока не закончилась одна из половин
  while (i<=M)and(j<=H) do
  begin
    if src[i]<src[j] then   // после просмотра записываем i-й элемент
      begin
        Dest[k]:=src[i];
        inc(i);
        inc(Result); // перестановка!
      end
    else
    begin
      Dest[k]:=src[j];    // после просмотра записываем j-й элемент
      inc(j);
      inc(Result); // перестановка!
    end;
    inc(k);
  end;
  //записываем оставшиеся элементы
  if i>M then // дописываем правую половину
  while j<=H do
    begin
      Dest[k]:=src[j];
      inc(j); inc(k);
      inc(Result); // перестановка!
    end
  else
  while i<=M do
    begin      // дописываем левую половину
      Dest[k]:=src[i];
      inc(i); inc(k);
      inc(Result); // перестановка!
    end;
end;

{Процедура расщепления}
function Split(L,H: integer; var src: TSortArray; var Dest: TSortArray):integer;
var M: integer;
// при первом обращении к данной процедуре массив Dest содержит копию src
Begin
  Result:=0;
  M:=(L+H) div 2; // середина последовательности
  // последовательность не элементарная => требуется разбиение
  If L<>H then
    begin
      Result:=Result+Split(L,M,src,dest);  // бисекция левой половины
      Result:=Result+Split(M+1,H,Src,dest); // бисекция правой половины
      Result:=Result+Merge(src,Dest,L,M,H);
      Src:=Dest;
    end;
  AR2:=Src;  {(*+*)}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 SW:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
  randomize;
  for i:=1 to CHB do AR1[i]:=random(999);
  ShowVectorInList(ListBox1,AR1);
end;

procedure TForm1.ShowVectorInList(List:TListBox; Src:TSortArray);
var i:integer;
begin
 List.Items.Clear;
 for i:=1 to CHB do
 List.Items.Add(IntToStr(Src[i]));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
SA: tSortArray;
begin
     SW:=0;
     SA:=AR1;
     SW:=Split(1,CHB,SA,SA);
     ShowVectorInList(ListBox2,AR2);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 i:integer;
 OldCursor:TCursor;
 k:real;
begin
 OldCursor:=Screen.Cursor;
 Screen.Cursor:=crHourGlass;
 for i:=1 to Form1.seElCount.Value do
 begin
  Application.ProcessMessages;
  seElCount.Value:=i; //устанавливаем длину сортируемого массива
  Button1.click; // генерируем массив случайным образом
  Button2.Click; //сортируем его
  k:=log(i,2);
  Series1.AddXY(i,i*k);
  Series2.AddXY(i,SW);
 end;
 Screen.Cursor:=OldCursor;
end;

end. 

[volvo]

А давай ты приведешь тот вариант, который (как ты утверждаешь) у тебя работает? Я например не вижу корректно работающей процедуры сортировки, а ползать по всей программе - это твоя проблема в первую очередь, раз уж ты ее так написал, что без этого не получается разобраться...

[RussoTuristo]

Функция Split производит расшепление последовательности символов, Merge сортирует, в принципе там еще комменты есть ... Могу их вынести отдельным сообщением ...
Есть программа моя, переделанная с индексами, но я там чето перемудрил ...и она вместо сортировки выводит одни нули ... задача уже мозг взрывает, вот важные процедуры из переделанной:

tIndexArray= array [1..1000] of integer;
function Merge(P:tIndexArray; src: TSortArray; var Dest:TSortArray; L,M,H: integer):integer;
//выполняет слияние 2-х половин массива src от L до M - нижняя,
//от M+1 до H - верхняя в массив Dest
var i,j,k: integer;
Begin
  Result:=0;
  i:=L;   // первый элемент последовательности
  j:=M+1; // первый элемент второй половины последовательности
  k:=L;   // место, куда записываем
  //пока не закончилась одна из половин
  while (i<=M)and(j<=H) do
  begin
    if src[P[i]]<src[P[j]] then   // после просмотра записываем i-й элемент
      begin
        Dest[k]:=P[i];
        inc(i);
        inc(Result); // перестановка!
      end
    else
    begin
      Dest[k]:=P[j];    // после просмотра записываем j-й элемент
      inc(j);
      inc(Result); // перестановка!
    end;
    inc(k);
  end;
  //записываем оставшиеся элементы
  if i>M then // дописываем правую половину
  while j<=H do
    begin
      Dest[k]:=P[j];
      inc(j); inc(k);
      inc(Result); // перестановка!
    end
  else
  while i<=M do
    begin      // дописываем левую половину
      Dest[k]:=P[i];
      inc(i); inc(k);
      inc(Result); // перестановка!
    end;
end;

{Процедура расщепления}
function Split(L,H: integer; var P: TIndexArray; var Dest: TSortArray):integer;
var M: integer;
Src:TSortArray;
// при первом обращении к данной процедуре массив Dest содержит копию src
Begin
  Result:=0;
  M:=(L+H) div 2; // середина последовательности
  // последовательность не элементарная => требуется разбиение
  If L<>H then
    begin
      Result:=Result+Split(L,M,P,dest);  // бисекция левой половины
      Result:=Result+Split(M+1,H,P,dest); // бисекция правой половины
      Result:=Result+Merge(P,Src,Dest,L,M,H);
      Src:=Dest;
    end;
  AR2:=Src;  {(*+*)}
end;

[volvo]

Что, издеваешься? Тебя просили НЕИНДЕКСНУЮ привести, РАБОТАЮЩУЮ!!! Нет, ты опять копируешь то, что и было в твоем архиве... Это я уже видел, зачем оно мне еще раз. Я хочу посмотреть на то, как БЕЗ ИНДЕКСОВ у тебя хоть что-то сортируется... Понимаешь? БЕЗ.

[RussoTuristo]

Извини, невнимательность ... ошибся и не ту прогу в архив сунул.

[volvo]

Раз - сами процедуры сортировки:

function Merge(var P:tIndexArray; src: TSortArray; var Dest:TSortArray; L,M,H: integer):integer;
var i,j,k: integer;
var DP: tindexarray;
Begin
  DP := P;
  Result:=0;
  i:=L;
  j:=M+1;
  k:=L;
  while (i<=M)and(j<=H) do begin
    if src[p[i]]<src[p[j]] then begin
      DP[k] := p[i];
      inc(i);
      inc(Result);
    end
    else begin
      dp[k] := p[j];
      inc(j);
      inc(Result);
    end;
    inc(k);
  end;

  if i>M then
    while j<=H do begin
      dp[k] := p[j];
      inc(j); inc(k);
      inc(Result);
    end
  else
    while i<=M do begin
      DP[k] := p[i];
      inc(i); inc(k);
      inc(Result);
    end;

  P := DP;
end;

function Split(var P: tIndexArray; L,H: integer; var src: TSortArray; var Dest: TSortArray):integer;
var M: integer;
Begin
  Result:=0;
  M:=(L+H) div 2;
  If L<>H then
    begin
      Result:=Result+Split(P, L,M,src,dest);
      Result:=Result+Split(P, M+1,H,Src,dest);
      Result:=Result+Merge(P, src,Dest,L,M,H);
    end;
  AR2:=Src;
end;

, два - вызов:

procedure TForm1.Button2Click(Sender: TObject);
var
  SA: tSortArray;
  P: tIndexArray;
  i: integer;
begin
     SW:=0;
     SA:=AR1;
     for i := 1 to CHB do P[i] := i; // Заполняем индексы значениями 1 .. CHB

     SW:=Split(P,1,CHB,SA,SA);

     ShowVectorInList(ListBox2,P); // Чтобы это отработало, я сделал tIndexArray = tSortArray;
end;

(в принципе, можно сделать другую процедуру для печати индексного массива).

Результат:

, противоречия не вижу, индексы располагаются в правильном порядке...

[RussoTuristo]

Спасибо большое.