mencari bilangan terkecil dalam array 2 dimensi

program matiks;

uses wincrt;

type
arin=array [1..100] of integer;

function min(b:arin;m,n:integer):integer;
var
i,j,domp:integer;
begin
domp:=b[1];
for i:=1 to m do
begin
for j:= 1 to n do
begin
if domp>=b[j] then
domp:=b[j];
end;
end;
min:=domp;
end;


var
a:arin;
i,j,m,n,x,domp:integer;

begin
write('masukan jumlah baris : ');readln(n);
write('masukan jumlah kolom : ');readln(m);
for i:=1 to m do
begin
for j:= 1 to n do
begin
write('a[',i,',',j,'] : ');readln(a[j]);
end;
end;
domp:=min(a,m,n);
writeln('jadi bilangan bilangan terkecil adalah ',domp);
end.

› Read More

mencAri bilangan x dalam array 2 dimensi

program matiks;

uses wincrt;

type
arin=array [1..100] of integer;

function cari(b:arin;m,n,x:integer):integer;
var
i,j,domp:integer;
begin
domp:=0;
for i:=1 to m do
begin
for j:= 1 to n do
begin
if b[j]=x then
domp:=domp+1;
end;
end;
cari:=domp;
end;


var
a:arin;
i,j,m,n,x,domp:integer;

begin
write('masukan jumlah baris : ');readln(n);
write('masukan jumlah kolom : ');readln(m);
for i:=1 to m do
begin
for j:= 1 to n do
begin
write('a[',i,',',j,'] : ');readln(a[j]);
end;
end;
write('masukan bilangan yang dicari : ');readln(x);
domp:=cari(a,m,n,x);
writeln('jadi bilangan yang dicari ada ',domp);
end.

› Read More

mencari rata-rata array 2 dimensi

program matiks;

uses wincrt;

type
arin=array [1..100] of integer;

function rata(b:arin;m,n:integer):real;
var
i,j,domp:integer;
begin
domp:=0;
for i:=1 to m do
begin
for j:= 1 to n do
begin
domp:=domp+b[j];
end;
end;
rata:=domp/(m*n);
end;


var
a:arin;
i,j,m,n:integer;
domp:real;

begin
write('masukan jumlah baris : ');readln(n);
write('masukan jumlah kolom : ');readln(m);
for i:=1 to m do
begin
for j:= 1 to n do
begin
write('a[',i,',',j,'] : ');readln(a[j]);
end;
end;
domp:=rata(a,m,n);
writeln('jadi rata-rata matriks adalah ',domp:0:2);
end.

› Read More

mencari nilai terkecil array 2 dimensi

program matiks;


uses wincrt;

type
tab=record
kolom:integer;
baris:integer;
bil:integer;
end;

type
arin=array [1..100] of integer;

procedure min(b:arin;m,n:integer;var c:tab);
var
i,j,domp,temp:integer;
begin
domp:=b[1];
c.baris:=1;
c.kolom:=1;
for i:=1 to m do
begin
for j:= 1 to n do
begin
if domp>=b[j] then
begin
domp:=b[j];
c.baris:=i;
c.kolom:=j;
end;
end;
end;
c.bil:=domp;
end;


var
a:arin;
i,j,m,n,x:integer;
domp:tab;

begin
write('masukan jumlah baris : ');readln(n);
write('masukan jumlah kolom : ');readln(m);
for i:=1 to m do
begin
for j:= 1 to n do
begin
write('a[',i,',',j,'] : ');readln(a[j]);
end;
end;
writeln;
min(a,m,n,domp);
writeln('jadi bilangan terkecil adalah : ',domp.bil,' berada di a[',domp.baris,',',domp.kolom,']');
end.

› Read More

mencari nilai maksimal dari 4 buah nilai

program min_4bil;

uses wincrt;

function min2(a,b:integer):integer;
var
x : integer;

begin
     if a > b then
     x:=a
     else
     x:=b;
     min2:=x;
end;

var
a,b,c,d,x,y,z:integer;

begin
readln(a);
readln(b);
readln(c);
readln(d);
x:=min2(a,b);
y:=min2(c,d);
z:=min2(x,y);
writeln('nilai max = ',z);
end.

› Read More

nilai maksimal dalam pascal

program maximal;
uses wincrt;
type
    tabint =array[1..100] of integer;
var
   M: array[1..100]of integer;
   nilai: tabint;
   n,i:integer;
   max,temp:integer;

function maxtab(n:integer):integer;
begin
     write('masukkan jumlah bilangan =');readln(M[i]);
     for i:= 1 to n do
     begin
          if(M[i])>max then
          max:=M[i];
     end;

         writeln('Nilai maximum adalah:',max);
         for i:=1 to n do
         begin
              if (i mod 2=1) then
              begin
              temp:= M[i];
              M[i]:= M[i+1];
              M[i+1]:= temp;
         end;
              writeln('M[i]');
     end;

end.

› Read More

program utuh dalam pascal

uses wincrt;
var jum1,jum2,i,j : integer;
    pilihan : char;
label akhir;
procedure inputjum;
begin
    write('masukkan jumlah tabel1 : ');readln(jum1);
    write('masukkan jumlah tabel2 : ');readln(jum2);
end;
procedure simetris;
  var  nilai : array [1..100] of integer;
  jum:integer;
   simetris : boolean;
label keluar;
begin
writeln('-------------------------- Soal PERTAMA by Ncik CECE------------------- ');
writeln('-------------------------- SIMETRIS GAN ------------------------ ');
     writeln('masukkan jumlah isi tabelnya, nilainya harus genap ia.. :) ');
     readln (jum);
            if jum mod 2=0 then
               begin
               for i := 1 to jum do
               begin
                    write('masukkan nilai ke ',i, ' :');
                    readln(nilai [i]);
                    end;
     simetris := true ; 
     for i := 1 to round (jum/2) do
         begin
         j := jum-i+1;                
                       if nilai [i] <> nilai [j] then
                       begin
                            simetris := false;
                            goto keluar;
                            end;
               end;
               writeln;
         keluar:
         if simetris then
            writeln('iya nox simetris dia eee..')
            else
            writeln('nggak simetris tauk');
            end           
            else writeln ('jumlah harus genap ia');
            readkey;
     end;
 procedure sisipkan(jum1,jum2 : integer);
 var nilai1,nilai2:array[1..100] of integer;   
begin
writeln('-------------------------- Soal Dua by Ncik CECE------------------- ');
writeln('-------------------------- sisipkan tabel ------------------------ ');
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   if jum1 > jum2 then
      begin
          j:=1;
          for i := jum1+1 to jum2+jum1 do
              begin
              nilai1[i] := nilai2[j];
              j:=j+1;
              end;

        {menampilkan nilai :}

        for i:= 1 to jum1+jum2 do
            writeln(nilai1[i]);
      end
    else
      begin
          j:=1;
          for i := jum2+1 to jum2+jum1 do
              begin
              nilai2[i] := nilai1[j];
              j:=j+1;
              end;
        for i:= 1 to jum1+jum2 do
            writeln(nilai2[i]);
      end;               
    readkey;
end;
procedure bandingkan(jum1,jum2:integer);
var nilai1,nilai2:array[1..100] of integer;
    beda : boolean;
begin
writeln('-------------------------- Soal tiga by Ncik CECE------------------- ');
writeln('-------------------------- sisipkan tabel ------------------------ ');         
   if jum1 = jum2 then
    begin
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   beda := false;
          for i := 1 to jum1 do
          if nilai1[i] <> nilai2[i] then
                       beda := true;
   if beda then
      writeln('Tabel 1 dan tabel 2 berbeda')
      else writeln('tabel1 dan tabel 2 sama');
   end
   else  writeln(' jumlah harus sama  ');
     readkey;
end;
procedure tukarisi(jum1,jum2 : integer);
var nilai1,nilai2:array[1..100] of integer;
 temp:integer;
begin
     writeln('-------------------------- Soal empat by Ncik CECE------------------- ');
     writeln('-------------------------- tukar  isi  tabel ------------------------ ');      
   writeln;
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   writeln;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   writeln;
   if jum1 < jum2 then
      for i:= 1 to jum1 do
          begin
              temp := nilai2[i];
              nilai2[i] := nilai1[i];
              nilai1[i] := temp;
          end
   else
       for i:= 1 to jum2 do
          begin
              temp := nilai2[i];
              nilai2[i] := nilai1[i];
              nilai1[i] := temp;
          end;
    writeln;
    writeln('tukar-tukar...');
   for i:=1 to jum1 do
       writeln('nilai tabel1 ke ',i, ' : ',nilai1[i]);
   writeln;
   for i:=1 to jum2 do
       writeln('nilai tabel2 ke ',i, ' : ',nilai2[i]);
   readln;
end;
procedure zigzag(jum1,jum2 : integer);
var nilai1,nilai2,hasil:array[1..100] of integer;
    index_a,index_b:integer;
begin
     writeln('-------------------------- Soal empat by Ncik CECE------------------- ');
     writeln('-------------------------- tukar zigzag  tabel ------------------------ ');                      
   writeln;
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);     
        end;
   writeln;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   index_a := 1;
          index_b := 1;
if jum1 < jum2 then
begin
  for i:=  1 to jum1*2 do
   begin
       if i mod 2 = 0 then
       begin
       hasil[i] := nilai2[index_b];
        index_b := index_b +1;
       end
       else
       begin
           hasil[i] := nilai1[index_a];
                  index_a := index_A +1;
           end;
     end;
   for i := (jum1*2 +1) to ((jum2-jum1)+jum1*2)  do
       begin
            hasil[i] := nilai2[index_b];
            index_b := index_b +1;
       end;
 end
 else if jum1 > jum2 then
begin
  for i:=  1 to jum2*2 do
   begin
       if i mod 2 = 0 then
       begin
       hasil[i] := nilai1[index_a];
        index_a := index_a +1;
       end
       else
       begin
           hasil[i] := nilai2[index_b];
                  index_b := index_b +1;
           end;
     end;
   for i := (jum2*2 +1) to ((jum1-jum2)+jum2*2)  do
       begin
            hasil[i] := nilai1[index_a];
            index_a := index_a +1;
       end;
 end;    
   for i:= 1 to jum1+jum2 do
       writeln(hasil[i]);
       readkey;
end;
begin
 repeat
 clrscr;
writeln('-----------------------------------------------------');
writeln('                   program Cece                    ');
writeln('-----------------------------------------------------');
Writeln('1. cek tabel simetris ');
Writeln('2. sisipkan tabel 1 dan 2 ');
Writeln('3. bandingkan dua buah tabel ');
Writeln('4. tukar isi tabel');
Writeln('5. gabungkan secara zig-zag');
Writeln('6. keluar');
writeln('masukkan kode yang ingin anda pilih [1-5] : ');
pilihan := readkey;
case pilihan of
     '1' : begin
        simetris;
       end;
    '2' : begin
        inputjum;
        sisipkan(jum1,jum2);
        end;
    '3' : begin
        inputjum;
        bandingkan(jum1,jum2);
end;
    '4' : begin
        inputjum;
        tukarisi(jum1,jum2);
                end;
    '5' : begin
    inputjum;
    zigzag(jum1,jum2);
end;
    '6' : goto akhir;
else
    writeln ('pilihan salah!!!');
end;
 until pilihan = '6';
akhir:
end.

› Read More

pytagoras dalam pascal

Program cobaaj;
uses wincrt;

function phytagoras(a,b,c:integer):boolean;
begin
if c=sqrt(sqr(a)+sqr(b)) then phytagoras:=true
else phytagoras:=false;
end;

var a,b,c:integer;
    hasil:boolean;
begin
write('Masukan A = ');readln(a);
write('Masukan B = ');readln(b);
write('Masukan C = ');readln(c);
hasil:=phytagoras(a,b,c);
if hasil then writeln('Segitiga Phytagoras')
else writeln('Segitiga Bukan Phytagoras');
end.
     

› Read More

mencari keliling lingkaran dalam pascal

program keliling;

uses wincrt;

type tab=record
     p:real;
     t:real;
     end;

function sm(a:tab):real;
begin
sm:=(sqrt(sqr(a.p)+sqr(a.t)));
end;

function kll(a:tab):real;
begin
kll:=(a.p+a.t+sm(a));
end;

var
a:tab;
hsl:real;

begin
readln(a.p);
readln(a.t);
hsl:=kll(a);
writeln;
writeln(hsl:0:2);
end.

› Read More

bilangan prima dalam pascal

Program Bil_prim2;
uses wincrt;

var prima:array[1..500] of boolean;
    batasan,batas,I,J:integer;
begin
Writeln('batas maksimal sampai dengan angka 500 ');
Write('masukkan batasan bilangan prima =  ');
Readln(batasan);
     for I:=1 to batasan do
         prima[I]:=true;
         batas:=trunc(sqrt(batasan));

         I:=2;
         while I<=batas do
               begin
                    if prima[I] then
                       begin
                            J:=I+I;
                            while J<=batasan do
                                  begin
                                       prima[J]:=false;
                                       J:=J+I
                                  end
                       end;
                    I:=I+1
               end;
         Writeln('Bilangan prima antara 1 s/d',batasan:1);
         writeln('----------------------------');
         Writeln;
         J:=1;
         for I:=1 to batasan do
             begin
             if prima[I] then
                begin
                     if J>8 then
                        begin
                        J:=1;
                        writeln;
                        end
                     else
                         begin
                         write('   ',I:3);
                         J:=J+1;
                         end;
                end;
             end;
         Writeln;
         Writeln;
         Writeln('selesai');
         end.

› Read More

fungsi ascending

program ascending;
uses wincrt;
type
    T = array[1..100] of integer;
procedure ascend (a : T; var temp : integer );
var
i,n,j,min : integer;
begin
     for i:=1 to (n-1) do
         begin
         min:=i;
         for j:=(i+1) to n do
             begin
             if a[min]>a[j] then
                begin
                min := j;
                end;
             end;
         temp := a[i];
         a[i] := a[min];
         a[min] := temp;
         writeln;
         end;
end;

var
a : T;
i,n,temp,min : integer;

begin
     write('batas: '); readln(n);
     for i:=1 to n do
         begin
         write('nilai',i,'='); readln(a[i]);
         end;
         writeln;
     ascend(a,temp);
     write(a[i]);
end.

› Read More

mengecek apakah tabel terurut (soal uts)

Program no4;
uses wincrt;
type tabint = array[1..100]of integer;

function cek_depan_kecil(a:tabint; n:integer):boolean;
var i:integer;
    x:boolean;
begin
i:=1;
x:=true;
while x and (i<n) do
      begin
      if a[i]>=a[i+1] then x:=false
      else i:=i+1;
      end;
cek_depan_kecil := x;
end;

var T:tabint;
    i,n:integer;
    check:boolean;
begin
write('Masukan batas = ');readln(n);
for i:=1 to n do
    begin
    write(i,' = ');readln(T[i]);
    end;
check := cek_depan_kecil(T,n);
writeln(check);
end.

› Read More

mencari letak posisi nilai terkecil (soal uts)

Program min_akhir;
uses wincrt;
type tabint = array[1..100]of integer;

function posisi_min_akhir(a:tabint; n:integer):integer;
var i,j,k:integer;
begin
k:=1;
j:=a[1];
for i:=2 to n do
    begin
    if a[i]<=j then
       begin
       j:=a[i];
       k:=i;
       end
    end;
posisi_min_akhir := k;
end;

var T:tabint;
    i,n,z:integer;
begin
write('Masukan batas = ');readln(n);
for i:=1 to n do
    begin
    write(i,' = ');readln(T[i]);
    end;
z := posisi_min_akhir(T,n);
writeln(z);
end.

› Read More

menukar isi array dalam pascal (soal uts)

Program no1;
uses wincrt;
type tabint = array[1..100]of integer;

procedure balik_elemen(var a:tabint; n:integer);
var i,tmp,j:integer;
begin
j:=n;
for i:=1 to (n div 2) do
    begin
    tmp:=a[i];
    a[i]:=a[j];
    a[j]:=tmp;
    j:=j-1;
    end
end;

var T:tabint;
    i,n:integer;
begin
write('Masukan batas = ');readln(n);
for i:=1 to n do
    begin
    write(i,' = ');readln(T[i]);
    end;
balik_elemen(T,n);
for i:=1 to n do
    begin
    writeln(T[i]);
    end;
end.

› Read More

fungsi kuadrat dalam pascal

program kuadrat;

uses wincrt;

function dua(a:integer):integer;

var
x : integer;
begin
x:= (a*a);
dua:= x;
end;
var
a,x : integer;
begin
write ('masukan bilangan = ');
readln (a);
x:=dua(a);
writeln('jadi hasil bilangan setelah dikuadratkan adalah',x);
end.

› Read More

mengubah tabel menjadi zig zag dalam pascal

program sigsag;

uses wincrt;

type
T=array [1..100] of integer;

procedure zigzag(a,b:T;n,m,p:integer; var c:T);

var
q,i,x:integer;

begin
p:=n+m;
x:=0;
if n<m then
   begin
   for i:= 1 to (n+n) do
   begin
   if i mod 2 <> 0 then
   begin
   c[i]:=a[i-x];
   x:=x+1;
   end;
   end;
   end
   else
   c[i]:=b[i+1];
end;

var
a,b,c:T;
i,n,m,p:integer;

begin
write('masukan jumlah array tabel ke 1 = ');read(n);
for i:=1 to n do
    begin  
    write('masukan bilangan ke ',i,' = ');read(a[i]);
    end;
writeln;
write('masukan jumlah array tabel ke 2 = ');read(m);
for i:=1 to m do
    begin  
    write('masukan bilangan ke ',i,' = ');read(b[i]);
    end;
writeln;
p:=n+m;
zigzag(a,b,n,m,p,c);
writeln('jadi tabel setelah disisipkan adalah');
writeln;
for i:= 1 to p do
write(c[i],' ');
end.

› Read More

mencari posisi terakhir dalam pascal

program memanggil_fungsi;
uses wincrt;
type
    tabint=array [1..100] of integer;


function searching (A:tabint; n,x:integer):boolean;
var
   i:integer;
   found,hasil: boolean;

begin
     i:=1;
     found:=false;
     while (not found) and (i<=n) do
           if A[i] = x then
              found:= true
           else
               i:=i+1;

end;



function sama (A,B : tabint; n,m: integer):boolean;
var
   found:boolean;
   i:integer;
begin
     if m=n then
       begin
        i:=1;
        found:=true;
        while found and (i<=n) do
          begin
              if A[i] <> B[i] then
                 found := false
              else
                 i:=i+1;
         end;
       end
               
     else
        found:=false;

    
end;

{***PROGRAM UTAMA***}

var
   A,B:tabint ;
   i,n,m,x : integer;
   found : boolean;
begin
     write('masukkan batas 1: ');
     readln(n);

     write('masukkan batas 2: ');
     readln(m);

     writeln ('tabel pertama : ');
     for i:=1 to n do
         readln (A[i]);

     writeln('tabel kedua : ');
     for i:=1 to m do
         readln(B[i]);

     write ('bilangan yang dicari : ');
     readln(x);

     searching(A,n,x);
     writeln(found);

     sama(A,B,n,m);
     writeln (found);

end.

› Read More