Forum > Beginners

Merge Sort doesn't work if count of elements is very big

(1/2) > >>

moskalenco_a:
Hi all! I have written code of Merge Sort.It works, but if count of elements above 50000 - RunTime Error,exitcode=201. It's maybe because of using too much memory. How can I solve this problem?
I tried to use dynamic arrays but that didn't help me.

--- Code: ---type vector=array[1..1000000] of Integer;
var a:vector;

procedure merge(l,r,x,y:Integer);
var i,j,k,s:Integer;
c:vector;
begin
i:=l;
j:=y;
k:=1;
while (l<=r) and (x<=y) do
 begin

  if a[l]<a[x] then
   begin
    c[k]:=a[l];
    inc(l);
   end else
   begin
    c[k]:=a[x];
    inc(x);
   end;
  inc(k);

 end;

  if l<=r then
   for s:=l to r do
    begin
     c[k]:=a[s];
     inc(k);
    end else
   for s:=x to y do
    begin
     c[k]:=a[s];
     inc(k);
    end;

k:=1;
for s:=i to j do
 begin
  a[s]:=c[k];
  inc(k);
 end;
end;

procedure sort(const l,r:Integer);
var m:Integer;
begin
if l=r then Exit;
m:=(l+r) div 2;
sort(l,m);
sort(m+1,r);
merge(l,m,m+1,r);
end;

procedure create_rand_vect(var a:vector;const n:Integer);
var i:Integer;
begin
for i:=1 to n do a[i]:=Random(51)-25;
end;

procedure print_vector(const a:vector; const n:Integer);
var i:Integer;
begin
for i:=1 to n do Write(a[i],' ');
Writeln;
end;

var n:Integer;
begin
Write('n=');
Readln(n);
Randomize;
create_rand_vect(a,n);
Writeln('1:');
print_vector(a,n);
Writeln('2:');
sort(1,n);
print_vector(a,n);
Readln;
end.
--- End code ---
P.S Sorry for my bad English, I'm from Ukraine...

Laksen:
Try using longint instead of integer. Integer is 16 bit in Linux when compiling in mode FPC.

moskalenco_a:
Thank you very much!!! There is even simplier solution: if write {$mode objfpc} Integer=LongInt and all is working!

moskalenco_a:
And with dynamic arrays it's much more quckly!

--- Code: ---{$mode objfpc}
type vector=array of Integer;
var a:vector;

procedure merge(l,r,x,y:Integer);
var i,j,k,s:Integer;
c:vector;
begin
i:=l;
j:=y;
k:=0;
SetLength(c,r-l+1+y-x+1);
while (l<=r) and (x<=y) do
 begin

  if a[l]<a[x] then
   begin
    c[k]:=a[l];
    inc(l);
   end else
   begin
    c[k]:=a[x];
    inc(x);
   end;
  inc(k);

 end;

  if l<=r then
   for s:=l to r do
    begin
     c[k]:=a[s];
     inc(k);
    end else
   for s:=x to y do
    begin
     c[k]:=a[s];
     inc(k);
    end;

k:=0;
for s:=i to j do
 begin
  a[s]:=c[k];
  inc(k);
 end;
end;

procedure sort(const l,r:Integer);
var m:Integer;
begin
if l=r then Exit;
m:=(l+r) div 2;
sort(l,m);
sort(m+1,r);
merge(l,m,m+1,r);
end;

procedure create_rand_vect(var a:vector;const n:Integer);
var i:Integer;
begin
SetLength(a,n);
for i:=0 to n-1 do a[i]:=Random(101);
end;

procedure print_vector(const a:vector; const n:Integer);
var i:Integer;
begin
for i:=0 to n-1 do Write(a[i],' ');
Writeln;
end;

var n:Integer;
begin
Write('n=');
Readln(n);
Randomize;
create_rand_vect(a,n);
{Writeln('1:');
print_vector(a,n);}
Writeln('2:');
sort(0,n-1);
print_vector(a,n);
Readln;
end.
--- End code ---
Thank's for help!

djzepi:
Here is a small example that allows you to compare speeds

unit umergesort;

{$mode objfpc} {$H+}

interface

uses
  Classes, SysUtils;
type
   TItemMergeSort = integer;

procedure MergeSort( var a: array of TItemMergeSort );

implementation

procedure merge(var a: array of TItemMergeSort; l,r,x,y:Integer);
var
  i,j,k,s: Integer;
  c: array of TItemMergeSort;
begin
  i := l ;
  j := y ;
  k := 0 ;
  SetLength(c, r - l + 1 + y - x + 1 ) ;
  while (l <= r ) and ( x <= y ) do
   begin
      if a[ l ] < a[ x ] then
     begin
      c[ k ] := a[l ] ;
      inc( l ) ;
     end else
     begin
      c[ k ] := a[ x ] ;
      inc( x ) ;
     end;
    inc( k ) ;
   end;
    if l <= r then
     for s := l to r do
      begin
       c[k] := a[ s ] ;
       inc( k ) ;
      end else
     for s := x  to y do
      begin
       c[k] := a[ s ] ;
       inc( k ) ;
      end ;
  k := 0 ;
  for s := i to j do
   begin
    a[ s ] := c[ k ] ;
    inc( k ) ;
   end;
end;

procedure sort(var a: array of TItemMergeSort; const l,r:Integer);
var m:Integer;
begin
  if l=r then Exit;
  m:=(l+r) div 2;
  sort(a, l,m);
  sort(a, m+1,r);
  merge(a,l,m,m+1,r);
end;

procedure MergeSort( var a: array of TItemMergeSort );
var
  n : integer;
begin
  n := length( a );
  sort(a, 0, n-1 );
end;

end.


program mergesortcompare;


{$mode objfpc}

uses SysUtils,umergesort,UCountingSort;

type vector=array of Integer;
var a, b:vector;


procedure create_rand_vect(var a,b:vector;const n:Integer);
var i:Integer;
begin
  SetLength(a,n);
  SetLength(b,n);
  for i:=0 to n-1 do
    begin
      a:=Random(1010);
      b := a;
    end;
end;

procedure print_vector(const a:vector; const n:Integer);
var i:Integer;
begin
for i:=0 to n-1 do Write(a,' ');
Writeln;
end;

procedure copy_vect(var a,b:vector;const n:Integer);
var i:Integer;
begin
  for i:=0 to n-1 do
    begin
      b := a;
    end;
end;

var n:Integer;

  timeStart, timeEnd, timeTotal: TDateTime;
begin
  Write('n=');
  Readln(n);
  Randomize;
  create_rand_vect(a,b,n);
  {Writeln('1:');
  print_vector(a,n);}
  Writeln('2:');
  timeStart := now;
  CountingSort(b);
  timeEnd := now;
  timeTotal :=  timeEnd - timeStart ;
  Writeln('CountingSort:'+formatdatetime('hh:nn:ss:zzzz', timeTotal));
  copy_vect( a, b,n);
  timeStart := now;
  MergeSort( b );
  timeEnd := now;
  timeTotal :=  timeEnd - timeStart ;
  Writeln('MergeSort:'+formatdatetime('hh:nn:ss:zzzz', timeTotal));
  //print_vector(b,n);
  Readln;
end.     



unit UCountingSort can be found:

http://wiki.lazarus.freepascal.org/Counting_sort

Try the other alternatives

Navigation

[0] Message Index

[#] Next page