Прочее

Program Kyrsov;
var x0,x1,e,a,b:real;
n:integer;
f:text;
st:string;
procedure PrMn (var y,y1:real);{---PrMn---}
var f1,f2,s: real;
begin
while abs(y1-y)>e do
begin
f1:=y*y-5*y+6; f2:=y1*y1-5*y1+6;
s:=y1-(y1-y)*f2/(f2-f1);
y:=y1; y1:=s;
end;
end; {---PrMn---}
procedure PrSin (var y,y1:real);{---PrSin---}
var f1,f2,s: real;
begin
while abs(y1-y)>e do
begin
f1:=y- cos(y); f2:=y1- cos(y1);
s:=y1-(y1-y)*f2/(f2-f1);
y:=y1; y1:=s;
end;
end; {---PrSin---}
procedure PrLn (var y,y1:real);{---PrLn---}
var f1,f2,s: real;
begin
while abs(y1-y)>e do
begin
f1:=ln(y)*ln(y)-ln(y)-2; f2:=ln(y1)*ln(y1)-ln(y1)-2;
s:=y1-(y1-y)*f2/(f2-f1);
y:=y1; y1:=s;
end;
end; {---PrLn---}
begin
writeln ('vvedite n (ot 1 do 3) ');
readln(n);
begin
writeln('vvedite x0,x1,e');
readln(x0,x1,e);
a:=x0;b:=x1;
case n of
1:PrMn(x0,x1);
2:PrSin(x0,x1);
3:PrLn(x0,x1);
end;
writeln('x=',x1);
assign(f,'fkyrspa.txt');
rewrite(f);
{ str(a,st);
writeln(f,st);
str(b,st);
writeln(f,st);
str(e,st);
writeln(f,st);}
str(x1,st);
writeln(f,st);
close(f);
reset(f);
writeln;
writeln('zapisano v file');
while not EoF(f) do
begin
readln(f,st);
writeln(st);
end;
close(f);
end;
if n>=4 then writeln('oshibka! n=',n);
readln;
end.

конец

Program n5;
var f:text;
b,c:char;
x,str,y:string[80];
i,n,nmax,nstr,nstrk:integer;
begin
assign(f,'la5.txt');
rewrite(f);
x:='a'; b:='k';
writeln('vvesti stroki');
while ( x<>b) do
begin
readln(x);
if x<>b then
writeln(f,x);
end;
nmax:=0;
close(f); assign(f,'la5.txt');
reset(f);nmax:=0;
nstr:=0;
writeln('in file');
while not EoF(f) do
begin
readln(f,y);
writeln(y);
n:=0; nstr:=nstr+1;
c:=' '; x:=y;
for i:=1 to length(x) do
begin
if ((x[i]>='a') and (x[i]<='z')) or ((x[i]>='A') and (x[i]>='Z'))
or (x[i]='-') or ((x[i]>='0') and (x[i]<='9'))
then else x[i]:=' ';
end;
for i:=1 to length(x) do
begin
if x[i]<>' 'then
begin
if c=' ' then
begin
n:=n+1; c:=x[i];
end;
end;
c:=x[i];
end;
if nmax<n then
begin
nmax:=n;
nstrk:=nstr;
str:=y;
end;
end;
writeln ('nmax=', nmax);
writeln ('nstrk=',nstrk,' ','str:',str);
readln;
close(f);
readln;
end.

Program n5;
uses crt;
var f:text;
b,c:char;
x:string[80];
m,i,n:integer;
begin
assign(f,'la5.txt');
reset(f); m:=0; n:=0;
while not EoF(f) do
begin
readln(f,x);
writeln(x);
for i:=1 to length(x) do
begin
if ( x[i]<>' ') and ( pos('mm',x)<>0) then n:=n+1;
end;
end;
readln;
writeln(n);
close(f);
readln;
end.

Program n5;
var f:text;
b,c:char;
x,str:string[80];
i,n,nmax,nstr,nstrk:integer;
begin
assign(f,'la5.txt');
reset(f); nmax:=0;
nstr:=0;
writeln('in file');
while not EoF(f) do
begin
readln(f,x);
writeln(x);
n:=0; nstr:=nstr+1;
c:=x[1];
for i:=1 to length(x) do
begin
if x[i]<>' 'then
begin
if c=' ' then begin n:=n+1; c:=x[i];end;
end;
c:=x[i];
if nmax<n then
begin
nmax:=n;
nstrk:=nstr;
str:=x;
end;
end;
end;
writeln ('nmax=', nmax+1);
writeln ('nstrk=',nstrk,' ','str:',str);
readln;
close(f);
readln;
end.

program abc;
var a:array [1..10] of integer;
i,cnt,tmp,prev:integer;
function k(elem:integer):integer;
var i,j,max:integer;
begin
max:=0;
for i:=1 to 10 do
begin
if a[i]=elem then
begin
j:=j+1;
cnt:=1;
while (a[j]=elem) do
begin
cnt:=cnt+1;
j:=j+1;
end;
if cnt>max then max:=cnt;
end;
end;
k:=max;
end;
BEGIN
for i:=1 to 10 do readln (a[i]);
for i:=1 to 10 do
begin
if prev=a[i] then continue;
tmp:=k(a[i]);
prev:=a[i];
if tmp>1 then writeln ('element:',a[i],'vstretilsya podryad raz:',tmp);
readln;
end;
end.

program l4;
var a:array [1..4] of integer;
b:array [1..6] of integer;
z,n,w,i,k,c,d,e,f,g:integer;
q,u,v:longint;
function fmx (n:integer):integer;
var max:integer;
begin
max:=a[1];
for i:=2 to n do
if max<a[i] then max:=a[i];
fmx:=max;
end;
function fmy (n1:integer):integer;
var min:integer;
begin
min:=a[1];
for i:=2 to n do
if min>a[i] then min:=a[i];
fmy:=min;
end;
BEGIN
writeln ('vvesti n');
readln (n);
writeln ('vvesti massiv a');
for i:=1 to n do readln (a[i]);
c:=fmx (n);
d:=fmy (n);
writeln ('c=', c,' ','d=',d);
b[1]:=c div 100;
e:=c mod 100;
b[2]:=e div 10;
b[3]:=e mod 10;
b[4]:=d div 100;
f:=d mod 100;
b[5]:=f div 10;
b[6]:=f mod 10;
z:=1;
while z=1 do
begin
z:=0;
for k:=1 to 5 do
begin
if b[k]<b[k+1] then
begin
g:=b[k];
b[k]:=b[k+1];
b[k+1]:=g;
z:=1;
end;
end;
end;
for k:=1 to 6 do writeln (b[k]);
begin u:=100000;q:=1000;v:=10000;
q:=b[1]*u+b[2]*v+b[3]*q+b[4]*100+b[5]*10+b[6];
end;
if (d>=10) and (d<100) then q:=q div 10;
if d<10 then q:=q div 100;
if (c>=10) and (c<100) then q:=q div 10;
if c<10 then q:=q div 100;
writeln ('naibolshee chislo=',q);
readln;
end.

program lab2;
var a, c, e, y:real;
n, k: integer;
begin
writeln ('vvesti e');
readln (e);
y:=1; n:=1; k:=0; a:=1; c:=1;
repeat
begin
a:=a/10;
c:=c/n;
y:=y+a+c;
k:=k+1;
n:=n+1;
end;
until (abs(a) < e) and (abs(c) < e);
writeln ('y=', y:2:4, ' ', 'k=', k);
readln;
end.

program lab3;
var MAX, z, x, m, i, j, k:integer;
a:array [1..3,1..3] of integer;
b:array [1..3] of real;
begin
writeln ('vvesti m');
readln (m);
writeln ('vvesti masiv a');
for i:=1 to m do
for j:=1 to m do
readln (a[i,j]);
writeln ('vvesti masiv b');
for k:=1 to m do
readln ( b[k]);
MAX:=a[1,1];
for i:=1 to m do
for j:=1 to m do
begin
if MAX < a[i,j] then
begin
MAX:=a[i,j];
z:=i; x:=j;
end;
end;
writeln ('z=', z, ' ', 'x=', x);
for k:=1 to m do
if z=x then b[k]:=b[k]*20
else b[k]:=b[k]*0.5;
for k:=1 to m do
writeln (b[k]:3:1);
readln;
end.

program lab4;
var a:array [1..10] of integer;
b:array [1..4] of integer;
i, k, x1, y1, n:integer;
d, e,q:integer;

function fx(n:integer):integer;
var max:integer;
begin
max:=a[1];
for i:=2 to n do
if max<a[i] then max:=a[i];
fx:=max;
end;

function fy(n1:integer):integer;
var min:integer;
begin
min:=a[1];
for i:=2 to n1 do
if min>a[i] then min:=a[i];
fy:=min;
end;

begin
writeln ('vvesti n ');
readln (n);
writeln ('vvod massiva a');
for i:=1 to n do
readln (a[i]);
x1:=fx(n); y1:=fy(n);
writeln ('x1=',x1,' ', 'y1=', y1);
b[1]:=x1 div 10;
b[2]:=x1 mod 10;
b[3]:=y1 div 10;
b[4]:=y1 mod 10;
i:=1;
while i=1 do
begin
i:=0;
for k:=1 to 3 do
begin
if b[k]<b[k+1] then
begin
d:=b[k];
b[k]:=b[k+1];
b[k+1]:=d; i:=1;
end;
end;
end;
for k:=1 to 4 do write (b[k]);
b[1]:=b[1]*1000;
b[2]:=b[2]*100;
b[3]:=b[3]*10;
e:=b[1]+b[2];
q:=b[3]+b[4];
q:=e+q;
writeln;
writeln ('naibolshee vozmognoe chislo=', q);
readln;
end.

Program Masive1;
var A:array [1..100] of integer;
n,m,i,s:integer;
begin
n:=7; S:=0;
writeln('vvesti masiv iz ',n,' chisel');
for i:=1 to n do
begin
readln(A[i]);
end;
m:=1;
while m<n do
begin
for i:=m to n do
begin
if A[m]=A[i+1] then A[i+1]:=0;
end;
m:=m+1;
end;
for i:=1 to n do
begin
S:=S+A[i];
end;
writeln('S=',S);
readln;
end.

10

Program r2;
var e,a,y:real;
n,k:integer;
begin
writeln('vvedite e');
readln(e);
y:=1/2; a:=1/2; n:=1; k:=1;
repeat
begin
n:=n+1;
a:=a*(1/(4*n-2));
y:=y+a;
k:=k+1;
end;
until abs(a)<e;
writeln('y=',y);
writeln('chislo elementov riyda vkluchennix v symmy =',k);
readln;
end.

Program n5;
var f,g:text;
b:char;
x:string[80];
begin
writeln('vvesti stroki');
assign(f,'pavel2.txt');
rewrite(f);
x:='a'; b:='!';
while ( x<>b) do
begin
readln(x);
if x<>b then
writeln(f,x);
end;
close(f);
assign(g,'pavel3.txt');
rewrite(g);
reset(f);
writeln;
writeln('zapisano v file');
while not EoF(f) do
begin
readln(f,x);
writeln(g,x);
if pos ('bit',x)<>0 then
begin
x:='**********';
writeln(g,x);
end;
end;
close(g);
writeln;
reset(g);
while not EoF(g) do
begin
readln(g,x);
writeln(x);
end;
readln;
close(f);
close(g);
readln;
end.

Program n5;
var f:text;
b:char;
x:string[80];
begin
assign(f,'pavel1.txt');
rewrite(f);
x:='a'; b:='!';
writeln ('vvecti ctroki');
while ( x<>b) do
begin
readln(x);
if x<>b then
writeln(f,x);
end;
close(f);
reset(f);
writeln('zapisano v file');
while not EoF(f) do
begin
readln(f,x);
writeln(x);
end;
close(f);
readln;
end.

Program l4;
var i,l:integer;
A,B:array [1..6] of char;
ch,ch1:char;
procedure KL(var M:array of char; var k1:char);
var i,n,c,t:integer;
k:char;
begin
c:=0;
for t:=0 to 5 do
begin
k:=M[t];
n:=0;
for i:=0 to 5 do
begin
if k=M[i] then n:=n+1;
end;
if c<n then
begin
c:=n;
k1:=k;
end;
end;
end;
begin
writeln('vvedite massiv A ');
for i:=1 to 6 do
readln(A[i]);
writeln('vvedite massiv B ');
for i:=1 to 6 do
readln(B[i]);
Kl(A,ch); KL(B,ch1);
for i:=1 to 6 do
begin
if A[i]=ch then A[i]:=ch1;
if B[i]=ch1 then B[i]:=ch;
end;
for i:=1 to 6 do
begin
writeln;
write(A[i]); write(' '); writeln(B[i]);
end;
readln;
end.

program b3;
var a:array [1..5,1..5] of integer;
i, n, z, j, q:integer;
begin
q:=0;
writeln ('vvesti n');
readln (n);
writeln ('vvesti massiv a');
for i:=1 to n do
for j:=1 to n do
readln (a[i,j]);
for j:=1 to n do
begin
z:=0;
for i:=1 to n do
begin
if a[i,j]<>0 then z:=z+1 ;
if z=n then q:=1;
end;
end;
writeln;
if q=1 then writeln ('est') else writeln ('net');
readln;
end.

Сайт создан в системе uCoz