На сортировку / 2 / 1 курс / 5.Алгоритм и языки программ / алгоритм шпор есеп

program n1;

uses crt;

var i,k,j,y:integer;

a:array[1..10] of integer;

begin

clrscr;

k:=0;

j:=0;

y:=0;

for i:=1 to 10 do

read(a[i]);

for i:=1 to 10 do

if a[i]<0 then k:=k+1 else

if a[i]>0 then j:=j+1 else y:=y+1;

writeln('0-den kichileri=',k);

writeln('0-den ulkender=',j);

writeln('0-ge tehder=',y);

readln;

end.

program n2;

uses crt;

var m,i,p,k:integer;

begin

clrscr;

writeln('Vvedite m chiclo');

read(m);

i:=0; k:=0;

for i:=2 to m do

begin

p:=0;

for k:=2 to i do

if i mod k=0 then p:=p+1;

if p=1 then write(i:4);

end;

read;

end.

program n3;

uses crt;

var j,s:integer;

begin

clrscr;

s:=0;

for j:=100 to 200 do

if j mod 17=0 then

s:=s+j;

writeln('s=',s:6);

read;

end.

program n4;

uses crt;

var i:integer;

s:array[1..20] of real;

begin

clrscr;

for i:=1 to 20 do

begin

s[i]:=i*2.54;

writeln('i=',i:4,'mani boladi= ',s[i]:3:2);

end;

read;

end.

program n5;

uses crt;

const n=4;

var i,j,k,l,max1,max2,max:integer;

a:array[1..n,1..n] of integer;

s1,s2:array[1..n-1] of integer;

d:text;

Procedure diag;

var i,j,k,l:integer;

begin

for k:=1 to n-1 do s1[k]:=0; s2[k]:=0;

for k:=1 to n-1 do

for i:=k+1 to n do

begin

s1[k]:=s1[k]+a[i,i-k];

s2[k]:=s2[k]+a[i-k,i];

end;

end;

BEGIN

clrscr;

assign(d,'c:\users\айкоша\desktop\pascal\matrica.txt');

reset(d);

for i:=1 to n do for j:=1 to n do

read (d,a[i,j]);

for i:=1 to n do

begin

for j:=1 to n do write (a[i,j]:4);

writeln;

end;

writeln;

diag;

for k:=n-1 downto 1 do write (s1[k]:3);

for k:=1 to n-1 do write (s2[k]:3);

writeln;

begin

for k:=1 to n-1 do max1:=s1[k];

for k:=1 to n-1 do

if s1[k]>max1 then

begin

max1:=s1[k];

end; writeln('max1=',max1);

end;

begin

for k:=1 to n-1 do max2:=s2[k];

for k:=1 to n-1 do

if s2[k]>max2 then

begin

max2:=s2[k];

end; writeln('max2=',max2);

end;

if max2<max1 then max:=max1

else max:=max2;

writeln('max=',max);

readln;

end.

program n6;

uses crt;

const m=5;

n=9;

var f:text;

a:array[1..m,1..n] of integer;

i,j,ii,mm,k,s:integer;

Function max(l:integer):integer;

var i,j,k,s,m:integer;

begin

m:=0;

for j:=1 to n do

begin

s:=1;

k:=j+1;

while (a[l,k]=a[l,j]) and (k<=n) do

begin

s:=s+1;

k:=k+1;

end;

if m<s then m:=s;

end;

max:=m;

end;

{---------------------------------}

begin

clrscr;

Assign(f,'D:\Maksat\TP7\Bin\Maksat.txt');

reset(f);

for i:=1 to m do

for j:=1 to n do read(f,a[i,j]);

for i:=1 to m do

begin

for j:=1 to n do write(a[i,j], ' '); writeln;

end;

mm:=0;

for i:=1 to m do if mm<max(i) then

begin

mm:=max(i);

ii:=i;

writeln('nomer stroki=',ii);

writeln('kolichestva odinakovyx elementov=',mm);

end;

readkey;

end.

program n7;

uses crt;

var i,k,s,m:integer;

a:array [1..10] of integer;

begin

clrscr;

for i:=1 to 10 do

read(a[i]);

m:=a[1];

for i:=2 to 10 do

if m>a[i] then

begin

m:=a[i];

k:=i;

end;

s:=0;

for k:=k+1 to 10 do

s:=s+a[k];

write('jiauabi=',s:6);

readkey;

end.

Program b8;

uses crt;

var i,k,s,m:integer;

a:array [1..10] of integer;

begin

clrscr;

for i:=1 to 10 do

read(a[i]);

m:=a[1];

for i:=2 to 10 do

if m<a[i] then

begin

m:=a[i];

k:=i;

end;

s:=0;

for k:=k+1 to 10 do

s:=s+a[k];

write('jiauabi=',s:6);

readkey;

end.

Program N9;

Uses crt;

Const n=8;

a:array [1..n] of integer=(1,2,0,3,6,5,0,2);

Var i,p,i1,i2:integer;

Begin

for i:=1 to n do

if a[i]=0 then i1:=i;

writeln('i1=',i1);

for i:=i1+1 downto 1 do

if a[i]=0 then i2:=i;

writeln('i2=',i2);

p:=1;

for i:=i2+1 to i1-1 do

p:=p*a[i];

write('p=',p);

readln;

end.

program n10;

uses crt;

const n=6;

var c:array[1..n] of integer;

k,a,b,i,d:integer;

begin

clrscr;

writeln(' vvedite a,b=');

readln(a,b);

writeln('vvedite massiv');

for i:=1 to n do read(c[i]);

k:=0;

for i:=1 to n do

if (c[i]>a) and (c[i]<b) then

begin

k:=k+1;

d:=c[k];

c[k]:=c[i];

c[i]:=d;

end;

for i:=1 to n do

if (c[i]<=a) or (c[i]>=b) then

begin

k:=k+1;

c[k]:=c[i];

end;

for k:=1 to n do

writeln(c[k]);

readln;

end.

Program n11;

Uses crt;

Const n=4; m=5;

a:array [1..n] of integer=(1,2,3,4);

b:array [1..m] of integer=(5,6,7,8,9);

Var c:array[1..n+m] of integer;

i,j,k:integer;

Begin

k:=0;

for i:=1 to n do

begin

k:=k+1;

c[k]:=a[i];

end;

for j:=1 to m do

begin

k:=k+1;

c[k]:=b[j];

end;

for k:=n+m downto 1 do

write(c[k],' ');

readln;

end.

program n12;

uses crt;

var i,j,n,k,g:integer;

begin

clrscr;

g:=0;

for n:=3 to 7 do

for i:=3 to 7 do

for j:=3 to 7 do

for k:=3 to 7 do

if (n<>i) and (j<>i) and (j<>k)

and (k<>n) and (n<>j) and (n<>k)

and (i<>k) then begin

write(n,j,k,i,' ') ;

g:=g+1; end;

write('kol=', g);

readln;

end.

program n13;

uses crt;

var a,b,c,g:integer;

begin

clrscr;

g:=0;

for a:=1 to 9 do

for b:=0 to 9 do

for c:=0 to 9 do

begin

if a+b+c=15 then begin

write(a,b,c,' ');

g:=g+1; end; end;

write('sany=', g);

readln;

end.

program n14;

uses crt;

var a,b,c:longint;

begin

clrscr;

read(c);

for a:=1 to c do

for b:=1 to c do

if a*a+b*b=c then writeln('a=',a,'b=',b);

readln;

end.

program n15;

uses crt;

var a,b,c,g,n:integer;

begin

clrscr;

n:=0;

readln(n);

for a:=2 to n do

for b:=2 to n do

for c:=2 to n do

begin

if a*b*c=n then begin

write(a,b,c,' '); end; end;

readln;

end.

16-билет 14-те

program n17;

uses crt;

var a,b,c,d,g:integer;

begin

clrscr;

g:=0;

for a:=1 to 9 do

for b:=0 to 9 do

for c:=0 to 9 do

for d:=0 to 9 do

begin

if a+b+c+d=28 then begin

write(a,b,c,d,' ');

g:=g+1; end; end;

write('sany=', g);

readln;

end.

program n18;

uses crt;

const n=8;

var a:array[1..n] of integer;

i,k,d:integer;

Begin

clrscr;

writeln(' массивті енгізініз');

for i:=1 to n do

read(a[i]);

k:=0;

for i:=1 to n do

if a[i]<>0 then

begin

k:=k+1;

d:=a[k];

a[k]:=a[i];

a[i]:=d;

end;

writeln('nol ен сонгы жазылу керек');

for i:=1 to n do

write(a[i], ' ');

readln;

END.

program n19;

uses crt;

var j,i,n,k:integer;

b:array[1..1000] of integer;

BEGIn

clrscr;

write('vvedite k=');

readln(k);

i:=1;

while k>=8 do

begin

n:=k mod 8;

k:= k div 8;

b[i]:=n;

if k<8 then

begin

inc(i);

b[i]:=k;

end;

inc(i);

end;

write('audaru');

for j:=i-1 downto 1 do

write (b[j]);

readln;

END.

program n20;

uses crt;

var s,i,n:integer;

a:array[1..1000] of integer;

BEGIn

clrscr;

write('vvedite 4islo=');

readln(s);

i:=0;

while s>=1 do

begin

i:=i+1;

a[i]:=s mod 2;

s:=s div 2;

end;

n:=i;

for i:=n downto 1 do

write (a[i]);

readln;

END.