• Szerző: Sallai András
• Copyright © Sallai András, 2011, 2015
• Licenc: CC BY-SA 4.0
• Web: https://szit.hu

A programozási tételek Pascal nyelvű megvalósításai. Fejlesztés alatt

osszegzes.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.

megszamolas.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.

Adott szám szerepel-e egy tömbben.

eldontes.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.

Adott szám hányadik helyen szerepel egy tömbben.

kivalasztas.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.

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.

kivalogatas.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.

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

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.

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.

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.

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.

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.

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.