BAB 1D : Fungsi dan Prosedur - Procedure

Solusi BAB 1D : Fungsi dan Prosedur - Procedure

PROGRAM prosedur;

var

    bil : integer;

procedure TulisJawaban(x: integer);

begin

    case x of

        1..9: begin writeln('satuan'); end;

        10..99: begin writeln('puluhan'); end;

        100..999: begin writeln('ratusan'); end;

        1000..9999: begin writeln('ribuan'); end;

        10000..30000: begin writeln('puluhribuan'); end;

    end;

end;

 

begin

while not eof(input) do

begin

    readln(bil);

    TulisJawaban(bil);

end;

end.

BAB 1D : Fungsi dan Prosedur - Function

Solusi BAB 1D : Fungsi dan Prosedur - Function

PROGRAM fungsi;

var

    bil: integer;

 

function Faktorial(n: integer): longint;

begin

    if (n = 0) then

        Faktorial := 1

    else

        Faktorial := n * Faktorial (n - 1);

end;

 

function Valid(n: integer): boolean;

begin

    Valid := (n >= 0) and (n <= 10);

end;

 

begin

    readln(bil);

    if (Valid(bil)) then

        writeln(Faktorial(bil))

    else

        writeln('ditolak');

end.

BAB 1D : Fungsi dan Prosedur - Var Parameter

Solusi BAB 1D : Fungsi dan Prosedur - Var Parameter

PROGRAM varparameter;

var

    a, b: integer;

 

 

procedure Swap(var a, b: integer);

var

    temp: integer;

begin

    temp := a;

    a := b;

    b := temp;

end;

 

 

begin

    readln(a, b);

    Swap(a, b);

    writeln(a, ' ', b);

end.

BAB 1C : Perulangan - Bilangan Agak Prima

Solusi BAB 1C : Perulangan - Bilangan Agak Prima

PROGRAM agakprima;

var pr,bts,tes,cek : longint;

    c,a : byte;

begin

     readln(c);

     for a:=1 to c do

         begin

              readln(pr);

              cek:=0;

              tes:=3;

              bts:=trunc(pr/2);

     if ((pr mod 2=0) and (pr<>2)) or (pr=1) then

        inc(cek);

     while tes<=bts do

     begin

       if (pr mod tes=0) then

       begin

        inc(cek);

        if cek>2 then break;

       end;

       inc(tes);

     end;

     if cek>2 then

       writeln('TIDAK')

     else

       writeln('YA');

     end;

end.

BAB 1C : Perulangan - Faktor Bilangan

Solusi BAB 1C : Perulangan - Faktor Bilangan

PROGRAM faktorbilangan;

var N,i:longint;

begin

readln(N);

for i:=1 to N do begin

 if N mod i=0 then begin

  writeln(N/i:0:0);

 end;

end;

 

readln end.

BAB 1C : Perulangan - Cek Bilangan Prima

Solusi BAB 1C : Perulangan - Cek Bilangan Prima

PROGRAM cekprima;

var i,j : integer;cek:boolean;

begin

while not eof do begin

readln(i);

cek:=true;

 if i<2 then cek:=false;

 for j:=2 to i-1 do begin

  if i mod j=0 then begin

   cek:=false; break;

  end;

 end;

if cek=true then writeln('YA') else writeln('TIDAK');

end;

readln end.

BAB 1C : Perulangan -Rata rata

Solusi BAB 1C : Perulangan - Rata rata

PROGRAM ratarata;

VAR

n,i : integer;

b,k,r,m,jum : real;

BEGIN

readln(n);

k := 1000000;

b := -1000000;

for i:= 1 to n do

begin

readln(m);

jum := jum+m;

if m < k then k := m;

if m > b then b := m;

end;

r := jum/n;

writeln(k:0:2,' ',b:0:2,' ',r:0:2);

END.

BAB 1C : Perulangan - Pola 3

Solusi BAB 1C : Perulangan - Pola 3

PROGRAM pola3;

var n,i,k : byte;

begin

     readln(n,k);

     for i:=1 to n-1 do

     begin

          if (i mod k = 0) then

          write('*')

          else

          write(i);

          write(#32);

     end;

     if ((n mod k) = 0) then

        write('*')

        else

        writeln(n);

end.