Programozási tételek - Pascal nyelvű megvalósítás

Az alábbiakban a programozási tetelek pascal nyelvű megvalósításait gyűjtöttük egybe.

Először készítsük el a program keretét, definiáljuk a szükséges változókat és készítsünk egyszerű beolvasó és kiíró eljárásokat!

Program Tetelek;
 
Const
  MaxN = 100;                      // Maximális elemszám
 
Var
  A : array[1..MaxN] of Integer;  // Elemeket tároló tömb
  N : Word;                       // Tényleges elemek száma
 
 
Procedure Beolvasas;            // Beolvassa az elemeket
 
    Var
      i : Word;                   // Ciklusváltozó
 
  Begin
    Write ('Adja meg az elemek számát: ');
    Readln(N);
    For i := 1 to N do
    Begin
      Write (i, '. elem: ');
      Readln(A[i]);
    End;(* For *)
  End;(* Beolvasas *)
 
 
  Procedure Kiir;                 // Kiírja az elemeket
 
    Var
      i : Word;                   // Ciklusváltozó
 
  Begin
    Write('A tömb elemei: ');
    For i := 1 to N-1 do
    Begin
      Write(A[i], ', ');
    End;(* For *)
    Writeln(A[i+1]);
  End;(* Kiiras *)
 
  // Ide kerülhetnek az egyes tételeket megvalósító függvények
 
Begin
 
  Beolvasas;
  Kiiras;
 
  // itt hívhatjuk meg a kívánt tételt megvalósító eljárást, függvényt
 
End.

Számoljuk meg, hogy hány negatív (T tulajdonságú) elem van a megadott számok között!

  Procedure Megszamolas;
    Var
      i  : Word;               // Ciklusváltozó
      Db : Word;               // A végeredmény
 
  Begin
    Db := 0;
    For i := 1 to N do
    Begin
      If (A[i] < 0) Then Inc(Db);
    End;(* For *)
    Writeln(Db, ' negatív szám található a megadott számok között!');
  End;(* Megszamolas *)

Adjuk össze a megadott számokat!

  Procedure Osszegzes;
 
    Var
      Sum : Integer;              // A végeredmény
      i   : Word;                 // Ciklusváltozó
 
  Begin
    Sum := 0;
    For i := 1 to N do
    Begin
      Sum := Sum + A[i];
    End;(* For *)
    Writeln('A számok összege: ', Sum);
  End;(* Osszegzes *)

Döntsük el, van-e negatív (T tulajdonságú) szám a megadott számok között!

  Procedure Eldontes;
 
    Var
      i : Word;                    // Ciklusváltozó
 
  Begin
    i := 1;
    While (i <= N) and (A[i] >= 0) do
    Begin
      Inc(i);
    End;(* While *)
    If (i <= N) Then Writeln ('Van negatív szám a megadottak között.')
    Else Writeln ('Nem található negatív szám a megadottak között.');
  End;(* Eldontes *)

Adjunk meg egy negatív (T tulajdonságú) számot a megadottak közül, ha tudjuk, hogy van negatív szám köztük!

  Procedure Kivalasztas;
 
    Var
      i : Word;                       // Ciklusváltozó
 
  Begin
    i := 1;
    While A[i] >= 0 do
    Begin
      Inc(i);
    End;(* While *)
    Writeln ('A sorozat ', i, '. eleme negatív (', A[i], ').');
  End;(* Kiválsztás *)

Döntsük el, hogy van-e a számsornak negatív (T tulajdonságú) eleme, és ha van, adjunk vissza egy negatív elemet!

  Procedure Kereses;
 
    Var
      i : Word;                      // Ciklusváltozó
 
  Begin
    i := 1;
    While (i <= N) and (A[i] >= 0) do
    Begin
      Inc(i);
    End;(* While *)
    If (i <= N) Then Writeln('Van negatív szám, például a sorozat ', i, '. eleme (', A[i], ')')
    Else Writeln ('Nem található negatív szám a sorban.');
  End;(* Kereses *)

Keressük meg a számok legnagyobbikát!

  Procedure MaximumKivalasztas;
 
    Var
      i    : Word;                  // Cilusváltozó
      MaxI : Word;                  // A legnagyobb elem indexe
 
  Begin
    MaxI := 1;
    For i := 2 to N do
    Begin
      If (A[MaxI] < A[i]) Then
      Begin
        MaxI := i;
      End;(* If *)
    End;(* For *)
    Writeln('A legnagyobb elem az ', MaxI, '. elem, ami: ', A[MaxI]);
  End;(* MaximumKivalogatas *)

Válogassuk ki egy másik tömbbe (Eredmeny) a negatív (T tulajdonságú) elemeket!

  Procedure Kivalogatas;
 
    Var
      i        :       Word;                      // Ciklusváltozó
      Db       :       Word;                      // Az negatív elemek száma
      Eredmeny :       Array[1..MAXN] of Integer; // A végeredmény
 
  Begin
    Db := 0;
    For i := 1 to N do
    Begin
      If (A[i] < 0) Then
      Begin
        Inc(Db);
        Eredmeny[Db] := A[i];
      End;(* If *)
    End;(* For *)
 
    // Az eredmény kiiratása
 
    Write('Negatív elemek: ');
    If Db > 0 Then
    Begin
      For i := 1 to Db-1 do
      Begin
        Write(Eredmeny[i], ', ');
      End;(* For *)
      Writeln(Eredmeny[i+1]);
    End;(* If *)
  End;(* Kivalogatas *)

Rendezzük a számsort növekvő sorrenbe!

• Kiválasztjuk a legkisebb elemet
• Első és a lekisebb cseréje
• A maradék, eggyel rövidebb számsorra ismételjük a fentieket
• Az N-1-edik elem helyrerakásakor kész vagyunk (az N. már csak jó helyen lehet.

  Procedure Rendezes;
 
    Var
      i, j     :       Word;             // Ciklusváltozó
      MinIndex :       Word;                // Minimális elem indexe
      seged    :       Integer;             // Segédváltozó a cseréhez
 
  Begin
    For i := 1 to N-1 do // i azt mutatja, hogy hanyadik elemet rakom a helyére
    Begin
 
      // MinimumKiválasztás tétele
 
      MinIndex := i;
      For j:= i+1 to N do
      Begin
        If A[j] < A[MinIndex] Then MinIndex:=j;
      End;(* For *)
 
      // A csere
 
      seged := A[i]; A[i] := A[MinIndex]; A[MinIndex] := seged;
    End;(* For *)
  End;(* Rendezes *)

Adott, rendezett sorozatban keressünk meg egy megadott értéket!

  Procedure LogaritmikusKereses;
 
    Var
      e, v, k :       Word;         // Eleje, vége , közepe
      x       :       Integer;      // A keresendő érték
      Talalat :       Boolean;      // Megtaláltuk-e már?
 
  Begin
    Talalat := False;
    Write ('Keresett elem: '); Readln(x);
    e := 1; v := N;
    While (e <= v) and not(Talalat) do
    Begin
      k := (e + v) div 2;
      If A[k] < x Then e := k+1
      Else If A[k] > x Then v := k-1
      Else Talalat := True;
    End;(* While *)
    If (A[k] = x) Then Writeln('A keresett elem a tömb ', k, '. eleme.')
    Else Writeln('Nincs ilyen elem!');
  End;(* LogaritmikusKereses *)