[[oktatas:programozás:Programozási_tételek|< Programozási tételek]]
====== Programozási tételek pascal megvalósítása ======
* **Szerző:** Sallai András
* Copyright (c) Sallai András, 2011, 2015
* Licenc: [[https://creativecommons.org/licenses/by-sa/4.0/|CC BY-SA 4.0]]
* Web: https://szit.hu
A programozási tételek Pascal nyelvű megvalósításai. Fejlesztés alatt
===== Alap tételek =====
==== Összegzés ====
var
tomb : array [1..5] of integer = (9, 3, 5, 4, 7);
meret, osszeg, i : integer;
begin
meret := 5;
osszeg:= 0;
for i := 1 to meret do
osszeg := osszeg + tomb[i];
end.
==== Megszámolás ====
var
tomb : array [1..9] of integer = (8,-2, 4, -5, 6, -9, 8, -3, 0);
i, n, c : integer;
begin
n := 9;
c := 0;
for i := 1 to n do
if tomb[i] < 0 then c := c + 1;
WriteLn('Negativ szamok: ', c);
end.
==== Eldöntés ====
Adott szám szerepel-e egy tömbben.
var
tomb : array [1..7] of integer = (8, 9, 3, 5, 4, 2, 7);
i, n, ker : integer;
begin
n := 7;
ker := 5;
i := 1;
while((i<=n) and (tomb[i] <> ker)) do
inc(i);
if i<=n then
WriteLn('Van ilyen')
else
WriteLn('Nincs');
end.
==== Kiválasztás ====
Adott szám hányadik helyen szerepel egy tömbben.
var
tomb : array [1..5] of integer = (3, 5, 9, 4, 1);
i, meret : integer;
begin
meret := 5;
i := 1;
while (i <= meret) and ( tomb[i] <> 5) do
i := i + 1;
if i <= meret then WriteLn('5-ös helye: ', i);
end.
==== Keresés ====
var
tomb : array [1..5] of integer = (3, 9, 3, 2, 6);
keresett : integer;
i, n : integer;
begin
keresett := 3;
n := 5;
i := 1;
while (i <= n) and (tomb[i] <> keresett) do
i := i + 1;
if i <= n then
begin
WriteLn('Van ilyen');
WriteLn('Indexe: ', i);
end
else
WriteLn('Nincs ilyen ertek');
ReadLn();
end.
==== Kiválogatás ====
var
a : array [1..5] of integer = (8, 3, 2, 6, 1);
b : array [1..5] of integer;
i, j, n : integer;
begin
j := 1;
n := 5;
for i := 1 to n do
if a[i] < 5 then
begin
b[j] := a[i];
j := j + 1;
end;
for i := 1 to j -1 do
WriteLn(b[i], ' ');
ReadLn();
end.
==== Szétválogatás ====
var
a : array [1..5] of integer = (8, 3, 2, 6, 1);
b : array [1..5] of integer;
c : array [1..5] of integer;
i, j, k, n : integer;
begin
j := 1;
k := 1;
n := 5;
for i := 1 to n do
if a[i] < 5 then
begin
b[j] := a[i];
j := j + 1;
end
else
begin
c[k] := a[i];
k := k + 1;
end;
for i := 1 to j -1 do
WriteLn(b[i], ' ');
WriteLn();
for i := 1 to k -1 do
WriteLn(c[i], ' ');
WriteLn();
ReadLn();
end.
==== Metszet ====
program metszet;
var
a : array [1..4] of integer = (8,5,3,4);
b : array [1..5] of integer = (3,8,9,6,4);
c : array [1..30] of integer;
i, j, k, n, m : integer;
begin
n := 4;
m := 5;
k := 1;
for i := 1 to n do
begin
j := 1;
while (j <= m) and (a[i]<>b[j]) do
j := j + 1;
if j <= m then
begin
c[k] := a[i];
k := k + 1;
end;
end;
for i := 1 to k - 1 do
Write(c[i], ' ');
end.
==== Unio ====
program unio;
var
a : array [1..4] of integer = (9, 5, 3, 4);
b : array [1..5] of integer = (3, 6, 2, 1, 10);
c : array [1..30] of integer;
i, j, k : integer;
n, m : integer;
begin
n := 4;
m := 5;
for i := 1 to n do
c[i] := a[i];
k := n;
for j := 1 to m do
begin
i := 1;
while (i <= n) and (b[j] <> a[i]) do
i := i + 1;
if i>n then
begin
k := k + 1;
c[k] := b[j]
end;
end;
for i := 1 to k do
Write(c[i], ' ');
WriteLn;
end.
===== Rendezések =====
==== Buborék rendezés ====
var
t : array [1..5] of integer = (9, 3, 4, 5, 8);
n, i, j, tmp : integer;
begin
n := 5;
for i := n - 1 downto 1 do
for j := 1 to i do
if t[j] > t[j+1] then
begin
tmp := t[j];
t[j] := t[j+1];
t[j+1] := tmp;
end;
for i := 1 to n do
Write(t[i], ' ');
WriteLn;
end.
==== Rendezés cserével ====
var
t : array [1..5] of byte = (5,9,8,2,3);
i, j, swap, n : byte;
begin
n := 5;
for i := 1 to n do Write(t[i], ' '); WriteLn();
for i := 1 to n-1 do
for j := i + 1 to n do
if t[i] > t[j] then
begin
swap := t[i];
t[i] := t[j];
t[j] := swap;
end;
for i := 1 to n do Write(t[i], ' '); WriteLn();
end.
==== Rendezés beszúrással ====
var
t : array [1..9] of integer = (8, 9, 3, 4, 1, 5, 2, 7, 6);
i, j, n, kulcs : integer;
begin
n := 9; //A tömb elemeinek száma
for i := 2 to n do
begin
kulcs := t[i];
j := i - 1;
while (j > 0) and (t[j] > kulcs) do
begin
t[j+1] := t[j];
j := j -1;
end;
t[j+1] := kulcs;
end;
for i := 1 to n do
Write(t[i], ' ');
WriteLn();
ReadLn();
end.
==== Shell-rendezés ====
var
tomb : array [1..9] of byte = (8, 9, 4, 7, 6, 3, 2, 1, 5);
h : array [1..3] of integer = (5, 3, 1);
i, j, k, n, x, lepes : integer;
begin
n := 9;
for i := 1 to n do
Write(tomb[i], ' ');
WriteLn();
for k := 1 to 3 do
begin
lepes := h[k];
for j := lepes + 1 to n do
begin
i := j - lepes;
x := tomb[j];
while(i>0) and (tomb[i] > x)do
begin
tomb[i+lepes] := tomb[i];
i := i - lepes;
end;
tomb[i + lepes] := x;
end;
end;
for i := 1 to n do
Write(tomb[i], ' ');
WriteLn();
end.
==== Összefésülő-rendezés =====
uses crt;
type Ttomb = Array [1..7] of Integer;
var
tomb : Ttomb = (8, 3, 4, 5, 2, 9, 7);
i : Integer;
procedure osszefesul(var a : Ttomb; p, q, r: Integer);
var
n1, n2, i, j, k : Integer;
bal, jobb : Ttomb;
begin
n1 := q-p+1;
n2 := r-q;
for i := 1 to n1 do
bal[i] := a[p+i-1];
for j := 1 to n2 do
jobb[j] := a[q+j];
bal[n1+1] := 10; {Őrszem}
jobb[n2+1] := 10; {Őrszem}
i := 1;
j := 1;
for k := p to r do
if bal[i]<=jobb[j] then
begin
a[k] := bal[i];
inc(i);
end
else
begin
a[k] := jobb[j];
inc(j);
end;
end;
procedure osszefesulorendezes(var a: Ttomb; p,r:Integer);
var
q : Integer;
begin
if p
===== Egyéb tételek =====
==== Összefuttatás (összefésülés) ====
var
i, j, k, n, m : integer;
a : array [1..5] of byte = (3, 4, 5, 7, 8 );
b : array [1..4] of byte = (1, 2, 6, 9);
c : array [1..10] of byte;
begin
n := 5;
m := 4;
i := 1;
j := 1;
k := 0;
while (i<= n) and (j<=m) do
begin
k := k + 1;
if a[i] < b[j] then
begin
c[k] := a[i];
i := i + 1;
end
else
if a[i] = b[j] then
begin
c[k] := a[i];
i := i + 1;
j := j + 1;
end
else
if a[i]> b[j] then
begin
c[k] := b[j];
j := j + 1;
end;
end;
while i <= n do
begin
k := k + 1;
c[k] := a[i];
i := i + 1;
end;
while j <= m do
begin
k := k + 1;
c[k] := b[j];
j := j + 1;
end;
for i := 1 to k do
Write(c[i], ' ');
WriteLn();
end.