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.

 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


volvo можно же ее сделать проще. не используя функции и процедуры. просто то что я написал нужно немного подредактировать. (Просто нельзя использовать никаких ни функций ни процедур)

Сообщение отредактировано: ifconfig -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
можно же ее сделать проще. не используя функции и процедуры
Можешь - делай, я посмотрю... Я не телепат (ну надоело уже мне это повторять!!!), чтобы ДОГАДАТЬСЯ что тебе нельзя использовать, а что - можно, понимаешь? Не телепат!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





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

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


Цитата(volvo @ 25.03.2008 19:43) *

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

так я и сделал
и код выложил.
но она ничего не хочет делать.
тоесть я ввожу масив а на выводе получаю тот же самый
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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