program Napisy;
begin
writeln('Te dwa napisy');
writeln('znajduja sie w kolejnych wierszach.');
writeln; { wiersz odstepu }
write('Ale te dwa napisy znajduja sie ');
writeln('w tym samym wierszu.')
{ przed end nie musi byc srednika }
end.
program obliczanie_iloczynu;
uses crt;
var i,n, iloczyn:word;
begin
clrScr;
iloczyn:=1;
writeln('podaj liczbe danych');
readln(n);
for i:=1 to n do iloczyn:=iloczyn*i;
writeln('iloczyn =', iloczyn);
readln;
end.
program pierw_rown_kwadrat2;
{program wyznacza pierwiastki rownania ax*x+bx+c=0}
uses crt;
var
a,b,c,delta:integer;
x1,x2:real;
begin
clrscr;
write('a= ');readln(a);
write('b= ');readln(b);
write('c= ');readln(c);
delta:=(b*b)-(4*a*c);
if delta<=0 then
write('Rownanie nie ma pierwiastkow, gdyz delta=',delta,' <0 ')
else x1:=(-b-sqrt(delta))/2*a; x2:=(-b+sqrt(delta))/2*a;
write('delta= ',delta, ' x1=',x1:0:2,' x2=',x2:0:2);
readln
end.
(12.03.2009 czwartek)
program rownanie; (17.03.2009 wtorek)
var a, c, x: real;
begin
writeln ('Podaj wspolczynniki a, c');
readln (a, c);
if a=0 then if c=0
then writeln ('Rownanie tozsame')
else
writeln ('Rownanie sprzeczne')
else
writeln ('x=', -c/a);
end.
program liniowa_(a, b, c); {tutaj nazywam program}
var a, b, c, x, y: real; {definiuje zmienne ktore beda potrzebne w programie}
begin {poczatek programu}
writeln('Podaj wsp˘lczynniki a, b, c r˘wnania ax+by=c'); {prosze o podanie wspolczynnikow}
readln(a, b, c); {wczytuje wspolczynniki}
if a = 0 then if b = 0 then if c = 0 then writeln('r˘wnanie tozsamosciowe') {sprawdzam czy a=0 jesli tak
sprawdzam czy b=0 jesli tak
sprawdzam czy c=0 jesli tak
wypisuje "rownanie tozsamosciowe"}
else
writeln('r˘wnanie sprzeczne') {jesli c nie jest rowne 0 wtedy
wypisuje "rownanie sprzeczne}
else
writeln(' y = ', c / b) {jesli b jest rozne od 0 wtedy wypisuje
"y=" i wyliczona wartosc c/b}
else
if b = 0 then writeln('x = ', c / a) {jesli a jest rozne od 0 sprawdzam czy b=0
jesli tak to wypisuje "x=" i wyliczone c/a}
else
if c = 0 then writeln(a, 'x = -',b) {jesli a i b sa rozne od 0 sprawdzam c
jesli jest rowne 0 to wypisuje
wartosc a "x=-" wartosc b "y"}
else
writeln(a, 'x +', b, 'y = ', c); {jesli a, b i c sa rozne od 0 wypisuje
wartosc a "x+" wartosc b "y=" wartosc c}
end. {koniec programu}
program T7_Zadanie1;
var
a,b:real;
begin
Write('Podaj dwie liczby rzeczywiste: ');
ReadLn(a,b);
if a>b then
WriteLn('Wieksza liczba to ',a:6:2)
else
WriteLn('Wieksza liczba to ',b:6:2);
end.
program T7_Zadanie2; (17.03.2009 wtorek)
var
a,b:real;
begin
Write('Podaj dwie liczby rzeczywiste: ');
ReadLn(a,b);
if a>b then
WriteLn('Wieksza liczba to ',a:6:2)
else if a<b then
WriteLn('Wieksza liczba to ',b:6:2)
else
WriteLn('Liczby sa rowne');
end.
program T7_Zadanie4;
var
a,b,c:byte;
i:integer;
begin
for i:=1 to 10 do
begin
WriteLn('*** Tr˘jkĄt nr ',i);
Write('Podaj dlugosci bokow trojkata: ');
ReadLn(a, b, c);
if (a+b>c) and (a+c>b) and (b+c>a) then
WriteLn('Mozna zbudowac trojkat')
else
WriteLn('Nie mozna zbudowac trojkata');
end;
end.
program T7_Zadanie5;
var
a,b,c:byte;
a2,b2,c2:word;
i:integer;
begin
for i:=1 to 10 do
begin
WriteLn('*** Trojkat nr ',i);
Write('Podaj dlugosci bok˘w trojkata: ');
ReadLn(a, b, c);
a2:=a*a;
b2:=b*b;
c2:=c*c;
if (a2+b2=c2) or (a2+c2=b2) or (b2+c2=a2) then
WriteLn('Tak')
else
WriteLn('Nie');
end;
end.
Czwartek 2 kwietnia
program T7_Zadanie7;
var
x,w:real;
i,n:integer;
begin
Write('Podaj liczbe danych: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj liczbe: ');
ReadLn(x);
if x>=0 then w:=x
else w:=-x;
Writeln('Wartosc bezwzgledna liczby ',x:6:2,'=',w:6:2);
end;
end.
program T7_Zadanie8a;
var
a,b,w:integer;
begin
Write('Podaj dwie liczby: ');
ReadLn(a, b);
if a=b then
WriteLn('Liczby sa rowne')
else
begin
if a>b then w:=a
else w:=b;
WriteLn('Wieksza z dwoch liczb to ',w)
end;
end.
program T7_Zadanie8b;
var
x,fx:real;
i,n:integer;
begin
Write('Podaj liczbe danych: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj x: ');
ReadLn(x);
if x<-1 then fx:=-1
else if x<=1 then fx:=x
else fx:=1;
WriteLn('F(',x:6:2,')=',fx:6:2);
end;
end.
program T7_Zadanie9;
var
x,fx:real;
begin
Write('Podaj x: ');
ReadLn(x);
if x<=0 then fx:=-1
else fx:=x-1;
WriteLn('F(',x:6:2,')=',fx:6:2);
end.
program T7_Zadanie10;
var
a,b,x:real;
i,n:integer;
begin
Write('Podaj liczbe danych: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj a, b: ');
ReadLn(a, b);
if a=0 then
if b=0 then
WriteLn('Nieskonczenie wiele rozwiazan')
else
WriteLn('Rownanie sprzeczne')
else
begin
x:=-b/a;
Writeln('x=',x:6:2);
end;
end;
end.
program T7_Zadanie11;
var
i,n:integer;
a,suma:real;
begin
suma:=0;
Write('Podaj liczbe danych: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj a: ');
ReadLn(a);
suma:=suma+a;
end;
WriteLn('Suma= ',suma:6:2);
end.
program T7_Zadanie12;
var
m,n:integer;
i,j:integer;
znak:char;
begin
Write('Podaj m: ');
ReadLn(m);
Write('Podaj n: ');
ReadLn(n);
for j:=1 to n do
begin
if j mod 2=1 then
znak:='A'
else
znak:='B';
for i:=1 to m do
Write(znak);
WriteLn;
end;
end.
program T7_Zadanie13;
var
m,n:integer;
i,j:integer;
ri,rj:integer;
begin
Write('Podaj m: ');
ReadLn(m);
Write('Podaj n: ');
ReadLn(n);
for j:=1 to n do
begin
for i:=1 to m do
begin
ri:=i mod 2;
rj:=j mod 2;
Write((ri+rj) mod 2);
end;
WriteLn;
end;
end.
program T7_Zadanie14;
var
a,b,c,d,pd:real;
begin
Write('Podaj a: '); ReadLn(a);
Write('Podaj b: '); ReadLn(b);
Write('Podaj c: '); ReadLn(c);
d:=b*b-4*a*c;
if d<0 then
WriteLn('Brak rozwiazan')
else if d=0 then
begin
WriteLn('x1=x2=',-b/(2*a):6:2);
end
else
begin
pd:=sqrt(d);
WriteLn('x1=',(-b-pd)/(2*a):6:2);
WriteLn('x2=',(-b+pd)/(2*a):6:2);
end;
end.
Program Dzielenie;
USES
Crt;
BEGIN
ClrScr;
Write('(2*3+17)/9 =',(2*3+17)/9:7:4);
END.
PROGRAM Pole_prostokata;
USES
Crt;
VAR
a,b,Pp:REAL;
BEGIN
ClrScr;
Writeln ('Obliczenie pola powierzchni prostokata');
Writeln;
Write ('Podaj wartosc boku a prostokata w cm, a= ');
Readln (a);
Writeln;
Write ('Podaj wartosc boku b prostokata w cm, b= ');
Readln (b);
Writeln;
IF a*b>0 THEN
(* Warunek sprawdzajacy istnienie prostokata - czy jednoczesnie
wartosci bokow a oraz b sa wieksze od zera *)
BEGIN
(* Jesli warunek jest spelniony to zostana wykonane instrukcje
zamkniete w bloku BEGIN_END*)
Writeln;
Writeln ('Boki wynosza a = ',a:6:2,' cm, b = ',b:6:2,' cm');
Pp:=a*b;
Writeln;
Write ('Pp = ',Pp:10:2,' cm kw. ');
END
ELSE
(* Jesli warunek istnienia prostokata nie jest spelniony
to zostanie wykonana instrukcja wystepujaca po ELSE *)
Write('Prostokat nie istnieje')
END.
program gwiazdki; 16 kwiecień 2009 r.
var z1, z2:char;
begin
writeln ('Podaj pierwszy znak: ');
readln (z1);
writeln ('Podaj drugi znak: ');
readln (z2);
if (z1='*') and (z2='*') then
writeln ('Obydwa znaki to *')
else
if z1='*' then
writeln ('Pierwszy znak to *')
else
if z2='*' then
writeln ('Drugi znak to *')
else
writeln ('Zaden nie jest gwiazka');
writeln ('Potwierdz');
readln
end.
program asci1;
uses crt;
var z:char;
x:integer;
begin
clrscr;
writeln ('Podaj kod z zakresu 32-255');
readln (x);
z:=char(x);
writeln(z);
writeln ('potwierdz');
readln;
end.
program silnia1;
var n, silnia, i :longint;
begin
writeln(' Podaj liczbe silni ');
readln(n);
i:=n;
while i > 1 do
begin
silnia:=n;
i:=i-1;
silnia:=silnia*i;
end;
writeln('silnia liczby ', n, ' wynosi ', silnia);
writeln('Wcisnij klawisz');
readln
end.
program srednia;
var n, i: integer;
sr, s, x: real;
begin
write ('podaj ilosc liczb:');
readln (n);
s:=0;
for i:=1 to n do
begin
write ('podaj liczbe:');
readln (x);
s:=s+x;
end;
sr:=s/n;
writeln ('suma=',s:10:3);
writeln ('srednia=',sr);
end.
program srednia;
var n, i: integer;
sr, s, x: real;
begin
write ('podaj ilosc liczb:');
readln (n);
s:=0;
i:=0;
repeat
i:=i+1;
write ('podaj liczbe:');
readln (x);
s:=s+x;
until i >= n;
sr:=s/n;
writeln ('suma=',s:10:3);
writeln ('srednia=',sr);
end.
program sumawhil;
var n, s, i :integer;
begin
writeln(' Podaj iloo? liczb');
readln(n);
s:=0;
i:=1;
while i <= n do
begin
s:=s + i;
i:=i + 1;
end;
writeln('Suma kolejnych liczb od 1 do ', n, ' wynosi ', s);
end.
program T8_Zadanie1;
uses
CRT;
(*
** UWAGA! Ekran ma 25 wierszy, jednak wypisanie znaku
** w prawym dolnym rogu ekranu powoduje "przewiniecie"
** zawartosci ekranu o jedna linie, skutkiem czego
** pozycje znak˘w uleglyby przesunieciu
*)
procedure Znak(c:char);
begin
ClrScr;
GotoXY(1,1); Write(c);
GotoXY(80,1); Write(c);
GotoXY(1,24); Write(c);
GotoXY(80,24); Write(c);
end;
begin
Znak('@');
end.
program zadanie3;
uses Crt;
var k1, k2:integer;
procedure Test(var x, y:integer);
var t: integer;
begin
t:=x;
x:=y;
y:=t+1;
end;
begin
ClrScr;
Readln (k1,k2);
Test(k1,k2);
Writeln('k1 = ',k1);
Writeln('k2 = ',k2);
Readln;
end.
program T8_Zadanie4;
var
i,n:integer;
ujemne,nieujemne:integer;
x:integer;
procedure Zliczaj(x:integer);
begin
if x<0 then ujemne:=ujemne+1
else nieujemne:=nieujemne+1;
end;
begin
ujemne:=0;
nieujemne:=0;
Write('Podaj liczbe element˘w: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj liczb©: ');
ReadLn(x);
Zliczaj(x);
end;
WriteLn('Liczba elementow ujemnych: ', ujemne);
WriteLn('Liczba elementow nieujemnych: ', nieujemne);
end.
program T8_Zadanie6;
uses
CRT;
var
i:integer;
procedure Wiersz(n:integer);
var
i:integer;
begin
for i:=1 to n do
Write('$');
WriteLn;
end;
begin
ClrScr;
for i:=10 downto 1 do
Wiersz(i);
end.
program T8_Zadanie7;
uses
CRT;
var
i,n:integer;
procedure Pytaj(var n:integer);
begin
repeat
Write('Podaj wielkosc figury (1-79): ');
ReadLn(n);
until (n>=1) and (n<80);
end;
procedure Wiersz(n:integer);
var
i:integer;
begin
for i:=1 to n do
Write('$');
WriteLn;
end;
begin
ClrScr;
Pytaj(n);
for i:=n downto 1 do
Wiersz(i);
end.
program T8_Zadanie8;
uses
CRT;
var
i,n:integer;
procedure Pytaj(var n:integer);
begin
repeat
Write('Podaj wielkosc choinki (1-79): ');
ReadLn(n);
until (n>=1) and (n<80);
end;
procedure Wiersz(poziom:integer);
var
i:integer;
begin
for i:=1 to n-poziom do
Write(' ');
for i:=1 to poziom*2-1 do
Write('$');
WriteLn;
end;
begin
ClrScr;
Pytaj(n);
for i:=1 to n do
Wiersz(i);
for i:=1 to 3 do
Wiersz(1);
end.
23 kwiecień
program T9_Zadanie1;
uses
CRT;
var
i:integer;
tab: array [1..10] of real;
procedure Czytaj;
begin
WriteLn('*** Wprowadzanie liczb:');
for i:=1 to 10 do
begin
Write('Podaj liczbe nr ',i,': ');
ReadLn(tab[i]);
end;
end;
begin
ClrScr;
Czytaj;
ClrScr;
WriteLn('*** Wyprowadzanie liczb:');
for i:=10 downto 1 do
begin
GoToXY(38,11-i+1);
Write(tab[i]:6:2);
end;
end.
program Licz_znaki;
var
tekst:string;
i,j,n,liczba_sp:integer;
procedure Zliczaj(var licznik:integer);
begin
licznik:=licznik+1;
end;
begin
Write('Podaj liczbe tekst˘w: ');
ReadLn(n);
for j:=1 to n do
begin
Write('Podaj tekst nr ',j,': ');
ReadLn(tekst);
liczba_sp:=0;
for i:=1 to Length(tekst) do
if tekst[i]=' ' then
zliczaj(liczba_sp);
WriteLn('Liczba spacji w tekscie: ',liczba_sp);
end;
end.
program T9_Zadanie3;
var
tab: array[1..8] of integer;
zero:boolean;
i:integer;
procedure Czytaj;
begin
WriteLn('*** Wprowadzanie liczb:');
for i:=1 to 8 do
begin
Write('Podaj liczb© nr ',i,': ');
ReadLn(tab[i]);
end;
end;
begin
Czytaj;
zero:=FALSE;
for i:=1 to 8 do
if tab[i]=0 then
zero:=TRUE;
if zero then
begin
WriteLn('Elementy zerowe:');
for i:=1 to 8 do
if tab[i]=0 then
WriteLn(i);
end
else
WriteLn('brak elementu zerowego');
end.
program T9_Zadanie4;
var
i,n:integer;
x,y:real;
operacja:char;
procedure Dodawanie(x,y:real);
begin
WriteLn('Suma=',x+y);
end;
procedure Odejmowanie(x,y:real);
begin
WriteLn('R˘ľnica=',x-y);
end;
procedure Mnozenie(x,y:real);
begin
WriteLn('Iloczyn=',x*y);
end;
procedure Dzielenie(x,y:real);
begin
WriteLn('Iloraz=',x/y);
end;
begin
Write('Podaj liczb© operacji: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj operacj©: ');
ReadLn(operacja);
Write('Podaj pierwszy argument:');
ReadLn(x);
Write('Podaj drugi argument:');
ReadLn(y);
case operacja of
'+': Dodawanie(x,y);
'-': Odejmowanie(x,y);
'*': Mnozenie(x,y);
'/': Dzielenie(x,y);
else WriteLn('Nieznana operacja');
end;
end;
end.
program T9_Zadanie5;
var
i,n:integer;
x,y:real;
operacja:char;
procedure Dodawanie(x,y:real);
begin
WriteLn('Suma=',x+y);
end;
procedure Odejmowanie(x,y:real);
begin
WriteLn('R˘znica=',x-y);
end;
procedure Mnozenie(x,y:real);
begin
WriteLn('Iloczyn=',x*y);
end;
procedure Dzielenie(x,y:real);
begin
if y=0 then
WriteLn('*** BĄd - dzielenie przez zero')
else
WriteLn('Iloraz=',x/y);
end;
begin
Write('Podaj liczbe operacji: ');
ReadLn(n);
for i:=1 to n do
begin
Write('Podaj operacje: ');
ReadLn(operacja);
Write('Podaj pierwszy argument:');
ReadLn(x);
Write('Podaj drugi argument:');
ReadLn(y);
case operacja of
'+': Dodawanie(x,y);
'-': Odejmowanie(x,y);
'*': Mnozenie(x,y);
'/': Dzielenie(x,y);
else WriteLn('Nieznana operacja');
end;
end;
end.
program T9_Zadanie6;
var
tekst:string;
i:integer;
begin
Write('Podaj tekst: ');
ReadLn(tekst);
for i:=1 to Length(tekst) do
if tekst[i]='a' then
tekst[i]:='b';
Write('Tekst po zmianach: ',tekst);
end.
program T9_Zadanie7;
uses
CRT;
const
N=20;
var
napis:string[N];
function Odwroc(s:string):string;
var
wynik:string;
i:integer;
begin
wynik:='';
for i:=Length(s) downto 1 do
wynik:=wynik+s[i];
Odwroc:=wynik;
end;
begin
ClrScr;
WriteLn('Wpisz wyraz: ');
ReadLn(napis);
if napis=Odwroc(napis) then
WriteLn('Wyraz jest palindromem')
else
WriteLn('Wyraz nie jest palindromem');
end.
program T9_Zadanie8;
var
znak:char;
begin
Write('Podaj znak: ');
ReadLn(znak);
if UpCase(znak)='I' then
WriteLn('Adam')
else if UpCase(znak)='N' then
WriteLn('Kowalski')
else
WriteLn('zly znak');
end.
program T9_Zadanie9;
var
z1,z2,z3:integer;
i,n:integer;
c:char;
procedure Zliczaj(var licznik:integer);
begin
licznik:=licznik+1;
end;
begin
Write('Podaj liczbe znak˘w: ');
ReadLn(n);
z1:=0;
z2:=0;
z3:=0;
for i:=1 to n do
begin
Write('Podaj znak: ');
ReadLn(c);
case c of
'*': Zliczaj(z1);
'%': Zliczaj(z2);
'x': Zliczaj(z3);
end;
end;
WriteLn('Liczba znakow ''*'': ',z1);
WriteLn('Liczba znakow ''%'': ',z2);
WriteLn('Liczba znakow ''x'': ',z3);
end.
program T9_Zadanie10;
var
i,spolgloski:integer;
tekst:string;
begin
Write('Podaj tekst: ');
ReadLn(tekst);
spolgloski:=0;
for i:=1 to Length(tekst) do
case tekst[i] of
'b','c','d','f','g','h','j','k','l','m',
'n','p','q','r','s','t','v','w','x','z':
spolgloski:=spolgloski+1;
end;
WriteLn('Liczba spolglosek: ',spolgloski);
end.
program T9_Zadanie11;
var
imie:string;
znak:char;
i:integer;
begin
Write('Podaj imie: ');
ReadLn(imie);
for i:=1 to Length(imie) do
imie[i]:=UpCase(imie[i]);
znak:=imie[Length(imie)];
if (znak='A') then
begin
if imie='BONAWENTURA' then
WriteLn('Imie meskie')
else if imie='MARIA' then
WriteLn('Imie meskie lub zenskie')
else
WriteLn('Imie meskie');
end
else
WriteLn('Imie meskie');
end.
(*
** Zakladamy, ze wyrazy sa rozdzielone spacjami
** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad
** i traktujemy je jako jedna spacje
*)
program T9_Zadanie13;
var
s:string;
i,wyrazy:integer;
bylaSpacja:boolean;
begin
Write('Podaj napis: ');
ReadLn(s);
bylaSpacja:=TRUE;
wyrazy:=0;
for i:=1 to Length(s) do
if s[i]=' ' then
bylaSpacja:=TRUE
else
begin
if bylaSpacja then
Inc(wyrazy);
bylaSpacja:=FALSE;
end;
WriteLn('Liczba wyrazow: ',wyrazy);
end.
(*
** Zakladamy, ze wyrazy sa rozdzielone spacjami
** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad
** i traktujemy je jako jedna spacje
*)
program T9_Zadanie14;
var
s:string;
i:integer;
bylaSpacja:boolean;
begin
Write('Podaj napis: ');
ReadLn(s);
bylaSpacja:=TRUE;
for i:=1 to Length(s) do
if s[i]=' ' then
bylaSpacja:=TRUE
else
begin
if bylaSpacja then
WriteLn;
Write(s[i]);
bylaSpacja:=FALSE;
end;
end.
(*
** Zakladamy, ze wyrazy sa rozdzielone spacjami
** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad
** i traktujemy je jako jedna spacje
*)
program T9_Zadanie15;
var
s, slowo:string;
i:integer;
bylaSpacja:boolean;
function JestPalindromem(s:string):boolean;
var
i, dlugosc:integer;
begin
JestPalindromem:=TRUE;
dlugosc:=Length(s);
for i:=1 to dlugosc div 2 do
if UpCase(s[i])<>UpCase(s[dlugosc-i+1]) then
begin
JestPalindromem:=FALSE;
exit;
end;
end;
begin
Write('Podaj napis: ');
ReadLn(s);
s:=s+' '; (* Wartownik *)
bylaSpacja:=TRUE;
for i:=1 to Length(s) do
if s[i]=' ' then
begin
if slowo<>'' then
begin
Write('Slowo "',slowo,'" ');
if not JestPalindromem(slowo) then
Write('nie ');
WriteLn('jest palindromem');
end;
bylaSpacja:=TRUE;
slowo:='';
end
else
begin
slowo:=slowo+s[i];
bylaSpacja:=FALSE;
end;
end.
program T9_Zadanie16;
var
s:string;
i:integer;
liczba:longint;
function JestPalindromem(s:string):boolean;
var
i, dlugosc:integer;
begin
JestPalindromem:=TRUE;
dlugosc:=Length(s);
for i:=1 to dlugosc div 2 do
if UpCase(s[i])<>UpCase(s[dlugosc-i+1]) then
begin
JestPalindromem:=FALSE;
exit;
end;
end;
begin
Write('Podaj liczbe: ');
ReadLn(liczba);
Str(liczba,s);
WriteLn(JestPalindromem(s));
end.
program T9_Zadanie17;
var
suma, liczba, potega:longint;
i, n:integer;
begin
Write('Podaj n: ');
ReadLn(n);
suma:=0;
liczba:=0;
potega:=1;
for i:=1 to n do
begin
liczba:=liczba+potega;
suma:=suma+liczba;
potega:=potega*10;
end;
WriteLn('Suma=',suma);
end.
program T9_Zadanie19;
const
M=6;
N=4;
type
Tablica=array [1..M,1..N] of real;
var
Tab:Tablica;
procedure CzytajTablice(var t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
Write('Podaj dane z wiersza ',i,' :' );
for j:=1 to N do
Read(t[i,j]);
ReadLn;
end;
end;
procedure WypiszTablice(t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
for j:=1 to N do
Write(t[i,j]:6:2);
WriteLn;
end;
end;
begin
CzytajTablice(Tab);
WriteLn('Oto wprowadzona przez Ciebie tablica:');
WypiszTablice(Tab);
end.
program T9_Zadanie20;
const
M=5;
N=5;
type
Tablica=array [1..M,1..N] of real;
var
Tab:Tablica;
procedure CzytajTablice(var t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
Write('Podaj dane z wiersza ',i,' :' );
for j:=1 to N do
Read(t[i,j]);
ReadLn;
end;
end;
procedure WypiszTablice(t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
for j:=1 to N do
Write(t[i,j]:6:2);
WriteLn;
end;
end;
function SumaPrzekatnej(t:Tablica):real;
var
i,min:integer;
wynik:real;
begin
wynik:=0.0;
if M<N then min:=M
else min:=N;
for i:=1 to min do
wynik:=wynik+t[i,i];
SumaPrzekatnej:=wynik;
end;
begin
CzytajTablice(Tab);
WypiszTablice(Tab);
WriteLn('Suma przekatnej=',SumaPrzekatnej(Tab):6:2);
end.
program T9_Zadanie21;
const
M=5;
N=5;
type
Tablica=array [1..M,1..N] of real;
var
Tab:Tablica;
procedure CzytajTablice(var t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
Write('Podaj dane z wiersza ',i,' :' );
for j:=1 to N do
Read(t[i,j]);
ReadLn;
end;
end;
procedure WypiszTablice(t:Tablica);
var
i,j:integer;
begin
for i:=1 to M do
begin
for j:=1 to N do
Write(t[i,j]:6:2);
WriteLn;
end;
end;
function SumaNadPrzekatna(t:Tablica):real;
var
i,j,min:integer;
wynik:real;
begin
wynik:=0.0;
if M<N then min:=M
else min:=N;
for i:=2 to min do
for j:=1 to i-1 do
wynik:=wynik+t[j,i];
SumaNadPrzekatna:=wynik;
end;
begin
CzytajTablice(Tab);
WypiszTablice(Tab);1
WriteLn('Suma element˘w nad przekatna=',SumaNadPrzekatna(Tab):6:2);
end.
28 kwietnia
program T10_Zadanie1;
var
i,j,liczba:integer;
begin
i:=0;
j:=0;
repeat
Write('Podaj liczbe: ');
ReadLn(liczba);
if liczba<0 then
i:=i+1
else if liczba>0 then
j:=j+1;
until liczba=0;
WriteLn('Liczba elementow dodatnich: ',j);
WriteLn('Liczba elementow ujemnych: ',i);
end.
program T10_Zadanie2;
var
liczba,suma,n:integer;
begin
n:=0;
suma:=0;
repeat
Write('Podaj liczbe: ');
ReadLn(liczba);
if liczba>0 then
begin
suma:=suma+liczba;
n:=n+1;
end;
until liczba<=0;
if n>0 then
WriteLn('srednia=',suma/n:6:2)
else
WriteLn('Nie wprowadzono zadnych liczb');
end.
program T10_Zadanie4;
var
z1,z2,z3:integer;
i,n:integer;
c:char;
procedure Zliczaj(var licznik:integer);
begin
licznik:=licznik+1;
end;
begin
z1:=0;
z2:=0;
z3:=0;
repeat
Write('Podaj znak: ');
ReadLn(c);
case c of
'*': Zliczaj(z1);
'%': Zliczaj(z2);
'x': Zliczaj(z3);
end;
until c='@';
WriteLn('Liczba znak˘w ''*'': ',z1);
WriteLn('Liczba znak˘w ''%'': ',z2);
WriteLn('Liczba znak˘w ''x'': ',z3);
end.
program T10_Zadanie6;
var
n,m:integer;
function Max(n:integer):integer;
var
i,liczba,wynik:integer;
begin
for i:=1 to n do
begin
Write('Podaj liczbe: ');
ReadLn(liczba);
if i=1 then
wynik:=liczba
else
if liczba>wynik then
wynik:=liczba;
end;
max:=wynik;
end;
begin
Write('Podaj liczbe element˘w: ');
ReadLn(n);
m:=Max(n);
WriteLn('Maksimum = ',m);
end.
program T10_Zadanie8;
var
a,b:integer;
begin
Write('Podaj a, b: ');
ReadLn(a, b);
while a<>b do
if a>b then a:=a-b
else b:=b-a;
WriteLn('NWD=',a);
end.
program T10_Zadanie12;
const
LICZBA_ELEMENTOW=5;
var
Elementy:array [1..LICZBA_ELEMENTOW] of integer;
iMin, iMax:integer;
procedure Czytaj(n:integer);
var
i:integer;
begin
for i:=1 to n do
begin
Write('Podaj liczbe ',i,': ');
ReadLn(Elementy[i]);
end;
end;
(*
** Funkcja znajduje _indeksy_ najmniejszego i najwiekszego elementu
** i umieszcza je w zmiennych odpowiednio iMin oraz iMax
*)
procedure MinMax(n:integer; var iMin,iMix:integer);
var
i:integer;
min,max:integer;
begin
iMin:=1;
min:=Elementy[iMin];
iMax:=1;
max:=Elementy[iMax];
for i:=2 to n do
begin
if Elementy[i]<min then
begin
iMin:=i;
min:=Elementy[iMin];
end;
if Elementy[i]>max then
begin
iMax:=i;
max:=Elementy[iMax];
end
end;
end;
begin
WriteLn('Podaj elementy:');
Czytaj(LICZBA_ELEMENTOW);
MinMax(LICZBA_ELEMENTOW, iMin, iMax);
WriteLn('Roznica = ',Elementy[iMax] - Elementy[iMin]);
end.
program T10_Zadanie13;
const
LICZBA_ELEMENTOW=5;
var
Elementy:array [1..LICZBA_ELEMENTOW] of integer;
sr:integer;
procedure Czytaj(n:integer);
var
i:integer;
begin
for i:=1 to n do
begin
Write('Podaj liczbe ',i,': ');
ReadLn(Elementy[i]);
end;
end;
function Srednia(n:integer):integer;
var
i:integer;
suma:longint;
begin
suma:=0;
for i:=1 to n do
suma:=suma+Elementy[i];
Srednia:=suma div n;
end;
function Mediana(n, srednia:integer):integer;
var
i:integer;
med, roznica, roznica2:integer;
begin
med:=Elementy[1];
roznica:=Abs(med-srednia);
for i:=2 to n do
begin
roznica2:=Abs(Elementy[i]-srednia);
if roznica2<roznica then
begin
roznica:=roznica2;
med:=Elementy[i];
end;
end;
Mediana:=med;
end;
begin
WriteLn('Podaj elementy:');
Czytaj(LICZBA_ELEMENTOW);
sr:=Srednia(LICZBA_ELEMENTOW);
WriteLn('srednia = ',sr);
WriteLn('Element najblizszy sredniej = ',
Mediana(LICZBA_ELEMENTOW, sr));
end.
program T10_Zadanie14;
const
LICZBA_ELEMENTOW=10;
var
Parzyste, Nieparzyste: array[1..LICZBA_ELEMENTOW] of word;
maxP, maxN: integer;
(*
** Po zakonczeniu procedury w zmiennych maxP i maxN
** znajda sie odpowiednio: indeks ostatniej liczby parzystej
** oraz indeks ostatniej liczby nieparzystej
*)
procedure Czytaj(var maxP, maxN:integer);
var
i:integer;
x:word;
begin
maxP:=0;
maxN:=0;
i:=1;
repeat
Write('Podaj liczbe ',i,': ');
ReadLn(x);
if x<>0 then (* Nie koniec *)
if x mod 2=0 then (* Parzysta *)
begin
maxP:=maxP + 1;
Parzyste[maxP]:=x;
end
else
begin
maxN:=maxN + 1;
Nieparzyste[maxN]:=x;
end;
i:=i+1;
until (i>LICZBA_ELEMENTOW) or (x=0);
end;
procedure WypiszParzyste(maxP:integer);
var
i:integer;
begin
WriteLn('*** Liczby parzyste:');
for i:=1 to maxP do
Write(Parzyste[i]:8);
WriteLn;
end;
procedure WypiszNieparzyste(maxN:integer);
var
i:integer;
begin
WriteLn('*** Liczby nieparzyste:');
for i:=1 to maxN do
Write(Nieparzyste[i]:8);
WriteLn;
end;
begin
Czytaj(maxP, maxN);
WypiszParzyste(maxP);
WypiszNieparzyste(maxN);
end.
program T10_Zadanie15;
var
a,b:word;
function Euklides(a,b: word):word;
var
t:word;
begin
while b<>0 do
begin
t:=a;
a:=b;
b:=t mod b;
end;
Euklides:=a;
end;
begin
Write('Podaj a, b: ');
ReadLn(a,b);
WriteLn('NWD(',a,',',b,')=',Euklides(a,b));
end.
program T10_Zadanie16;
var
l1, l2:integer;
sl1, sl2:word;
function SumaCyfr(n:integer):word;
var
suma:word;
begin
if n<0 then
n:=-n;
suma:=0;
while n<>0 do
begin
suma:=suma + n mod 10; (* Wartosc cyfry = reszta z dzielenia przez 10 *)
n:=n div 10;
end;
SumaCyfr:=suma;
end;
function WprowadzLiczbe:integer;
var
n:integer;
begin
repeat
Write('Podaj liczbe wieksza od 1: ');
ReadLn(n);
until n>1;
WprowadzLiczbe:=n;
end;
begin
Writeln('*** Wprowadzanie pierwszej liczby');
l1:=WprowadzLiczbe;
Writeln('*** Wprowadzanie drugiej liczby');
l2:=WprowadzLiczbe;
sl1:=SumaCyfr(l1);
sl2:=SumaCyfr(l2);
if sl1=sl2 then
WriteLn('Sumy cyfr sa rowne')
else if sl1>sl2 then
WriteLn('Liczba o wiekszej sumie cyfr to: ',l1,' (suma=',sl1,')')
else
WriteLn('Liczba o wiekszej sumie cyfr to: ',l2,' (suma=',sl1,')');
end.
program T10_Zadanie17;
var
liczba:word;
function JestPierwsza(n:word):boolean;
var
i:word;
begin
JestPierwsza:=TRUE;
for i:=2 to Trunc(Sqrt(n)) do
if n mod i=0 then (* Podzielna *)
begin
JestPierwsza:=FALSE;
exit;
end;
end;
begin
Write('Podaj liczbe: ');
ReadLn(liczba);
if JestPierwsza(liczba) then
WriteLn('Liczba ',liczba,' jest pierwsza')
else
WriteLn('Liczba ',liczba,' nie jest pierwsza');
end.
program T10_Zadanie18;
var
licznik,liczba:word;
function JestPierwsza(n:word):boolean;
var
i:word;
begin
JestPierwsza:=TRUE;
for i:=2 to Trunc(Sqrt(n)) do
if n mod i=0 then (* Podzielna *)
begin
JestPierwsza:=FALSE;
exit;
end;
end;
begin
licznik:=1;
liczba:=3;
WriteLn('*** Liczby blizniacze:');
repeat
if JestPierwsza(liczba) then
begin
if JestPierwsza(liczba+2) then
begin
WriteLn(liczba,' ',liczba+2);
licznik:=licznik+1;
end;
liczba:=liczba+2
end
else
liczba:=liczba+1;
until licznik>20;
end.
program T10_Zadanie19;
const
MAX_WSP=4;
type
TWsp=array [0..MAX_WSP] of real;
var
MojeWsp:TWsp;
x:real;
procedure WprowadzWsp(var w:TWsp);
var
i:integer;
begin
for i:=MAX_WSP downto 0 do
begin
Write('Podaj wspolczynnik nr ',i,': ');
ReadLn(w[i]);
end;
end;
procedure WypiszWielomian(var w:TWsp);
var
i:integer;
begin
for i:=MAX_WSP downto 1 do
Write(w[i]:6:2,'*x^',i,' + ');
WriteLn(w[0]:6:2);
end;
function Horner(var w:TWsp; x:real):real;
var
i:integer;
wynik:real;
begin
wynik:=w[MAX_WSP];
for i:=MAX_WSP-1 downto 0 do
wynik:=w[i]+x*wynik;
Horner:=wynik;
end;
begin
WriteLn('*** Wprowadzanie wspolczynnikow wielomianu ***');
WprowadzWsp(MojeWsp);
WypiszWielomian(MojeWsp);
WriteLn('Podaj wartosc x: ');
ReadLn(x);
WriteLn('Wartosc wielomianu=',Horner(MojeWsp,x):8:2);
end.
33