program MergeSort

program MergeSort;

uses crt;

const
    n=100;

type
    A = array[1..n] of integer;

procedure mergeasc (var h: integer; m: integer; U: A; V:A; var S:A);
var
    i,j,k,l : integer;
begin
    i:=1;
    j:=1;
    k:=1;
   
    while (i<=h) and (j<=m) do
    begin
        if (U[i] < V[j]) then
        begin
            S[k]:=U[i];
            i:=i+1;
        end
        else
        begin
            S[k]:=V[j];
            j:=j+1;
        end;
        k:=k+1;
    end;
       
    if i>h then
    begin
        for l:= j to m do
        begin
            S[k]:=V[l];
            k:=k+1;
        end;
    end
    else
    begin
        for l:= i to h do
        begin
            S[k]:=U[l];
            k:=k+1;
        end;
    end;
   
    {for i:= 1 to k-1 do
    begin
        Write(S[i]:2);
    end;
    Writeln;
    Writeln;}
end;

procedure mergedesc (var h: integer; m: integer; U: A; V:A; var S:A);
var
    i,j,k,l : integer;
begin
    i:=1;
    j:=1;
    k:=1;
   
    while (i<=h) and (j<=m) do
    begin
        if (U[i] > V[j]) then
        begin
            S[k]:=U[i];
            i:=i+1;
        end
        else
        begin
            S[k]:=V[j];
            j:=j+1;
        end;
        k:=k+1;
    end;
       
    if i>h then
    begin
        for l:= j to m do
        begin
            S[k]:=V[l];
            k:=k+1;
        end;
    end
    else
    begin
        for l:= i to h do
        begin
            S[k]:=U[l];
            k:=k+1;
        end;
    end;
   
    {for i:= 1 to k-1 do
    begin
        Write(S[i]:2);
    end;
    Writeln;
    Writeln;}
end;

procedure mergesortasc (var n:integer; var S:A);
var
    U : A;
    V : A;
    h,m,i,j: integer;
begin
    if n > 1 then
    begin
        h:= n div 2;
        m:= n-h;
       
        for i:=1 to h do
        begin
            U[i]:= S[i];
            //write (U[i]:2);
        end;
        //writeln;
       
        j:=h+1;
        for i:=1 to m do
        begin
            V[i]:= S[j];
            j:=j+1;
            //write (V[i]:2);
        end;
        //writeln;
       
        mergesortasc(h,U);
        mergesortasc(m,V);
       
        mergeasc (h,m,U,V,S);
    end;
end;

procedure mergesortdesc (var n:integer; var S:A);
var
    U : A;
    V : A;
    h,m,i,j: integer;
begin
    if n > 1 then
    begin
        h:= n div 2;
        m:= n-h;
       
        for i:=1 to h do
        begin
            U[i]:= S[i];
            //write (U[i]:2);
        end;
        //writeln;
       
        j:=h+1;
        for i:=1 to m do
        begin
            V[i]:= S[j];
            j:=j+1;
            //write (V[i]:2);
        end;
        //writeln;
       
        mergesortdesc(h,U);
        mergesortdesc(m,V);
       
        mergedesc (h,m,U,V,S);
    end;
end;

var
    S:A;
    i,t,pilih: integer;
BEGIN
    Write('Masukkan jumlah data: ');
    Readln(t);
    for i:= 1 to t do
    begin
        Write (i,') ');
        Readln(S[i]);
    end;
   
    Writeln ('Pilih: ');
    Writeln ('1. Ascending');
    Writeln ('2. Descending');
    Readln(pilih);
   
    if pilih=1 then   
    mergesortasc (t,S)
    else
    mergesortdesc (t,S);
   
    Write('Data sekarang: ');
    for i:= 1 to t do
    begin
        Write(S[i]:2);
    end;
END.

Tweet