Sisipan

program lokasi;
uses wincrt;
type tipelarik=array [1..100] of real;


var e,c,m:integer;
    d:tipelarik;

procedure tukarkan(var a,b:real);
var t:real;
begin
t:=a;
a:=b;
b:=t;
end;

procedure sisip_langsung(var a:tipelarik;n:integer);
var i,j:integer; t:real;
begin
for i:=2 to n do
    begin
    t:=a[i];j:=i-1;
    a[0]:=t;
    while t< a[j] do
        begin
        a[j+1]:=a[j];
        dec(j);
        end;
    a[j+1]:=t;
    end;
end;



begin
write('jumlah data');readln(m);
for e:=1 to m do
readln(d[e]);

sisip_langsung(d,m);

for c:=1 to m do
writeln(d[c]:0:0)
           
end.

Continue Reading...

Quik Short

program quick;
uses wincrt;
type tipelarik=array [1..100] of real;


var e,c,m,aw,ak:integer;
    d:tipelarik;

procedure tukarkan(var a,b:real);
var t:real;
begin
t:=a;
a:=b;
b:=t;
end;

procedure qs(var a:tipelarik; aw,ak:integer);
var i,j:integer;

 procedure atur;
  begin
   i:=aw+1;
   j:=ak;
   while a[i]
   while a[j]>a[aw] do dec(j);
   while i
    begin
     tukarkan(a[i],a[j]);
     while a[i]
     while a[j]>a[aw] do dec(j);
    end;
   tukarkan(a[aw],a[j]);
   end;

  begin {procedure qs}
  if aw
   begin
    atur;
    qs(a,aw,j-1);
    qs(a,j+1,ak);

   end;
 end;

 begin
write('jumlah data');readln(m);
for e:=1 to m do
readln(d[e]);

qs(d,1,m);

for c:=1 to m do
writeln(d[c]:0:0)
          
end.

Continue Reading...

Bublesort

program sorting;
uses wincrt;
type tipelarik=array [1..100] of real;


var e,c,m:integer;
    d:tipelarik;

procedure tukarkan(var a,b:real);
var t:real;
begin
t:=a;
a:=b;
b:=t;
end;

procedure bublesort(var a:tipelarik;n:integer);
var i,j: integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if a[j]>a[j+1] then tukarkan(a[j],a[j+1])
end;


begin
write('jumlah data=');

readln(m);
writeln('masukkan data=');
for e:=1 to m do
readln(d[e]);

writeln('data yang diurutkan=');
bublesort(d,m);

for c:=1 to m do
writeln(d[c]:0:0)
           
end.

Continue Reading...