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

[serega204]

Помогите пожалуйста с сортировкой...написал так как нам объяснили...а тут не сортируется ничего...спасибо...вот задание
Дан массив типа "запись". Запись содержит сведения о туристических фирмах и состоит из четырёх полей: название, специализация, адрес и телефон. Упорядочить элементы по названию фирмы, используя сортировку методом последовательного слияния!!!

Program LR_5; Uses Crt;
Type
St = String[15];
Struct = Record
            NF : String[15];
            AI : String[17];
            AD : String[32];
           Tel : Longint;
             End;
  Fl = File Of Struct;
Var  i : integer;
     Z : Struct;
Fi, Fr : Text;
     F : Fl;
 
{Процедура вывода данных одной строки}
Procedure P;
Begin     With Z do
Writeln (Fr, NF, AI, AD, Tel);
End;
 
{Процедура сортировки методом последовательного слияния}
Procedure Posl_Sl;
Type TA = Array[1..10] Of Struct;
    PTA = ^TA;
Var A, B : PTA;
    Dl, Dl_1, Dl_2, i1, i2, N1, N2, k, N : Integer;
    p1, p2 : Boolean;
Label M1, M2, M3;
 
{Пересылка очередного элемента в выходной массив}
Procedure PS(Var i, NP : integer; Var p : Boolean);
Begin
     B^[k] := A^[i]; i := i+1;
If i > NP then p := False;
End;
BEGIN
Reset(F);       N := FileSize(F);
GetMem(A, N*Sizeof(Struct));
Writeln(Fr, 'Массив до сортировки');
  For i := 1 to N do Begin
  Read(F, Z);   P;   A^[I] := Z;
                     End;
For i := N DownTo 2 do Begin
Dl := 1;
M1 : Dl_1 := Dl_1-1; i1 := 1;
M2 : N1 := i1+Dl_1; i2 := N1+1; N2 := i2+Dl_1;
p1 := True; p2 := True;
                       End;
If N2 <= N Then GoTo M3; N2 := N;
If i2 <= N then GoTo M3; p2 := False;
If N1 > N  then N1 := N;
M3 : For k := i1 to N2 Do
     If P1 and p2 then
        If A^[i].NF < A^[i2].NF then PS(i1, N1, p1)
                                else PS(i2, N2, p2)
                  else
        If p1 then PS(i1, N1, p1)
              else PS(i2, N2, p2);
If N2 < N then Begin
   i1 := N2+1; GoTo M2; End;
   A^ := B^;
If Dl < (N+1) div 2 then Begin
   Dl := Dl*2; GoTo M1;  End;
Writeln(Fr, #10#13, 'Массив после сортировки');
Seek(F, 0);
For i := 1 to N do Begin
    Z := A^[i]; Write(F, Z); P;
                   End;
Close(F);
FreeMem(A, N*SizeOf(Struct));
END;
 
{----- ОСНОВНАЯ ПРОГРАММА -----}
Begin CLRSCR;
Assign (F, 'lr8.typ');
Assign (Fr, ''); Rewrite (Fr);
Writeln('                     Туристические фирмы г.Москвы');
Writeln('Название            Веб-сайт                 Адрес              Телефон');
Writeln;
    Posl_Sl;
Readln;
Close (Fr);
End.

[volvo]

А знаешь, почему ответов нет? Потому, что разбирать "лапшу" с метками и GoTo не хочется никому. Напиши программу, как положено, без этих жутких операторов и нормально отформатируй исходник (сейчас это больше похоже на квесты "найди метку среди операторов" и "а ты заметил вызов процедуры?") - тогда посмотрим что у тебя не получается.

[serega204]

Помогите пожалуйста с сортировкой...написал по другому без Goto и меток...но всё равно не сортируется, но хорошо хоть исходный массив выводится, спасибо...вот задание
Дан массив типа "запись". Запись содержит сведения о туристических фирмах и состоит из четырёх полей: название, специализация, адрес и телефон. Упорядочить элементы по названию фирмы, используя сортировку методом последовательного слияния!!!....вот текст программы:

Program lr_4; Uses Crt;
Const N = 10;
Type
     Struct = Record
              NF : String[15];
              AI : String[17];
              AD : String[32];
             Tel : Longint;
              End;
         Mas = Array[1..N] Of Struct;
         Fl = File Of Struct;
Var Z : Array [1..N] Of Struct;
    C : Struct;
    I : Integer;
   Fi : Text;
    F : Fl;

{Ввод массива записей}
Procedure Vivod;
Begin
For I := 1 to N do
    Begin with Z[I] do
    Writeln (NF, AI, AD, Tel);
    End;
End;

{Вывод массива записей из текстового файла}
Procedure Vvod;
Begin
     Assign (FI, '2.dat'); Reset (FI);
     Writeln('                       Туристические фирмы г.Москвы', #10#13);
For I := 1 to N do
With Z [I] do Begin
Readln (FI, NF, AI, AD, Tel);
End;
     Vivod;
     Close (FI);
     End;

{Процедура сортировки записей методом последовательного слияния}
Procedure Posl_Sl;
Type Mas = Array[1..N] of Struct;
    TMas = ^Mas;
Var A, B : Tmas;
    N, k, j, t, q, r, p0, q0, s0, p : Integer;
Begin
     Reset(F);
     N := FileSize(F);
     GetMem(A, N*SizeOf(Struct));
     k := 1;
     while k < N do
     Begin
          t := 0;
          While t + k < N do
          Begin
               p := t; q := t + k;
               If (t+2*k) > N then r := t+2*k;
               p0 := p; q0 := q; s0 := p;
               While (p0 <> q) or (q0 <> r) do
               Begin
                    If (p0 < q) and ((q0 = r) or ((q0 < r) and
                    (A^[p0 + 1].NF <= A^[q0 + 1].NF))) then
                    Begin
                         B^[p0 + 1].NF := A^[p0 + 1].NF;
                         Inc(p0);
                    End
                                                        else
                         Begin
                              B^[s0 + 1].NF := A^[q0 + 1].NF;
                              Inc(q0);
                         End;
               Inc(s0);
               End;
          t := r;
          End;
     k := k shl 1;
     A^ := B^;
     End;
     For k := 1 To N do
         Begin
              C := B^[k]; Write(F, C);
              Writeln (C.NF, C.AI, C.AD, C.Tel);
              Close(F);
              FreeMem(A, N*SizeOf(Struct));
         End;
End;

{----- ОСНОВНАЯ ПРОГРАММА -----}
BEGIN Clrscr;
Assign(F, 't.typ');
Writeln('Массив до сортировки');
   Vvod;
Writeln(#10#13, 'Массив после сортировки');
        Posl_Sl;
Repeat Until KeyPressed;
END.

[volvo]

А тут у тебя вообще непонятно что: ты читаешь данные из TXT-файла, то есть, насколько можно судить, TYP-файл в начале работы программы пуст? Тогда это неверно, потому что N := FileSize(F); вернет 0... В любом случае, у тебя 2 очень серьезные ошибки: во-первых, ты не заполняешь A^ данными, там у тебя мусор. А во-вторых - B вообще не инициализируется, хотя переход по указателю B^ в программе присутствует. Это тоже мусор. В общем, выделяй память как положено, и заполняй массивы, потом продолжим...

[serega204]

А что мне тогда надо сделать, не очень понятно

[volvo]

Я не знаю, что такое последовательное слияние. Естественное слияние - знаю, с его помощью задача решается так:

procedure NaturalMerge(var vA: array of Struct; const size: integer);
type
  PArr = ^TArr;
  TArr = array[0 .. pred(maxint div sizeof(Struct))] of struct;

  function less_eq(const X, Y: struct): boolean;
  begin
    less_eq := X.nf <= Y.nf;
  end;
  function more_eq(const X, Y: struct): boolean;
  begin
    more_eq := X.nf >= Y.nf;
  end;

  procedure merge(A, B: PArr; lo, hi: integer; asc: boolean);
  var
    k, c: integer;
    i, j: integer;
  begin
    if asc then begin
      k := lo; c := 1;
    end
    else begin
      k := hi; c := -1;
    end;
    i := lo; j := hi;

    while i <= j do begin
      if less_eq(a^[i], a^[j]) then begin
        b^[k] := a^[i]; inc(i);
      end
      else begin
        b^[k] := a^[j]; dec(j);
      end;
      inc(k, c);
    end;

  end;

  function mergeruns(a, b: parr): boolean;
  var
    i, k: integer;
    X: struct;
    asc: boolean;
  begin
    i := 0; k := 0; asc := true;
    while i < size do begin
      k := i;
      repeat
        X := A^[i]; inc(i);
      until not ((i < n) and less_eq(X, A^[i]));

      while (i < size) and more_eq(X, A^[i]) do begin
        X := a^[i]; inc(i);
      end;
      merge(a, b, k, i - 1, asc);
      asc := not asc;
    end;

    mergeruns := k = 0;
  end;

var
  A, B: PArr;

  procedure nms;
  begin
    while not mergeruns(a, b) and not mergeruns(b, a) do;
  end;

begin
  getmem(A, size * sizeof(struct));
  for i := 0 to size - 1 do A^[i] := vA[i];
  getmem(B, size * sizeof(struct));

  nms;

  freemem(B, size * sizeof(struct));
  for i := 0 to size - 1 do vA[i] := A^[i];
  freemem(A, size * sizeof(struct));
end;

Вызывать вот так:

{ читаем данные из файла в массив Z, число записей = size }
naturalmerge(z, size);
{ массив Z отсортирован, делаем с ним что нужно }

[serega204]

спасибо огромное, обязательно посмотрю

[serega204]

Volvo спасибо огромное, я посмотрел, всё хорошо работает, добавил в текстовый файл ещё записей и всё получается просто СУПЕРРРРР? ,благодарю ....спасибо и жму руку

[Lapp]

Volvo спасибо огромное, я посмотрел, всё хорошо работает, добавил в текстовый файл ещё записей и всё получается просто СУПЕРРРРР? ,благодарю ....спасибо и жму руку

За чем же дело? Правила, предисловие, третий абзац.