someon

Prašom.
 

program braskes; var b,d,k,n,i:integer; begin Write('Iveskite kiek pirmaja diena lysveje prinoko braskiu. ');readln(b); write('Iveskite kiek kita diena braskiu prinoksta daugiau, negu pries tai buvusia. ');readln(d); write('Iveskite kiek dienu auginamos braskes. ');readln(n); k := b; for i := 1 to n - 1 do begin b += d; k += b; end; writeln('Per ',n,' dienas prinoko ', k,' braskes'); readln; end.

{Parašykite programą: c) su procedūra 12 elementų masyvui užpildyti klaviatūra renkamais sveikaisiais skaičiaus; d) ir procedūra šį masyvą spausdinti vienoje eilutėje; e) ir procedūra kitoje eilutėje spausdinti masyvo elementus atvirkščia tvarka.} program Buzduotis2; type masyvas = array[1..12] of integer; var i : integer; A : masyvas; {-------------------procedura uzpildyti masyva---------------------------------} procedure uzpildymas; var i : integer; begin for i := 1 to 12 do readln(A[i]); end; {------------------procedura spausdinti vienoje eiluteje-----------------------} procedure spausdinimas; var i : integer; begin for i := 1 to 12 do write(A[i],' '); writeln; end; {-----------------prodedura spausdinti atvirkscia tverka-----------------------} procedure atvirksciai; var i : integer; begin for i := 12 downto 1 do write(A[i],' '); end; begin uzpildymas; spausdinimas; atvirksciai; Readln; end.
 

{1. Parašykite programą: a) su procedūra 8 elementų masyvui užpildyti elementų indeksais; b) ir su procedūra masyvo elementus išspausdinti vienoje eilutėje.} program Buzduotis1; type masyvas = array[1..8] of integer; var i : integer; A : masyvas; {-------------------procedura uzpildyti masyva---------------------------------} procedure uzpildymas; var i : integer; begin for i := 1 to 8 do A[i] := i; end; {------------------procedura spausdinti vienoje eiluteje-----------------------} procedure spausdinimas; var i : integer; begin for i := 1 to 8 do write(A[i],' '); end; begin uzpildymas; spausdinimas; Readln; end.
as taip suprantu pirma uzduoti :rolleyes: nzn ar gerai :)
 

{3. Antrąją programą papildyti procedūra, kuri suskaičiuotų masyvo elementų, didesnių už 5, sumą skaičiavimo.} program uzduotis2; type masyvas = array[1..12] of integer; var i : integer; A : masyvas; {-------------------procedura uzpildyti masyva---------------------------------} procedure uzpildymas; var i : integer; begin for i := 1 to 12 do readln(A[i]); end; {------------------procedura didesniu uz 5 sumai skaicuoti---------------------} procedure sum; var i, suma : integer; begin suma := 0; for i := 1 to 12 do if A[i] > 5 then suma += A[i]; writeln('didesniu uz 5 suma yra ',suma); end; {------------------procedura spausdinti vienoje eiluteje-----------------------} procedure spausdinimas; var i : integer; begin for i := 1 to 12 do write(A[i],' '); writeln; end; {-----------------prodedura spausdinti atvirkscia tverka-----------------------} procedure atvirksciai; var i : integer; begin for i := 12 downto 1 do write(A[i],' '); writeln; end; begin uzpildymas; spausdinimas; atvirksciai; sum; Readln; end.
 
jei reiks pakomentuot galiu, klausk jei ko nesuprasi ;)

program uzduotis; type asmuo = record kazkas, pavad, vard, pav : string[10]; akod: string[11]; bkiek: integer; B: array[1..100] of integer; end; masyvas = array[1..100] of asmuo; var A : masyvas; pavadinimas: string[10]; //atitdziai pasiziurek, kad butu tiek arba daugiau simboliu pries grup. dydi grupDYD: integer; //visos grupes dydis i: integer; {------------------procedura failo nuskaitymui---------------------------------} procedure skaitymas(var A: masyvas; var grupDYD: integer; var pavadinimas: string[10]); //geriau globaliuju kintamuju nenaudok, bus aiskiau. var fd : text; i, j,z, sk: longint; begin assign(fd, 'C:/kel.txt'); reset(fd); Read(fd, pavadinimas); ReadLn(fd, grupDYD); for i := 1 to grupDYD do begin read(fd,A[i].vard, A[i].pav, A[i].akod, A[i].bkiek); for z := 1 to A[i].bkiek do read(fd, a[i].B[z]); ReadLn(fd); //pereina i nauja eilute, kuria skaitysime cikle end; close(fd); end; begin skaitymas(A, grupDYD, pavadinimas); for i := 1 to 3 do writeln(a[i].vard,a[i].pav,a[i].akod); readln; end.
 
Duomenų failas: (atidėjau visur kur reikia po 10 simbolių) taip pat asmens kodą įrašiau į string'a, nes mano žiniom į longint neturėjo tilpt :)
 

'Egle' 3 Jonas Petraitis 38808080099 10 500 20 500 100 20 20 20 10 10 50 Petras Jonaitis 38099820014 8 20 10 50 100 500 10 50 10 Aidas Briedis 38956854245 5 10 20 50 200 100
 
Jeigu dar kils klausimų, rašyk :)

28.
 

program Noname2; const T = 1000; type masyvas = array[1..T] of integer; var i, kiek: integer; pirm: masyvas; sk1, sk2: integer; procedure pirminiai (var pirm: masyvas; var kiek: integer); var i, j, k: integer; mas: array[1..T] of boolean; begin k := 0; for i := 2 to T do mas[i] := true; for i := 2 to 500 do if mas[i] = true then begin j := 2*i; while j<= T do begin mas[j] := false; j := j+i; end; end; for i := 2 to T do if mas[i] = true then begin k := k +1; pirm[k] := i; end; kiek := k; end; function dvyniai(sk1,sk2: integer; pirm: masyvas; kiek: integer):boolean; var i: integer; begin dvyniai := false; for i := 1 to kiek - 1 do if (pirm[i] = sk1) and (pirm[i + 1] = sk2) then dvyniai := true; end; begin pirminiai(pirm, kiek); WriteLn('Iveskite 2 skaicius'); readln(sk1, sk2); if dvyniai(sk1,sk2, pirm, kiek) = true then writeln('dvyniai') else writeln('skaiciai nera dvyniai'); Readln; end.
 
29.
 

program Noname3; procedure skaitmSum(var sk: integer; var rez: integer); var sum: integer; begin rez := 0; while sk > 0 do begin rez := rez + sk mod 10; sk := sk div 10; end; end; var sk, rez: integer; begin WriteLn('Iveskite skaiciu'); readln(sk); rez := 10; while rez > 9 do begin skaitmSum(sk, rez); sk := rez; end; writeln('Skaitm. saknis: 'rez); Readln; end.
 
27.
 

program Noname4; var i, sk, prad: integer; sum: longint; function fakt(n: integer): longint; var i: integer; begin fakt := 1; for i := 1 to n do fakt := fakt * i; end; begin writeln('Iveskite skaiciu'); readln(sk); prad := sk; while sk > 0 do begin sum := sum + fakt(sk mod 10); sk := sk div 10; end; if sum = prad then writeln('Skaicius yra Kordenskio skaicius') else writeln('Tai ne kordenskio skaicius'); Readln; end.
 
15.
 

program Noname5; var yra: boolean; sk, n: integer; function fakt(n: integer): longint; var i: integer; begin fakt := 1; for i := 1 to n do fakt := fakt * i; end; begin WriteLn('Iveskite skaiciu'); ReadLn(sk); n := 1; yra := false; while (fakt(n) <= sk) and (yra = false) do begin if sk = fakt(n) then yra := true; n :=n + 1; end; if yra = true then writeln('Duotas skaicius yra ',n - 1, ' faktorialas') else writeln('Skaicius nera kieno nors faktorialas'); Readln; end.

28.
 

program Noname2; const T = 1000; type masyvas = array[1..T] of integer; var i, kiek: integer; pirm: masyvas; sk1, sk2: integer; procedure pirminiai (var pirm: masyvas; var kiek: integer); var i, j, k: integer; mas: array[1..T] of boolean; begin k := 0; for i := 2 to T do mas[i] := true; for i := 2 to 500 do if mas[i] = true then begin j := 2*i; while j<= T do begin mas[j] := false; j := j+i; end; end; for i := 2 to T do if mas[i] = true then begin k := k +1; pirm[k] := i; end; kiek := k; end; function dvyniai(sk1,sk2: integer; pirm: masyvas; kiek: integer):boolean; var i: integer; begin dvyniai := false; for i := 1 to kiek - 1 do if (pirm[i] = sk1) and (pirm[i + 1] = sk2) then dvyniai := true; end; begin pirminiai(pirm, kiek); WriteLn('Iveskite 2 skaicius'); readln(sk1, sk2); if dvyniai(sk1,sk2, pirm, kiek) = true then writeln('dvyniai') else writeln('skaiciai nera dvyniai'); Readln; end.
 
29.
 

program Noname3; procedure skaitmSum(var sk: integer; var rez: integer); var sum: integer; begin rez := 0; while sk > 0 do begin rez := rez + sk mod 10; sk := sk div 10; end; end; var sk, rez: integer; begin WriteLn('Iveskite skaiciu'); readln(sk); rez := 10; while rez > 9 do begin skaitmSum(sk, rez); sk := rez; end; writeln('Skaitm. saknis: 'rez); Readln; end.
 
27.
 

program Noname4; var i, sk, prad: integer; sum: longint; function fakt(n: integer): longint; var i: integer; begin fakt := 1; for i := 1 to n do fakt := fakt * i; end; begin writeln('Iveskite skaiciu'); readln(sk); prad := sk; while sk > 0 do begin sum := sum + fakt(sk mod 10); sk := sk div 10; end; if sum = prad then writeln('Skaicius yra Kordenskio skaicius') else writeln('Tai ne kordenskio skaicius'); Readln; end.
 
15.
 

program Noname5; var yra: boolean; sk, n: integer; function fakt(n: integer): longint; var i: integer; begin fakt := 1; for i := 1 to n do fakt := fakt * i; end; begin WriteLn('Iveskite skaiciu'); ReadLn(sk); n := 1; yra := false; while (fakt(n) <= sk) and (yra = false) do begin if sk = fakt(n) then yra := true; n :=n + 1; end; if yra = true then writeln('Duotas skaicius yra ',n - 1, ' faktorialas') else writeln('Skaicius nera kieno nors faktorialas'); Readln; end.

Kazicko forumas
Olimpiadiniai uždaviniai