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

var
mas:array [1..20] of integer;
i,n,k:byte;

function GetMin (i1,i2:integer):integer;
var
j,min,jmin:integer;
begin
min:=mas[i1];
jmin:=i1;
for j:=i1+1 to i2 do
if mas[j]<min then begin
min:=mas[j];
jmin:=j;
end;
GetMin:=jmin;
end;

procedure change (i1,i2:integer);
var
i,t:integer;
begin
for i:=1 to n do
begin
t:=mas[i1];
mas[i1]:=mas[i2];
mas[i2]:=t;
end;
end;

begin
writeln('::: Sortirovka po neubivaniyu metodom vibora :::');
write('Vvedite kol-vo elementov v massive ');read(n);
writeln('Ishodniy massiv:');
randomize;
for i:=1 to n do
begin
mas[i]:=random(10)-10;
write(mas[i],' ');
end;
writeln;

for i:=1 to n-1 do
begin
k:=GetMin(i,n);
if (k<>i) and ((mas[k] mod 2)<>0) then
change(k,i);
end;

writeln('Otsortirovanniy massiv:');
for i:=1 to n do
write(mas[i],' ');
end.
Tribunal
вооот...алгоритм сортировки по-другому соорудила...
только всё равно не работает=(((

  {сортируем нечетные элементы массива}
i:=1;
repeat
m:=mas[i];
k:=i; j:=i;
repeat
if m>mas[j] then begin
m:=mas[j];
k:=j;
end;
inc(j);
until j<=n;
if ((mas[k] mod 2)<>0) then begin
mas[k]:=mas[i];
mas[i]:=m;
inc(i);
end;
until i<=n;
Tribunal
=( ну в чем же ошибка?
помогите...никак не разберусь
Tribunal
нечетность теперь проверяю в другом месте....
алгоритм не работает....

i:=1;
repeat
min:=m[i];
k:=i; j:=i;
repeat
if min>m[j] then begin
min:=m[j];
k:=j;
end;
inc(j);
until j<=t;
m[k]:=m[i];
m[i]:=min;
inc(i);
until i<=t;
Romtek
Ты сначала покажи сортировку массива выборомдля всех чисел, а для нечётных добавить будет легко. По-моему, у тебя вообще не сортировка...
Tribunal
Цитата(Romtek @ 6.06.2006 19:16) *

Ты сначала покажи сортировку массива выборомдля всех чисел, а для нечётных добавить будет легко. По-моему, у тебя вообще не сортировка...

ну вот...смотрите выше....
Malice
Цитата(Tribunal @ 6.06.2006 12:15) *


until j<=t;
until i<=t;

В until ставится условие выхода из цикла, в связи с чем цикы не работают.
volvo
Tribunal,
Нет... Так не пойдет. Ты приведи ПОЛНУЮ, компилирующуюся программу, а не эти обрывки... Легче написать заново, чем заставить работать то, что ты привела...
Tribunal
Цитата(Malice @ 6.06.2006 19:20)
В until ставится условие выхода из цикла, в связи с чем цикы не работают.

какая глупая ошибка...
большое спасибо за помощь)

Цитата(volvo @ 6.06.2006 19:23)
Tribunal,
Нет... Так не пойдет. Ты приведи ПОЛНУЮ, компилирующуюся программу, а не эти обрывки... Легче написать заново, чем заставить работать то, что ты привела...

вот)...
var
mas,m:array [1..20] of integer;
i,n,k,j,t:byte;
min:integer;
begin
writeln('::: Sortirovka massiva po neubivaniyu :::');
write('Vvedite kol-vo elementov v massive do 20 :');read(n);

writeln('Ishodniy massiv:');
randomize;
for i:=1 to n do
begin
mas[i]:=random(10)-10;
write(mas[i],' ');
end;
writeln;

writeln('Massiv nechetnix chisel:');
j:=0;
for i:=1 to n do
if (mas[i] mod 2)<>0
then begin
inc(j);
m[j]:=mas[i];
write(m[j],' ');
end;
t:=j;
writeln;

i:=1;
repeat
min:=m[i];
k:=i; j:=i;
repeat
if min>m[j] then begin
min:=m[j];
k:=j;
end;
inc(j);
until j>t;
m[k]:=m[i];
m[i]:=min;
inc(i);
until i>t;


writeln('Otsortirovanniy massiv:');
for i:=1 to t do write(m[i],' ');
writeln; readln;


кстати....
у меня вопрос:как заставить затормозить выход из программы,
если readln не срабатывает?

кстати....
у меня вопрос:как затормозить выход из программы,
если readln не срабатывает?
Romtek
Теперь сортирует.
Выставь ещё readln; smile.gif

Только не пойму куда делись чётные элементы. Их в расчёт не надо брать?
volvo
Цитата
если readln не срабатывает?
Задаться вопросом "А почему он не срабатывает?" Возможно, потому, что лучше делать:
  write('Vvedite kol-vo elementov v massive do 20 :');readLN(n);

?
Tribunal
Цитата(Romtek @ 6.06.2006 19:38) *

Теперь сортирует.
Выставь ещё readln; smile.gif

Только не пойму куда делись чётные элементы. Их в расчёт не надо брать?

=)

честно говоря,даже не знаю....
в задании сказано:отсортировать по неубыванию нечетные элементы массива
Romtek
При сортировке всё равно надо их учитывать, а сортировать только *нечётные*. То есть при сравнении нужно проверять на нечётность.
volvo
Цитата(Tribunal @ 6.06.2006 12:48)
в задании сказано:отсортировать по неубыванию нечетные элементы массива

yes2.gif А четные должны остаться на местах... Вот так, например (я оставил твой вывод ТОЛЬКО нечетных элементов, чтоб было легче контролировать результаты, хотя в принципе массив M здесь вообще не нужен...)
var
mas,m:array [1..20] of integer;
i,n,k,j,t:byte;
min:integer;
begin
writeln('::: Sortirovka massiva po neubivaniyu :::');
write('Vvedite kol-vo elementov v massive do 20 :');read(n);

writeln('Ishodniy massiv:');
randomize;
for i:=1 to n do
begin
mas[i]:=random(10)-10;
write(mas[i],' ');
end;
writeln;

writeln('Massiv nechetnix chisel:');
j:=0;
for i:=1 to n do
if (mas[i] mod 2)<>0
then begin
inc(j);
m[j]:=mas[i];
write(m[j],' ');
end;
t:=j;
writeln;

i:=1;
repeat
if odd(abs(mas[i])) then begin
min:=mas[i];
k:=i; j:=i;
repeat
if odd(abs(mas[j])) and (min>mas[j]) then begin
min:=mas[j]; k:=j;
end;
inc(j);
until j>n;
mas[k]:=mas[i];
mas[i]:=min;
end;
inc(i);
until i>n;


writeln('Otsortirovanniy massiv:');
for i:=1 to n do write(mas[i],' ');
writeln; readln;
end.
Tribunal
логично)...
спасибо... smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.