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.

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.

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.

mencari niali 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.

uts ppd ( agak melenceng dari tema blog)

NAMA                         : GDE ARI KUSUMA

NIM                             : 1015051045

KELAS/SEMESTER    : A/II

Mata Kuliah                  : Perkembangan Peserta Didik

1.      Perbedaan antara pertumbuhan dan perkembangan adalah : Kalau pertumbuhan itu dapat dilihat perubahannya dengan jelas, dapat diukur (kuantitatif), dan terjadi pada fisik. Sedangkan perkembangan itu perubahannya tak dapat dilihat dengan jelas, bersifat kualitatif, dan terjadi pada psikis (jiwa/kepribadian).

2.       Masa dewasa adalah masa dimana kita telah memiliki jiwa yang matang, sudah memiliki persektif dan pengetahuan yang luas, mampu berpandangan kedepan, sudah memiliki tanggung jawab, mampu memilih mana yang baik dan mana yang tidak baik.Bila dipandang dari sudut pandang kejiwaan, seorang individu dapat dikatakan telah dewasa bila telah memiliki jiwa yang matang, prinsip yang kuat, mampu mengendalikan emosi, dll. Sedangkan bila dilihat dari sudut pandang agama, seseorang dapat dikatakan dewasa bila ia telah memahami ilmu agama, mampu menjadi panutan, mampu mengamalkan semua ajaran agama, mampu bertindak sesuai ajaran agama, dll.

3.      Yang dimaksud dengan perkembangan kognitif pada remaja menurut Piaget adalah tahap perkembangan yang dialami oleh anak ketika ia berumur belasan tahun yaitu ketika ia beranjak remaja ( pubertas ). Pada masa ini para remaja sudah mampu berfikir abstrak, mulai mengenal cinta, mampu berfikir secara logis, sudah mulai berani melawan orang tua, wataknya sudah mulai terbentuk sehingga ia selalu ingin bebas melaksanakan keinginannya. Adapun tindakan preventif yang dapat dilakukan oleh orang tua adalah biarkan ia melaksanakan keinginannya namun tetap diawasi agar tidak menyimpang, memberi pembekalan agama yang kuat, memberi pengertian agar ia tidak mudah terpengaruh yang jelek dari orang lain, bisa menjadi tempat curhatan si anak, dll.

4.      Yang dimaksud dengan periode neonatus adalah periode atau masa kehidupan pertama si bayi di luar rahim sampai dengan usia 28 hari. Pada masa ini terjadi pematangan organ hampir pada semua system. Periode ini dikatakan periode yang sangat berbahaya jika dibandingkan dengan periode lainnya karena: 

        1. Bayi belum bisa menolong dirinya sendiri, 

        2. Bayi harus mengubah kebiasaannya waktu di dalam rahim, yaitu tergantung dengan ibu, 

      3. Belum semua organ-organ penting dalam tubuh si bayi itu matang, sehingga kerja organ-organ tersebut agak terganggu, 

        4. Daya imunitas (daya tahan tubuh) si bayi masih lemah, 

        5. Perubahan keadaan yang sangat signifikan antara keadaan di dalam rahim dan di luar rahim.

5.      Adapun perubahan tingkah laku yang dialami individu akibat perubahan fisik pada masa remaja adalah : 

      1. Misalnya si anak mengalami perubahan bentuk tubuh dari kurus menjadi gemuk karena ia sering makan malam – malam, ia menjadi tidak percaya diri, sering minder dalam bergaul karena sering di ejek oleh teman-temannya karena tubuhnya gemuk,karena itu ia menjadi tertutup dengan temannya. 

      2. Misalnya si anak mengalami pertumbuhan tinggi badan yang terlalu cepat , maka dalam pergaulannya ia sering dijaili dengan teman-temannya , hingga membuatnya menjadi anak yang pendiam dan sering memendam masalahnya sendiri dan berjalan bungkuk.

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.

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.

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.

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.
     

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.

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.

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.

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.

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.

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.

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.

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.

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.