program arh_bsort_menaik;

uses wincrt;

var i,n,j : integer;
a: array [1..100] of integer;

procedure buble;
var z: integer;
begin
for i:= 1 to n-1 do
begin
for j:= n downto i+1 do
begin
if a[j] < a[j-1] then
begin
z:= a[j];
a[j]:= a[j-1];
a[j-1]:=z;
end;
end;
end;

end;
begin
write('masukkan banyak larik (maks 100) : '); readln(n);
for i:= 1 to n do
begin write('A[',i,'] : '); readln(a[i]);
end;

buble;
write('data setelah diurutkan : ');

for j:=1 to n do
write (a[j],' ');
end.

Yang harus diperhatikan adalah koding
if a[j] < a[j-1] then
begin
z:= a[j];
a[j]:= a[j-1];
a[j-1]:=z;
end;
fungsi koding diatas adalah untuk menukarkan posisi dari angka yang ada pada larik. Jika nilai sekarang lebih kecil dari nilai sebelumnya maka tukar posisi array. Maksudnya serpti ini, misalnya kita punya data 1 4 3 ketika yang dicek array indeks ke 2 a[2]=4, akan dibandingkan nilainya dengan array indeks sebelumnya a[2-1]=1, apakah 4 < 1 ? kalau iya ditukar posisinya. Kalau tidak ya gak ditukar.
Selanjutnya pada array indeks ke 3 a[3]=3 dan a[3-1]=4. Apakah 3<4? Iya, barulah dijalankan proses pertukaran tempat/posisi array.

Konsepnya sama seprti algoritma tukar bejana. Dimana kita memiliki sebuah variabel temp yang bernama z.pertama nilai dari larik sekarang (yang ingin dipindahkan) a[i] akan diletakkan pada temp (z). kemudian nilai larik sekarang (a[i]) di isi dengan nilai sebelumnya a[i-1]. Lalu nilai dari a[i-1] di isi nilai z.
Contohnya : nilai a[i]= 4 a[i-1]=3. Maka tahapan pertukarannya adalah
z := 4; a[i]= 3; a[i-1]=4; selesai deh pertukaran dicek dan dilakukan terus sampai angka terurut semua.



Koding untuk bubble sort menurun

program arh_bsort_menurun;

uses wincrt;

var i,n,j : integer;
a: array [1..100] of integer;

procedure buble;
var z: integer;
begin
for i:= 1 to n-1 do
begin
for j:= n downto i+1 do
begin
if a[j] > a[j-1] then
begin
z:= a[j];
a[j]:= a[j-1];
a[j-1]:=z;
end;
end;
end;

end;
begin
write('masukkan banyak larik (maks 100) : '); readln(n);
for i:= 1 to n do
begin write('A[',i,'] : '); readln(a[i]);
end;

buble;
write('data setelah diurutkan : ');

for j:=1 to n do
write (a[j],' ');
end.

Kodingnya sama saja perbedaannya hanya pada tulisan yang berwarna merah.

btw yang belom punya tpw download dulu di sini klik

program arh_si2plarik;

uses wincrt;

var N, x,r,i,idx : integer;

ketemu :boolean;

a: array [1..100] of integer;

begin
write('masukkan banyak data '); readln(n);

for r:= 1 to n do
begin write('A[',r,'] : '); readln(a[r]);
end;

idx:=1;
ketemu:=false;
write ('nilai yang akan disisipkan : '); readln(x);

while (idx<=n) and (not ketemu) do
if (x<a[idx]) then ketemu:=true
else
idx:=idx+1;

if (ketemu) then
for i:=n downto idx do
a[i+1] := a[i];
a[idx]:= x;
if (not ketemu) then
a[n+1]:=x;


writeln;
writeln('hasil setelah pengurutan ');
writeln;


for r:= 1 to n+1 do
write (' ',a[r]);
end.
 

penjelasan
guna while (idx<=n) and (not ketemu) do
if (x<a[idx]) then ketemu:=true
else
idx:=idx+1;

Mencek apakah nilai yang disisipkan berada ditengah-tengah aray atau berada di akhir aray. Misalnya data array 1 2 4 5 yang disisipkan 3, berarti 3 berada ditengah-tengah aray (1 2 3 4 5) disiipkan ditengah.
guna while (idx<=n) melakukan perulangan sebanyak n kali dan indeks dari angka yang disisipkan belum ketemu.
if (x<a[idx]) then ketemu:=true jika nilai yang disisipkan (x) lebih kecil dari data yang sudah ada, berati angka tersebut akan disisipkan ditengah atau akan disisipkan diawal array.
else
idx:=idx+1;
jika tidak, menambahkan indeks baru, berati angka akan disisipkan di bagian ujung kanan.

Sintaks berikut.

if (ketemu) then
for i:=n downto idx do
a[i+1] := a[i];
a[idx]:= x;

Gunanya untuk meletakkan angka yang akan disisipkan (menyisipkan angka kedalam array). Pertama program mencek apakah angka berada ditengah array atau tidak (kalau ketemu berarti ditengah array). Maka data pun akan dirubah dengan sintaks for i:=n downto idx do a[i+1] := a[i]; memasukkan nilai pada array a[n] sampai array a[idx]

a[idx]:= x; memasukkan nilai yang disisipkan kedalam array dengan indeks a[idx]

if (not ketemu) then
a[n+1]:=x; (memasukkan nilai x kedalam indeks paling ujung sebelah kanan.)

program karakterNG;
uses wincrt;

const
L: array [1..11] of char = ('N','A','N','G','K','A',' ','A','N','G','#');
var
a,n : integer;

begin

write (L);
n:=0;
a:=1;
while (L[a] <> '#') do
begin
if (L[a] = 'N') and (L[a+1]='G') then
begin n:=n+1;
end;

L[a]:=L[a+1];
a:= a+1;
end;

writeln;
write('jumlah karakter NG : ',n,' buah');
end.

OUTPUT : jumlah karakter NG : 2 buah

penjelasan : pertama kita membuat sebuah konstanta L/larik dimana isinya adalah kumpulan dari karakter. dari karakter tersebut akan dicari apakah ada huruf NG, jika ada maka pada output akan ditampilkan berapa banyak huruf N yang berdampingan dengan G.
kemudian kita tulis kata yang ada di dalam larik/array L write(L);
setelah itu beri nilai n dan a untuk indeks pada larik.

kemudian cek apakah karakter merupakan # ? kalau iya berarti pencarian dihentikan.
kalau tidak, dicek lagi apakah isi karakter merupakan huruf 'N' dan karakter selanjutnya adalah 'G' jika iya maka nilai n (variabel yang menampung jumlah karakter NG) ditambah 1.

guna
L[a]:=L[a+1];
a:= a+1;
adalah untuk melakukan pencarian berikutnya. larik yang selanjutnya.

menghitung banyak kata

untuk menghitung banyak kata hanya perlu mengganti kondisi
if (L[a] = 'N') and (L[a+1]='G') then
begin n:=n+1;
end;


menjadi if (L[a] <> ' ') and (L[a+1]=' ') then

dan ganti n:=0 menjadi n:=1


menjadi

program karakterNG;
uses wincrt;

const
L: array [1..11] of char = ('N','A','N','G','K','A',' ','A','N','G','#');
var
a,n : integer;

begin

write (L);
n:=1;
a:=1;
while (L[a] <> '#') do
begin
if (L[a] <> ' ') and (L[a+1]=' ') then
begin n:=n+1;
end;

L[a]:=L[a+1];
a:= a+1;
end;

writeln;
write('jumlah kata pada teks adalah : ',n,' buah');
end.