Post Reply 
 
Thread Rating:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Struktur Data] Source Code dari Tugas List
10-13-2012, 05:53 AM (This post was last modified: 10-21-2012 04:16 PM by thurevsky.)
Post: #1
[Struktur Data] Source Code dari Tugas List
Mungkin temen-temen ada yang kebingungan kemarin pas ngerjain tugas list, dan mungkin juga udah banyak yang bisa. Di sini ane cuma mau ngeshare bagi yang kebingungan aja. Jadi intinya program ini itu memakai struktur data list linier yang bukan circular. Nah, behaviournya itu kalo kita masukkin angka random itu otomatis langsung disorting. Contoh :

input : 3
list : 3
input : 4
list : 3 4
input : 1
list : 1 3 4
input : 9999
hasil list : 1 3 4
*exit program*

Di source code ane ini, ane buat programnya flexibel, jadi bisa pake limited (banyaknya inputan terbatas), dan juga bisa pake unlimited (banyaknya inputan tidak terbatas). Tapi itu ane buat jadi pre-konfigurasi, jadi harus diatur sebelum di compile, dan setelah dicompile sudah ga bisa diubah lagi. Big Grin

Codingnya adalah sbb :

Code:
{
Pembuat         : Sahid Nur Afrizal [24010311140085]
Nama Program    : List Bulat Positif Terurut
Deskripsi       : Program untuk memasukkan list berupa bilangan bulat
                   positif lalu secara otomatis langsung diurutkan membesar
Judul Skrip     : Sahid Nur Afrizal-24010311140085.pas
Versi           : 3
Update Terakhir : 9 Oktober 2012 11:05 PM
Compiler         : Free Pascal with Turbo Pascal Syntaxes
}
program list_bulpos_2;

uses
wincrt;

const
const_lim=10; {panjang list max, 1-n untuk panjang=n, 0 untuk unlimited}

type
componentType = integer;
nodePointer = ^nodeType;
nodeType = record
  component : componentType;
  link : nodePointer
end;

var
list:nodePointer;
x:integer;
limit:integer;

{*** THE PROCEDURES AND FUNCTIONS ***}
procedure init(var L:nodePointer);
begin
New(L);
L^.component:=0;
L^.link:=nil;
end;

function isEmpty(var L:nodePointer):boolean;
begin
if (L^.link=nil) and (L^.component=0) then
  isEmpty:=true
else
  isEmpty:=false;
end;

function isOneComponent(var L:nodePointer):boolean;
begin
if (L^.link=nil) and (L^.component>0) then
  isOneComponent:=true
else
  isOneComponent:=false;
end;

procedure addDepan(var L:nodePointer;var data:componentType);
var
newNode:nodePointer;
begin
New(newNode);
newNode^.component:=data;
if not(isEmpty(L)) then
  newNode^.link:=L
else
  newNode^.link:=nil;
L:=newNode;
end;

procedure addAntara(var prev,next:nodePointer;var data:componentType);
var
newNode:nodePointer;
begin
New(newNode);
newNode^.component:=data;
newNode^.link:=next;
prev^.link:=newNode;
end;

procedure addBelakang(var prev:nodePointer;var data:componentType);
var
newNode:nodePointer;
begin
New(newNode);
newNode^.component:=data;
newNode^.link:=nil;
prev^.link:=newNode;
end;

procedure searchNinsert(var L:nodePointer;var data:componentType);
var
current,prev:nodePointer;
begin
if isEmpty(L) then
  addDepan(L,data)
else if isOneComponent(L) then
begin
  if data>L^.component then
   addBelakang(L,data)
  else
   addDepan(L,data);
end
else
begin
  init(prev);
  current:=L;
  while (current^.component<data) and (current^.link<>nil) do
  begin
   prev:=current;
   current:=current^.link;
  end;
  if (current=L) and (data<=current^.component) then
   addDepan(L,data)
  else if (data>=current^.component) and (current^.link=nil) then
   addBelakang(current,data)
  else
   addAntara(prev,current,data);
end;
end;

procedure cetakList(var L:nodePointer);
var
current:nodePointer;
begin
current:=L;
write(' <LIST : ');
if isEmpty(current) then
  write('<Empty>')
else if isOneComponent(current) then
  write('|',current^.component,'|->|NIL|')
else
begin
  while current^.link<>nil do
  begin
   write('|',current^.component,'|->');
   current:=current^.link;
  end;
  write('|',current^.component,'|->|NIL|');
end;
write('>');
writeln;
end;

procedure start_limited(var list:nodePointer;var limit,x:integer);
begin
writeln('PERHATIAN : NILAI INTEGER MAX = 32766');
writeln('Masukkan angka yang mau dimasukkan ke list sebanyak ',limit,' buah');
writeln('atau akhiri dengan "0" :');
writeln('Inputs remaining : ',limit);
write('> ');
readln(x);
while (x<>0) and (limit>0) do
begin
  if (x>0) then
  begin
    searchNinsert(list,x);
    cetakList(list);
    limit:=limit-1;
  end
  else
   writeln(' <ERROR : Harap masukkan bilangan bulat positif (x>0)>');
  if (limit>0) then
  begin
   writeln('Inputs remaining : ',limit);
   write('> ');
   readln(x);
  end;
end;
end;

procedure start_unlimited(var list:nodePointer;var x:integer);
begin
writeln('PERHATIAN : NILAI INTEGER MAX = 32766');
writeln('Masukkan angka yang mau dimasukkan ke list dan akhiri dengan "0" :');
write('> ');
readln(x);
while (x<>0) do
begin
  if (x>0) then
  begin
   searchNinsert(list,x);
   cetakList(list);
  end
  else
   writeln(' <Harap masukkan bilangan bulat positif (x>0)>');
  write('> ');
  readln(x);
end;
end;

procedure judul;
begin
writeln('=================================================');
writeln('|                 LIST Program                  |');
writeln('=================================================');
writeln('Copyrighted by Sahid Nur Afrizal - 24010311140085');
writeln;
end;

{*** THE CORE ***}
begin
clrscr;
New(list);
limit:=const_lim;
init(list);
judul;
if (limit<>0) then
  start_limited(list,limit,x)
else
  start_unlimited(list,x);
clrscr;
judul;
writeln('Hasil List :');
cetakList(list);
writeln;
writeln('Press any key to exit ...');
readkey;
Dispose(list);
end.

Kalo ada yang mau ditanyain, monggo, barangkali ane ato temen-temen lain bisa bantu. Big Grin
Oh ya kalo ada yang kasus bocor juga gapapa kok ngasih kritik ato saran ke ane Big Grin

[Image: joshiraku0.jpg]
サヒドはここにあった...
Visit this user's website Find all posts by this user
Quote this message in a reply
 Thanks given by: inouzuka , hexaludira
10-13-2012, 08:33 AM (This post was last modified: 10-13-2012 11:04 AM by thurevsky.)
Post: #2
RE: [Struktur Data] Source Code dari Tugas List
=.="
malah dihapus postingannya..
ckckckck

[Image: joshiraku0.jpg]
サヒドはここにあった...
Visit this user's website Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump:


User(s) browsing this thread: 1 Guest(s)