Padėkit ištaisyti klaidas pascal programoje

Whooops... dabar lyg ir viskas ok.

EDIT: ne viskas ok, jeigu įvedi 123123 vistiek false rodo

Antrą jau išspręndžiau pats, dabar dar vienas liko, kurio iki galo nepabaigiu niekaip. Sąlyga:

Užrašykite matematine formule šios funkcijos veiksmą:
function Y (a: real; n: integer): real;
var i, j: integer;
begin
for i := 1 to n do
   for j := 1 to n do
	  a := a * a;
Y := a 
end;

Gaunasi kažkas panašaus į n^4=x; a^x, bet ne visada ji tinka, yra idėjų?

Y(a, n) = a^(n*n)

EDIT: ne viskas ok, jeigu įvedi 123123 vistiek false rodo

ten nepažiūrėjau dar tavo skaičiai neteisingai paimami, nes pvz.: 123123 div 100 =1231

reikėtų 123123 div 100 mod 10 =1231 mod 10=1 (su visais ten mod 10)

ten mapažiūrėjau dar tavo skaičiai neteisingai paimami, nes pvz.: 123123 div 100 =1231

reikėtų 123123 div 100 mod 10 =1231 mod 10=1 (su visais ten mod 10)

Aha, bet vistiek dar neveikia kažkas lyg

ir dar, kadangi ten funkcija tai ,man rodos, reikia paigoje priskirti

lagaminas:=nr;

ir dar, kadangi ten funkcija tai ,man rodos, reikia paigoje priskirti

lagaminas:=nr;

O, dabar veikia, tik ne lagaminas, o laimingas ten :biggrin_xmas:

O, dabar veikia, tik ne lagaminas, o laimingas ten :biggrin_xmas:

Oi :) nežinia kodėl taip parašiau :D

Y(a, n) = a^(n*n)

Na kas padės likusioje programoje?

Parašykite funkciją nevienodi(sk: longint): longint, kuri iš duoto skaičiaus pašalintų visus vienodus skaitmenis.

Pavyzdžiui,

nevienodi(13) = 13, nevienodi(14405) = 105, nevienodi(5522) = 0, nevienodi(10021) = 2.

Buvau radęs programą su masyvais, bet jų naudoti negalima :(

Pasiimk skaičius iš eilės patikrink pereidamas per visus skaičius kiek tokių pačių yra, jeigu 2 arba daugiau, tai skaičiaus nededame į atsakymą, kitu atveju dedam (nevienodi := nevienodi * 10 +sk ). Ir kartok su visais skaitmenimis :rolleyes:

Sveiki,

užduotis:

Parašykite programą, kurioje būtų panaudota procedūra, duotąjį tekstą užšifruojanti pagal tokį algoritmą: pirmasis simbolis sukeičiamas su trečiuoju, antrasis – su ketvirtuoju, penk¬tasis su septintuoju, šeštasis su aštuntuoju ir taip toliau. Keičiami visi simboliai, ne tik raidės.

Pavyzdžiui, tekstas „NETEPSI – NEVAŽIUOSI“ užšifruojamas taip:

„TENEI PSNE– ŽIVASIUO“.

Padariau tiek, kaip reikia dabar spausdinti skaitmenis tokia tvarka?

program šifratorius;
const R = 100;
type Mas = array [1..R] of char;
var A : Mas;
 n: integer;
procedure simboliai (var A : Mas; var n : integer);
begin
writeln ('Įveskite simbolių einutę ');
n := 0;
while not Eoln and (n < R) do
 begin
  n := n + 1;
  read (A[n]);
  end;
pr
end;
procedure rasyti (var A : Mas; var s : integer);
begin
  s := length(A);

end;
begin
simboliai (A, n);
end.

Atradau, kad yra seka šiokia tokia čia, pagal ją ir padariau programą, bet meta dabar, kad peržengti rėžiai ir dar nežinau ką reikia daryti kai simbolių skaičius nesidalina iš 4, bet svarbiau dabar pirmąją išspręsti. Programa:

program šifratorius;
const R = 100;
type Mas = array [1..R] of char;
var A : Mas;
 n, i, s, k: integer;
procedure simboliai (var A : Mas; var n : integer);
begin
writeln ('Įveskite simbolių einutę ');
n := 0;
while not Eoln and (n < R) do
 begin
  n := n + 1;
  read (A[n]);
  end;
end;
procedure rasyti (var A : Mas; var i, s, k : integer);
begin
  i := length(A);
  s := 3;
  k := i div 4;
  if (i mod 4 = 0) then
begin
 while (k >= 1) do
  begin
   write (A[s]);
   s := s + 1;
   write (A[s]);
   s := s - 3;
   write (A[s]);
   s := s + 1;
   write (A[s]);
   s := s + 5;
   write (A[s]);
   k := k - 1;
  end;
end;
end;
begin
simboliai (A, n);
rasyti (A, i, s, k);
end.

program šifratorius;
const R = 100;
type Mas = array [1..R] of char;
var A : Mas;
 n, i, s, k: integer;
procedure simboliai (var A : Mas; var n : integer);
begin
writeln ('Įveskite simbolių einutę ');
n := 0;
while not Eoln and (n < R) do
 begin
  n := n + 1;
  read (A[n]);
  end;
end;
procedure rasyti (var A : Mas; var i, s, k : integer);
begin
  s := 3;
  k := n div 4;
  if (n mod 4 = 0) then
begin
 while (k >= 1) do
  begin
   write (A[s]);
   s := s + 1;
   write (A[s]);
   s := s - 3;
   write (A[s]);
   s := s + 1;
   write (A[s]);
   s := s + 5;
   k := k - 1;
  end;
end;
end;
begin
simboliai (A, n);
rasyti (A, n, s, k);
end.

Veikia, bet tik su skaitmenų suma, kuri dalinasi iš 4

Kažkaip per sudėtingai tu čia padarei. ;) Pats uždavinys šiek tiek neaiškus. Jeigu eilutėje yra nelyginis simbolių skaičius, paskutinis arba priešpaskutinis simbolis neturi su kuo keistis vietomis. Perrašiau procedūra taip, kad jeigu simbolis neturi su kuo keistis, pasilieka savo vietoje.

procedure rasyti (A : Mas; i, s, k : integer);
begin
i:=1;
while i<=n  do
 begin
  if (i+2)<n then 
begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
end
  else
begin
 if i=n then
  begin
   Write(A[i]);
   i:=i+4;
  end
 else
  begin
   Write(A[i+2],A[i+1],A[i]);
   i:=i+4;
  end;
end;
 end;
end;

O jeigu vis dėl to keičiame to simbolio vietą, tai keičiame jį su "įsivaizduojamu" tarpu:

procedure rasyti (A : Mas; i, s, k : integer);
begin
i:=1;
while i<=n do
 begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
 end;
end;

Kažkaip per sudėtingai tu čia padarei. :) Pats uždavinys šiek tiek neaiškus. Jeigu eilutėje yra nelyginis simbolių skaičius, paskutinis arba priešpaskutinis simbolis neturi su kuo keistis vietomis. Perrašiau procedūra taip, kad jeigu simbolis neturi su kuo keistis, pasilieka savo vietoje.

procedure rasyti (A : Mas; i, s, k : integer);
begin
i:=1;
while i<=n  do
 begin
  if (i+2)<n then 
begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
end
  else
begin
 if i=n then
  begin
   Write(A[i]);
   i:=i+4;
  end
 else
  begin
   Write(A[i+2],A[i+1],A[i]);
   i:=i+4;
  end;
end;
 end;
end;

O jeigu vis dėl to keičiame to simbolio vietą, tai keičiame jį su "įsivaizduojamu" tarpu:

procedure rasyti (A : Mas; i, s, k : integer);
begin
i:=1;
while i<=n do
 begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
 end;
end;

Įvedu labas, o išmeta bala abiejose procedūrose, kaip ir buvo pas mane :lol:

Ir kodėl neveikia šita funkcija dorai? :lol: nesupratu niekaip

function lygu (L, M : Mas; var s : integer; n : integer; var a : integer) : integer;
begin
a := 1;
for n := 1 to s do
 begin
  if L[n] <> M[n]
then a := 0
else a := 1;
lygu := a;
 end;
end;

Ji turi nustatyti ar L[n] ir M[n] yra lygūs, jeigu lygūs tada ats 1, jeigu nelygūs 0. S tai elementų skaičius masyvuose.

Neįmanoma, pats rašydamas testavau su "labas". :) Turbūt kažkur įveli klaidą klijuodamas kodą, nes man veikia taip kaip ir turi. :lol: Štai bandyk visą kodą:

program šifratorius;
const R = 100;
type Mas = array [1..R] of char;
var A : Mas;
 n, i, s, k: integer;
procedure simboliai ( var A : Mas; var n : integer);
begin
writeln ('Įveskite simbolių eilutę ');
n := 0;
while not Eoln and (n < R) do
 begin
  n := n + 1;
  read (A[n]);
  end;
end;
procedure rasyti (A : Mas; i: integer);
begin
i:=1;
while i<=n  do
 begin
  if (i+2)<n then
begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
end
  else
begin
 if i=n then
  begin
   Write(A[i]);
   i:=i+4;
  end
 else
  begin
   Write(A[i+2],A[i+1],A[i]);
   i:=i+4;
  end;
end;
 end;
end;

begin
simboliai (A, n);
rasyti (A, i);
readln;
readln;
end.

Įvedu "labas", išveda "balas". O šita:

program šifratorius;
const R = 100;
type Mas = array [1..R] of char;
var A : Mas;
 n, i, s, k: integer;
procedure simboliai ( var A : Mas; var n : integer);
begin
writeln ('Įveskite simbolių eilutę ');
n := 0;
while not Eoln and (n < R) do
 begin
  n := n + 1;
  read (A[n]);
  end;
end;
procedure rasyti (A : Mas; i : integer);
begin
i:=1;
while i<=n do
 begin
 Write(A[i+2],A[i+3],A[i],A[i+1]);
 i:=i+4;
 end;
end;

begin
simboliai (A, n);
rasyti (A, i);
readln;
readln;
end.

Įvedu "labas", išveda "bala__s".

Ir kodėl neveikia šita funkcija dorai? :lol: nesupratu niekaip

 

function lygu (L, M : Mas; var s : integer; n : integer; var a : integer) : integer;
begin
a := 1;
for n := 1 to s do
 begin
  if L[n] <> M[n]
then a := 0
else a := 1;
lygu := a;
 end;
end;

Ji turi nustatyti ar L[n] ir M[n] yra lygūs, jeigu lygūs tada ats 1, jeigu nelygūs 0. S tai elementų skaičius masyvuose.

Bet kad jūs norit viską per aplinkui daryt. Ar ne paprasčiau vietoj "<>" parašyt "=" ir apkeist eilutes? :) Aišku čia klaidos nėra, bet kartais glumina tokie užrašai. Dabar veikia:

function lygu (L, M : Mas; s : integer; var a : integer) : integer;
var n:integer;
begin
for n := 1 to s do
 begin
  if L[n] = M[n]
then a := 1
else a := 0;
 end;
end;

Bet kad jūs norit viską per aplinkui daryt. Ar ne paprasčiau vietoj "<>" parašyt "=" ir apkeist eilutes? :lol: Aišku čia klaidos nėra, bet kartais glumina tokie užrašai. Dabar veikia:

function lygu (L, M : Mas; s : integer; var a : integer) : integer;
var n:integer;
begin
for n := 1 to s do
 begin
  if L[n] = M[n]
then a := 1
else a := 0;
 end;
end;

Vistiek nepadėjo :D Kas blogai visoj programoj?
program lyginimas;
const R = 100;
type Mas = array [1..R] of integer;
var L, M : Mas;
s, n, a, k, ats : integer;
procedure skaityti (var L, M : Mas; s, n  : integer);
begin
write ('Kiek skaičių bus lyginama? ');
read (s);
writeln ('Įveskite skaičus į pirmąjį masyvą');
for n := 1 to s do
 begin
  read (L[n]);
 end;
writeln ('Įveskite skaičus į antrąjį masyvą');
for n := 1 to s do
 begin
 read (M[n]);
 end;
end;
function lygu (L, M : Mas; s : integer; var a : integer) : integer;
var n : integer;
begin
for n := 1 to s do
 begin
  if L[n] = M[n]
then a := 1
else a := 0;
 end;
end;
function nelygu (L, M : Mas; s : integer; var a : integer) : integer;
var n : integer;
begin
for n := 1 to s do
 begin
  if L[n] <> M[n]
then a := 1
else a := 0;
nelygu := a;
 end;
end;
begin
skaityti (L, M, s, n);
writeln ('Kelintą operacij1ą atlikti su masyvais?');
read (k);
k := 1;
 if k = 1 then ats := lygu (L, M, s, a);
 if k = 2 then ats := nelygu (L, M, s, a);
 if ats = 1
  then writeln ('masyvų elementai tenkina operaciją')
  else writeln ('masyvų elementai operacijos netenkina');
end.

Lyginimo operacijos su masyvais Paskalio kalboje neapibrėžtos. Susitarkime, kad du masyvai, kurių elementai yra to paties paprastojo tipo, bet kurią lyginimo operaciją tenkina tada, kai šią operaciją tenkina kiekviena masyvų elementų, pažymėtų tuo pačiu indeksu, pora.

Parašykite programą, kurioje būtų panaudotos funkcijos, su masyvais atliekančios šias lygi¬nimo operacijas:

a) lygu (=);

b) nelygu (<>);

Šiaip gan kvailas uždavinys. Bet pagal sąlygą, turėtų išvesti TRUE arba FALSE. Jeigu cikle yra tik viena eilutė, nereikia rašyti begin end; ir pačią funkciją galima naudoti kaip kintamąjį. Štai veikiantis variantas. Analizuokis:

program lyginimas;
const R = 100;
type Mas = array [1..R] of integer;
var L, M : Mas;
s, n : integer;

procedure skaityti (var L, M : Mas; s:integer);
var n:integer;
begin
writeln ('Įveskite skaičus į pirmąjį masyvą');
for n := 1 to s do
  read (L[n]);
writeln ('Įveskite skaičus į antrąjį masyvą');
for n := 1 to s do
 read (M[n]);
end;

function lygu (L, M : Mas; s : integer) : boolean;
var n : integer;
begin
for n := 1 to s do
 begin
  if L[n] = M[n]
then lygu := TRUE;
 end;
end;

function nelygu (L, M : Mas; s : integer) : boolean;
var n : integer;
begin
for n := 1 to s do
 begin
  if L[n] <> M[n]
then nelygu:=FALSE
else nelygu:=TRUE;
 end;
end;

begin
WriteLn('Kiek skaičių yra masyvuose?');
ReadLn(s);
skaityti(L,M,s);
Writeln(lygu (L,M,s));
Writeln(nelygu(L,M,s));
readln;
readln;
end.

...

Sveiki,

net nesuprantu užduoties ką reikia padaryti:

Sakoma, kad skaičiai, gauti pagal formulę http://i46.tinypic.com/1ibuz4.png yra pirminiai.

Parašykite programą, tikrinančią, ar šis teiginys teisingas intervalo [1;10000] skaičiams.

Tai reikia pasirašyti funkciją, kuri randa pirminius skaičius iš to intervalo ir ką tada daryt ar kaip čia?

Sveiki,

net nesuprantu užduoties ką reikia padaryti:

 

Sakoma, kad skaičiai, gauti pagal formulę http://i46.tinypic.com/1ibuz4.png yra pirminiai.

Parašykite programą, tikrinančią, ar šis teiginys teisingas intervalo [1;10000] skaičiams.

 

Tai reikia pasirašyti funkciją, kuri randa pirminius skaičius iš to intervalo ir ką tada daryt ar kaip čia?

Praeini visa intervala, jei nors vienas ne pirminis istacius x i formule, tai sustoji ir rasai kad neteisinga, priesingu atveju - teisinga...

Na as galvoju kad reiketu pasidaryt funkcija kuri tikrintu ar skaicius pirminis ir gautą rezultatą tikrinti/lyginti su rezultatu gautu pagal tą formulę.

Ką toliau daryti, kaip tikrinti pagal tą formulę nesuprantu niekaip :D

program pirminiai;
var a, b : integer;
begin
b := 0;
for a := 1 to 10000 do
begin
if 10000 mod a = 0 then b := b + 1;
end;
if b = 2 then
else
end.

Sveiki,

net nesuprantu užduoties ką reikia padaryti:

 

Sakoma, kad skaičiai, gauti pagal formulę http://i46.tinypic.com/1ibuz4.png yra pirminiai.

Parašykite programą, tikrinančią, ar šis teiginys teisingas intervalo [1;10000] skaičiams.

 

Tai reikia pasirašyti funkciją, kuri randa pirminius skaičius iš to intervalo ir ką tada daryt ar kaip čia?

Kvailas uždavinys, nes galima suprast dvejopai. Pirma, tai kad imi x iš duoto intervalo, statai į formulę ir tikrini ar gautas skaičius pirminis. Antra, tai kad gauti skaičiai turi tilpti duotame intervale, o x jau imi atsižvelgdamas į tai. Nors man atrodo logiškesnis pirmas variantas, gal pabandyk patikslint. ;)