Массивы

[hewlett]

1. В одномерном массиве все отрицательные элементы переместить в начало массива, а остальные в конец с сохранением порядка следования.
2. Дана действительная матрица размера n x m. Получите b1,b2,...bn, где bi это значение ближайшего к единице элемента i-й строки (если таких элементов нет, то bi=0).
3. Даны описания:
type vector = array [1..20] of integer;
matrix = array [1..20] of vector;
var x: vector; A: matrix;
Написать программу, которая нечетные столбцы матрицы заменяет на x.

[Google2010]

553566179.стучи.сделаю.

[Филантроп]

(******************************************************************************
 *все отрицательные элементы маcсива переместить в начало, а остальные в конец*
 *                с сохранением порядка следования Pascal                     *
 ******************************************************************************)
program  massiv;
uses crt;
type Tv = array [1..100] of integer;
var i,n,k:integer;
 a:Tv;
 procedure inMas(var m:Tv;var r:integer;p:integer;el:integer);
 var i:integer;
 begin
  r:=r+1;
  for I := r downto p+1 do
    m[i]:=m[i-1];
  m[p]:=el;
 end;
 procedure delMas(var m:Tv;var r:integer;p:integer);
 var i:integer;
 begin
  for I := p to r-1 do
    m[i]:=m[i+1];
  r:=r-1;
 end;
 begin
  randomize;
 k:=1;
 writeln('n=');
 Readln(n);
  for I := 1 to n  do begin
    a[i]:=random(20)-10;
  write (a[i]:5);
  end;
  for I := 1 to n  do
      if a[i]<0 then begin
        inmas(a,n,k,a[i]);
        delmas(a,n,i+1);
        inc(k);
      end;
    writeln ;
    for I := 1 to n  do begin
  write (a[i]:5);
  end;
  readln;
end.

(******************************************************************************
 *        Получить массив содержащий ближайшие к 1 элементы i-строки          *
 *                           матрицы Pascal                                   *
 ******************************************************************************)
program matrix;
uses crt;
var i,j,n,m,k:integer;
 a:array[1..100,1..100] of real;
 b:array[1..100] of real;
 begin
  randomize;
  writeln('n=');
  Readln(n);
  writeln('m=');
  Readln(m);
  
  m:=10;n:=10;
  for I := 1 to n  do begin
  for j := 1 to 10 do begin
  a[i,j]:=random(2)+random(100)/100;
  write (a[i,j]:5:2);
  end;
  writeln;
  end;
  for I := 1 to n  do  begin
  k:=1;
      for j := 1 to 10 do begin
        if abs(a[i,j]-1)<abs(a[i,k]-1) then k:=j;

      end;
    b[i]:=a[i,k];
    end;
    writeln ;
    for I := 1 to n  do begin
  write (b[i]:6:2);
  end;
  readln;
end.

(******************************************************************************
 *    Заменить элементы нечетные строки матрицы А элементами вектора Х        *
 *          соответствующими элементами вектора Х Pascal                      *
 ******************************************************************************)

program Mat_vect;
uses crt;
type vector=array[1..20] of integer;
type matrix=array[1..20] of vector;
var i,j:integer;
a:matrix;x:vector;
begin
randomize;
for i:=1 to 20 do begin
for j:=1 to 20 do begin
a[i,j]:=random(20)+1;
write(a[i,j]:3);
end;
Writeln;
end;
writeln;
for j:=1 to 20  do begin
x[j]:=random(20)+1;
write(x[i]:3);
end;
writeln;
writeln;
i:=1;
while i<=19 do begin
for j:=1 to 20 do
a[i,j]:=x[j];
inc(i,2);
end;
for i:=1 to 20 do begin
for j:=1 to 20  do begin
write(a[i,j]:3);
end;
Writeln;
end;
readln;
end.