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=');
Randomize;
create_rand_vect(a,n);
Writeln('1:');
print_vector(a,n);
Writeln('2:');
sort(1,n);
print_vector(a,n);
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=');
Randomize;
create_rand_vect(a,n);
{Writeln('1:');
print_vector(a,n);}
Writeln('2:');
sort(0,n-1);
print_vector(a,n);
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=');
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);
end.

unit UCountingSort can be found:

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

Try the other alternatives

[#] Next page

Go to full version