procedure pirmas(n:integer; var a:mas);
var max,min:integer;
begin
for i := 1 to n do
begin
max := 0;
min:=0;
for j := 1 to n do
if a[i,j] > max then max := j;
if a[i,j]< min then min := j;
a[i, max] := k;
a[i, min] := k;
end;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]);
writeln;
end;
end;
program matrica;
VAR a : array[ 1 .. 1000, 1..1000] of integer;
m, n, i, j, i2: integer;
begin
//write ('Kiek bus eiluciu ? '); readln(m); nereikalingas
write ('Kiek bus stulpeliu? '); readln(n);
m:=0;
for i:=1 to n do
begin
for j :=1 to m do
begin
a[i,j] := 0;
write(a[i,j],' ');
end;
for i2 := 1 to n-m do
begin
a[i,i2+m] := i2;
write(a[i,i2+m],' ');
end;
writeln();
m += 1;
end;
end.
Nu zodziu parasau visaip ir kad nuo 1 iki 100 surasho ir dar kitaip nu kad su nuliais butu priekyje niekai neisheina pvz parashiau kad surashytu visose eilutese nuo 1 iki 10, ka reikia dadeti, kad priekije tie nuliai atsirastu. Brrr atsibodo...
program matrica; USES crt; VAR a : array[ 1 .. 10, 1..10 ] of integer; m, n, i, j: integer; begin write ('Kiek bus eiluciu ? '); readln(m); write ('Kiek bus stulpeliu? '); readln(n); for i:=1 to m do for j:=1 to n do a[i,j]:= (i - 1)*1+j ; for i:=1 to m do begin for j:=1 to n do write ((a[i,j]), ' '); writeln; end; readln end.
Prasau gal galit padeti: Reikia ishspresti labai paprasta uzhduoti ishsorendzhiau tik nezhinau ar teisingai: "Parašykite sakinius, kuriais realusis skaičius, reiškiantis pinigų sumą, būtų paverstas dviem sveikaisiais skaičiais: litais ir centais." program Pinigai; var x, y, pin: real; begin WriteLn('Iveskite realuji skaichiu reishkianti litus ir centus'); Readln(pin); x:= int(pin); y:= frac(pin); Writeln('Bus: ', x :8 :0, ' litu(-ai) ir ', y :0 :2, ' centu(-ai) .'); Readln; end.
Sveiki, taigi 10 klasės informatikos kurse tenka visiems paragauti programavimo pradmenų. Vieniems sekasi geriau, kitiems blogiau... Bet visgi dauguma žmonių prašo pagalbos forume sprendžiant vienokius ar kitokius uždavinius. Todėl nusprendžiau su jumis pasidalinti savo programomis, kurias darėme praeitais metais ir dar keletu naudingų dalykėlių, kuriuos "pasiskolinau" iš mokyklos kompiuterio. :) Taigi štai: SPAUSTI ČIA Čia rasite testą iš kompiuterių raidos, po to dar keletą testų, padedančių suprasti sąlygos sakinius ir pan. ir dar informatikos pradmenų vadovėlį. :) Na, o žemiau pakopinsiu visas programas, kurias teko padaryti praeitais metais (taip taip, aš jas visas atsikopijuodavau į flashą). :D Manau, kad visiems duoda sudaryti maždaug panašias programas, todėl jei rasit kokią panašią, galėsit truputį pasiredaguot. :) Beveik visos yra su uždavinio sąlygomis, todėl neturėtų būti labai sunku susigaudyti. P.S. Nesmerkite už netvarkingą rašymą, galbūt dar kur ir klaidų įsivėlė ir t.t., nes praeitais metais buvau visiškas noobas, kaip ir dauguma dabartinių 10-okų (neįsižeiskit). :) Štai dar linkas su tom pačiom programom, tik išryškinta sintakse: SPAUSTI ČIA
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri surastu dvieju skaiciu didziausia bendra dalikli.}
program didziausias_bendras_daliklis;
var a, b, i, dbd:integer;
begin
WriteLn('Iveskite du skaicius:');
Readln(a, b);
for i:= 1 to a do
if (a mod 10= 0) and (b mod 10= 0) then
dbd:=i;
writeln ('DBD yra: ',dbd);
readln
end.
/--------------------------------------------------------------------------------------
Prasykite programa, kuri patikrintu ar is triju ivestu atkarpu galima sudaryti trikampi.
program trikampis;
var a, b, c: real;
begin
WriteLn('Iveskite tris atkarpas');
Readln(a, b, c);
if (a+b>c) and (b+c>a) and (a+c>b)
then writeln ('Galima sudaryti trikampi')
else writeln ('Negalima sudaryti trikampio');
readln
end.
/--------------------------------------------------------------------------------------
Prasykite programa, kuri patikrintu ar is triju ivestu atkarpu galima sudaryti trikampi, jei galima, tai koki? Lygiakrasti, lygiasoni ar statuji?
program trikampis;
var a, b, c: real;
begin
WriteLn('Iveskite tris atkarpas');
Readln(a, b, c);
if (a+b>c) and (b+c>a) and (a+c>b)
then begin
if (a=b) and (b=c) then writeln ('Trikampis lygiakrastis')
else if (a=b) or (b=c) or (a=c) then writeln ('Trikampis lygiasonis');
if (sqr(a)+ sqr(b)= sqr(c)) or (sqr(c)+ sqr(a)= sqr(b)) or (sqr(c)+ sqr(b)= sqr(a))
then writeln ('Trikampis status')
end
else writeln ('Negalima sudaryti trikampio');
readln
end.
/--------------------------------------------------------------------------------------
Parasykite programa kvadratinei lygciai spresti.
program kv_lygtis;
var a, b, c, d, x1, x2 :real;
begin
WriteLn('Iveskite a, b, c');
Readln(a, b, c);
if (a<>0) and (b<>0) and (c<>0)
then begin
d:=sqr(b)-4*a*c;
if d>0 then begin
x1:=(-b-sqrt(d))/(2*a);
x2:=(-b+sqrt(d))/(2*a);
writeln ('x1 yra:',x1: 8: 2);
writeln ('x2 yra:',x2: 8: 2);
end
else writeln ('Diskriminantas neigiamas. Sprendiniu nera.');
end
else writeln ('Ivestas skaicius negali buti 0!');
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa rezultato y reiksmei apskaiciuoti. }
program Bevarde36;
var x, y: real;
begin
WriteLn('Iveskite x reiksme:');
Readln (x);
if x<0 then y:=0
else if x<=5 then y:=x
else y:=sqr(x)-3;
writeln ('Kai ', x:8:2, ' tai reiksme yra ', y:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa rezultato y reiksmei apskaiciuoti. }
program Bevarde37;
var x, y: real;
begin
WriteLn('Iveskite x reiksme');
Readln (x);
if x<-10 then y:=abs(x)
else if x<=-4 then y:=-2*x
else if x<4 then y:=sqr(x)
else if x<=10 then y:=sqr(x)-x
else if x>10 then y:=7;
writeln ('Kai ', x:8:2, 'tai reiksme yra', y:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa rezultato y reiksmei apskaiciuoti. }
program Bevarde38;
var x, y: real;
begin
WriteLn('Iveskite x reiksme');
Readln (x);
if x<=-13 then y:=sqr(x)-2
else if x<-2 then y:=6
else if x=-2 then y:=0
else if x>-2 then y:=x+2;
writeln ('Kai ', x:8:2, 'tai reiksme yra', y:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Duotas naturalusis keturzenklis skaicius. Parasyti programa, kuri suformuotu
skaiciu isbraukiant du vidurinius skaitmenis ir surastu visu skaitmenu suma,
jeigu skaitmenu sandauga dalijasi is 3 be liekanos. Priesingu atveju surastu
visu skaitmenu geometrini vidurki.}
program keturzenklis;
var n, a, b, c, d, k, s :integer;
g: real;
begin
WriteLn('Iveskite keturzenkli skaiciu:');
readln (n);
a:= n mod 10;
b:= n div 10 mod 10;
c:= n div 100 mod 10;
d:= n div 1000;
if (a*b*c*d) mod 3=0 then begin
k:= d*10+a;
writeln ('Du krastiniai skaiciai:', k);
s:= a+b+c+d;
writeln ('Skaiciu suma yra:', s);
end
else begin
g:= sqrt(a*b*c*d);
writeln ('Skaiciu geometrinis vidurkis:', g:8:2);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa rezultato y reiksmei apskaiciuoti.}
program Bevarde38;
var x, y: real;
begin
WriteLn('Iveskite x reiksme');
Readln (x);
if x<2 then y:=x-5
else if x<=7 then y:=sqr(x)+2*x
else if x<27 then y:=18
else if x>=27 then y:=x-sqr(x);
writeln ('Kai ', x:8:2, 'tai reiksme yra', y:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą kuri, bet kuriame sveikųjų skaičių intervale
suskaičiuotų skaičių besibaigiančių trim sandaugą ir juos atspausdintų,
bei surastų skaičių besidalančių iš 7 aritmetinį vidurkį.
Jei intervale nurodytų skaičių nebuvo, tai programa turi parašyti,
kad tokių skaičių nėra.}
program valentino_diena;
var a, b, san, k, i: integer;
s: real;
begin
WriteLn('Įveskite intervalo ribas:');
Readln(a, b);
write ('Skaičiai besibaigiantys trim: ');
san:=1;
s:=0;
k:=0;
for i:= a to b do
begin
if i mod 10 = 3 then begin
san:= san * i;
write(i, ' ')
end;
if i mod 7 = 0 then begin
s:=s+i;
k:=k+1
end;
end;
writeln;
if san=1 then writeln ('Skaičių besibaigiančių trim nėra.')
else writeln ('Skaičių besibaigiančių trim sandauga: ', san);
if k=0 then writeln ('Skaičių dalių iš 7 nėra.')
else writeln ('Skaičių dalių iš 7 vidurkis yra:', s/k:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Parasyti programa, kuri bet kuriame sveikuju skaiciu intervale surastu
skaiciu besidalanciu is astuoniu sandauga (jei intervale nurodytu skaiciu
nebuvo tai rasyti besidalanciu is astuoniu skaiciu nera) ir lyginiu skaiciu
aritmetini vidurki, taip pat atspausdintu skaicius, kurie baigiasi sesiais.}
program ketvirtadienis;
var a, b, san, k, s, i: integer;
begin
WriteLn('Iveskite intervalo ribas: ');
Readln (a, b);
Write ('Skaiciai besibaigiantys sesiais: ');
san:= 1;
s:= 0;
k:= 0;
for i:= a to b do
begin
if i mod 8 = 0 then san:= san * i;
if i mod 2 = 0 then begin
s:= s + i;
k:= k + 1;
end;
if i mod 10 = 6 then
write (i, ' ');
end;
writeln;
if san=1 then writeln ('Skaiciu besidalanciu is astuoniu nera.')
else writeln ('Skaiciu besidalanciu is astuoniu sandauga: ', san);
if k <> 0 then
writeln ('Skaiciu besidalanciu is astuoniu vidurkis: ', s/k:8:2);
readln
end.
/--------------------------------------------------------------------------------------
{Parasyti programa, kuri bet kuriame intervale suskaiciuotu,
kiek yra skaiciu besibaigianciu devyniais(jei tokiu nebuvo, rasyti kad nera)
skaiciu daliu is triju aritmetini vidurki ir juos atpausdinti ir skaiciu
besibaigianciu septyniais sandauga.}
program zudikas_mirs_visi;
var a, b, san, k, k2, s, i: longint;
begin
WriteLn('Iveskite intervalo ribas: ');
Readln(a, b);
write ('Skaiciai dalus is 3: ');
san:=1;
s:=0;
k:=0;
k2:=0;
for i:=a to b do
begin
if i mod 10=9 then
k:=k+1;
if i mod 3=0 then begin
s:=s+i;
k2:=k2+1;
end;
if i mod 10=7 then
san:=san*i;
end;
writeln;
if k=0 then
writeln('Skaiciu besibaigianciu 9 nera')
else writeln ('Sk besib 9: ', k);
if k2<>0 then
writeln ('Sk besib 3 vid yra: ', s/k2:8:2);
if san<>1 then
writeln ('Sk besib 7 san.', san);
readln;
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri bet kuriame naturaliuju skaiciu intervale
atspausdintu skaicius besibaigiancius 7 ir suskaiciuotu nelyginiu skaiciu
aritmetini vidurki, skaiciu besidalanciu is 4 sandauga ir skaiciu
besibaigianciu 6 kieki}
program ketvirtadienis;
var a,b,i,s,k,n,san:integer;
begin
WriteLn('Įveskite intervalo ribas');
readln (a,b);
write (' Skaičiai besibaigiantys 7: ');
san:=1;
n:=0;
for i:= a to b do
begin
if i mod 2=1 then begin
s:=s+i;
k:=k+1;
end;
if i mod 4=0 then san:=san*i;
if i mod 10=7 then write (' ', i);
if i mod 10=6 then n:=n+1;
end;
writeln;
writeln (' skaiciu besibaigianciu 4 sandauga ', san );
writeln (' skaiciu besibaigianciu 6 kiekis ', n );
if k<>0 then writeln (' nelyginiu skaiciu aritmetinis vidurkis', s/k:8:2);
Readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri bet kuriame sveikuju skaiciu intervale suskaiciuotu
skaiciu besidalanciu is 9 aritmetini vidurki, skaiciu besibaigianciu 8 sandauga,
skaiciu besibaigianciu 7 suma ir juos atspausdintu, skaiciu besidalanciu is 4
kieki. Jei tokiu skaiciu nebuvo tai turi spausdinti, kad tokiu skaiciu nera.}
program intervalas;
var a, b, s, k, s7, n, i, san :integer;
begin
WriteLn('Iveskite intervalo ribas');
Readln (a,b);
san:=1;
s:=0;
k:=0;
s7:=0;
n:=0;
for i:= a to b do
begin
if i mod 9=0 then begin
s:= s+i;
k:=k+1;
end;
if i mod 10=8 then san:= san *i;
if i mod 10=7 then begin
s7:= s7+i;
end;
if i mod 4=0 then n:=n+1
end;
writeln;
writeln ('Skaiciu besibaigianciu 8 sandauga: ', san);
writeln ('Skaiciu besibaigianciu 7 suma: ', s7);
if n<>0 then writeln ('Skaiciu besibaigianciu 4 kiekis: ', n)
else writeln ('Skaiciu besidalanciu is 4 nera.');
if k<>0 then writeln ('Skaiciu besibaigianciu 9 aritmetinis vidurkis', s/k:8:2);
readln
end.
/--------------------------------------------------------------------------------------
Parašyti programą, kuri surastų mažiausią skaičiaus skaitmenį, atspausdintų atbulą, surastų skaitmenų besidalančių iš trijų artimetinį vidurkį ir lyginių nenulinių skaitmenų sandaugą.
program ankstyvas_rytas;
var n, s, san, atb, k, ps, maz :integer;
begin
WriteLn('Iveskite naturaluji skaiciu');
Readln (n);
k:=0; san:=1; atb:=0; maz:=9;
while n>0 do
begin
ps:=n mod 10;
if maz > ps then maz:=ps;
if ps mod 3 = 0 then begin
k:=k+1;
s:=s+ps;
end;
atb:=atb*10+ps;
if (ps mod 2=0) and (ps<>0) then
san:=san*ps;
n:= n div 10;
end;
Writeln ('Skaiciaus lyginiu skaitmenu sandauga yra ', san);
Writeln ('Maziausias skaiciaus skaitmuo yra ', maz);
if k<>0 then Writeln ('Skatmenu besidalanciu is triju vidurkis ', s/k:8:2);
Writeln ('Ivestas skaicius atbulai ', atb);
Readln;
end.
/--------------------------------------------------------------------------------------
Parašyti programą, kuri surastų didžiausią ir mažiausią skaičiaus skaitmenis.
readln(n);
did:=0;
maz:=9;
while n>0 do
begin
ps:=n mod 10;
if did < ps then did:= ps;
if maz > ps then maz:=ps;
n:= n div 10;
end;
/--------------------------------------------------------------------------------------
program dalikliai;
var a, i: integer;
begin
WriteLn('Įveskite skaičių');
Readln(a);
writeln('Skaičiaus ', a,' dalikliai: ');
for i:= 1 to a do
if a mod i=0 then writeln(i, ' ');
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri apskaiciuotu skaiciaus faktoriala.}
program skaiciaus_faktorialas;
var n, i, f:integer;
begin
WriteLn('Iveskite skaiciu:');
Readln(n);
f:=1;
for i:= 1 to n do
f:=f*i;
writeln('Skaiciaus ',n,' faktorialas yra: ',f);
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri skaiciu 2 pakeltu n laipsniu.}
program skaicius_pakeltas_n_laipsniu;
var n, i, l:integer;
begin
WriteLn('Iveskite laipsni, kuriuo kelsite skaiciu 2:');
Readln(n);
l:=1;
for i:= 1 to n do
l:=l*2;
writeln('Skaicius 2 pakeltas ',n,' laipsniu yra: ',l);
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri bet koki skaiciu pakeltu naturaliuoju laipsniu.}
program skaicius_pakeltas_naturaliuoju_laipsniu;
var a, b, i, l:integer;
begin
WriteLn('Iveskite pagrinda ir laipsni:');
Readln(a, b);
l:=1;
for i:= 1 to n do
l:=l*a;
writeln('Skaicius a pakeltas ',n,' laipsniu yra: ',l);
readln
end.
/--------------------------------------------------------------------------------------
{Duotas natūralusis penkiaženklis skaičius.
Pparašykite programą, kuri, jei įvestas skaičius lyginis surastų šio
skaičiaus visų skaitmenų sandaugą ir vidurkį. Priešingu atveju
atspausdinti skaičių atbulai.}
program penkiazenklis;
var a, b, c, d, e, n, san, atb: longint;
vid: real;
begin
WriteLn('Įveskite penkiaženklį skaičių:');
Readln(n);
a:= n mod 10;
b:= n div 10 mod 10;
c:= n div 100 mod 10;
d:= n div 1000 mod 10;
e:= n div 10000;
if a mod 2=0 then begin
san:= a*b*c*d*e;
writeln ('Įvestų skaičių sandauga yra: ', san);
vid:= (a+b+c+d+e)/5;
writeln ('Įvestų skaičių vidurkis yra:', vid:5:2);
end
else begin
atb:= a*10000 + b*1000 + c*100 + d*10 + e;
writeln ('Atbulas skaičius yra: ', atb)
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parasykite programa, kuri patikrintu ar ivestas skaicius yra pirminis.
d=dalikliai}
program pirminis;
var n, i, d:integer;
begin
WriteLn('Iveskite skaiciu:');
Readln(n);
d:=0;
for i:= 1 to n do
if n mod i = 0 then
d:= d + 1;
if d=2 then
writeln ('Skaicius pirminis')
else writeln ('Skaicius sudetinis');
readln
end.
/--------------------------------------------------------------------------------------
program metai;
var x, y, s, d: real;
begin
WriteLn('Ei zasine yvesk du skaicius');
Readln (x, y);
s := x + y;
d := x * y;
writeln ('Sudejus ',x: 5: 2,' ir ',y: 5: 2,' bus ',s: 5: 2);
writeln ('Sudauginus ',x: 5: 2,' ir ',y: 5: 2,' bus ',d: 5: 2);
readln
end.
/--------------------------------------------------------------------------------------
Sekos.
Duota sveikųjų skaičių seka. Sekos pabaiga 0.
Parašykite programą, kuri surastų visų sekos skaičių aritmetinį vidurkį.
program Bevardė56;
var n, s, k: longint;
begin
writeln ('Įveskite pirmą sekos narį. Sekos pabaiga - nulis.');
readln (n);
s:=0;
k:=0;
while n<>0 do
begin
s:=s+n;
k:=k+1;
writeln ('Įveskite kitą sekos narį: ');
readln (n);
end;
if k<>0 then writeln ('Skaičiaus aritmetinis vidurkis yra: ', s/k:8:2);
readln;
end.
/--------------------------------------------------------------------------------------
Duota sveikųjų skaičių seka. Sekos pabaiga - nulis. Parašykite programą, kuri suskaičiuotų, kiek sekoje yra neigiamų skaičių, skaičių, kurių paskutinis skaitmuo 4 sandaugą ir skaičių besidalančių iš 3 aritmetinį vidurkį. Jei kokių tai skaičių nebuvo, tai turi rašyti, jog tokių skaičių nebuvo.
program seka;
var n, s, k, kn, san : integer;
begin
WriteLn('Įveskite pirmą sekos narį. Sekos pabaiga - nulis.');
Readln(n);
s:=0; k:=0; kn:=0; san:=1;
while n <>0 do
begin
if n<0 then kn:=kn+1;
if n mod 10=4 then san:=san*n;
if n mod 3=0 then begin
s:=s+n;
k:=k+1;
end;
writeln('Įveskite kitą sekos narį');
readln(n);
end;
if kn>0 then writeln('Neigiamu skaiciu yra', kn)
else writeln('Neigiamu skaiciu nera');
if san>0 then writeln('Skaiciu, kuriu pask.skaitmuo 4 sandauga ', san)
else writeln('Skaiciu, kuriu pask.skaitmuo 4 nera.');
if k<>0 then writeln('Skaiciu,besidalinanciu is 3 aritm.vid ', s/k:8:2)
else writeln('Skaiciu, besidalinanciu is 3 nera.');
readln;
end.
/--------------------------------------------------------------------------------------
{Duoda seka. Sekos pabaiga - nulis. Parasyti programa, kuri surastu
didziausia ir maziausia sekos nari.}
program Bevarde56;
var n, did, maz: longint;
begin
writeln ('Iveskite pirma sekos nari. Sekos pabaiga - nulis.');
readln (n);
did:=n;
maz:=n;
while n<>0 do
begin
if n > did then did:=n;
if n<maz then maz:=n;
writeln ('Iveskite kita sekos nari: ');
readln (n);
end;
writeln ('Didziausias sekos narys yra ', did, ' Maziausias sekos narys yra ', maz);
readln;
end.
/--------------------------------------------------------------------------------------
{Duota sveikuju skaiciu seka. Sekos pabaiga - nulis. Parasykite programa,
kuri suskaiciuotu kiek sekoje yra skaiciu mazesniu uz simta. Sandauga,
skaiciu, kurie baigiasi 4. Ir didziausia sekos nari. Jei nera tai nera.}
program Bevarde56;
var n, san, k, did: longint;
begin
writeln ('Iveskite pirma sekos nari. Sekos pabaiga - nulis.');
readln (n);
san:=1;
k:=0;
did:=n;
while n<>0 do
begin
if n mod 10=4 then san:=san*n;
if n>did then did:=n;
if n<100 then k:=k+1;
writeln ('Iveskite kita sekos nari: ');
readln (n);
end;
if k<>0 then writeln('Skaiciu mazesniu uz 100 yra: ', k)
else writeln('Skaiciu mazesniu uz 100 nera.');
if san<>0 then writeln('skaiciu,kuriu pask.skaitmuo 4 sandauga ', san)
else writeln('skaiciu,kuriu pask.skaitmuo 4 nera');
writeln('Didziausias sekos narys: ', did);
readln;
end.
/--------------------------------------------------------------------------------------
program blahblahblah;
var n, a, b, c, san, atb: integer;
vid: real;
begin
WriteLn('Yvesk trizenkli sk.');
Readln (n);
a:= n mod 10; {paskutinis skaitmuo}
b:= n div 10 mod 10;
c:= n div 100;
if (a>b) and (c>b)
then begin
atb:= a*100 + b*10 + c;
san:= a*b*c;
writeln ('Atbulas yra:', atb ,'ir skaitmenu sandauga:', san)
end
else begin
vid:= (a+b+c)/3;
writeln ('Aritmetinis vidurkis:', vid:8:2);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, spausdinančią visus triženklius skaičius, kurių kiekvienas kitas skaitmuo vienetu didesnis už prieš tai buvusį, skaičiuojančią tų skaičių sumą ir kiek yra tokių skaičių.}
program Bevard?0;
var a,b,c,d ,sum, k:longint;
begin
sum :=0;
k:=0;
for a:=100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if (b+1=c) and (b+2=d) then
begin
writeln (a);
sum:=sum+a;
k:=k+1;
end;
end;
writeln ('suma ', sum);
writeln ('kiekis', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, spausdinančią visus keturženklius skaičius, kurių kiekvienas skaitmuo du kartus didesnis už prieš tai buvusį, skaičiuojančią šių skaičių skirtumo modulį ir kiek yra tokių skaičių.}
program Bevarde0;
var a,b,c,d ,e,sk, k:longint;
begin
k:=0;
sk:=0;
for a:=1000 to 9999 do
begin
b := a div 1000;
c := a div 100 mod 10;
d := a div 10 mod 10;
e := a mod 10;
if (b*2=c) and (c*2=d) and (d*2=e) then
begin
writeln (a);
sk:=sk - a;
k:=k+1;
end;
end;
sk:=abs(sk);
writeln ('Skirtumo modulis ', sk);
writeln ('Kiekis', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, skaičiuojančią visų dviženklių skaičių, dalių iš penkių, kvadratų sumą ir kiek yra tokių dviženklių skaičių.}
program Bevarde0;
var a,sum, k:longint;
begin
k:=0;
sum:=0;
for a:=10 to 99 do
begin
if a mod 5 = 0 then
begin
sum:=sum + sqr (a);
k:=k+1;
end;
end;
writeln ('Suma ', sum);
writeln ('Kiekis', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, kuri sumuotų visus natūraliųjų skaičių intervalo [m;n] skaičius, dalius iš keturių, ir suskaičiuotų, kiek tame intervale yra tokių skaičių.}
program Bevarde0;
var a,m,n,sum,k:longint;
begin
writeln ('Iveskite m ir n');
readln(m,n);
k:=0;
sum:=0;
for a:=m to n do
if a mod 4 = 0 then
begin
sum:=sum + a;
k:=k+1;
end;
writeln ('Suma ', sum);
writeln ('Kiekis', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, skaičiuojančią įvesto nelyginio skaičiaus dvigubą faktorialą. Pvz.: 5!! = 1 * 3 * 5, 11!! = 1 * 3 * 5 * 7 * 9 * 11.}
program Bevarde0;
var a,f,x:longint;
begin
writeln ('Iveskite x');
readln(x);
f:=1;
for a:=1 to x do
begin
if x mod 2 <> 0 then
if a mod 2 <> 0 then
f:=f*a;
end;
writeln ('Faktorialas ', f);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, skaičiuojančią kiek sveikųjų skaičių intervale [a;b] yra skaičių, kurie dalijasi iš septynių.}
program Bevarde0;
var a,b,i, k:longint;
begin
writeln ('Iveskite [a;b]');
readln(a,b);
k:=0;
for i:=a to b do
begin
if i mod 7 = 0 then
k:=k+1;
end;
writeln ('Kiekis ', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, kuri skaičiuotų visų triženklių skaičių, lygių savo skaitmenų kubų sumai, sumą ir kiekį.}
program Bevarde0;
var a,b,c,d ,sum, k:longint;
begin
sum :=0;
k:=0;
for a:=100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if (b*b*b+c*c*c+d*d*d)=a then
begin
sum:=sum+a;
k:=k+1;
end;
end;
writeln ('suma ', sum);
writeln ('kiekis', k);
readln
end.
/--------------------------------------------------------------------------------------
{Sudarykite programą, kuri skaičiuotų, kiek sveikųjų skaičių intervale [a;b] yra lyginių ir nelyginių skaičių, suskaičiuotų lyginių ir nelyginių skaičių sumas ir jas palygintų. Pvz., jei turime [5;10], tai jame yra 3 lyginiai skaičiai, kurių suma lygi 24 ir 3 nelyginiai skaičiai, kurių suma lygi 21. Didesnė yra lyginių skaičių suma.}
program Bevarde0;
var a,b,i, knelyg, sumnelyg, klyg, sumlyg:longint;
begin
writeln ('Iveskite [a;b]');
readln(a,b);
knelyg:=0;
sumlyg:=0;
klyg:=0;
sumnelyg:=0;
for i:=a to b do
if i mod 2 = 0
then
begin
klyg:=klyg+1;
sumlyg:=sumlyg+i;
end
else
begin
knelyg:=knelyg+1;
sumnelyg:=sumnelyg+i;
end;
writeln ('Kiekis nelyginiu ', knelyg);
writeln ('Kiekis lyginiu ', klyg);
writeln ('Suma nelyginiu ', sumnelyg);
writeln ('Suma lyginiu ', sumlyg);
if sumlyg > sumnelyg
then writeln ('Didesne suma lyginiu.')
else writeln ('Didesne suma nelyginiu.');
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus triženklius skaičius, kurie yra du kartus mažesni už jiems atbulus skaičius.}
program Bevarde0;
var a,b,c,d,atb:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
atb:=d*100+c*10+b;
if atb div a = 2 then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus triženklius skaičius, kurių vidurinysis skaitmuo yra du kartus didesnis už kraštinių skaitmenų sumą.}
program Bevarde0;
var a,b,c,d:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if c = 2*(b+d) then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus triženklius skaičius, kurie dalijasi iš visų savo skaitmenų.}
program Bevarde0;
var a,b,c,d:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if (b<>0) and (c<>0) and (d<>0) then
if (a mod b = 0) and (a mod c = 0) and (a mod d = 0) then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus triženklius palindromus (palindromas – skaičius, vienodai skaitomas iš dešinės į kairę ir iš kairės į dešinę, pvz. 242).}
program Bevarde0;
var a,b,c,d, atb:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
atb:=d*100+c*10+b;
if atb = a then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus triženklius skaičius, kurių pirmasis skaitmuo penkiais mažesnis už paskutinį.}
program Bevarde0;
var a,b,c,d:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if b = d-5 then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
{Parašykite programą, kuri atspausdintų visus nelyginius triženklius skaičius, besidalijančius bent iš vieno savo skaitmens.}
program Bevarde0;
var a,b,c,d:integer;
begin
for a:= 100 to 999 do
begin
b := a div 100;
c := a div 10 mod 10;
d := a mod 10;
if a mod 2 <> 0 then
if (b<>0) and (c<>0) and (d<>0) then
if (a mod b = 0) or (a mod c = 0) or (a mod d = 0) then
writeln (a);
end;
readln
end.
/--------------------------------------------------------------------------------------
Nežinomų kartojimų skaičiaus ciklas.
Surasti natūraliojo skaičiaus pirmąjį skaitmenį.
while n>9 do
n:=n div 10
writeln ('pirmas skaitmuo ", n);
/--------------------------------------------------------------------------------------
Surasti skaičiaus skaitmenų sumą (ps = paskutinisskaiciausskaitmuo).
s:=0;
m:=n;
while n>0 do
begin
ps:= n mod 10;
s:=s + ps
n:=n div 10
end;
writeln(skaiciaus ',m,'skaitmenusuma", s);
/--------------------------------------------------------------------------------------
Surastų lyginių skaitmenų sumą.
readln(n);
s:=0;
m:=n;
while n>0 do
begin
ps:= n mod 10;
if ps mod 2 = 0 then s:=s+ps,
n:=n div 10
end;
writeln(skaiciaus ',m,'skaitmenusuma", s)
/--------------------------------------------------------------------------------------
Surasti skaitmenų aritmetinį vidurkį.
readln(n);
s:=0;
m:=n;
k:=0;
while n>0 do
begin
ps:= n mod 10;
s:=s+ps;
k:=k+1;
n:=n div 10
end;
if k<> 0 then writeln('skaitmenu aritmetinis vidurkis', s/k:8:2)
/--------------------------------------------------------------------------------------
Parašyti programą, kuri suformuotų atbulą skaičių.
readln(n);
atb:=0;
while n>0 do
begin
ps:= n mod 10
atb:= atb*10+ps;
n:= n div 10;
end;
writeln ('atbulas skaicius: ', atb);
/--------------------------------------------------------------------------------------
{Duotas naturalusis skaicius. Suraskite nelyginiu skaitmenu aritmetini
vidurki ir visu skaitmenu sandauga, lyginiu suma ir sufomuoti atbula skaiciu.}
program ciklas_while;
var a, nelyg, san, k, atb, ps :integer;
begin
WriteLn('Įveskite natūralųjų skaičių');
Readln (a);
k:=0; nelyg:=0; san:=1; atb:=0;
while a<>0 do
begin
ps:= a mod 10;
if ps mod 2 <>0 then begin
k:=k+1;
nelyg:=nelyg+ps;
end;
atb:=atb*10+ps;
san:=san*ps;
a:= a div 10;
end;
if k<>0 then Writeln ('Skaiciaus nelyginiu skaitmenu vidurkis yra ', nelyg/k:8:2);
Writeln ('Skaiciaus skaitmenu sandauga yra ', san);
Writeln ('Ivestas skaicius atbulai ', atb);
Readln;
end.
/--------------------------------------------------------------------------------------
program palindromas; var x1,x2,k,k1,ps,ns:integer; begin WriteLn('iveskite skaiciu intervala'); readln (x1,x2); For k:=x1 to x2 do begin k1:=k; ns:=0; while k1>0 do begin ps:=k1 mod 10; ns:=ns*10+ps; k1:=k1 div 10; end; if ns=k then writeln (k); end; Readln; end.
Čia surašys visus palindromus intervale, pasitobulink, kad suradus pirmą, programa sustotu :)
lincikas79 gavo reakciją nuo Plx SVARBU! Pradedantiesiems programuotojams!