Crypto

{
Agung Fitriyanto 7644;
Firman Maulana 7666;
Tri Danarto 7806;
}

program kripto;
uses crt;
var kata1,kata2,kata3,sandi1,sandi2,terj1,terj2,bantu:string;
a,b,c:char;
i,j,k,l:integer;
jalan:boolean;

procedure caribinernya(var tempat:string;x:integer);
{Procedure untuk mengubah suatu nilai integer ke bilangan biner 8 digit
dengan format string (karena tidak ada format biner dalam pascal)untuk
kemudian dikodekan}
begin
if x>127 then begin tempat:=tempat+'1';x:=x-128 end else tempat:=tempat+'0';
if x>63 then begin tempat:=tempat+'1';x:=x-64 end else tempat:=tempat+'0';
if x>31 then begin tempat:=tempat+'1';x:=x-32 end else tempat:=tempat+'0';
if x>15 then begin tempat:=tempat+'1';x:=x-16 end else tempat:=tempat+'0';
if x>7 then begin tempat:=tempat+'1';x:=x-8 end else tempat:=tempat+'0';
if x>3 then begin tempat:=tempat+'1';x:=x-4 end else tempat:=tempat+'0';
if x>1 then begin tempat:=tempat+'1';x:=x-2 end else tempat:=tempat+'0';
if x=1 then begin tempat:=tempat+'1';x:=x-1 end else tempat:=tempat+'0';
end;

procedure cariintegernya(x:string;var y:integer);
{Procedure untuk mengubah suatu nilai biner (dalam variabel berbentuk string)
ke suatu nilai integernya dengan basis 10}
var anu:integer;
begin
y:=0;
if x[1]='1' then y:=y+128;
if x[2]='1' then y:=y+64;
if x[3]='1' then y:=y+32;
if x[4]='1' then y:=y+16;
if x[5]='1' then y:=y+8;
if x[6]='1' then y:=y+4;
if x[7]='1' then y:=y+2;
if x[8]='1' then y:=y+1;
end;

procedure acak(x:string;var y:string);
{Procedure untuk pengkodean dengan subsitusi}
begin
if x='000' then y:='010';
if x='001' then y:='011';
if x='010' then y:='100';
if x='011' then y:='101';
if x='100' then y:='110';
if x='101' then y:='111';
if x='110' then y:='000';
if x='111' then y:='001';
end;

procedure acak2(x:string;var y:string);
{Procedure untuk penerjemahan balik dari suatu kode}
begin
if x='000' then y:='110';
if x='001' then y:='111';
if x='010' then y:='000';
if x='011' then y:='001';
if x='100' then y:='010';
if x='101' then y:='011';
if x='110' then y:='100';
if x='111' then y:='101';
end;

begin
clrscr;
kata1:='';
while kata1='' do
begin
write(' Kata yang mau diacak = ');{Kata yang mau dikodekan}
readln(kata1);
end;

jalan:=true;
while jalan do
begin
a:=kata1[1];{ambil karakter terdepan}
i:=ord(a);{cari nilai ASCII-nya}
caribinernya(sandi1,i);{ubah ke bentuk biner 8 digit}
while length(sandi1)>=3 do {dipotong per-3 untuk dikodekan}
begin
terj1:=sandi1[1]+sandi1[2]+sandi1[3];{ambil 3 karakter terdepan}
acak(terj1,terj2);{pengkodean tiga karakter tadi}
sandi2:=sandi2+terj2; {hasil pengkodean disimpan di sandi2}
delete(sandi1,1,3);{tiga karakter terdepan yang sudah dikodekan dihapus}
end;

while length(sandi2)>=8 do {hasil pengkodean (sandi2) di terjemahkan ke
kode ASCII kembali per 8 digit (1 karakter)}
begin
bantu:='';
for j:=1 to 8 do bantu:=bantu+sandi2[j];{8 karakter terdepan diambil}
cariintegernya(bantu,k);{8 digit bilangan dicari nilai integernya}
kata2:=kata2+char(k);{hasil pengkodean di masukkan ke kata2}
delete(sandi2,1,8);{8 karakter yang sudah dikodekan dihapus}
end;
delete(kata1,1,1);{hapus karakter terdepan dari kata1}
if kata1='' then jalan:=false;{perulangan berhenti jika kata sudah habis}
end;

{Percabangan di bawah ini digunakan jika ternyata jumlah karakter yang
mau dikodekan bukan kelipatan 3 sehingga ada kekurangn digit pada
terjemahan per-3 digit}
if sandi1<>'' then {Sandi1 masih menyisakan karakter yang belum dikodekan}
begin
l:=0;
while length(sandi1)<3 do
begin
sandi1:=sandi1+'0';
l:=l+1;{l merupakan jumlah karakter yang ditambahkan agar genap 3 digit}
end;
terj1:=sandi1;sandi1:='';
acak(terj1,terj2);
sandi2:=sandi2+terj2;
if length(sandi2)>8 then delete(sandi2,9,l);{setelah dikodekan sandi2
dipotong sebanyak penambahannya}
cariintegernya(sandi2,k);
kata2:=kata2+char(k);
end;
writeln(' Kode yang dihasilkan = ',kata2); {Kode final}
readln;
{Untuk jumlah karakter kata1 yang tidak kelipatan 3 maka akan mengakibatkan
sandi1 sebagai variabel penyimpan bilangan-bilangan biner yang akan dikodekan
masih menyimpan beberapa digit sisa, sehingga harus ditambahkan suatu bilangan
ada 2 kemungkinan pada terjemahan per-3 yaitu kurang 1 digit atau 2 digit.
Untuk itu ditambahkan suatu bilangan di belakangnya sehingga:
xx0 --> 000 menjadi 010 atau 00_ menjadi 01_
010 menjadi 100 atau 01_ menjadi 10_
100 menjadi 110 atau 10_ menjadi 11_
110 menjadi 000 atau 11_ menjadi 00_
x00 --> 000 menjadi 010 atau 0__ menjadi 0__
100 menjadi 110 atau 1__ menjadi 1__
kemudian setelah pengacakan 3 digit bilangan tersebut pada penerjemahan ke
bilangan ASCII dipotong kembali pada digit belakang sesuai jumlah penambahan

Sedangkan untuk penerjemahan balik dari suatu kode maka tentunya akan mengalami
kendala yang sama, tapi pada digit yang kurang tersebut ditambahkan bilagan 1
sehingga :
xx1 --> 001 dibaca 111 atau 00_ menjadi 11_
011 dibaca 001 atau 01_ menjadi 00_
101 dibaca 011 atau 10_ menjadi 01_
111 dibaca 101 atau 11_ menjadi 10_
x11 --> 011 dibaca 001 atau 0__ menjadi 0__
111 dibaca 101 atau 1__ menjadi 1__

Dengan metode diatas terjadi kesesuaian dengan penambahan bilangan 0 pada
saat pengkodean.
Untuk membuktikan hal tersebut di bawah ini dibuat sebuah pengkodean balik
dari kode yang sudah dibuat diatas dengan cara seperti yang sudah disebutkan

}

jalan:=true;sandi1:='';sandi2:='';
while jalan do
begin
a:=kata2[1];
i:=ord(a);
caribinernya(sandi1,i);
while length(sandi1)>=3 do
begin
terj1:=sandi1[1]+sandi1[2]+sandi1[3];
acak2(terj1,terj2);
sandi2:=sandi2+terj2;
delete(sandi1,1,3);
end;

while length(sandi2)>=8 do
begin
bantu:='';
for j:=1 to 8 do bantu:=bantu+sandi2[j];
cariintegernya(bantu,k);
kata3:=kata3+char(k);
delete(sandi2,1,8);
end;
delete(kata2,1,1);
if kata2='' then jalan:=false;
end;

if sandi1<>'' then
begin
l:=0;
while length(sandi1)<3 do
begin
sandi1:=sandi1+'1';
l:=l+1;
end;
terj1:=sandi1;sandi1:='';
acak2(terj1,terj2);
sandi2:=sandi2+terj2;
if length(sandi2)>8 then delete(sandi2,9,l);
cariintegernya(sandi2,k);
kata3:=kata3+char(k);
end;
writeln(' Kode yang dibalikkan = ',kata3);
readln;
end.

Ember Queue

Program Ember;

Const
QUEUE_SIZE = 1000000;
MaxA = 4;
MaxB = 3;

Type
TQueue = Record
Sebelumnya : LongInt;
Langkah : Byte;
A, B : Integer;
End;

Var
Queue : Array[0..QUEUE_SIZE] of TQueue;
Langkah : Array[1..QUEUE_SIZE] of Byte;
QPos : LongInt;
QNext : LongInt;
A1, B1 : Integer;
A2, B2 : Integer;
i, j : LongInt;

Procedure Proses;
Begin

QPos := 0;
QNext := 0;

Queue[QPos].Langkah := 0;
Queue[QPos].A := A1;
Queue[QPos].B := B1;

While True do
Begin
If (Queue[QPos].A = A2) And (Queue[QPos].B = B2) Then
Break;

{ A diisi penuh --> hanya jika A belum penuh}
If Queue[QPos].A < MaxA Then
Begin
QNext := QNext + 1;
Queue[QNext].A := MaxA;
Queue[QNext].B := Queue[QPos].B;
Queue[QNext].Langkah := 1;
Queue[QNext].Sebelumnya := QPos;
End;

{ B diisi penuh --> hanya jika B belum penuh }
If Queue[QPos].B < MaxB Then
Begin
QNext := QNext + 1;
Queue[QNext].A := Queue[QPos].A;
Queue[QNext].B := MaxB;
Queue[QNext].Langkah := 2;
Queue[QNext].Sebelumnya := QPos;
End;

{ A dikosongkan --> hanya jika A tidak kosong }
If Queue[QPos].A > 0 Then
Begin
QNext := QNext + 1;
Queue[QNext].A := 0;
Queue[QNext].B := Queue[QPos].B;
Queue[QNext].Langkah := 3;
Queue[QNext].Sebelumnya := QPos;
End;

{ B dikosongkan --> hanya jika B tidak kosong }
If Queue[QPos].B > 0 Then
Begin
QNext := QNext + 1;
Queue[QNext].A := Queue[QPos].A;
Queue[QNext].B := 0;
Queue[QNext].Langkah := 4;
Queue[QNext].Sebelumnya := QPos;
End;

{ A dipindahkan ke B sampai A kosong --> hanya jika MaxB-B >= A }
If MaxB - Queue[QPos].B >= Queue[QPos].A Then
Begin
QNext := QNext + 1;
Queue[QNext].A := 0;
Queue[QNext].B := Queue[QPos].B + Queue[QPos].A;
Queue[QNext].Langkah := 5;
Queue[QNext].Sebelumnya := QPos;
End;

{ A dipindahkan ke B sampai B penuh --> hanya jika MaxB-B < A }
If MaxB - Queue[QPos].B < Queue[QPos].A Then
Begin
QNext := QNext + 1;
Queue[QNext].A := Queue[QPos].A - (MaxB - Queue[QPos].B);
Queue[QNext].B := MaxB;
Queue[QNext].Langkah := 6;
Queue[QNext].Sebelumnya := QPos;
End;

{ B dipindahkan ke A sampai B kosong --> hanya jika MaxA-A >= B }
If MaxA - Queue[QPos].A >= Queue[QPos].B Then
Begin
QNext := QNext + 1;
Queue[QNext].A := Queue[QPos].A + Queue[QPos].B;
Queue[QNext].B := 0;
Queue[QNext].Langkah := 7;
Queue[QNext].Sebelumnya := QPos;
End;

{ A dipindahkan ke B sampai A penuh --> hanya jika MaxA-A < B }
If MaxA - Queue[QPos].A < Queue[QPos].B Then
Begin
QNext := QNext + 1;
Queue[QNext].A := MaxA;
Queue[QNext].B := Queue[QPos].B - (MaxA - Queue[QPos].A);
Queue[QNext].Langkah := 8;
Queue[QNext].Sebelumnya := QPos;
End;

QPos := QPos + 1;
End;

i := 1;
While True do
Begin
Langkah[i] := Queue[QPos].Langkah;
i := i + 1;
QPos := Queue[QPos].Sebelumnya;
If QPos = 0 Then
Break;
End;

For j := i DownTo 1 do
Begin
Case Langkah[j] of
1: WriteLn('A diisi penuh');
2: WriteLn('B diisi penuh');
3: WriteLn('A dikosongkan');
4: WriteLn('B dikosongkan');
5: WriteLn('A dipindahkan ke B sampai A kosong');
6: WriteLn('A dipindahkan ke B sampai B penuh');
7: WriteLn('B dipindahkan ke A sampai B kosong');
8: WriteLn('B dipindahkan ke A sampai A penuh');
End;
End;

End;

Begin

{ Kondisi Awal }
A1 := 0;
B1 := 0;

{ Kondisi Akhir }
A2 := 2;
B2 := 0;

{ Proses }
Proses;

End.

Binary Search Tree 2

{Searches a binary search tree in O(logn) }

type tree = ^ node;
node = record
left, right : tree;
info : char
end;




function subtree( item : char ) : tree;
{creates a subtree}
var t : tree;
begin
new( t );
t^.info := item;
t^.left := nil;
t^.right := nil;
subtree := t
end;

procedure infix( t : tree);
begin
if t <> nil then begin
infix( t^.left );
write( t^.info );
infix( t^.right )
end
end;


procedure prefix( t : tree);
begin
if t <> nil then begin
write( t^.info );
prefix( t^.left );
prefix( t^.right )
end
end;

procedure postfix( t : tree);
begin
if t <> nil then begin
postfix( t^.left );
postfix( t^.right );
write( t^.info );
end
end;

procedure insert( item : char; var t : tree );
begin
if t = nil then
t := subtree( item )
else if item <= t^.info then insert( item, t^.left) else insert( item, t^.right) end; procedure bst( var root : tree ); {produces a binary search tree} var item : char; begin writeln('type your sentence'); root := nil; while not eoln do begin read( item ); insert( item, root ) end end; procedure search( key: char; var found: boolean; t : tree); begin if (t <> nil) and not found then begin
if key = t^.info then
found := true
else if key < t^.info then
search(key, found, t^.left)
else
search(key, found, t^.right)
end
end;

var root : tree;
found : boolean;
key : char;

begin
bst( root );
infix( root );
writeln;
readln;
writeln( 'type your letter');
found := false;
readln( key );
search( key, found, root);
if found then
writeln( key, ' was found.')
else
writeln( key, ' was not found.');
readln;
readln

end.

Tree

PROGRAM Tree (Input, Output);
{Written by Jason John Schwarz with Turbo Pascal v6.0.
Purpose: A demonstration binary tree.}

USES CRT;

TYPE
Point = ^Node;
Node = RECORD
Data : REAL;
Left : Point;
Right : Point;
END;{Node}

VAR
Root : Point;

PROCEDURE Initialize;
BEGIN
Root:=NIL;
END;{Initialize}

PROCEDURE Create (Data : REAL);
BEGIN
NEW(Root);
Root^.Data:=Data;
Root^.Left:=NIL;
Root^.Right:=NIL;
END;{Create}

PROCEDURE AddNode (Data :REAL; Root : Point);
VAR
Temp : Point;
BEGIN
NEW(Temp);
IF Data>=Root^.Data THEN Root^.Right:=Temp;
IF Data=Root^.Data) THEN
IF Root^.Right<>NIL THEN Add(Data,Root^.Right)
ELSE AddNode(Data,Root);
IF (Data<>NIL THEN Add(Data,Root^.Left)
ELSE AddNode(Data,Root);
END;{Root=NIL}
END;{Add}

PROCEDURE InOrder (Root : Point);
BEGIN
IF Root <> NIL THEN BEGIN
InOrder(Root^.Left);
WRITELN(Root^.Data);
InOrder(Root^.Right);
END;{Root<>NIL}
END;{InOrder}

PROCEDURE PreOrder (Root : Point);
BEGIN
IF Root <> NIL THEN BEGIN
WRITELN(Root^.Data);
PreOrder(Root^.Left);
PreOrder(Root^.Right);
END;{Root<>NIL}
END;{PreOrder}

PROCEDURE PostOrder (Root : Point);
BEGIN
IF Root<>NIL THEN BEGIN
PostOrder(Root^.Left);
PostOrder(Root^.Right);
WRITELN(Root^.Data);
END;{Root<>NIL}
END;{PostOrder}

PROCEDURE GetData;
VAR Data : REAL;
BEGIN
WRITE(Output,'What is the new number?');
READLN(Input,Data);
Add(Data,Root);
END;{GetData}

PROCEDURE Loop;
VAR
Choice : CHAR;
BEGIN
REPEAT
Choice:=CHR(0);
GetData;
CLRSCR;
WRITELN(Output,'InOrder Tree:');
InOrder(Root);
WRITELN(Output,'PostOrder Tree:');
PostOrder(Root);
WRITELN(Output,'PreOrder Tree:');
PreOrder(Root);
WRITE(Output,'Do you wish to add another number?');
READLN(Input,Choice);
UNTIL Choice IN ['N','n'];
END;{Loop}

BEGIN
Initialize;
Loop;
END.