Senin, 23 April 2012

Program Single_linked_list; ( Struktur Data )


Program Single_linked_list;
uses crt;
Type
  pointer = ^data;
  data    = Record
    Info : integer;
    Next : Pointer;
  End;
Var
  awal, akhir : pointer;
  menu,elemen : integer;

procedure create;
begin
  awal := nil;
  akhir := nil;
end;

procedure tambahBelakang(elemen : integer; var awal,akhir : pointer);
var
  baru : pointer;
begin
  new(baru);
  baru^.info := elemen;
  if(awal = nil) then
  begin
    baru^.next := nil;
    awal := baru;
  end
  else
    akhir^.next := baru;

  akhir := baru;
end;

procedure tambahDepan(var awal : pointer;elemen : integer);
var
  baru : pointer;
begin
  new(baru);
  baru^.info := elemen;
  baru^.next := awal;
  awal := baru;
end;

procedure tambahTengah(elemen : integer;var awal,akhir : pointer);
var
  baru, bantu : pointer;
  datasisip,dataInput   : integer;
  ketemu : boolean;
begin
    dataInput := 1;
    textcolor(9);gotoxy(20,7);write('Setelah angka berapa data akan ditambahkan? ');textcolor(14);readln(datasisip);
    bantu := awal;
    ketemu := false;
    while(not ketemu) and (bantu <> nil) do
    begin
      if (datasisip = bantu^.info) then
        ketemu := true
      else
        bantu := bantu^.next;
    end;

    if(ketemu) then
    begin
      if (bantu = akhir) then
        tambahBelakang(dataInput,awal,akhir)
      else
      begin
        new(baru);
        baru^.info := elemen;
        baru^.next := bantu^.next;
        bantu^.next := baru;
      end
    end
    else
    begin
      clrscr;
      gotoxy(25,8);textcolor(12);write(datasisip,' tidak ada di linked list');
    end;
end;

procedure isiDataAwal(var awal,akhir : pointer);
var
  dataInput,n,i : integer;
begin
  textcolor(9);gotoxy(25,7);write('Berapa data yang akan dibuat? ');textcolor(14);readln(n);
  clrscr;
  for i := 1 to n do
  begin
    textcolor(9);gotoxy(27,5+i);Write('Masukan data ke-',i,' = ');textcolor(14);read(dataInput);
    tambahBelakang(dataInput,awal,akhir);
  end;
end;

procedure hapusDepan(var elemen : integer ;var awal,akhir : pointer);
var
  phapus : pointer;
begin
  phapus := awal;
  elemen := phapus^.info;
  if(awal = akhir) then
  begin
    awal := nil;
    akhir := nil;
  end
  else
    awal := awal^.next;

  dispose(phapus);
end;

procedure hapusBelakang(var elemen : integer;var awal,akhir : pointer);
var
  phapus : pointer;
begin
  phapus := awal;
  elemen := phapus^.info;
  while(phapus^.next <> akhir) do
    begin
    phapus := phapus^.next;
    end;
  akhir := phapus;
  phapus := phapus^.next;
  akhir^.next := nil;
  dispose(phapus);
end;

procedure hapusTengah(var elemen : integer ;var awal,akhir : pointer);
var
  phapus, bantu : pointer;
  posisihapus,hapuscari : integer;
  ketemu : boolean;
begin
  if (awal = nil) then
    begin
      textcolor(12);gotoxy(11,7);write('Linked list sudah kosong, silahkan isi data terlebih dahulu!')
    end
  else
  begin
    phapus := awal;
    textcolor(9);gotoxy(23,7);write('Tentukan posisi data yang akan dihapus! ');textcolor(14);read(hapuscari);
    posisihapus := 1;
    ketemu := false;
    while (not ketemu) and (phapus <> nil) do
    begin
      if (posisihapus = hapuscari) then
        ketemu := true
      else
      begin
        phapus := phapus^.next;
        posisihapus := posisihapus + 1;
      end;
    end;

    if(ketemu) then
    begin
      if (awal = phapus) then
      begin
        hapusDepan(elemen,awal,akhir)
      end
      else
      if (akhir = phapus) then
      begin
        hapusBelakang(elemen,awal,akhir)
      end
      else
      begin
        bantu := awal;
        elemen := phapus^.info;
        while(bantu^.next <> phapus) do
          bantu := bantu^.next;

        bantu^.next := phapus^.next;
        dispose(phapus);
      end
    end
    else
    begin
      textcolor(4);gotoxy(23,8);write(posisihapus,' tidak ditemukan');
    end;
  end;
end;

procedure cariData(awal : pointer);
var
  bantu : pointer;
  datacari : integer;
  ketemu : boolean;
begin
  if (awal = nil) then
  begin
    textcolor(12);gotoxy(11,7);write('Linked list masih kosong, silahkan isi data terlebih dahulu!')
  end
  else
  begin
  textcolor(9);gotoxy(23,7);write('Masukan data yang akan dicari! ');textcolor(14);readln(datacari);
  bantu := awal;
  ketemu := false;
  while(not ketemu) and (bantu <> nil) do
  begin
    if (bantu^.info = datacari) then
      ketemu := true
    else
      bantu := bantu^.next;
  end;

  if(ketemu) then
  begin
  clrscr;
    gotoxy(29,7);textcolor(15);write(datacari,' ditemukan di linked list')
  end
  else
  begin
    clrscr;
    gotoxy(25,7);textcolor(12);writeln(datacari,' tidak ada dalam linked list');
  end;
  end;
end;

procedure minimumSortAsc(awal,akhir : pointer);
var
  min,i,j  : pointer;
  temp     : integer;
begin
  i := awal;
  while(i <> akhir) do
  begin
    min := i;
    j := i^.next;
    while(j <> nil) do
    begin
      if(j^.info < min^.info) then
      begin
        min := j;
      end;

      j := j^.next
    end;
    temp := i^.info;
    i^.info := min^.info;
    min^.info := temp;

    i := i^.next;
  end;
end;

procedure tampilData(awal : pointer);
var
  bantu : pointer;
  i : integer;
begin
  if (awal = nil) then
  begin
    textcolor(12);gotoxy(11,7);write('Linked list masih kosong, silahkan isi data terlebih dahulu!')
  end
  else
  begin
  i := 1;
  bantu := awal;
  while (bantu <> nil) do
  begin
    gotoxy(39,3+(i*2));write(bantu^.info);
    bantu := bantu^.next;
    i := i + 1;
  end;
  end;
end;

procedure destroy(awal,akhir : pointer);
var
  phapus : pointer;
begin
  phapus := awal;
  while(awal <> akhir) do
  begin
    awal := awal^.next;
    dispose(phapus);
    phapus := awal;
  end;
end;

procedure pilihanTambah(var awal,akhir : pointer);
var
  menu,dataInput : integer;

begin
  if (awal = nil) then
  begin
    textcolor(12);gotoxy(11,7);write('Linked list masih kosong, silahkan isi data terlebih dahulu! ')
  end
  else
  begin
  repeat
  clrscr;
  textcolor(10);gotoxy(30,2);writeln('Menu Sisip');
  textcolor(11);gotoxy(29,3);writeln('============');
  textcolor(15);gotoxy(28,5);writeln('1.Penyisipan di Depan');
  gotoxy(28,6);writeln('2.Penyisipan di Belakang');
  gotoxy(28,7);writeln('3.Penyisipan di Tengah ');
  gotoxy(28,8);writeln('4.Tampilkan Data');
  gotoxy(28,9);writeln('5.Keluar');
  textcolor(9);gotoxy(28,11);write('Silakan Memilih Menu! [1-5] ');textcolor(14);readln(menu);
  {validasi menu pilihan}
  while(menu < 1) or (menu > 5) do
  begin
    gotoxy(15,15);
    textcolor(12);write('Nomor tidak ada dalam Menu, tekan enter untuk mengulang!');
    readln;gotoxy(56,11);
    textcolor(14);readln(menu);
  end;
  case (menu) of
  1 : begin
        clrscr;
        textcolor(9);gotoxy(25,7);write('Masukan data yang akan disisipkan! ');textcolor(14);read(dataInput);
        tambahDepan(awal,dataInput);
        readln;
      end;

  2 : begin
        clrscr;
        textcolor(9);gotoxy(25,7);write('Masukan data yang akan disisipkan! ');textcolor(14);read(dataInput);
        tambahBelakang(dataInput,awal,akhir);
        readln;
      end;

  3 : begin
        clrscr;
        textcolor(9);gotoxy(25,7);write('Masukan data yang akan disisipkan! ');textcolor(14);read(dataInput);
        clrscr;
        tambahTengah(dataInput,awal,akhir);
        readln;
      end;

  4 : begin
        clrscr;
        textcolor(10);gotoxy(31,2);writeln('Single Linked List');
        textcolor(11);gotoxy(30,3);writeln('====================');
        textcolor(15);
        tampilData(awal);
        readln;
      end;
  end;
  until(menu=5);
  end;
end;

procedure pilihanHapus(var awal,akhir : pointer);
var
  menu : integer;

begin
  if (awal = nil) then
  begin
    textcolor(12);gotoxy(11,7);write('Linked list masih kosong, silahkan isi data terlebih dahulu! ')
  end
  else
  begin
  repeat
  clrscr;
  textcolor(10);gotoxy(30,2);writeln('Menu Hapus');
  textcolor(11);gotoxy(29,3);writeln('============');
  textcolor(15);gotoxy(28,5);writeln('1.Penghapusan di Depan');
  gotoxy(28,6);writeln('2.Penghapusan di Belakang');
  gotoxy(28,7);writeln('3.Penghapusan di Tengah ');
  gotoxy(28,8);writeln('4.Tampilkan Data');
  gotoxy(28,9);writeln('5.Keluar');
  textcolor(9);gotoxy(28,11);write('Silakan Memilih Menu! [1-5] ');textcolor(14);readln(menu);
  {validasi menu pilihan}
  while(menu < 1) or (menu > 5) do
  begin
    gotoxy(15,15);
    textcolor(12);write('Nomor tidak ada dalam Menu, tekan enter untuk mengulang!');
    readln;gotoxy(56,11);
    textcolor(14);readln(menu);
  end;
  case (menu) of
  1 : begin
        clrscr;
        hapusDepan(elemen,awal,akhir);
        textcolor(12);gotoxy(25,7);write('Data telah dihapus satu di depan');
        readln;
      end;

  2 : begin
        clrscr;
        hapusBelakang(elemen,awal,akhir);
        textcolor(12);gotoxy(25,7);write('Data telah dihapus satu di belakang');
        readln;
      end;

  3 : begin
        clrscr;
        hapusTengah(elemen,awal,akhir);
        readln;
      end;

  4 : begin
        clrscr;
        textcolor(10);gotoxy(31,2);writeln('Single Linked List');
        textcolor(11);gotoxy(30,3);writeln('====================');
        textcolor(15);
        tampilData(awal);
        readln;
      end;
  end;
  until(menu=5);
  end;
end;

begin
  repeat
  clrscr;
  textcolor(10);gotoxy(30,2);writeln('Menu Utama');
  textcolor(11);gotoxy(29,3);writeln('============');
  textcolor(15);gotoxy(28,5);writeln('1.Isi Data Awal');
  gotoxy(28,6);writeln('2.Tambah Data');
  gotoxy(28,7);writeln('3.Hapus Data');
  gotoxy(28,8);writeln('4.Cari Data');
  gotoxy(28,9);writeln('5.Tampil Data');
  gotoxy(28,10);writeln('6.Keluar');
  textcolor(9);gotoxy(28,12);write('Silakan Memilih Menu! [1-6] ');textcolor(14);readln(menu);
  {validasi menu pilihan}
  while(menu < 1) or (menu > 6) do
  begin
    gotoxy(15,15);
    textcolor(12);write('Nomor tidak ada dalam Menu, tekan enter untuk mengulang!');
    readln;gotoxy(56,12);
    textcolor(14);readln(menu);
  end;
  case (menu) of
  1 : begin
        clrscr;
        create;
        isiDataAwal(awal,akhir);
        readln;
      end;

  2 : begin
        clrscr;
        pilihanTambah(awal,akhir);
        readln;
      end;


  3 : begin
        clrscr;
        pilihanHapus(awal,akhir);
        readln;
      end;


  4 : begin
        clrscr;
        cariData(awal);
        readln;
      end;


  5 : begin
        clrscr;
        if (awal=nil) then
        begin
          tampilData(awal);
          readln;
        end
        else
        begin
          textcolor(10);gotoxy(20,2);writeln('Single Linked List yang Tersusun Ascending ');
          textcolor(11);gotoxy(19,3);writeln('============================================');
          textcolor(15);
          minimumSortAsc(awal,akhir);
          tampilData(awal);
        readln;
        end;
      end;

  6 : begin
        clrscr;
        destroy(awal,akhir);

      end;
  end;
  until(menu=6);
end.

Tidak ada komentar:

Posting Komentar