Сортировка списка слиянием. Опции

[ohad]

Добрый вечер, уважаемые форумчане!
Посмотрите мой код, пожалуйста!

Задача была написать сортировку слиянием для списка.
Проблема в программе: она заканчивает работу с ошибкой 216, я не могу понять почему... Так же, если посмотреть на вывод списка, он постепенно уменьшается. Куда пропадают элементы?
Что не так? Помогите, пожалуйста, найти ошибку!

Program mergelist;
uses
  crt; 
type
  Tinf=integer; 
  List=^TList;  
  TList=record 
    data:TInf;  
    next:List;   
  end;
 
 var i, l:integer;
 f:text;
 path:string;
 dff: integer;
 counter, moveCounter, n, k, i1: integer;
 spis, tmp1, lastelem:List;
 ch:char;

 {Список}
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1:List;znach1:TInf);
var
  tmp:List;
begin
  if spis1=nil then
  begin
    GetMem(spis1,sizeof(TList));  
    tmp:=spis1;
  end
  else 
  begin
    tmp:=spis1;
    while tmp^.next<>nil do
      tmp:=tmp^.next; 
    GetMem(tmp^.next,sizeof(TList)); 
    tmp:=tmp^.next;   
  end;
  tmp^.next:=nil; 
  tmp^.data:=znach1; 
end;
 
{процедура печати списка}
procedure Print(spis1:List);
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  while spis1<>nil do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next
  end;
end;
 
 
 {Сортировка}
 
 {Процедура слияния}
 function merge(priorNode1, priorNode2: list; count1, count2: integer): list;
 
 var i:integer;
 node1, node2, lastnode, temp: list;
 
 begin
 writeln('begin merge');
 lastnode:=priornode1;
 node1:=priornode1^.next;
 node2:=priornode2^.next;
 
 while (count1<>0) and (count2<>0) do begin
 if (node1^.data <= node2^.data) then begin 
 lastnode:=node1;
 node1:=node1^.next;
 dec(count1);
 end
 
 else begin
 temp:=node2^.next;
 node2^.next:=node1;
 lastnode^.next:=node2;
 lastnode:=node2;
 node2:=temp;
 dec(count2);
 end;
 end;
 
 if (count1 = 0) then begin
 lastnode^.next:=node2;
 for i:=0 to pred(count2) do
 lastnode:=lastnode^.next;
 end
 
 else begin 
 for i:=0 to pred(count2) do
 lastnode:=lastnode^.next;
 lastnode^.next:=node2;
 end;
 
 merge:=lastnode;
 end;
 
 {рекурсивная сортировка}
 function mergesort(priorNode: list; count: integer): list;
 var
 count2:integer;
 priorNode2:list;
 dummyNode:list;
 
 begin
if (count=1) then begin
writeln('begin 1 mergesort');
 mergesort:=priorNode^.next;
 exit;
 end;
 count2:=count div 2;
 count:=count-count2;
 writeln('count ', count);
 writeln('count2 ', count2);
 priorNode2:=mergesort(priorNode, count);
 dummyNode:=mergesort(priorNode2, count2);
 
 mergesort:=merge (priorNode, priorNode2, count, count2);
writeln('spis');
  print(spis);

 end;

 {запускаем сортировку}
 procedure sort (fhead: list; count:integer);
 begin
 if (count>1) then mergesort (fHead, count);
 
 {issorted:=true;}
 end;

 
 {программа}
begin
  Spis:=nil;
  
    clrscr;   
   For i1:=1 to 1 do begin
counter:=0; {счетчик сравнений}
moveCounter:=0; {счетчик перемещений}
  Spis:=nil;
  tmp1:=nil;

        case i1 of
    1:  begin path:='input.txt'; n:=10 end;
 
    end;
    
    assign(f,path);
    reset(f);
    
{читаем содержимое файла, записываем его в список}
    while not eof(f) do begin
    readln(f, dff);
    AddElem(spis, dff);
    end;
    end;
    
    print(spis);
    writeln('--end of list--');
    
    sort(spis, n);
    print(spis);
    
    
end.

[Федосеев Павел]

Чтобы легче было читать и разбираться с текстом программы - советую воспользоваться форматтером кода JCF.

Далее. Как говорят в голливудских фильмах: "Ты работаешь со списком и должен думать как список".
Это я к тому, что у списка нет индексов. И сортировку можно организовать примерно так

procedure Sort(var a: List);
  var
    left,
    right,
    tmp: List;
    n: integer;
begin
  {подсчёт числа элементов}
  tmp:= a;
  while  tmp<>nil do
  begin
    inc(n);
    tmp:=tmp^.next;
  end;
  if n>1 then
  begin
    {делим список на две части}
    ........................................
    {вызываем рекурсивный метод для каждой}
    Sort(left);
    Sort(right);

    {сливаем два списка в один}
    ......................................
  end;
end;

Причём, т.к. работаем со списком, то при разделении списка на две части, делаем так, чтобы оба списка left и right были независимы - т.е. последний элемент списков left и right должен указывать на nil.

Сообщение отредактировано: Федосеев Павел - 18.05.2014 11:33

[Федосеев Павел]

Примерно, так

program mergelist;

uses
  crt;

type
  Tinf = integer;
  List = ^TList;

  TList = record
    Data: TInf;
    Next: List;
  end;

  {Список}
  {Процедура добавления нового элемента в односвязный список}
  procedure AddElem(var spis1: List; znach1: TInf);
  var
    tmp: List;
  begin
    if spis1 = nil then
    begin
      GetMem(spis1, sizeof(TList));
      tmp := spis1;
    end
    else
    begin
      tmp := spis1;
      while tmp^.Next <> nil do
        tmp := tmp^.Next;
      GetMem(tmp^.Next, sizeof(TList));
      tmp := tmp^.Next;
    end;
    tmp^.Next := nil;
    tmp^.Data := znach1;
  end;

  {процедура печати списка}
  procedure Print(spis1: List);
  begin
    if spis1 = nil then
    begin
      WriteLn('Список пуст.');
      exit;
    end;
    while spis1 <> nil do
    begin
      Write(spis1^.Data, ' ');
      spis1 := spis1^.Next;
    end;
  end;

  {процедура освобождения памяти списка}
  procedure FreeList(var spis: List);
  var
    tmp: List;
  begin
    while spis <> nil do
    begin
      tmp  := spis;
      spis := spis^.Next;
      FreeMem(tmp, sizeof(TList));
    end;
  end;

  {Сортировка}
  procedure MergeSort(var a: List);
  var
    left, right, tmp, LastInA: List;
    i, n: integer;
  begin
    {подсчёт числа элементов}
    n   := 0;
    tmp := a;
    while tmp <> nil do
    begin
      Inc(n);
      tmp := tmp^.Next;
    end;

    if n > 1 then
    begin
      {делим список на две части}
      left := a;
      tmp  := a;
      for i := 1 to (n div 2) - 1 do
        tmp := tmp^.Next;
      right := tmp^.Next;
      tmp^.Next := nil;
      a := nil; {т.к. единого списка a уже не существует}
      Print(left);
      Write(' --- ');
      Print(right);
      WriteLn;
      {вызываем рекурсивный метод для каждой}
      MergeSort(left);
      MergeSort(right);
      {сливаем два списка в один}
      LastInA := nil;
      tmp     := nil;
      while (left <> nil) and (right <> nil) do
      begin
        if left^.Data > right^.Data then
        begin
          tmp  := left;
          left := left^.Next;
        end
        else
        begin
          tmp   := right;
          right := right^.Next;
        end;
        tmp^.Next := nil;
        if a = nil then
        begin
          a := tmp;
          LastInA := a;
        end
        else
        begin
          LastInA^.Next := tmp;
          LastInA := LastInA^.Next;
        end;
      end;
      if left <> nil then
        LastInA^.Next := left;
      if right <> nil then
        LastInA^.Next := right;
    end;
  end;

var
  f:    Text;
  path: string;
  dff:  integer;
  counter, moveCounter: integer;
  spis: List;

  {программа}
begin
  clrscr;
  counter     := 0;     {счетчик сравнений}
  moveCounter := 0;     {счетчик перемещений}

  {читаем содержимое файла, записываем его в список}
  path := 'input.txt';
  Assign(f, path);
  reset(f);
  Spis := nil;
  while not EOF(f) do
  begin
    readln(f, dff);
    AddElem(spis, dff);
  end;

  WriteLn('Incoming list:');
  Print(spis);
  WriteLn('--end of list--');

  MergeSort(spis);

  WriteLn('Sorted list:');
  Print(spis);
  WriteLn('--end of list--');

  FreeList(spis);
end.