Algoritma 2

[Anta]

Nih coding-coding algoritma 2 gw.

Operasi dengan array

Code: [Select]

program array_record;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type mhs = record
             npm,nama :string;
             tugas,uts,uas,na,ind :real;
           end;

var mahasiswa :array[1..2]of mhs;
    i,j:byte;
    jm :integer;

function nakhir(a,b,c:real):real;
begin
  nakhir:=0.2*a+0.3*b+0.5*c;
end;

function index(nilaiA:real):char;
begin
  if (nilaiA>=85) then index:='A'
  else if (nilaiA>=70) then index:='B'
  else if (nilaiA>=60) then index:='C'
  else if (nilaiA>=50) then index:='D'
  else index:='E';
end;


begin
   //input data
   i:=1;
   write('Nama : '); readln(mahasiswa[i].nama);
   while (mahasiswa[i].nama <>'') do
   begin
     write('NPM   : '); readln(mahasiswa[i].npm);
     write('Tugas : '); readln(mahasiswa[i].tugas);
     write('UTS   : '); readln(mahasiswa[i].uts);
     write('UAS   : '); readln(mahasiswa[i].uas);
     i:=i+1;
     write('Nama : '); readln(mahasiswa[i].nama);
   end;

   //hitung nilai
   jm:=i-1;
   for j:=1 to jm do
     mahasiswa[j].na:=nakhir(mahasiswa[j].tugas,mahasiswa[j].uts,mahasiswa[j].uas);

   //tampil
   writeln('----------------------------------------------------------');
   writeln('        NPM          Nama      Tugas     UTS     UAS    NA  INDEX');
   writeln('----------------------------------------------------------');

    for j:=1 to jm do
    begin
      with mahasiswa[j] do
      begin
        ind:=index(mahasiswa[j].na);
        writeln(npm:10,nama:20,tugas:7:0,uts:7:0,uas:7:0,na:7:0, ind);
      end;
   end;
   writeln('----------------------------------------------------------');
readln;
end.

Operasi dengan File

Code: [Select]

{**************************************************
 ** File operation 1 written by Anta             **
 ** -cara pertama-                               **
 **************************************************
 ** - Read File                                  **
 ** - Write File                                 **
 ** - Search File                                **
 **************************************************
 ** opensource & openmind project                **
 ** http://soalanta.gk3.org (anta@gk3.org)       **
 ****************************************************************
 ** Fungsi baru                                                **
 ****************************************************************
 ** Uppercase(string) = untuk membesarkan semua char di string **
 **                     eks 'Anta' -> 'ANTA'                   **
 ** Lowercase(string) = Sebaliknya                             **
 ** Fileexists(nfile) = menghasilkan true bila nfile(namafile) **
 **                     ada dalam storage                      **
 ** Filesize(file)    = Besar File (Bila file of byte) or      **
 **                     Jumlah Record (Bile file of record)    **
 ** Filepos(file)     = Posisi File dalam satuan record        **
 **                     (Bila file of record)                  **
 ** Seek(file,pos)    = Lompat ke posisi pos dalam file        **
 **                     pos dalam satuan record                **
 ** Rewrite(file)     = Membuat ulang file, ati2 data yang     **
 **                     lama keapus lho! (kalo ada)...         **
 ** AssignFile        = Menandai bahwa file akan di tulis/baca **
 ** (file,namafile)     pada/ke namafile                       **
 ****************************************************************
 ** mau tau lebih lanjut??? lu tanya aja ibu inge :p or baca   **
 ** delphi help di "Help->Delphi Help" (Pedoman Gue Selalu)    **
 ****************************************************************}

program soal_file;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type TData = Record
              Nama              : String[100];
              // ati2 buat file tuh panjang string harus di cantumin
              Kode              : char;
              Lama              : integer;
            End;

var key  : char; // global variable
const ffile = 'cobacoba.dat'; // cuma biar lebih efisien (ga ditulis berulang2)


function gaji( kd:char): real;
begin
  case kd of
   '1' : gaji:= 1000000;
   '2' : gaji:= 100000;
   '3' : gaji:= 3000000
   else gaji := 0;
  end;
end;

function jabatan(kd : char): string;
begin
  case kd of
   '1' : Jabatan:= 'Manager';
   '2' : Jabatan:= 'Supervisor';
   '3' : Jabatan:= 'Staff'
   else jabatan := '';
  end;
end;

function lembur(lm:integer; gj:real): real;
begin
  if lm>40 then lembur:= (lm-40)* (0.1*gj)
  else lembur:=0;
end;

procedure TambahData;
var F  : file of TData; // file of
    D  : TData; // data
begin
   AssignFile(F, ffile);
   // cek file dah ada ato belom
   if not Fileexists(ffile) then ReWrite(F) // buat file
   else
   Begin
      Reset(F); // buka file
      Seek(F,Filesize(F)) // Lompat ke Posisi Paling Akhir
   End;
   Write('Nama      : ');Readln(D.Nama);
   while (D.Nama <> '') do
   begin
     Write('Kode        : ');Readln(D.Kode);
     write('Lama kerja  : ');readln(D.lama);
     Write(F, D); // tulis ke file
     Writeln;
     Write('Nama      : ');Readln(D.Nama);
   end;
   CloseFile(F);
end;

procedure cetakdata;
var F  : file of TData; // file of
    D  : TData; // data
    tgj : Real;

begin
   AssignFile(F, ffile);
   // cek file dah ada ato belom
   if Fileexists(ffile) then
   Begin
      Reset(F); // buka file
      writeln('====================================================================');
      Writeln('   Kode  | Nama       | Jabatan    | Gaji     | Lembur   | Totalgaji');
      writeln('====================================================================');
      While not EOF(F) Do
      Begin
         Read(F, D); // baca dari file ke record D
         with D do
         begin
           tgj := gaji(kode)+lembur(lama,gaji(kode));
           Writeln('   ',kode:5, ' | ', Nama:10,' | ', Jabatan(kode):10,' | ', gaji(kode):8:0,' | ', lembur(lama,gaji(kode)):8:0,' | ',Tgj:9:0);
         end;
      End;
      writeln('====================================================================');
      CloseFile(F); // jangan lupa tutup file;
   End else Writeln('File ga ada tuh...');
   Writeln;
end;

procedure caridata;
var F     : file of TData; // file of
    D     : TData; // data
    ncari : string;
    ketemu: boolean;
begin
   ketemu := false;
   Write('Nama yang dicari? ');Readln(ncari);
   AssignFile(F, ffile);
   // cek file dah ada? dan ncari bukan ''
   if Fileexists(ffile) and (ncari <> '') then
   Begin
      Reset(F); // buka file
      // loop ampe ujung file dan 'not ketemu'
      While (not EOF(F)) and (not ketemu) Do
      Begin
         // baca dari file
         Read(F, D);
         // capital(D) = capital(ncari)? >yoi?! set ketemu = true
         if Uppercase(D.Nama) = Uppercase(ncari) then
           ketemu := true;
      End;
      if ketemu then Writeln('Data ditemukan di posisi ',FilePos(F))
      else Writeln('Data ga ketemu...');
      CloseFile(F); // jangan lupa tutup file;
   End
   else Writeln('File ga ada tuh ato nama ga diisi...');
   Writeln;
end;

begin
  repeat
    Writeln;
    Writeln('---------[ MENU ]---------');
    Writeln('1. Tambah Data');
    Writeln('2. Cari Data');
    Writeln('3. Cetak Data');
    Writeln('4. Keluar');
    Writeln;
    write('pilihan : ');readln(key);
    Writeln;
    case key of
       '1' : TambahData;
       '2' : Caridata;
       '3' : cetakdata;
    end;
  until key='4'; // looping terus sampe key = 4
  Writeln('dadah...');
end.


Operasi File 2

Code: [Select]

{**************************************************
 ** File operation 2 written by Anta             **
 ** -cara kedua-                                 **
 **************************************************
 ** - Read File    - Fillchar (opsional)         **
 ** - Write File                                 **
 ** - Search File                                **
 **************************************************
 ** opensource & openmind project                **
 ** http://soalanta.gk3.org (anta@gk3.org)       **
 ****************************************************************
 ** Fungsi baru                                                **
 ****************************************************************
 ** Fillchar(variable,length,char) = membanjiri variable       **
 **                                  tertentu dengan suatu char**
 ** SizeOf(variable)               = Besar ukuran suatu        **
 **                                  variable dalam byte       **
 ****************************************************************}
program soal_file2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type TData = Record
              Nama              : String[100];
              // ati2 buat file tuh panjang string harus di cantumin
              Kode              : char;
              Lama              : integer;
              Lembur            : Real;
              TotalGaji         : Real;
            End;

var key  : char; // global variable
const ffile = 'cobacob2.dat'; // cuma biar lebih efisien (ga ditulis berulang2)


function gaji( kd:char): real;
begin
  case kd of
   '1' : gaji:= 1000000;
   '2' : gaji:= 100000;
   '3' : gaji:= 3000000
   else gaji := 0;
  end;
end;

function jabatan(kd : char): string;
begin
  case kd of
   '1' : Jabatan:= 'Manager';
   '2' : Jabatan:= 'Supervisor';
   '3' : Jabatan:= 'Staff'
   else jabatan := '';
  end;
end;

function hlembur(lm:integer; gj:real): real;
begin
  if lm>40 then hlembur:= (lm-40)* (0.1*gj)
  else hlembur:=0;
end;

procedure TambahData;
var F  : file of TData; // file of
    D  : TData; // data
begin
   AssignFile(F, ffile);
   // cek file dah ada ato belom
   if not Fileexists(ffile) then ReWrite(F) // buat file
   else
   Begin
      Reset(F); // buka file
      Seek(F,Filesize(F)) // Lompat ke Posisi Paling Akhir
   End;
   FillChar(D,SizeOf(D), 0); // mengosongkan seluruh data D
   Write('Nama      : ');Readln(D.Nama);
   while (D.Nama <> '') do
   begin
     Write('Kode        : ');Readln(D.Kode);
     write('Lama kerja  : ');readln(D.lama);
     Write(F, D); // tulis ke file
     Writeln;
     FillChar(D,SizeOf(D), 0); // mengosongkan seluruh data D
     Write('Nama      : ');Readln(D.Nama);
   end;
   CloseFile(F);
end;

procedure calcdata;
var F  : file of TData; // file of
    D  : TData; // data
begin
   AssignFile(F, ffile);
   // cek file dah ada ato belom
   if Fileexists(ffile) then
   Begin
      Reset(F); // buka file
      While not EOF(F) Do
      Begin
         Read(F, D); // baca dari file ke record D
         with D do
         begin
           Lembur := hlembur(lama,gaji(kode)); // kalkulasi lebur
           TotalGaji := gaji(kode)+lembur; // kalkulasi totalgaji
         end;
         Seek(F,FilePos(F)-1); // lompat ke posisifile -1
         Write(F, D); // timpa posisifile dengan data record
      End;
      Writeln('Kalkulasi berhasil...');
      CloseFile(F); // jangan lupa tutup file;
   End else Writeln('File ga ada tuh...');
   Writeln;
end;

procedure cetakdata;
var F  : file of TData; // file of
    D  : TData; // data
begin
   AssignFile(F, ffile);
   // cek file dah ada ato belom
   if Fileexists(ffile) then
   Begin
      Reset(F); // buka file
      writeln('====================================================================');
      Writeln('   Kode  | Nama       | Jabatan    | Gaji     | Lembur   | Totalgaji');
      writeln('====================================================================');
      While not EOF(F) Do
      Begin
         Read(F, D); // baca dari file ke record D
         with D do
         begin
           Writeln('   ',kode:5, ' | ', Nama:10,' | ', Jabatan(kode):10,' | ', gaji(kode):8:0,' | ', lembur:8:0,' | ',Totalgaji:9:0);
         end;
      End;
      writeln('====================================================================');
      CloseFile(F); // jangan lupa tutup file;
   End else Writeln('File ga ada tuh...');
   Writeln;
end;

procedure caridata;
var F     : file of TData; // file of
    D     : TData; // data
    ncari : string;
    ketemu: boolean;
begin
   ketemu := false;
   Write('Nama yang dicari? ');Readln(ncari);
   AssignFile(F, ffile);
   // cek file dah ada? dan ncari bukan ''
   if Fileexists(ffile) and (ncari <> '') then
   Begin
      Reset(F); // buka file
      // loop ampe ujung file dan 'not ketemu'
      While (not EOF(F)) and (not ketemu) Do
      Begin
         // baca dari file
         Read(F, D);
         // capital(D) = capital(ncari)? >yoi?! set ketemu = true
         if Uppercase(D.Nama) = Uppercase(ncari) then
           ketemu := true;
      End;
      if ketemu then Writeln('Data ditemukan di posisi ',FilePos(F))
      else Writeln('Data ga ketemu...');
      CloseFile(F); // jangan lupa tutup file;
   End
   else Writeln('File ga ada tuh ato nama ga diisi...');
   Writeln;
end;

begin
  repeat
    Writeln;
    Writeln('---------[ MENU ]---------');
    Writeln('1. Tambah Data');
    Writeln('2. Cari Data');
    Writeln('3. Cetak Data');
    Writeln('4. Calc Data');
    Writeln('5. Keluar');
    Writeln;
    write('pilihan : ');readln(key);
    Writeln;
    case key of
       '1' : TambahData;
       '2' : Caridata;
       '3' : cetakdata;
       '4' : calcdata;
    end;
  until key='5'; // looping terus sampe key = 4
  Writeln('dadah...');
end.

kalo ada yang kelewat, error, ga ngerti tentang algoritma 2 posting ke thread ini aja.

[Anta]

Soal latihan UTS

Code: [Select]

{**************************************************
 ** Soal Latihan UTS 18 mar 2006 written by Anta **
 **************************************************
 ** - bubblesort                                 **
 ** - binary search                              **
 ** - array & record                             **
 **************************************************
 ** opensource & openmind project                **
 ** http://soalanta.gk3.org (anta@gk3.org)       **
 **************************************************}
program soal_uts;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const MAX_ARRAY = 100;

type TMhs = Record
              NIM  : String;
              NAMA : String;
              TUGAS,
              UTS, UAS,
              NA   : Real;
              IDX  : Char;
            End;
     AMhs = Array[1..MAX_ARRAY] of TMhs;


// global variable
var Data : AMhs;
    Len  : Integer;
    key  : char;

procedure inputdata(var D : Amhs;var L: integer); // 2 output
var x : integer; // pencacah
begin
   x := 1; // cause array mulai dari [1.. kalo [0.. x = 0
   writeln;
   Writeln('Masukan Data ke ',x);
   Write('   NIM      : ');Readln(D[x].NIM);
   while (D[x].NIM <> '') and (x < MAX_ARRAY) do
   begin
     Write('   NAMA     : ');Readln(D[x].NAMA);
     Write('   TUGAS    : ');Readln(D[x].TUGAS);
     Write('   UTS      : ');Readln(D[x].UTS);
     Write('   UAS      : ');Readln(D[x].UAS);
     inc(x); // sama aja dengan x := x + 1
     Writeln('Masukan Data ke ',x);
     Write('   NIM      : ');Readln(D[x].NIM);
   end;
   L := X-1; // Jumlah Data = X (pencacah) kurang 1
end;

procedure cetakdata(D: AMhs; L: Integer); // 0 output
var x : integer; // pencacah
begin
   Writeln;
   for x := 1 to L do // loop dari 1 ke jumlah data
     with D[x] do
     begin
        Writeln('Data ke ',x);
        Writeln('   NIM    : ',NIM);
        Writeln('   NAMA   : ',NAMA);
        Writeln('   TUGAS  : ',TUGAS:3:1);
        Writeln('   UTS    : ',UTS:3:1);
        Writeln('   UAS    : ',UAS:3:1);
        Writeln('   NA     : ',NA:3:1);
        Writeln('   Indeks : ',IDX);
     end;
   Writeln;
end;

procedure urutdata(var D: AMhs; L: Integer); // 1 output
var x, y : integer;
    tmp  : TMhs; // inget tmp harus recordnya data! bukan yang laen!
begin
   for x := 1 to L-1 do
     for y := L Downto x+1 do
       begin
          if D[y].NIM < D[y-1].NIM Then
            begin
               // tuker tempat
               tmp := D[y];
               D[y] := D[y-1];
               D[y-1] := tmp;
            end;
       end;
   writeln;
   writeln('Selesai membubble sort data...');
   // sorry kalo ada yang salah gw ga begitu ngerti sort2an
end;

procedure CariData(D: Amhs; L: Integer); // 0 output
var c, b, e, pos : integer;
    S: string;
begin
   Writeln;
   Write('Masukan NIM yang mau dicari : ');Readln(S);
   pos := 0;
   b := 1; // begin = 1
   e := L; // end = jumlah data
   // looping kalo (begin lebih kecil dari end) dan (pos blm ditemukan)
   while (b<=e) and (pos = 0) do
     begin
        c:= (b + e) div 2; // current = (begin + end) bagi 2
        if D[c].NIM = S then // bila Data[current] = S set pos=current
         pos := c
        else if S > D[c].NIM then // else bila S > Data[current] set begin=current +1
          b := c+1
          else e:= c-1; // else set end = current -1
     End;
   if pos > 0 then
     with D[pos] do
     begin
        writeln('Data ditemukan di posisi ',pos);
        Writeln('   NIM    : ',NIM);
        Writeln('   NAMA   : ',NAMA);
        Writeln('   TUGAS  : ',TUGAS:3:1);
        Writeln('   UTS    : ',UTS:3:1);
        Writeln('   UAS    : ',UAS:3:1);
        Writeln('   NA     : ',NA:3:1);
        Writeln('   Indeks : ',IDX);
     end
   else writeln('Data tidak ditemukan');
end;

procedure CalcNA(var D: Amhs; L: Integer); // 1 output
var x : integer; // pencacah lageeee
begin
   for x := 1 to L do
     With D[x] Do // pake with biar lebih ringkas
       NA := (TUGAS * 0.2) + (UTS * 0.3) + (UAS * 0.5);
   writeln;
   writeln('Selesai mengkalkulasi Nilai Akhir');
end;

procedure CalcIDX(var D: Amhs; L: Integer);
var x : integer; // another pencacah
begin
   for x := 1 to L do
     With D[x] Do
       if NA >= 80 then IDX := 'A'
       else if NA >= 70 then IDX := 'B'
       else if NA >= 60 then IDX := 'C'
       else if NA >= 50 then IDX := 'D'
       else if NA > 0 then IDX := 'E'
       else IDX := 'K';
   // ribet yah?? sok di teliti n dipahami lg!... :p
   writeln;
   writeln('Selesai mengkalkulasi Indeks');
end;

begin
  len := 0; // set jumlah data ke 0 dl yah, biar si kompi ga binun
  repeat
    Writeln;
    Writeln('---------[ MENU ]---------');
    Writeln('1. Input Data');
    Writeln('2. Cetak Data');
    Writeln('3. Urut Data');
    Writeln('4. Cari Data');
    Writeln('5. Kalkulasi Nilai Akhir');
    Writeln('6. Kalkulasi Indeks');
    Writeln('7. Keluar');
    Writeln;
    write('pilihan : ');readln(key);
    Writeln;
    case key of
       '1' : inputdata(data, len);
       '2' : cetakdata(data, len);
       '3' : urutdata(data, len);
       '4' : begin
               // kalo binary search khan datanya kudu urut,
               // so mau ga mau kudu ngurutin dl
               urutdata(data, len);
               caridata(data, len);
              end;
       '5' : calcna(data, len);
       '6' : calcidx(data, len);
    end;
  until key='7'; // looping terus sampe key = 7
  Writeln('dadah...');
end.


[robz cuy]

bang anta kapan yah g bisa algoritma kaya abang....

[Anta]

bang anta kapan yah g bisa algoritma kaya abang....

terus berjuang, pasti bisa kok, gw juga ga pinter-pinter bgd.

[awan]

terus berjuang, pasti bisa kok, gw juga ga pinter-pinter bgd.

wew...

emang...
ilmu padi...
makin berisi makin mahal, eh salah,harusnya
makin berisi makin merunduk...

@gantengin
ampe algoritma bisa dinikmatin kayak fireworks...yang bungkus biru yah...bukan yang merah...hehehe

[Z_HeN]

bang anta minta post yg kasus pake POINTER/Link-list donk...
yg dari array rubah ke POINTER/Link-list...
plizz...

[S2L]

pd hebat2 ya algony....
kpn bs ky gt....

[Anta]

bang anta minta post yg kasus pake POINTER/Link-list donk...
yg dari array rubah ke POINTER/Link-list...
plizz...

ok nti diproses secepatnya

[fdixxx]

jadi pada penambahan data pada file, untuk ke posisi paling akhir dari pada pakai

Code: [Select]

assignfile(fpengunjung, 'pengunjung.dat');
  reset(fpengunjung);

   while not (eof(fpengunjung)) do
   begin
       read(fpengunjung,pengunjung);
   end;

lebih efisien pakai

Code: [Select]

  assignfile(fpengunjung, 'pengunjung.dat');
  reset(fpengunjung);
  seek(fpengunjung,filesize(fpengunjung));

 

[Anta]

jadi pada penambahan data pada file, untuk ke posisi paling akhir dari pada pakai

Code: [Select]

assignfile(fpengunjung, 'pengunjung.dat');
  reset(fpengunjung);

   while not (eof(fpengunjung)) do
   begin
       read(fpengunjung,pengunjung);
   end;

lebih efisien pakai

Code: [Select]

  assignfile(fpengunjung, 'pengunjung.dat');
  reset(fpengunjung);
  seek(fpengunjung,filesize(fpengunjung));

 

betul sekali, tapi cara no 1 ga optimal banget, bayangin aja kalo filesizenya 4GB. si cursornya harus step by step baca dari awal ampe ke posisi akhir.

[fdixxx]

berbagi cara procedure mengurutkan data menggunakkan link dan list :

Code: [Select]

procedure urutkan_data(var kepala, ekor : pmhs);
var temp, p : pmhs;
    nama : string;
begin
p := kepala;
while (p <> nil) do
 begin
  temp := p^.next;
  while (temp <> nil) do
   begin
    if (p^.nama > temp^.nama) then
    begin
      //tukar nama
      nama := p^.nama;
      p^.nama := temp^.nama;
      temp^.nama := nama;
    end;
    temp := temp^.next;
   end;
  p := p^.next;
 end;
end;


[Dhanny]

@ fdixx : pertanyaannya
kl di linklist tsb datanya bukan cuma nama, gmn tuh?
hehehe

bakal panjang banget dong tuh programnya

[Anta]

ada sih,pake 1 fungsi bisa mindahin seluruh data, cuma harus pake record..
yak, ini teka teki nih, buat anak anak baru. silahkan posting, kalo nyerah ntar g bantuin jawab hehehe