Rendezések megvalósítása

Létrehozunk egy tömböt, amit feltöltünk azokkal az adatokkal, amiket rendezni szeretnénk.



Hánydarab van, a  program megszámolja

hanydarab.pas
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.



Elemek összeadása

osszeadas.pas
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.


Hány elem van benne?

dontes.pas
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.

Hányadik helyen szerepel a tömbben.

valaszt.pas
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
kereses.pas
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.


valogat.pas
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

szetvalogatas.pas
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

metszet.pas
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

unio.pas
  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

buborekrendezes.pas
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

rendezescserevel.pas
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

rendezesbeszurassal.pas
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

shellrendezes.pas
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

osszefes.pas

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<r then
begin
q := (p + r) div 2;
osszefesulorendezes(a, p, q);
osszefesulorendezes(a, q+1, r);
osszefesul(a, p, q, r);
end;
end;

BEGIN
osszefesulorendezes(tomb, 1, 7);
for i := 1 to 7 do
Write(tomb[i], ' ');
WriteLn;
END.



Összefuttatás (összefésülés)

osszefuttatas.pas
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.