1.
program sorozat_szamitas;
const Max=100;
var sorozat: array[1..Max] of Real;
n, i: Integer;
novekvo, csokkeno: Boolean;
F: Text;
begin
Assign(F, 'sorozat.in');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('A SOROZAT.IN allomany nem talalhato!');
Halt(1)
end;
n:=0;
while not Eof(F) do begin
n:=n+1;
Read(F, sorozat[n])
end;
novekvo := sorozat[1] <= sorozat[2];
csokkeno := sorozat[1] >= sorozat[2];
for i := 2 to n-1 do begin
if novekvo then novekvo := sorozat[i] <= sorozat[i+1];
if csokkeno then csokkeno := sorozat[i] >= sorozat[i+1];
end;
if novekvo or csokkeno then
WriteLn('IGEN')
else
WriteLn('NEM');
Close(F);
ReadLn;
end.
2.
program pontok_szama;
var n, i, korben: Integer;
r, x, y: Real;
F: Text;
begin
Assign(F, 'pontok.in');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('A PONTOK.IN allomany nem talalhato!');
ReadLn;
Halt(1)
end;
ReadLn(F, n, r);
korben:= 0;
for i:=1 to n do begin
ReadLn(F, x, y);
if x*x + y*y < r*r then
Inc(korben)
end;
Close(F);
Assign(F, 'pontok.out');
Rewrite(F);
WriteLn(F, korben);
Close(F);
end.
3.
program abc_sorrend;
const Maganhangzok = ['A', 'E', 'I', 'O', 'U', 'a', 'e', 'i', 'o', 'u'];
Massalhangzok = ['B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L', 'M', 'N',
'P', 'Q', 'R', 'S', 'T', 'V', 'W', 'X', 'Y', 'Z',
'b', 'c', 'd', 'f', 'g', 'h', 'j', 'k', 'l', 'm', 'n',
'p', 'q', 'r', 's', 't', 'v', 'w', 'x', 'y', 'z'];
StrMagan = 'AEIOUaeiou';
StrMassal = 'BCDFGHJKLMNPQRSTVWXYZbcdfghjklmnpqrstvwxyz';
NrMagan = 10;
NrMassal = 42;
var F: Text;
magan: array[1..NrMagan] of byte;
massal: array[1..NrMassal] of byte;
i: byte;
c: char;
begin
Assign(F, 'szoveg.in');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szoveg.in" allomany nem erheto el.');
Readln;
Halt(1)
end;
for i:=1 to NrMagan do magan[i]:=0;
for i:=1 to NrMassal do magan[i]:=0;
while not EOF(F) do begin
Read(F,c);
if c in Maganhangzok then begin
i:= Pos(c, StrMagan);
Inc(magan[i])
end else
if c in Massalhangzok then begin
i:= Pos(c, StrMassal);
Inc(massal[i])
end;
end;
Close(F);
Assign(F, 'eredmeny.out');
Rewrite(F);
Writeln(F, 'Maganhangzok:');
for i:=1 to NrMagan do
if magan[i]<>0 then
Writeln(F, StrMagan[i], '----', magan[i], ' db');
Writeln(F, 'Massalhangzok:');
for i:=1 to NrMassal do
if massal[i]<>0 then
Writeln(F, StrMassal[i], '----', massal[i], ' db');
Close(F)
end.
4.
program elemek_indexei;
const Max=100;
type PNod=^TNod;
TNod=record
szam, index: byte;
bal, jobb: PNod;
end;
var n: Byte;
x: array[1..Max] of byte;
Gyoker: PNod;
F: Text;
procedure Init(var P: PNod);
begin
P^.szam:= 0;
P^.index:= 0;
P^.bal:= nil;
P^.jobb:= nil
end;
procedure Beolvas;
var i: byte;
begin
Assign(F, 'tomb.in');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "tomb.in" allomany nem erheto el.');
Readln;
Halt(1)
end;
Readln(F, n);
for i:=1 to n do
Read(F, x[i]);
Close(F)
end;
procedure FatEpit(var Gyoker: PNod);
var P: PNod;
i: byte;
procedure Hozzaad(var Gyoker: PNod; P: PNod);
begin
if Gyoker=nil then
Gyoker:= P
else
if P^.szam < Gyoker^.szam then
Hozzaad(Gyoker^.bal, P)
else
Hozzaad(Gyoker^.jobb, P)
end;
begin
for i:=1 to n do begin
New(P);
Init(P);
P^.szam:= x[i];
P^.index:= i;
if i=1 then
Gyoker:= P
else
Hozzaad(Gyoker, P)
end
end;
procedure Kiir;
procedure Atjar(Gyoker: PNod);
begin
if Gyoker<>nil then begin
Atjar(Gyoker^.bal);
Write(F, Gyoker^.index, ' ');
Atjar(Gyoker^.jobb)
end
end;
begin
Assign(F, 'sorrend.out');
Rewrite(F);
Atjar(Gyoker);
Close(F)
end;
procedure FatTorol(var Gyoker: PNod);
begin
if Gyoker<>nil then begin
FatTorol(Gyoker^.bal);
FatTorol(Gyoker^.jobb);
Dispose(Gyoker)
end
end;
begin
Beolvas;
FatEpit(Gyoker);
Kiir;
FatTorol(Gyoker)
end.
5.
program matrix_szamitas;
const Max = 10;
var matrix: array[1..Max, 1..Max] of Byte;
i, j, n: Byte;
F: Text;
begin
repeat
Write('n= '); ReadLn(n);
if (n<2) or (n > Max) then
WriteLn('2 <= n <= ', Max);
until (n>=2) and (n<= Max);
for i:= 1 to n do
for j:= 1 to n do begin
if (i=j) or (i=n+1-j) then
matrix[i,j]:= 0;
if (i>j) and (i<n+1-j) then
matrix[i,j]:= 1;
if (i<j) and (i<n+1-j) then
matrix[i,j]:= 2;
if (i<j) and (i>n+1-j) then
matrix[i,j]:= 3;
if (i>j) and (i>n+1-j) then
matrix[i,j]:= 4;
end;
Assign(F, 'matrix.txt');
Rewrite(F);
for i:= 1 to n do begin
for j:= 1 to n do
Write(F, matrix[i,j]:2);
WriteLn(F);
end;
Close(F);
end.
6.
program oszthatosag;
var n: LongInt;
F: Text;
function Osszeg(n: Longint): LongInt;
var s: LongInt;
begin
s:= 0;
while n>0 do begin
s:= s+ (n mod 10);
n:= n div 10
end;
Osszeg:= s
end;
begin
Assign(F, 'szam.in');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('A SZAM.IN allomany nem talalhato!');
Halt(1)
end;
Read(F, n);
Close(F);
Assign(F, 'valasz.out');
Rewrite(F);
if n mod Osszeg(n) = 0 then
Write(F, 'IGEN')
else
Write(F, 'NEM');
Close(F)
end.
7.
program szamtani_kozeparanyos;
var n, i, szam, min, max: Byte;
atlag: Real;
F: Text;
begin
Assign(F, 'szam.in');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('A SZAM.IN allomany nem talalhato!');
Halt(1)
end;
ReadLn(F, n);
if n>0 then begin
Read(F, min);
max:= min;
for i:= 2 to n do begin
Read(F, szam);
if szam < min then
min:= szam;
if szam > max then
max:= szam
end;
atlag:=(max+min)/2;
Close(F);
Assign(F, 'atlag.out');
Rewrite(F);
Write(F, atlag:5:2);
end;
Close(F)
end.
8.
program szot_kiir;
var F: Text;
szo: string;
i, j, n: byte;
begin
Assign(F, 'szo.in');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szo.in" allomany nem erheto el.');
Readln;
Halt(1)
end;
ReadLn(F, szo);
Close(F);
Assign(F, 'szo.out');
Rewrite(F);
n:= Length(szo);
for i:= n downto 1 do begin
for j:=i to n do
Write(F, szo[j]);
WriteLn(F)
end;
Close(F)
end.
9.
program max_szamjegy;
var n, i, szam, s, max, smax: integer;
F: Text;
function osszeg(n: integer): integer;
var s: integer;
begin
s:=0;
while n>0 do begin
s:=s+ n mod 10;
n:= n div 10
end;
osszeg:=s
end;
begin
Write('n='); ReadLn(n);
i:=1;
Write(i,'. szam: '); ReadLn(szam);
max:=szam;
smax:=osszeg(szam);
for i:=2 to n do begin
Write(i,'. szam: '); ReadLn(szam);
s:=osszeg(szam);
if s>smax then begin
max:=szam;
smax:=s
end;
end;
Assign(f, 'out.txt');
Rewrite(F);
Write(F, max);
Close(F);
ReadLn;
end.
10.
program paros_paratlan;
var n, paros, paratlan: Integer;
F: Text;
begin
Assign(F, 'in.txt');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('Az IN.TXT allomany nem talalhato!');
Readln;
Halt(1)
end;
paros:= 0;
paratlan:= 0;
repeat
Read(F, n);
if n<>0 then
if n mod 2 = 0 then
paros:=paros+1
else
paratlan:=paratlan+1
until n=0;
Close(F);
Assign(F, 'out.txt');
Rewrite(F);
WriteLn(F, 'Paros szamok szama: ', paros);
WriteLn(F, 'Paratlan szamok szama: ', paratlan);
Close(F)
end.
11.
program szam_forgatas;
var szam: string;
c: char;
n, i, j: Integer;
F, G: Text;
begin
Assign(F, 'in.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "in.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
ReadLn(F, szam);
Close(F);
n:= Length(szam);
Assign(G, 'out.txt');
Rewrite(G);
WriteLn(G, szam);
for i:= 1 to n-1 do begin
c:=szam[1];
for j:= 1 to n-1 do
szam[j]:=szam[j+1];
szam[n]:=c;
WriteLn(G, szam)
end;
Close(G)
end.
12.
program faktorialis_szamitas;
var n: Byte;
nstart, nveg, i, nr: LongInt;
F: Text;
function osszeg(n: LongInt): LongInt;
var s: LongInt;
function faktorialis(n: LongInt):LongInt;
begin
if n<=1 then faktorialis:=1
else faktorialis:= faktorialis(n-1)*n
end;
begin
s:= 0;
while n>0 do begin
s:=s+faktorialis(n mod 10);
n:=n div 10
end;
osszeg:=s
end;
begin
Assign(F, 'in.txt');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('Az IN.TXT allomany nem talalhato!' );
Readln;
Halt(1)
end;
ReadLn(F, n);
Close(F);
nstart:=1;
nveg:= 9;
for i:=2 to n do begin
nstart:=nstart*10;
nveg:=nveg*10+9
end;
Assign(F, 'out.txt');
Rewrite(F);
nr:=0;
for i:=nstart to nveg do begin
if i=osszeg(i) then begin
WriteLn(F, i);
nr:=nr+1
end;
end;
if nr=0 then
WriteLn(F, 'Nincs ilyen szam!');
Close(F)
end.
13.
program matrix;
const Max = 10;
var matrix: array[1..Max, 1..Max] of Byte;
i, j, n: Byte;
F: Text;
begin
repeat
Write('n= '); ReadLn(n);
if (n<2) or (n > Max) then
WriteLn('2 <= n <= ', Max);
until (n>=2) and (n<= Max);
for i:= 1 to n do
for j:= 1 to n do begin
if i=j then
matrix[i,j]:= 0;
if i>j then
matrix[i,j]:= 1;
if i<j then
matrix[i,j]:= 2;
end;
Assign(F, 'matrix.txt');
Rewrite(F);
for i:= 1 to n do begin
for j:= 1 to n do
Write(F, matrix[i,j]:2);
WriteLn(F);
end;
Close(F);
end.
14.
program szimmetrikus_tomb;
const max=10;
var tomb: array[1..max, 1..max]of integer;
n, i, j: integer;
szimetrikus: boolean;
F: Text;
begin
Assign(F, 'matrix.txt');
{$I-}Reset(F);{$I+}
if IOResult <> 0 then begin
WriteLn('A MATRIX.TXT allomany nem talalhato!' );
Halt(1)
end;
ReadLn(F, n);
for i:=1 to n do
for j:=1 to n do
Read(F, tomb[i,j]);
Close(F);
szimetrikus:= true;
for i:=1 to n do
for j:=1 to n do
if tomb[i,j]<>tomb[j,i] then
szimetrikus:=false;
if szimetrikus then
WriteLn('Szimetrikus matrix')
else
WriteLn('Nem szimetrikus matrix');
WriteLn('ENTER - folytatas...');
ReadLn;
end.
15.
program primszamok;
var n, szam, talaltprimek: Integer;
F: Text;
function prim(szam: Integer): Boolean;
var p:boolean;
i: Integer;
begin
if (szam=1) or (szam=2) then p:= true
else
if szam mod 2 = 0 then p:= false
else begin
p:= true;
for i:= 3 to round(sqrt(szam)) do
if szam mod i = 0 then p:= false
end;
prim:= p;
end;
begin
Write('n= '); ReadLn(n);
Assign(F, 'primek.out');
Rewrite(F);
talaltprimek:= 0;
szam:=1;
repeat
if prim(szam) then begin
Writeln(F, szam);
talaltprimek:= talaltprimek+1;
end;
szam:=szam+1;
until talaltprimek>=n;
Close(F)
end.
16.
program fibonacci_szam;
var n: Integer;
F: Text;
function fibonacci(szam: Integer): Boolean;
var a, b, c: Integer;
begin
if (szam=0) or (szam=1) then fibonacci:= true
else begin
a:=0;
b:=1;
c:=1;
repeat
a:=b;
b:=c;
c:=a+b;
until c>=szam;
if c=szam then fibonacci:= true
else fibonacci:= false
end;
end;
begin
Assign(F, 'szam.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szam.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
Read(F, n);
if fibonacci(n) then
WriteLn(n, ' fibonacci szam.')
else
WriteLn(n, ' nem fibonacci szam.');
Close(F);
WriteLn;
WriteLn('ENTER - folytatas...');
ReadLn;
end.
17.
program binaris_szam;
var binaris: string;
n, i, szam, hatvany: Integer;
F: Text;
begin
Assign(F, 'binaris.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "binaris.txt" allomany nem erheto el.' );
Readln;
Halt(1) {ki és leállítjuk a programot }
end;
ReadLn(F, binaris);
Close(F);
n:= Length(binaris);
hatvany:= 1;
for i:= 1 to n-1 do
hatvany:= 2*hatvany;
szam:= 0;
for i:= 1 to n do begin
if binaris[i]='1' then
szam:= szam+hatvany;
hatvany:=hatvany div 2
end;
WriteLn('A ', binaris, ' binaris szam tizes szamrendszerben= ' , szam);
WriteLn;
WriteLn('ENTER - folytatas...');
ReadLn
end.
18.
program prim_osztoi;
var n, i: Integer;
F: Text;
function prim(szam: Integer): Boolean;
var p:boolean;
i: Integer;
begin
if (szam=1) or (szam=2) then p:= true
else
if szam mod 2 = 0 then p:= false
else begin
p:= true;
for i:= 3 to round(sqrt(szam)) do
if szam mod i = 0 then p:= false
end;
prim:= p;
end;
begin
Assign(F, 'szam.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szam.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
ReadLn(F, n);
Close(F);
Write('A(z) ', n, ' szam prim osztoi: ');
for i:= 1 to n do
if n mod i = 0 then
if prim(i) then
Write(i, ' ');
WriteLn;
WriteLn('ENTER - folytatas...');
ReadLn
end.
19.
program kettes_szamrendszer;
var n, m: Integer;
s: string;
F: Text;
begin
Assign(F, 'szam.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szam.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
Read(F, n);
Close(F);
s:='';
m:= n;
while m>0 do begin
if m mod 2 = 0 then
s:='0'+s
else
s:='1'+s;
m:=m div 2
end;
WriteLn(n, ' kettes szamrendszerben: ', s);
WriteLn;
WriteLn('ENTER - folytatas...');
ReadLn
end.
20.
program palindrom;
var n: Integer;
F: Text;
function fordit(n: Integer): Integer;
var m: Integer;
begin
m:= 0;
while n>0 do begin
m:= 10*m + n mod 10;
n:= n div 10
end;
fordit:= m
end;
begin
Assign(F, 'szam.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szam.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
Read(F, n);
Close(F);
if n=fordit(n) then
WriteLn(n, ' palindrom szam.')
else
WriteLn(n, ' nem palindrom szam.');
WriteLn;
WriteLn('ENTER - folytatas...');
ReadLn
end.
21.
program szam_csere;
const max=100;
var n, i: Integer;
a: array[1..max] of Integer;
F, G: Text;
procedure rendez;
var i, seged: Integer;
vancsere: boolean;
begin
repeat
vancsere:= false;
for i:=1 to n-1 do
if a[i]<a[i+1] then begin
seged:= a[i];
a[i]:= a[i+1];
a[i+1]:= seged;
vancsere:= true
end;
until not vancsere;
end;
begin
Assign(F, 'szamok.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "szamok.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
ReadLn(F, n);
for i:= 1 to n do
Read(F, a[i]);
Close(F);
rendez;
Assign(G, 'rendez.txt');
Rewrite(G);
for i:= 1 to n do
Write(G, a[i], ' ');
Close(G)
end.
22.
program osszeg;
var x, tag, s: Real;
n, i: Integer;
F: Text;
begin
Write('x= '); ReadLn(x);
Write('n= '); ReadLn(n);
s:= 1;
tag:= 1;
for i:= 1 to n do begin
tag:= tag*x/i;
s:= s+ tag
end;
Assign(F, 's.txt');
Rewrite(F);
Write(F, s:8:2);
Close(F)
end.
23.
program primszam;
var n: Integer;
F: Text;
function prim(szam: Integer): Boolean;
var p:boolean;
i: Integer;
begin
if (szam=1) or (szam=2) then p:= true
else
if szam mod 2 = 0 then p:= false
else begin
p:= true;
for i:= 3 to round(sqrt(szam)) do
if szam mod i = 0 then p:= false
end;
prim:= p;
end;
begin
Assign(F, 'in.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "in.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
while not Eof(F) do begin
ReadLn(F, n);
Write(n:6);
if prim(n) then
WriteLn(' IGEN')
else
WriteLn(' NEM');
end;
Close(F);
WriteLn('ENTER - folytatas...');
ReadLn
end.
24.
program max_paros;
var n, max, paros: Integer;
F: Text;
begin
Assign(F, 'be.txt');
{$I-}Reset(F);{$I+}
if IOResult<>0 then begin
Write('A "be.txt" allomany nem erheto el.' );
Readln;
Halt(1)
end;
if not Eof(F) then
ReadLn(F, n);
max:= n;
if n mod 2 = 0 then
paros:= 1
else
paros:= 0;
while not Eof(F) do begin
ReadLn(F, n);
if n>max then
max:= n;
if n mod 2 = 0 then
paros:= paros+1
end;
Close(F);
WriteLn('A legnagyobb szam: ', max);
WriteLn('A paros szamok szama: ', paros);
WriteLn('ENTER - folytatas...');
ReadLn
end.
