FILE

Program filee;

Uses Crt;

Var

    tes : Text;

    nama,nim : String;

    no,shift,pilih,i : byte;

    Tanya : Char;

Begin

Repeat

ClrScr;

        writeln('-------------------------------');

        Writeln('| Program File Text Sederhana |');

        Writeln('-------------------------------');

        Writeln('| 1. Masukan Data Anda        |');

        Writeln('| 2. Lihat Data               |');

        Writeln('| 3. Hapus Data               |');

        Writeln('| 4. Keluar                   |');

        Writeln('|------------------------------|');

        Write(' Pilihan Anda : ');Readln(Pilih);

        Case Pilih Of

        1 : Begin clrscr;

                Assign(tes,'praktikum.txt');

                rewrite(tes);

                Repeat

                inc(i);

                writeln(' Data - ',i);

                writeln(' -------------------------------------');

                write(' Nama     : '); readln(nama); writeln(tes,nama);

                write(' NIM      : '); readln(nim);  writeln(tes,nim);

                write(' Shift    : '); readln(shift);writeln(tes,shift);

                write(' No. Meja : '); readln(no);   writeln(tes,no);

                writeln(tes,' ');

                Write(' Memasukan Lagi (Y/T) : '); readln(tanya);

                writeln(' -------------------------------------');

                writeln;

                Until UpCase(tanya) = 'T';

                Close(tes);

             End;

        2 : Begin clrscr;

                Assign(tes,'praktikum.txt');

                reset(tes);

                i:= 0;

                   while not eof(tes) do

                   begin

                   inc(i);

                        readln(tes,nama);  readln(tes,nim);

                        readln(tes,shift); readln(tes,no);

                        readln(tes);

                        writeln(' Data - ',i);

                        writeln(' -----------------------------------');

                        writeln(' Nama     : ',nama);

                        writeln(' NIM      : ',nim);

                        writeln(' Shift    : ',shift);

                        writeln(' No. Meja : ',no);

                        writeln(' -----------------------------------');

                        writeln;

                   end; readln;

             End;

        3 : Begin clrscr;

                write(' Data akan dihapus [y/t] : '); readln(tanya);

                if upcase (tanya) = 'Y' then

                Assign(tes,'praktikum.txt');

                erase(tes);

            End;

       else End;

until pilih=4;

End.

link list

program linked_list;

uses crt;
type ptrdata = ^recorddata;
     recorddata = record
        item : string;
        berikut : ptrdata
     end;

var pd : ptrdata;
    elem : string;


procedure node_baru(var baru: ptrdata; elemen: string);
var ps: ptrdata;
begin
new(ps);
new(baru);
         baru^.item := elemen;
         baru^.berikut := nil;

end;


Procedure tambah_depan(Var depan : ptrData; elemen : string);
Var  ps :ptrdata;
Begin
new(ps);
new(depan);
                node_baru(ps,elemen);
ps^.berikut  :=  pd;
pd:=ps ;
End;


begin
clrscr;
 new(pd);
 elem := 'Nama          : Eko Prayogo';
        tambah_depan(pd, elem);
        writeln(pd^.item);

 elem := 'NIM           : J1F114075';
        tambah_depan(pd, elem);
        writeln(pd^.item);
        writeln;

 elem := 'Nama          : Eka Prayoga';
        tambah_depan(pd, elem);
        writeln(pd^.item);

  elem := 'NIM           : J1F114076';
        tambah_depan(pd, elem);
        writeln(pd^.item);

readln;
end.

POINTER

Program pointerr;
uses crt;

var nama, nim : ^string;
    shift, no : byte;

begin
clrscr;
new(nama); new(nim);
        nama^ := 'Rizki Amalia';
        nim^ := 'J1F114062';
        shift := 1;
        no := 11;

writeln('Nama           : ',nama^);
writeln('NIM            : ',nim^);
writeln('Shift          : ',shift);
writeln('No. Meja       : ',no);
dispose(nama); dispose(nim);
readln;
end.

seacrhing

program searching:


uses crt;
var lg :string;
ask:integer;

procedure sequential;
type
arrint = array [1..2000] of integer;
var
x      : integer;
tabint :arrint;
n,i    : integer;
indeks : integer;
function seqsearch1(xx : integer): integer;
var i : integer;
begin
i := 1;
while ((i<n) and (tabint[i] <> xx)) do
i:=i+1;
if tabint[i] = xx then
        seqsearch1:=i
else
        seqsearch1:=0;
end;

begin
clrscr;
write('Masukanbanyak data = '); readln(n);
for i:=1 to n do
begin
write('Angka ke [',i,'] = '); readln(tabint[i]);
end;
write('Nilai yang dicari = '); readln(x);
indeks:=seqsearch1(x);
if indeks<> 0 then
write(x,' ditemukan pada indekske :',indeks)
else
write(x,' tidak ditemukan');
readln;;
end;

procedure binary;
type arrint = array [1..1000] of integer;
var x : integer;
a :arrint;
n,i,j,z : integer;
indeks: integer;
function binarysearch (xx : integer): integer;
var i : integer;
atas,bawah,tengah : integer;
ditemukan :boolean;
indexx : integer;
begin
atas := 1;
bawah := n;
ditemukan :=false;
indexx:=0;
while ((atas<=bawah) and (not ditemukan)) do
begin
tengah :=(atas+bawah) div 2;
if xx = a[tengah] then
begin
ditemukan:=true;
indexx := tengah;
end
else
begin
if xx<a[tengah] then
bawah := tengah - 1
else
atas:=tengah + 1;
end;
end;

binarysearch:=indexx;
end;

begin
clrscr;
write('Masukan banyak data : ');
readln(n);
for i := 1 to n do
begin
write ('angka ke [',i,'] = ');
readln(a[i]);
end;
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;

writeln;
write('data setelah diurutkan : ');
for j:=1 to n do
write(a[j],' ');

writeln;
write('nilai yang dicari : ');
readln(x);
indeks:=binarysearch(x);
if indeks<> 0 then
write(x,' ditemukan pada indekske : ',indeks)
else
write(x,' tidak ditemukan ');
readln;
end;


begin
repeat
clrscr;
writeln;
writeln('  Program Pencarian Data');

writeln;
writeln('==========================');
writeln('|        M E N U                                  |');
writeln('|                                                         |');
writeln('|=========================|');
writeln('|(1) Sequential Search                      |');
writeln('|(2) Binary Search                            |');
writeln('|(3) Keluar                                        |');
writeln('==========================');
write(' Pilih = ');readln(ask);
clrscr;
case ask of
1 : begin
sequential;
end;
2 : begin
binary;
end;
3 : begin
exit;
end;
end;
until(ask=3);
end.

 SORTING

uses crt ;
var
    nama    : array[1..3] of string ;
    xnama   : string ;
    jmldata : byte ;
    i, j    : byte ;

begin
clrscr;

    jmldata := 3 ;
     for i := 1 to jmldata do
     begin
       write('Nama ke ',i,':') ; readln(nama[i]) ;
     end;
     clrscr;
     for i := 1 to jmldata do
     begin
          writeln ('Nama ke ',i,':', nama[i]) ;
     end;

     for i:= 1 to jmldata-1 do
     begin
          for j:= jmldata-1 downto i do
          begin
              if nama[j] > nama[j+1] then
              begin
                   xnama     := nama[j] ;
                   nama[j]   := nama[j+1] ;
                   nama[j+1] := xnama   ;
              end;
          end;
     end;
     writeln;
     for i := 1 to 3 do
     begin
          writeln ('Nama ke ',i,':', nama[i]) ;
     end;
     readln;
end.

TUGAS PRAKTIKUM

ALGORITMA DAN PEMROGRAMAN II

"REKURSIF"

Nama     : Rizki Amalia Marseli

           NIM    : J1F114062

KEMENTERIAN RISET TEKNOLOGI  DAN PENDIDIKAN TINGGI

UNIVERSITAS LAMBUNG MANGKURAT

FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM

PROGRAM STUDI S1 ILMU KOMPUTER

BANJARBARU

2015

 

 

 REKURSIF

 

 

 

BILANGAN FIBONACCI

 

 

 uses crt;
var
n,i : integer;
a : array [0..100] of integer;

begin
clrscr;
gotoxy (25,05); write ('____________________________');
gotoxy (25,06); write ('                            ');
gotoxy (25,07); write ('  DERET BILANGAN FIBONACCI  ');
gotoxy (25,08); write ('____________________________');
gotoxy (25,12); write ('Masukkan angka pembatas :  '); readln (n);

gotoxy (25,15);
for i := 0 to n-1 do
   begin
      if (i=0) or (i=1) then
         begin
            a [i] := 1;
            write (a [i],' ');
         end
      else
         begin
            a [i] := a [i-1] + a [i-2];
            write (a [i],' ');
         end;
    end;
readkey;
end.

TUGAS PRAKTIKUM

ALGORITMA DAN PEMROGRAMAN II

"ARRAY OF RECORD"

Nama     : Rizki Amalia Marseli

  NIM    : J1F114062

KEMENTERIAN RISET TEKNOLOGI  DAN PENDIDIKAN TINGGI

UNIVERSITAS LAMBUNG MANGKURAT

FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM

PROGRAM STUDI S1 ILMU KOMPUTER

BANJARBARU

2015

 

 

  ARRAY of Record

Program Data_Mahasiswa;
Uses crt;

  Type Tabel_Mhs = Record
     Nama  : String[10];
     NIM   : String[10];
     Nilai : Integer;
     Grade : String[10];
  End;

 Var

  Mhs  : Array[1..20] of Tabel_Mhs;
  Angka: Real;
  i, n: Integer;

        Begin
        clrscr;
        write('Masukkan banyak data : ');readln(n);
        for i:=1 to n do
        begin
          write('Nama Mahasiswa    : ');readln(Mhs[i].Nama);
          write('NIM Mahasiswa     : ');readln(Mhs[i].NIM);
          write('Nilai             : ');readln(Mhs[i].Nilai);

      if Mhs[i].Nilai >= 80 then
         Mhs[i].Grade:= 'A'
      Else if Mhs[i].Nilai >= 70 then
         Mhs[i].Grade:= 'B'
      Else if Mhs[i].Nilai >= 60 then
         Mhs[i].Grade:= 'C'
      Else if Mhs[i].Nilai >= 50 then
         Mhs[i].Grade:= 'D'
      Else if Mhs[i].Nilai < 50 then
         Mhs[i].Grade:= 'E';
         Writeln('Grade      : ',Mhs[i].Grade);readkey;
       End;

Begin
Clrscr;
gotoxy(1,2);Writeln('DATA REPORT':45);
gotoxy(1,4);Writeln('[----][-------------][---------------][-----------][-----------]');
gotoxy(1,5);Writeln('[ NO ][     Nama    ][      NIM      ][   Nilai   ][   Grade   ]');
gotoxy(1,6);Writeln('[----][-------------][---------------][-----------][-----------]');

For i:= 1 to n do
 Begin
 with Mhs[i] do
 begin
  gotoxy(1,6+i);Write('[    ][             ][               ][           ][           ]');
  gotoxy(1,7+i);Write(' ----  -------------  ---------------   ----------  ----------- ');
  gotoxy(4,6+i);Write(i);
  gotoxy(11,6+i);Write(Nama);
  gotoxy(27,6+i);Write(NIM);
  gotoxy(43,6+i);Write(Nilai);
  gotoxy(57,6+i);Write(Grade);

 End;
 Readkey;

 End;

 End;

 End.