Binary Search Tree pada Pascal

program treea;

uses crt;

type

tipeinfo=char;

tree=^simpul;

simpul = record

   info : tipeinfo;

   kiri,kanan : tree;

end;

var kata:string;

    pohon : tree;

    i: byte;

procedure inisialisasi(var pohon: tree);

begin

new(pohon);

  pohon:=nil;

end;

procedure insertdata(var pohon:tree;data:tipeinfo);

var baru :tree;

begin

  new(baru);

  baru^.info:=data;

  baru^.kiri:=nil;

  baru^.kanan:=nil;

  if(pohon=nil) then pohon:= baru

  else if (data <>

  else insertdata(pohon^.kanan,data);

end;

procedure prefix(pohon :tree);

begin

if pohon<>nil then begin

  write(pohon^.info);

  prefix(pohon^.kiri);

  prefix(pohon^.kanan); end;

end;

procedure infix(pohon :tree);

begin

if pohon<>nil then begin

  infix(pohon^.kiri);

  write(pohon^.info);

  infix(pohon^.kanan);  end;

end;

procedure posfix(pohon :tree);

begin

if pohon<> nil then begin

  posfix(pohon^.kiri);

  posfix(pohon^.kanan);

  write(pohon^.info);    end;

end;

begin

write('masukkan kata');

readln(kata);inisialisasi(pohon);

for i:=1 to length(kata) do

 insertdata(pohon,kata[i]);

writeln('prefix');

prefix(pohon);

writeln;

writeln('infix');

infix(pohon);

writeln;

writeln('posfix');

posfix(pohon);

writeln;

readln;

end.

selection sort pascal

program buble_sort;

uses crt;

var

x:array [0..20] of integer;

i,j,k:integer;

procedure tukar(var a,b:integer);

var temp:integer;

begin

temp:=a;

a:=b;

b:=temp;

end;

procedure input(var n:integer);

var a:integer;

begin

write('masukkan bilangan : ');

readln(a);

n:=a;

for i:=1 to a do

begin

write('masukkan bilangan ke-',i,' : ');

readln(x[i]);

end;

end;

procedure bublesort(var n:array of integer;var p:integer);

begin

for i:=1 to p do begin

for j:=1 to p-i do begin

if x[j] > x[j+1] then

 tukar(x[j],x[j+1]);

 end;end;

end;

procedure cetak(var n:array of integer;var p:integer);

begin

for i:=1 to p do

writeln('nilai ke-',i,' adalah ',n[i]);

writeln;

end;

begin

input(k);

cetak(x,k);

bublesort(x,k);

cetak(x,k);

readln;

end.

buble sort pascal

program buble_sort;

uses crt;

var

x:array [0..20] of integer;

i,j,k:integer;

procedure tukar(var a,b:integer);

var temp:integer;

begin

temp:=a;

a:=b;

b:=temp;

end;

procedure input(var n:integer);

var a:integer;

begin

write('masukkan bilangan : ');

readln(a);

n:=a;

for i:=1 to a do

begin

write('masukkan bilangan ke-',i,' : ');

readln(x[i]);

end;

end;

procedure bublesort(var n:array of integer;var p:integer);

begin

for i:=1 to p do begin

for j:=1 to p-i do begin

if x[j] > x[j+1] then

 tukar(x[j],x[j+1]);

 end;end;

end;

procedure cetak(var n:array of integer;var p:integer);

begin

for i:=1 to p do

writeln('nilai ke-',i,' adalah ',n[i]);

writeln;

end;

begin

input(k);

cetak(x,k);

bublesort(x,k);

cetak(x,k);

readln;

end.

queue dengan linklist di pascal

program queue;

uses crt;

type

  tipeinfo=integer;

  tipeptr=^tipenode;

  tipenode =record

    info :tipeinfo;

    next:tipeptr;

  end;

  tipequeue=tipeptr;

var stackpointer:tipequeue;

    data: tipeinfo;

    kata:string;

    i:byte;

procedure inisialisasi(var queue:tipequeue);

begin

  new(queue);

  queue:=nil;

end;

function kosong(queue:tipequeue):boolean;

begin

         kosong:=queue=nil;

end;

procedure enQueue(var queue:tipequeue; infobaru:tipeinfo);

var nodebaru:tipequeue;

begin

  new(nodebaru);

  nodebaru^.info:=infobaru;

  nodebaru^.next:=queue;

  queue:=nodebaru;

end;

function deQueue(var queue:tipequeue):integer;

var

temp,p:tipequeue;

begin

if not(kosong(queue)) then

   begin

     if(queue^.next = nil) then

     begin

       dequeue:=queue^.info;

       queue:=nil;

     end

     else

     begin

       temp:=queue;

       while(temp^.next^.next<>nil) do

       begin

         temp:=temp^.next;

       end;

       p:=temp^.next;

       deQueue:=p^.info;

       temp^.next:=nil;

       dispose(p);

     end;

   end;

end;

procedure cetak(queue:tipequeue);

var temp:tipequeue;

begin

temp:=queue;

while (queue<>nil) do

begin

write(queue^.info,' ');

queue:=queue^.next;

end;

writeln;

end;

begin

inisialisasi(stackpointer);

enqueue(stackpointer,5);

//enqueue(stackpointer,2);

//enqueue(stackpointer,9);

cetak(stackpointer);

write('data yang di deQueue : ');

writeln(dequeue(stackpointer));

cetak(stackpointer);

readln;

end.

queue dengan array di pascal

program queue;

uses crt;

const max=100;

type

  tipeinfo=integer;

//  tipeptr=^tipenode;

  tipequeue =record

    info :array [1..max] of integer;

    belakang:integer;

  end;

//  tipequeue=tipeptr;

var stackpointer:tipequeue;

    data: tipeinfo;

    kata:string;

    i:byte;

procedure inisialisasi(var myqueue:tipequeue);

begin

//  new(myqueue);

  myqueue.belakang:=0;

end;

function kosong(var myqueue:tipequeue):boolean;

begin

         kosong:=myqueue.belakang=0;

end;

function penuh(var myqueue:tipequeue):boolean;

begin

         penuh:=myqueue.belakang=max;

end;

procedure enQueue(var myqueue:tipequeue; infobaru:integer);

begin

if not(penuh(myqueue)) then begin

inc(myqueue.belakang);

myqueue.info[myqueue.belakang]:=infobaru;          end;

end;

function deQueue(var myqueue:tipequeue):integer;

var i:integer;

begin

if not(kosong(myQueue)) then

   begin

        deQueue:=myqueue.info[1];

        for i:=1 to myqueue.belakang-1 do

           myqueue.info[i]:=myqueue.info[i+1];

   end;

end;

procedure cetak(myqueue:tipequeue);

var i:integer;

begin

if not(kosong(myqueue)) then begin

for i:=1 to myqueue.belakang do

 write(myqueue.info[i],' ');

writeln;

writeln;

end else writeln('kosong');

end;

begin

inisialisasi(stackpointer);

cetak(stackpointer);

enqueue(stackpointer,5);

enqueue(stackpointer,2);

enqueue(stackpointer,9);

cetak(stackpointer);

writeln(deQueue(stackpointer));

readln;

end.

stack pascal linkedlist

program stack;

uses crt;

type

  tipeinfo=integer;

  tipeptr=^tipenode;

  tipenode =record

    info :integer;

    next:tipeptr;

  end;

  tipestack=tipeptr;

var stackpointer:tipestack;

    data: tipeinfo;

    kata:string;

    i:byte;

procedure inisialisasi(var mystack:tipestack);

begin

  new(mystack);

  mystack:=nil;

end;

function stackkosong(var mystack:tipestack):boolean;

begin

         stackkosong:=mystack=nil;

end;

procedure push(var mystack:tipestack; infobaru:integer);

var nodebaru:tipeptr;

begin

  new(nodebaru);

  nodebaru^.info:=infobaru;

  nodebaru^.next:=mystack;

  mystack:=nodebaru;

end;

function pop(var mystack:tipestack):integer;

var

temp:tipeptr;

begin

if not(stackkosong(mystack)) then

   begin

     pop:=mystack^.info;

     temp:=mystack;

     mystack:=mystack^.next;

     dispose(temp);

   end;

end;

procedure cetak(mystack:tipestack);

var temp:tipestack;

begin

temp:=mystack;

while (mystack<>nil) do

begin

writeln(mystack^.info);

mystack:=mystack^.next;

end;

end;

begin

inisialisasi(stackpointer);

push(stackpointer,5);

push(stackpointer,2);

push(stackpointer,9);

cetak(stackpointer);

writeln(pop(stackpointer));

readln;

end.

stack balik kata linked list pascal

program stack;

uses crt;

type

  tipeinfo=integer;

  tipeptr=^tipenode;

  tipenode =record

    info :char;

    next:tipeptr;

  end;

  tipestack=tipeptr;

var stackpointer:tipestack;

    data: tipeinfo;

    kata:string;

    i:byte;

procedure inisialisasi(var mystack:tipestack);

begin

  new(mystack);

  mystack:=nil;

end;

function stackkosong(var mystack:tipestack):boolean;

begin

         stackkosong:=mystack=nil;

end;

procedure push(var mystack:tipestack; infobaru:char);

var nodebaru:tipeptr;

begin

  new(nodebaru);

  nodebaru^.info:=infobaru;

  nodebaru^.next:=mystack;

  mystack:=nodebaru;

end;

function pop(var mystack:tipestack):char;

var

temp:tipeptr;

begin

if not(stackkosong(mystack)) then

   begin

     pop:=mystack^.info;

     temp:=mystack;

     mystack:=mystack^.next;

     dispose(temp);

   end;

end;

procedure cetak(mystack:tipestack);

var temp:tipestack;

begin

temp:=mystack;

while (mystack<>nil) do

begin

writeln(mystack^.info);

mystack:=mystack^.next;

end;

end;

begin

inisialisasi(stackpointer);

{push(stackpointer,5);

push(stackpointer,2);

push(stackpointer,9);

cetak(stackpointer);

writeln(pop(stackpointer));}

readln(kata);

for i:=1 to length(kata) do

begin

  push(stackpointer,kata[i]);

  write(kata[i]);

end;

writeln;

for i:=1 to length(kata) do

begin

  write(pop(stackpointer));

end;

readln;

end.

stack balik kata dengan pascal

program stack;

uses crt;

const maxstack=15;

type tipestack=record

data:array[1..maxstack] of char;

top : integer;

end;

var S,T:tipestack;

   x:char;i:integer;

   k:string;

procedure inisialisasi(S:tipestack);

begin

S.top:=0;

end;

function penuh(S:tipestack):boolean;

begin

if S.top=maxstack then penuh:=true else penuh:=false;

end;

function kosong(S:tipestack):boolean;

begin

if S.top=0 then kosong:=true else kosong:= false;

end;

procedure push(var S:tipestack; x:char);

begin

if (penuh(S)=false) then

  begin

    S.top:=S.top+1;

    S.data[S.top]:=x;

  end

else

  writeln('stack penuh');

end;

Procedure pop(var S:tipestack; var x:char);

begin

if (kosong(S)=false) then

  begin

    x:=S.data[S.top];

    S.top:=S.top-1;

  end

else

 writeln('stack kosong');

end;

Procedure cetak (S:tipestack);

var i:integer;

begin

if kosong(S)=false then begin

for i:= 1 to S.top do

writeln(i,' ',S.data[i]);

end else

writeln('data kosong');

end;

Begin

clrscr; 

writeln('masukkan kata :');

readln(k);

inisialisasi(S);

for i:=1 to length(k) do

push(s,k[i]);

cetak(S);

writeln;

writeln('data di balik');

inisialisasi(T);

for i:=S.top downto 1 do

begin

pop(S,x);

push(T,x);

end;

cetak(T);

readln;

end.

bermain stack dengan array statis di pascal

program stack;

uses crt;

const maxstack=5;

type tipestack=record

data:array[1..maxstack] of integer;

top : integer;

end;

var S:tipestack;

   x:integer;

procedure inisialisasi(S:tipestack);

begin

S.top:=0;

end;

function penuh(S:tipestack):boolean;

begin

if S.top=maxstack then penuh:=true else penuh:=false;

end;

function kosong(S:tipestack):boolean;

begin

if S.top=0 then kosong:=true else kosong:= false;

end;

procedure push(var S:tipestack; x:integer);

begin

if (penuh(S)=false) then

  begin

    S.top:=S.top+1;

    S.data[S.top]:=x;

  end

else

  writeln('stack penuh');

end;

Procedure pop(var S:tipestack; var x:integer);

begin

if (kosong(S)=false) then

  begin

    x:=S.data[S.top];

    S.top:=S.top-1;

  end

else

 writeln('stack kosong');

end;

Procedure cetak (S:tipestack);

var i:integer;

begin

if kosong(S)=false then begin

for i:= 1 to S.top do

writeln(i,' ',S.data[i]);

end else

writeln('data kosong'); 

end;

Begin

inisialisasi(S);

push(S,3);

push(S,5);

push(S,2);

push(S,9);

push(S,12);

cetak(S);

pop(S,x);

writeln(x);

readln;

end.

stack -pascal

konsep stack

 

dengan record sbb :

type  tipestack=record;

data :array[1..makstack] of integer;

top: integer;

end;

proses yang ada :

1. inisialisasi

* S.top:=0;

2. push

cek penuh tidak

*S.top:=S.top+1;

*S.data[S.top]:=x

3.pop

cek kosong tidak

*x:=S.data[S.top]

*S.top:=S.top-1

4.KOsong

if(S.top=0) then kosong:= true else kosong:=false;

5.Penuh

penuh:=(top:=makStack) dst..

linked list

program list;

uses crt;

type TipeSenarai=^RecordSenarai;

     RecordSenarai=record

        data:integer;

        next:TipeSenarai;

     end;

var

     senaraiku1,senaraiku2:TipeSenarai;

Procedure inisialisasi(var senarai:TipeSenarai);

begin

        senarai:=nil;

end;

Procedure tambahbarusimpul(baru:integer; var senarai:TipeSenarai);

var

   pbaru,ekor:TipeSenarai;

begin

   ekor:=senarai;

   if ekor <> NIL then

   begin

     new(pbaru);

     pbaru^.data:=baru;

     pbaru^.next:=NIL;

     while ekor^.next<>nil do

     ekor:=ekor^.next;

     ekor^.next:=pbaru;

   end

   else

   begin

     new(senarai);

     senarai^.data:=baru;

     senarai^.next:=NIL;

   end;

end;

Procedure sisipsimpul(baru:integer; var senarai:TipeSenarai);

var

   pbaru,p:TipeSenarai;

begin

   if senarai=NIL then

   begin

     senarai^.data:=baru;

     senarai^.next:=NIL;

   end

   else

   begin

     new(pbaru);

     pbaru^.data:=baru;

     pbaru^.next:=NIL;

     if baru

     begin

       pbaru^.next:=senarai;

       senarai:=pbaru;

     end

     else

     begin

       p:=senarai;

       while(p^.next<>nil) and (baru <>

         p:=p^.next;

       pbaru^.next:=p^.next;

       p^.next:=pbaru;

      end;

   end;

end;

procedure cetaksenarai(senarai:TipeSenarai);

var

   ekor:TipeSenarai;

begin

   ekor:=senarai;

   if ekor <> NIL then

   while ekor<>nil do

   begin

     writeln(ekor^.data);

     ekor:=ekor^.next;

   end

   else

   writeln('kosong');

   writeln; 

end;

BEGIN

inisialisasi(senaraiku1);

tambahbarusimpul(3,senaraiku1);

tambahbarusimpul(1,senaraiku1);

cetaksenarai(senaraiku1);

sisipsimpul(3,senaraiku1);

sisipsimpul(1,senaraiku1);

cetaksenarai(senaraiku1);

readln;

end.

contoh enam

/* contoh6.c */
#include
#include
#include
#include


/* prototype fungsi */
void doparent(char[]);
void dochild1();
void dochild2();

int main()
{
int rv=0,i;
char fname[20];
pid_t pid1,pid2;


printf("Input nama file yang telah di baca : ");
scanf("%s",fname);

pid1=fork(); /* buat proses child1 */
if(pid1==-1)
{
perror("Fork gagal");
exit(EXIT_FAILURE);
}

if(pid1==0)
{
dochild1();
pid2=fork(); /* buat proses child2 */
if(pid2==-1)
{
perror("Fork gagal");
exit(1);
}
if(pid2==0)
dochild2();
else
doparent(fname);
}

}


void doparent(char *fname){
FILE *pf; /* pointer file */
char buff;//fname[15], buff;
int i=0;

printf("Input nama file yang dibaca :");
scanf("%s",fname);

/* ambil nama file yang isinya ingin dibaca*/
pf=fopen(fname,"r"); /* buka file untuk dibaca */

if(pf==NULL){
perror("PARENT: Error : \n");
exit(EXIT_FAILURE); /* exit jika buka file gagal */
}

buff=getc(pf); /* baca karakter pertama */
printf("PARENT: ISI FILE yang dibaca\n");
while(buff!=EOF){
putc(buff,stdout); /* cetak karakter */
buff=getc(pf); /* baca karakter berikutnya sampai ketemu EOF */
}

fclose(pf); /* tutup file */
}


void dochild1(){
int i;
FILE *pf=fopen("data2.txt","w");

if(pf==NULL){
printf("CHILD1: Error\n");
exit(EXIT_FAILURE);
}

for(i=1; i<=5; ++i)
fprintf(pf,"%d.Ini dari child1\n",i);

fclose(pf);
}


void dochild2(){
int i;
FILE *pf=fopen("data3.txt","w");

if(pf==NULL){
printf("CHILD2: Error \n");
exit(1);
}

for(i=5; i>=1; --i)
fprintf(pf,"%d.Ini dari child2\n",i);
fclose(pf);
}

pointer lagi

uses crt;

var

p: Pointer;

q: ^byte;

r: array[0..19] of byte;

i: Byte;

begin

   getmem(p,20);

   q:=p;

   for i:=0 to 19 do

   begin

     r[i]:=19-i;

     q^:=19-i;

     inc(q);

   end;

   q:=p;

   for i:=0 to 19 do

   begin

     write('r[',i,'] = ',r[i], ' : ');

     write('p^ ke-',i,' = ',q^);

     writeln;

     inc(q);

   end;

   readln;

end.

nyobain yang laen berikut:

uses crt;

var

p: Pointer;

q: ^byte;

r: array[0..19] of byte;

i: Byte;

begin

   getmem(p,20);

   q:=p;

   for i:=0 to 19 do

   begin

     r[i]:=19-i;

     q^:=19-i;

     inc(q);

   end;

   q:=p;

   for i:=0 to 19 do

   begin

     write('r[',i,'] = ',r[i], ' : ');

     write('p^ ke-',i,' = ',q^);

     writeln;

     inc(q);

   end;

   readln;

end.

bermain pointer

mencoba pointer pascal,,

program coba_poiinter;

uses crt;

p,q :^integer;

a,b:integer;

begin

a:=20;

b:=30;

p:=@a;

p^:=15;

p:=@b;

p^:=a;

writeln('a = ',a,' b = ',b);

readln;

end.

nah kalo yang dibawah ini udah maenan yang lebih lagi..

hehehe

monggoh di jajal..

:D

program pointer;

uses crt;

type pointerstring = ^string;

var

p,q,r,s :pointerstring;

nilai :string;

begin

nilai :='ini adalah string nilai';

p:= @nilai;

new(q);

new(s);

q^:='ini adalah isi pointer';

r:=q;

s^:=q^;

writeln('alamat pointer p = ',

seg(p^):4,' : ',ofs(p^):4,' : ','isi pointer p : ',p^);

writeln('alamat pointer q = ',

seg(q^):4,' : ',ofs(q^):4,' : ','isi pointer p : ',q^);

writeln('alamat pointer r = ',

seg(r^):4,' : ',ofs(r^):4,' : ','isi pointer p : ',r^);

writeln('alamat pointer s = ',

seg(s^):4,' : ',ofs(s^):4,' : ','isi pointer p : ',s^);

readln;

end.