IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Сортировка двохвымерных массивов
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3
Пол: Мужской
Реальное имя: Жека

Репутация: -  0  +


Задача.
Есть двохвымерный массив 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






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.

 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 13.09.2025 1:23
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name