четверг, 12 сентября 2013 г.

Определение седловой точки матрицы pascal

const n=3;
type mas=array[1..n,1..n] of integer;

procedure Vvod(var v:mas);
var i,j:integer;
begin
for j:=1 to n do
for i:=1 to n do
v[i,j]:=random(100)-50;
end;

procedure Vyvod(var v:mas);
var i,j:integer;
begin
for j:=1 to n do begin
for i:=1 to n do begin
write(v[i,j]:4);
end;
writeln;
end;
writeln;
writeln;
end;

procedure sil(var a:mas);
var f, i, j, x, strmin, r, k :integer;
begin
i:=1;
f:=0;
while (i<=n)and(f=0) do
begin
strmin:=a[i,1];
j:=2; x:=1;
while (j<=n)and(f=0) do
begin
if a[i,j]<strmin then begin strmin:=a[i,j]; x:=j; end;
inc(j);
end;
r:=0; k:=1;
while (k<=n)and(r=0) do begin
if a[k,x]>strmin then r:=1;
inc(k);
end;
if r=0 then begin writeln ('seldowaja tochta: a[',x,';',i,']=',strmin); f:=1; end;
inc(i);
end;

if f=0 then writeln('sedlowyh tochek net!');





end;

var a,b:mas;
begin
Vvod(a);
Vyvod(a);
sil(a);
end.

четверг, 5 сентября 2013 г.

Сортировка пузырьком

Const n=6;
type mas=array[1..n] of integer;
Var a:mas; l:integer;

procedure puzyr(var x:mas);
Var v,i,j:integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do if x[j] < x[j+1] then
begin
v:=x[j+1];
x[j+1]:=x[j];
x[j]:=v;
end;
end;

Сдвиг столбцов матрицы на заданную позицию влево

const n=5;
m=4;
type mas=array[1..n,1..m] of integer;

procedure Vvod(var v:mas);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to m do
v[i,j]:=random(100)-50;
end;

procedure Vyvod(var v:mas);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do begin
write(v[i,j]:4);
end;
writeln;
end;
writeln;
end;

procedure Sdvigstrochka(var a:mas;k:integer);
var i,j,x:integer;
begin

for i:=1 to n do
begin
x:=a[i,1];
for j:=1 to m-1 do
begin
a[i,j]:=a[i,j+1];
end;
a[i,m]:=x;
end;
writeln('Rezultat:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:4);
writeln;
end;

end;



var a,b:mas;
begin
Vvod(a);
Vyvod(a);
Sdvigstrochka(a,1);
end.

Сдвиг элементов массива на один влево

const n=5;
type mas=array[1..n] of integer;

procedure Vvod(var v:mas);
var i:integer;
begin
for i:=1 to n do
v[i]:=random(100)-50;
end;

procedure Vyvod(var v:mas);
var i:integer;
begin
for i:=1 to n do
write(v[i]:4);
writeln;
writeln;
end;

procedure Sdvig(var v:mas;k:integer);
var i,j,bf:integer;
begin

for j:=1 to k do
begin
bf:=v[1];
for i:=1 to n-1 do
v[i]:=v[i+1];
v[n]:=bf;
end;

end;

var a,b:mas;
begin
Vvod(a);
Vyvod(a);
b:=a;
Sdvig(b,1);
Vyvod(b);
b:=a;

end.

Смена элементов главной и побочной диагонали в матрице

const n=5;
type mas=array[1..n,1..n] of integer;

procedure Vvod(var v:mas);
var i,j:integer;
begin
for j:=1 to n do
for i:=1 to n do
v[i,j]:=random(100)-50;
end;

procedure Vyvod(var v:mas);
var i,j:integer;
begin
for j:=1 to n do begin
for i:=1 to n do begin
write(v[i,j]:4);
end;
writeln;
end;
writeln;
writeln;
end;

procedure Smena(var v:mas);
var i,j,buf:integer;
begin
for i:=1 to n do begin
buf:=v[i,i];
v[i,i]:=v[i,n+1-i];
v[i,n+1-i]:=buf;

end;

for j:=1 to n do begin
for i:=1 to n do begin
write(v[i,j]:4);
end;
writeln;
end;


end;

var a,b:mas;
begin
Vvod(a);
Vyvod(a);
Smena(a);
end.