Помощь - Поиск - Пользователи - Календарь
Полная версия: Сортировка двохвымерных массивов
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
ifconfig
Задача.
Есть двохвымерный массив 3х3. отсортировать элементы массива, сума индексов которая парная методом пузырька по спаданию, а у которых непарная - методом вставки по возростанию.

я ее пытался сделать но у меня она не работает..
Вот текст программы, если что-то не так исправьте пожалуйста.

uses
crt;
var
mas: array [1..3,1..3] of real;
i,j,k:integer;
r:real;
f:boolean;
begin
clrscr;
writeln ('Введите элементы массива');
for i:=1 to 3 do
for j:=1 to 3 do
begin
write('mas[',i,',',j,']=');
read(mas[i,j]);
end;
writeln ('Масив до изменений');
for i:=1 to 3 do begin
for j:=1 to 3 do
write (mas[i,j]:5:2,' ');
writeln;
end;
for i:=1 to 3 do
for j:=1 to 3 do
if (i+j) mod 2 =0 then
begin
k:=0;
repeat
f:=false;
for i:=1 to 3-k do
if mas[i,j]<mas[i+1,j+1] then begin
r:=mas[i,j];
mas[i,j]:=mas[i+1,j+1];
mas[i+1,j+1]:=r;
f:=true;
end;
k:=k+1;
until f=false;
if (i+j) mod 2 <> 0 then
begin
k:=1;
while (i>1) and (mas[i,j] > mas[i-1,j-1]) do
begin
mas [i-1,j-1]:=r;
k:=k-1;
r:=mas[i,j];
mas[i,j]:=mas[i-1,j-1];
end;
end;
end;
writeln ('Массив после изменений');
writeln;
for i:=1 to 3 do begin
for j:=1 to 3 do
write (mas[i,j]:7:2,' ');
writeln;
end;
readkey;
end.
volvo
ifconfig, ну, смотри, ты сам хотел smile.gif

Прежде чем говорить, что это не работает - перечитай задание, убедись что ты его понял, и проверь на листе бумаги, каким ДОЛЖЕН быть результат.

procedure sort(var ar: array of real;
row_size, col_size: integer);

var where: boolean;

function index(i_col, i_row: integer): integer;
begin
index := pred(i_col) * row_size + pred(i_row);
end;

procedure get_pred(curr_ix: integer; var ip_col, ip_row: integer);
var
i, j: integer;
save_col, save_row: integer;
c_ix: integer;
begin
ip_col := -1; ip_row := -1;
for i := 1 to col_size do begin
for j := 1 to row_size do begin

if odd(i + j) = where then begin
c_ix := index(i, j);
if c_ix < curr_ix then begin
save_col := i; save_row := j;
end
else
if c_ix = curr_ix then begin
ip_col := save_col; ip_row := save_row;
end;
end;

end;
end;
end;

var
j, prev_ix: integer;
T: real;
i_col, i_row: integer;
pi, pj: integer;
begin
for where := false to true do begin

for i_col := 1 to col_size do
for i_row := 1 to row_size do

if odd(i_col + i_row) = where then
for j := pred(col_size * row_size) downto index(i_col, i_row) + 1 do begin
get_pred(j, pi, pj);
if (pi > 0) and (pj > 0) then begin

prev_ix := index(pi, pj);
if (ar[prev_ix] > ar[j]) = where then begin
T := ar[prev_ix]; ar[prev_ix] := ar[j]; ar[j] := T
end

end;
end;

end;
end;

{ Вызывать вот так: }
const
size = 3;
arr: array[1 .. size, 1 .. size] of real = (
(10, 20, 30),
(4, 5, 6),
(7, 8, 9)
);

var
i, j: integer;

begin
sort(arr[1], 3, 3);

for i := 1 to 3 do begin
for j := 1 to 3 do write(arr[i, j]:7:2);
writeln;
end;
writeln;
end.

ifconfig
volvo можно же ее сделать проще. не используя функции и процедуры. просто то что я написал нужно немного подредактировать. (Просто нельзя использовать никаких ни функций ни процедур)
volvo
Цитата
можно же ее сделать проще. не используя функции и процедуры
Можешь - делай, я посмотрю... Я не телепат (ну надоело уже мне это повторять!!!), чтобы ДОГАДАТЬСЯ что тебе нельзя использовать, а что - можно, понимаешь? Не телепат!
ifconfig
Цитата(volvo @ 25.03.2008 19:43) *

Можешь - делай, я посмотрю...

так я и сделал
и код выложил.
но она ничего не хочет делать.
тоесть я ввожу масив а на выводе получаю тот же самый
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.