Két tömb feltöltése véletlen számokkal, ezek elrendezése, majd összefésülése és eltárolása egy újabb tömbbe, eljárások használatával (Fesules.pas) program fesules; uses crt; var i,j,n,k,x,h,m:integer; a:array [1..100] of integer; Létrehozunk három tömböt, az első kettőt fésüljük össze a harmadikba. Ezért a 3. tömbnek legalább annyi eleműnek kell lennie, mint az első kettőnek együtt. b:array [1..100] of integer; c:array [1..200] of integer; procedure tombfeltoltes1; Véletlen számokkal feltöltjük az a tömböt. begin i:=1; write('Hany szam legyen az a[] tombben? '); readln(n); while (i<=n) do begin a[i]:=trunc(90*random+1); i:=i+1; end; end; procedure tombfeltoltes2; Véletlen számokkal feltöltjük az b tömböt. begin j:=1; write('Hany szam legyen a b[] tombben? '); readln(m); while(j<=m) do begin b[j]:=trunc(90*random+1); j:=j+1; end; end; procedure rendezes1; Elrendezzük az a tömb elemeit, legkisebb alapján történő rendezéssel. Természetesen itt bármilyen rendezést használhatunk. begin i:=1; while (i<n) do begin j:=i+1; while(j<=n) do begin if (a[j]<a[i]) then begin x:=a[j]; a[j]:=a[i]; a[i]:=x; end; j:=j+1; end; i:=i+1; end; writeln('Az a tomb elemei rendezve:'); i:=1; while(i<=n) do begin writeln('Az a tomb ',i,'. eleme: ',a[i]); i:=i+1; end; end; procedure rendezes2; Elrendezzük a b tömb elemeit, legkisebb alapján történő rendezéssel. Természetesen itt bármilyen rendezést használhatunk. begin j:=1; while (j<m) do begin h:=j+1; while (h<=m) do begin if (b[h]<b[j]) then begin x:=b[h]; b[h]:=b[j]; b[j]:=x; end; h:=h+1; end; j:=j+1; end; writeln ('A b tomb elemei rendezve:'); j:=1; while (j<=m) do begin writeln ('A b tomb ',j,'. eleme: ',b[j]); j:=j+1; end; end; procedure osszefesules; begin i:=1; j:=1; k:=1; while ((i<=n) and (j<=m)) do begin Amíg mindkét összefésülendő tömbben van további elem, addig hajtódik végre a ciklus. if (a[i]<b[j]) then begin Ha az a tömb i-edik eleme kisebb, mint a b tömb j-edik eleme, akkor az a tomb i-edik elemét rakja bele a c tömb aktuális elemébe. c[k]:=a[i]; i:=i+1; end else begin Ellenkező esetben a b tömb aktuális elemének értéke kerül a c tömb aktuális elemébe. c[k]:=b[j]; j:=j+1; end; k:=k+1; A c tömb következő elemére lépünk át. end; while (i<=n) do begin Ez a ciklus akkor lép életbe, ha a b tömb kevesebb elemű, mint az a tömb. Az a tömb maradék elemeit sorra belepakolja a c tömbbe. c[k]:=a[i]; i:=i+1; k:=k+1; end; while (j<=m) do begin Ez a ciklus akkor lép életbe, ha az a tömb kevesebb elemű, mint a b tömb. A b tömb maradék elemeit sorra belepakolja a c tömbbe. c[k]:=b[j]; j:=j+1; k:=k+1; end; end; procedure kiiras; begin k:=1; writeln('A ket tomb osszefesulve:'); while (k<=(n+m)) do begin Kiírjuk a c tömb elemeit. A ciklusfeltételben szereplő összeadás arra utal, hogy annyi szám van a c tömbben, mint az a-ban és b-ben együtt. writeln('Az uj tomb ',k,'. eleme: ',c[k]); k:=k+1; end; end; BEGIN clrscr; tombfeltoltes1; rendezes1; tombfeltoltes2; rendezes2; osszefesules; kiiras; readkey; END.