Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ удаление столбца матрицы, и сортировка 1 строки.

Автор: HUNTER77 25.03.2011 23:27

uses crt;
const
n=3;m=3;
var
a:array[1..n , 1..m] of byte;
i,j,max,imax,jmax:byte;
begin
for i:=1 to n do
for j:=1 to m do     begin
writeln('a[',i,j,']'); readln(a[i,j]);
end;     writeln;
imax:=1;jmax:=1;
max:=a[imax,jmax];

 max:=a[1,1];
    For i:=1 to n do begin
For j:=1 to m do          begin
 If max< a[i,j] then
  max:=a[i,j]         end     end;
   imax:=1; jmax:=1;
    for i:=1 to n do
     for j:=1 to m do
if a[i,j] > a[imax,jmax] then begin
 imax:= i;
  jmax:= j end;
  writeln;
  for i:=1 to n do   begin
for j:=1 to m do
write(a[i,j], '  '); writeln; end;
writeln;
write(max);                   read;    end.

необходимо:удалить столбец содержащий максимальный элемент матрицы,(это я пытался сделать...но ничего не вышло,мои попытки:

 For i:=imax to n do
For j:=1 to n do
a[i,j]:=a[i+1,j];

For i:=1 to n do
For j:=jmax to n do
a[i,j]:=a[i,j+1];
,,,,,,,,

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

for j:=jmax to n-1 do
 for i:=1 to n do
  a[i,j]:=a[i,j+1];

,,,,,,,,,,,,,,,,,,,,,,,,,,,
  for i:=1 to n do   begin
for j:=1 to m do
write(a[i,j], '  '); writeln; end;
writeln;
write(max);                   read;    end.

                          for i := 1 to N do
                        for j := jmax to m - 1 do

    a[i, j] := a[i, j + 1];
Dec(i,M);

нечетные отрицательные элементы элементы первой строки расположить по убыванию,,на этот счет вообще нет никаких мыслей.
кто может прошу помочь!

Автор: volvo 25.03.2011 23:35

Цитата

Поиск может помочь, я лично выкладывал решение такого задания.

P.S. В следующий раз пользуйся тегами CODE, без них код абсолютно нечитаемый...
Да и с ними не очень, если честно. Форматированием кода тоже займись. Для этого даже выкладывалась специальная утилитка: http://forum.pascal.net.ru/index.php?showtopic=26376

Автор: DarkWishmaster 26.03.2011 18:31

Вот похожая програма, удаляет одну колону и одну линию так чтобы сума всех чисел из матрицы была максимальной, может поможет:


Program P1; Uses Crt;
const Nmax=50;
type matrice=array[1..Nmax,1..Nmax] of integer;
var a,b:matrice;   m,n,x,y,max,flag,i,j,aux:integer;
     procedure Print;
       var i,j:integer;
       begin
        for i:=1 to n do       begin
         for j:=1 to m do begin
           write(a[i,j],' '); end; writeln; end; end;

function Suma:integer;
     var x,y,S:integer;
     begin
       S:=0;
        for x:=1 to n do
        for y:=1 to m do
          if (x<>i) and (y<>j) then S:=a[x,y]+S;
        Suma:=S;
    end;

Begin ClrsCr;
 read(n,m);
  for i:=1 to n do
   for j:=1 to m do
    a[i,j]:=random(9)+1;
Print;
 for i:=1 to n do
  for j:=1 to m do
    if Suma>max then begin
     max:=suma; x:=i; y:=j;  end;
 for i:=1 to n do       begin
  for j:=1 to m do begin
   if (i<>x) and (j<>y) then write(a[i,j],' '); end;
   writeln; end;  writeln(max);
 readln;
 readln;
 end.

Только я тут не удаляю, а просто пропускаю элементы линии и колоны которые должны быть удалены.
Просто если удалят то надо сместить всю матрицу в одну сторону. Так быстрее

Зачем столько циклов:


  max:=a[1,1]; 
  for i:=1 to n 
      for j:=1 to m do 
      if a[i,j]>max then begin
       max:=a[i,j]; // находим максимальный элемент
          x:=j; // запоминаем  столбец

// снова в цикл

for i:=1 to n do begin
     for j:=1 to m do begin
          if j<>x then write(a[i,j],' ');  //мы не удаляем а пропускаем элементы колоны X
  end; writeln; end;

для удаленя то


  if x<m then     // так как если макс. элемент находится в последнем столбце то сместить матрицу влево незачем.
     for i:=1 to n do
         for j:=x to m-1 do
            a[i,x]:=a[i,x+1];
        
m:=m-1;  // так как матрица короче на один столбик

В паскале не пробовал, но должно быть правильно.

Автор: DarkWishmaster 26.03.2011 18:59

...

Автор: volvo 26.03.2011 19:29

Цитата

//так как нам нужно первая строка то очевидно что нужен только один цикл

Давай договоримся, ты сначала будешь проверять решения, и только потом - из публиковать. То, что ты привел задачу не решает. Как был массив:

const
  m = 10;
  a : array[1 .. 1, 1 .. m] of integer =
  ((1, 2, 3, -1, -5, 6, 7, -3, -4, 10));

, так после "сортировки" и остался:

Running "f:\programs\pascal\eee.exe "
   1   2   3  -1  -5   6   7  -3  -4  10

И где тут сортировка отрицательных элементов? Ответ должен быть таким:
1 2 3 -1 -3 6 7 -5 -4 10
(то есть, все отрицательные нечетные сортируются по убыванию, все остальные - на своих местах!!!). Повторяю: поиск и еще раз поиск, задача решалась. Неоднократно.

Автор: DarkWishmaster 26.03.2011 19:41

Цитата(volvo @ 26.03.2011 16:29)

const
  m = 10;
  a : array[1 .. 1, 1 .. m] of integer =
  ((1, 2, 3, -1, -5, 6, 7, -3, -4, 10));

, так после "сортировки" и остался:

Running "f:\programs\pascal\eee.exe "
   1   2   3  -1  -5   6   7  -3  -4  10

Прошу прощения. Надеюсь это лучше:

 
 function Control(x:integer):boolean;
     begin
       if (a[1,x]<0) and (a[1,x] mod 2<>0) then Control:=True
         else Control:=False;
       end;

 
   for j:=1 to m do
        if control(j)=True then begin
           for x:=j to n-1 do
            if Control(x)=True then
             if a[1,x]>a[1,j] then begin
               aux:=a[1,x]; a[1,x]:=a[1,j]; a[1,j]:=aux;
                end;
            end;

Автор: HUNTER77 26.03.2011 20:20

столбец удалил..
теперь надо сортировать

Код

uses crt;
var a:array[1..20,1..20]of integer;
    n,m,i,j,max,jmax:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
write('m=');readln(m);
writeln('Ishodnaia matrica:');
for i:=1 to n do
   begin
     for j:=1 to m do
        begin
          a[i,j]:=random(20);
          write(a[i,j]:4);
        end;
     writeln;
   end;
readln;
max:=a[1,1];jmax:=1;
for i:=1 to n do
for j:=1 to m do
if a[i,j]>=max then
    begin
      max:=a[i,j];
      jmax:=j;
    end;
writeln('max element=',max,' v stlbce ',jmax);
writeln;
writeln('Rezultat:');
for j:=jmax to m-1 do
for i:=1 to n do
  begin
    a[i,j]:=a[i,j+1];
  end;
for i:=1 to n do
   begin
    for j:=1 to m-1 do
    write(a[i,j]:4);
    writeln;
  end;
readln
end.

Автор: volvo 27.03.2011 14:49

Ну, раз удалил - то теперь сортируй:

{ Доп. функции для реализации сортировки: }
function Check (i : integer) : boolean;
begin
   Check := (a[1, i] < 0) and odd (abs (a[1, i]));
end;
function prev (i : integer) : integer;
begin
  while (i > 0) and not Check (i) do dec (i);
  prev := i;
end;

{ Сама сортировка первой строки матрицы: }
  for i := 1 to m - 1 do
    for j := m - 1 downto i + 1 do
    begin
      { Переменные pv и T надо будет добавить в Var }
      pv := prev (pred(j)); if pv = 0 then continue;

      if Check (j) and (a[1, pv] < a[1, j]) then
      begin
        T := a[1, pv]; a[1, pv] := a[1, j]; a[1, j] := T
      end
    end;

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

Сразу говорю: без функций можно, но я этого делать не буду. Дублировать код и писать километровые условия там, где этого можно избежать - оно мне не сдалось. Нужно - извращайся. Мне оно не надо.

P.S. Ты в курсе, что вот таким способом (через random(20)) ты не получишь отрицательных элементов, да?

Автор: HUNTER77 27.03.2011 14:56

да..я переделал

Добавлено через 16 мин.
спасибо!!

Автор: HUNTER77 27.03.2011 17:26

ты проверял сортировку?

Автор: volvo 27.03.2011 17:32

Свою - проверял. Было:
(-11, 2, 3, -1, -5, 6, 7, -3, -4, 10)
стало:
-1 2 3 -3 -5 6 7 -11 -4 10
, как видишь, все отрицательные нечетные отсортированы. Остальные остались там же, где и были. А что?

Автор: HUNTER77 27.03.2011 18:05

значит у меня паскаль глючный.
спасибо))

Автор: volvo 27.03.2011 18:56

Цитата

значит у меня паскаль глючный.

Возможно. Скачай http://freepascal.org/