Двухмерный массивы

[lilia2121]

Помогите с задачками люди добрые. уж что-то совсем не поняла..
1)Определить по три наибольших элемента в каждом столбце матрицы А(6,6). И записать их последовательно в одномерный массив В.
Массив В отпечатать
2)Дана матрица А(6,6) Найти число столбцов, в которых положительных элементов больше чем отрицательных. Если таких столбцов больше трёх, заменить все отриц. элементы матрицы на заданное значение Р

[Grag]

Pascal.
Обращайся, сделаю... недорого... договоримся...
Контакты:
e-mail: skiper@rol.ru
icq: 585281783
Skype: delmas61

[lilia2121]

ну совсем денег нет..

[Dizistar]

Попробуй такой вариат, я не мастер мог ошибиться.
Ну и может кто лучше что предложет... Если что не понятно спроси.
Readln поставил для задержки чтобы посмотреть результат там 2 раза
вывод и задержку можешь убрать.

uses crt;
 type mass=array[1..6] of byte;

var a:array[1..6,1..6] of byte;
       b:mass;
     i, j:byte;

 procedure Sortir(var b:mass);  {сортировка массива}
 Var n,t,tempr, m: byte;
BEGIN
 for n:=1 to 5 do
 begin
M := n;
For t := i + 1 to 6 do IF b[t] >= b[m] Then m := t;  {если последующий элемент больше чем элемент текущий}
tempr := b[n]; b[n] := b[m]; b[m] := tempr; {всё останеться на местах если не больше иначе меняются местами}
End;
 END;

 procedure DobEl(s: byte; var b:mass);   {Добавляем элемент в массив B}
 begin
IF s >= b[6] then begin b[6] := s; Sortir(b);end; {И сортируем}
end;

begin
clrscr;
{задаем матрицу 6 на 6 рандомно для примера, в условиях не указано как задавать.}
randomize;
for i:=1 to 6 do
 begin
 b[i]:= 0; {обнуляем массив b заодно}
  for j:=1 to 6 do
   begin
    a[i,j]:=random(255);
   write(a[i,j]:6);
   end;
   end;
 readln;

{теперь сама программа }
  for i:=1 to 5 do
 begin
  for j:=1 to 5 do
   begin
 If a[i,j] < a[i+1,j] then DobEl(a[i+1,j],b);
 If a[i,j] < a[i,j+1] then DobEl(a[i,j+1],b);
end;
 end;

 Writeln('----- ------');
 for i:=1 to 5 do Writeln(b[i]);
 readln;
 End.

[Dizistar]

Ну это типа первый вариант... твоего вопроса, если что переменные массива можно изменить на integer.

[Dizistar]

Cтоп! Я чегото не то намудрил... Там же 18 элементов а не 6 получиться...
Начало можно так переделать...

uses crt;
 type mass=array[1..18] of integer;

var a:array[1..6,1..6] of integer;
       b:mass;
     i, j:byte;

{ сортировка вроде норм вариант}

 procedure Sortir(var b:mass);  {сортировка массива}
 Var n,t, m: byte;
 tempr: integer;

BEGIN
 for n:=1 to 17 do
 begin
M := n;
For t := i + 1 to 18 do IF b[t] >= b[m] Then m := t;  
tempr := b[n]; b[n] := b[m]; b[m] := tempr; 
End;
 END;

И в общем надо подумать... ты тоже подключай мозги :-) или ты ждешь когда тебе готовую прогу дадут? ))

[Dizistar]

Вот что-то типа этого:

 uses crt;
 type mass=array[1..18] of integer;
         matrix=array[1..6,1..6] of integer;

var a:matrix;
       b:mass;
    e, i, j:byte;

 procedure Sortir(s: byte; a:matrix; var b:mass);
{сортируем столбец в массиве отдельно и записываем 3 наибольших значения в b массив}
 Var n,t, m: byte;
tempr: integer;
BEGIN
 for n:=1 to 5 do
 begin
m := n;
For t := n + 1 to 6 do IF a[t,s] >= a[m,s] Then m := t;
tempr := a[n,s]; a[n,s] := a[m,s]; a[m,s] := tempr;
 End;
  {Теперь просто переписываем в B массив первые три из столбца}

 t:=s;  if s <> 1 then begin t := (s * 3);  For m := 1 to 3 do b[m+t] := a[m,s]; end
 Else begin For m := 1 to 3 do b[m] := a[m,s]; end;
 END;

 begin
clrscr;
{ тут рандомная матрица... }
randomize;
for i:=1 to 6 do
 begin
   for j:=1 to 6 do
   begin
    a[i,j]:=random(255);
   write(a[i,j]:6);
   end;
   end;

 readln; { это можно стереть также и вывод масиива...}

 for i:=1 to 18 do b[i]:= 0; {обнуляем массив b }


  for j:=1 to 6 do Sortir(j, a, b);

 Writeln('----- ------');
 for i:=1 to 18 do Write(b[i]:4);
 readln;
 End.

Но возможны ошибки и может можно лучше сделать чем я намудрил.

[lilia2121]

большое спасибо, как же я без вас

[mifomen]

2 задача

program matr;
uses crt;
var a:array [1..6,1..6] of integer;
    h,p,l,k,i,j:integer;

begin clrscr;randomize;

for i:=1 to 6 do begin
 for j:=1 to 6 do begin
  a[i,j]:=random(30)-4; write(a[i,j]:4); end; writeln; end;
   h:=0;
  for j:=1 to 6 do begin k:=0;l:=0;
   for i:=1 to 6 do begin
    if a[i,j]<0 then inc(k) else inc(l); end;
    if k<l then inc(h);
    write('-',k,' +',l); end;
    writeln;writeln(h);

    if h>3 then begin readln(p);
     for i:=1 to 6 do begin
      for j:=1 to 6 do
        if a[i,j]<0 then a[i,j]:=p;end;end
             else writeln('Stoblcov <3 ');

        for i:=1 to 6 do begin
         for j:=1 to 6 do
         write(a[i,j]:4); writeln; end;
readkey
end.

[mifomen]

1 задача.
Выводил несколько раз, только из-за проверки. Можешь подредактровать и исправить.)

program quest_one;
uses crt;
var a:array [1..6,1..6] of integer;
    b:array [1..18] of integer;
    k,t,d,i,j:integer;
begin clrscr;randomize;
    for i:=1 to 6 do begin
     for j:=1 to 6 do begin
      a[i,j]:=random(30)-15; write(a[i,j]:4); end; writeln; end;
     writeln;writeln;
      for j:=1 to 6 do
       for i:=1 to 5 do
        for d:=i+1 to 6 do begin
        if a[d,j]<a[i,j] then begin
                               t:=a[d,j];
                               a[d,j]:=a[i,j];
                               a[i,j]:=t;
                              end;
                           end;
       for i:=1 to 6 do begin
     for j:=1 to 6 do
      write(a[i,j]:4);  writeln; end;
    writeln;writeln;
     k:=1;
       for i:=4 to 6 do begin
      for j:=1 to 6 do
      write(a[i,j]:4); writeln; end;

     for i:=4 to 6 do
      for j:=1 to 6 do begin
       b[k]:=a[i,j]; inc(k);end;
        writeln;
       for k:=1 to 18 do
       write(b[k],' ');

readkey
end.