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

Автор: RIDDICK 11.04.2005 22:32

Дана матрица Х[9,10]. Упорядочить элементы столбцов матрицы по возрастанию, а сами столбцы по возрастанию произведения четных элементов столбцов (использовать сортировку ”пузырек с флажком”).



помогите пожалуйста реализовать в Pascal ...

Автор: klem4 11.04.2005 22:36

goto FAQ http://forum.pascal.net.ru/index.php?showtopic=3065

http://forum.pascal.net.ru/index.php?showtopic=3065&view=findpost&p=34991


http://forum.pascal.net.ru/index.php?showtopic=2694

Автор: volvo 11.04.2005 22:37

А что именно не получается? Не может же быть, что ВСЁ ...

Автор: RIDDICK 11.04.2005 22:55

пузырек с флажком - это че ?

Автор: klem4 11.04.2005 22:57

а кто его знает :D может это есть пузырек с просеиванием ? я ссылку дал.

Автор: RIDDICK 11.04.2005 22:58

"столбцы по возрастанию произведения четных элементов столбцов " - не понял

Автор: klem4 11.04.2005 23:02

нужно посчитать произведение ЧЕТНЫХ элементов в столбце
те
1 2
2 3
3 5
5 1
6 7
7 2

1)2*6=12
2)2*2=4
не упорядочены -> меняешь местами

2 1
3 2
5 3
1 5
7 6
2 7

Автор: RIDDICK 16.04.2005 18:24

так, я сделал сортировку элементов столбца по возрастанию... а как теперь сделать сортировку столбцов " по возрастанию произведения четных элементов столбцов " ?

Uses
 crt;

const
 NN = 9;
 MM = 10;

Type
  Matrix =
   array [1..NN, 1..MM] of Integer;

var
 A : Matrix;

(* заполнение массива случайными элементами *)
Procedure RandMatr (var tmp: Matrix; r: integer);
Var
 n,m : word;
begin
 randomize;
 For n:=1 to NN do
   For m:=1 to MM do
     tmp[n,m]:=random®
end;

(* вывод массива *)
Procedure PrintMatr (var tmp: Matrix);
Var
 n,m : word;
begin
For n:=1 to NN do
  begin
  For m:=1 to MM do
    write(tmp[n,m]:2,'  ');
    writeln
  end
end;

(* сортировка *)
Procedure BubbleMatr (var tmp: Matrix);
var
    i,j,t,m :word;
    flagsort:boolean;

begin
  for m:= 1 to MM do
  begin
    repeat
      flagsort:=true;
      for i:=1 to NN-1 do
       if (tmp[i,m]>tmp[i+1,m]) then
        begin
           t:=tmp[i,m];
           tmp[i,m]:=tmp[i+1,m];
           tmp[i+1,m]:=t;
           j:=i;

           while (j>1)and (tmp[j-1,m]>tmp[j,m]) do
            begin
               t:=tmp[j,m];
               tmp[j,m]:=tmp[j-1,m];
               tmp[j-1,m]:=t;
               dec(j);
            end;
            flagsort:=false
        end;
   until flagsort
 end
end;

(* основная программа *)
begin
 Clrscr;
 RandMatr (A, 50);
 PrintMatr (A);
 writeln;
 BubbleMatr (A);
 PrintMatr (A);
 Readkey
end.

Автор: volvo 16.04.2005 18:41

Читай пост №7, klem4 написал, что надо сделать...
Допустим, есть матрица:

запоминаешь произведения четных элементов для КАЖДОГО столбца в отдельном массиве (в приведенном примере массив будет таким: <2, 48, 4, 192>), вводишь индексный массив (изначально <1, 2, 3, 4>), и сортируешь тот массив, который содержит произведения, параллельно с этим ТОЧНО так же переставляя и соответствующие элементы индексного массива. В результате получаешь, что массив произведений равен <2, 4, 48, 192>, а индексный = <1, 3, 2, 4>, то есть, чтобы матрица была отсортирована, столбцы должны располагаться именно в таком порядке...

Все, что останется - только поменять нужные столбцы местами (для этого можно воспользоваться советом, приведенным здесь: http://forum.pascal.net.ru/index.php?showtopic=2694&view=findpost&p=38100, будет НАМНОГО легче реализовать обмен столбцов...)

Автор: RIDDICK 16.04.2005 18:44

блин как найти четные элементы я не понял ) функция какая ?

Автор: volvo 16.04.2005 18:49

Odd(x) = True - значит элемент НЕчетный, в противном случае - четный...
Ну, или по-старинке:

if x mod 2 = 0 then {четный} else {нечетный}

:P

Автор: RIDDICK 16.04.2005 18:50

да, спасиб, я уже туплю совсем ))

Автор: -Smoke- 28.12.2006 19:09

Ммм.. Вот это пузырёк с флажком если кому то надо чёткий исходик.
Написал сам по теории, по мне этот проще чем указаный раньше.
Тип (Type Xmas = Array[1 .. n] Of Integer;) для этого случая.

Procedure Swap(var a,b: integer);
var tmp: integer;
begin tmp:=a; a:=b; b:=tmp end;

Procedure Bubble_flag(Var a: xmas; n: Integer);
Var i,j: integer; F: boolean;
Begin
     i:=2;
     F:=True;
while (i<=N) and F do
      begin
      F:=False;
      J:=n;
      while j>=i do
           begin
           if a[j-1]>a[j] then
              begin
              Swap(a[j-1],a[j]);
              f:=True;
              end;
           dec(j);
           end;
      inc(i);
      end;
End;

Автор: klem4 29.12.2006 1:16

1) Некрофилия это плохо
2) В Паскале есть цикл for
3)

Это выглядит так:

repeat
  flag := true;
  for i := 1 to n - 1 do
   if not (x[i] <= x[i + 1]) then begin
   T := x[i]; x[i] := x[i + 1]; x[i + 1] := T; flag := false;
   end;
until flag;