============!
MATERI UAS !
============!
1. Soal2 PTI
2. Matematika Diskrit
Selasa, 29 Januari 2013
Minggu, 13 Januari 2013
Menambah Data;
program Latihan_menambah_file;
uses wincrt;
var
ftext:text;
begin
assign(ftext,'Latihan.txt');
append (ftext);
writeln;
writeln(ftext,'=>LATIHAN BROOOO<=');
writeln(ftext,'==================');
writeln(ftext,'MASUK ANGIN');
writeln(ftext,'BALING');
writeln(ftext,'<===============>');
close (ftext);
end.
uses wincrt;
var
ftext:text;
begin
assign(ftext,'Latihan.txt');
append (ftext);
writeln;
writeln(ftext,'=>LATIHAN BROOOO<=');
writeln(ftext,'==================');
writeln(ftext,'MASUK ANGIN');
writeln(ftext,'BALING');
writeln(ftext,'<===============>');
close (ftext);
end.
membuat file
program Latihan_file;
uses wincrt;
var
ftext:text;
begin
assign(ftext,'Latihan.txt');
rewrite(ftext);
writeln(ftext,'=>LATIHAN BROOOO<=');
writeln(ftext,'==================');
writeln(ftext,'SAYA LAGI BELAJAR');
writeln(ftext,'SAYA LAGI SIBUKKK');
writeln(ftext,'<===============>');
close (ftext);
end.
uses wincrt;
var
ftext:text;
begin
assign(ftext,'Latihan.txt');
rewrite(ftext);
writeln(ftext,'=>LATIHAN BROOOO<=');
writeln(ftext,'==================');
writeln(ftext,'SAYA LAGI BELAJAR');
writeln(ftext,'SAYA LAGI SIBUKKK');
writeln(ftext,'<===============>');
close (ftext);
end.
Pencarian Bagi Dua
program Pencarian_Bagi_Dua;
uses wincrt;
var
L : array [1..100] of integer;
n1,x1,m,hasil :integer;
function BinarySearch2(n :integer; x : integer) : integer;
var
i,j : integer;
idx, k : integer;
ketemu : boolean;
begin
i := 1;
j := n;
ketemu := false;
while (not ketemu) and (i <= j) do
begin
k:=(i + j) div 2;
if (L[k] = x) then
ketemu:= true
else
if (x > l[k]) then
i := k + 1
else
j := k - 1;
end;
if (ketemu) then
idx := k
else
idx := -1;
BinarySearch2:=idx;
end;
begin
write ('masukkan jumlah data : ');
readln (n1);
for m:=1 to n1 do
begin
write ('masukkan isi larik ke ' ,m,' ');
readln (L[m]);
end;
write ('inputkan data yang ingin dicari : ');
readln (x1);
hasil:=BinarySearch2 (n1,x1);
if (hasil = -1) then
writeln ('tidak ditemukan di larik')
else
writeln ('data inputan ditemukan di larik ke : ', hasil);
end.
uses wincrt;
var
L : array [1..100] of integer;
n1,x1,m,hasil :integer;
function BinarySearch2(n :integer; x : integer) : integer;
var
i,j : integer;
idx, k : integer;
ketemu : boolean;
begin
i := 1;
j := n;
ketemu := false;
while (not ketemu) and (i <= j) do
begin
k:=(i + j) div 2;
if (L[k] = x) then
ketemu:= true
else
if (x > l[k]) then
i := k + 1
else
j := k - 1;
end;
if (ketemu) then
idx := k
else
idx := -1;
BinarySearch2:=idx;
end;
begin
write ('masukkan jumlah data : ');
readln (n1);
for m:=1 to n1 do
begin
write ('masukkan isi larik ke ' ,m,' ');
readln (L[m]);
end;
write ('inputkan data yang ingin dicari : ');
readln (x1);
hasil:=BinarySearch2 (n1,x1);
if (hasil = -1) then
writeln ('tidak ditemukan di larik')
else
writeln ('data inputan ditemukan di larik ke : ', hasil);
end.
Minggu, 06 Januari 2013
Program Bubble_Sort;
Uses WinCrt;
const
max = 100;
type
Larik = array [1..max] of integer;
var
A: Larik;
I: integer;
N: integer;
pil:byte;
procedure Jumlah_Data;
begin
write('Masukkan banyaknya data = '); readln(N);
writeln;
end;
procedure Input;
var
I: integer;
begin
for I:=1 to N do
begin
write('Masukkan data ke-', I, ' = '); readln(A[I]);
end;
end;
procedure Change(var A, B: integer);
var
T: integer;
begin
T:=A;
A:=B;
B:=T;
end;
procedure asc_buble;
var
p,q :INTEGER;
flag:boolean;
begin
flag:=false;
p:=2;
while (p<N) and (not flag) do
begin
flag:=true;
for q:=N downto p do
if A[q]<A[q-1] then
begin
change(A[q],A[q-1]);
flag:=false;
end;
inc(i);
end;
writeln;
write('Data Diurutkan Secara Ascending: ');
end;
procedure desc_buble;
var
p,q :byte;
flag:boolean;
begin
flag:=false;
p:=2;
while (p<max) and (not flag) do
begin
flag:=true;
for q:=max downto p do
if A[q]>A[q-1] then
begin
change(A[q],A[q-1]);
flag:=false;
end;
inc(i);
end;
writeln;
write('Data Diurutkan Secara Descending: ');
end;
procedure Output;
var
i: integer;
begin
for i:=1 to N do
write(A[i], ' ');
writeln;
end;
begin
Jumlah_Data;
input;
clrscr;
writeln('[1].pengurutan secara Ascending');
writeln('[2].pengurutan secara Descending');
write('Silahkan Masukkan Pilihan Anda = ');readln(pil);
case pil of
1:asc_buble;
2:desc_buble;
end;
output;
end.
Langganan:
Postingan (Atom)