Сортировка по неубыванию Опции

[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]

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

ну вот...смотрите выше....

[Malice]

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

В until ставится условие выхода из цикла, в связи с чем цикы не работают.

[volvo]

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

[Tribunal]

В until ставится условие выхода из цикла, в связи с чем цикы не работают.

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

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;

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

[volvo]

если readln не срабатывает?

Задаться вопросом "А почему он не срабатывает?" Возможно, потому, что лучше делать:

  write('Vvedite kol-vo elementov v massive do 20 :');readLN(n);

?

[Tribunal]

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

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

=)

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

Сообщение отредактировано: Tribunal - 6.06.2006 16:52

[Romtek]

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

[volvo]

в задании сказано:отсортировать по неубыванию нечетные элементы массива

А четные должны остаться на местах... Вот так, например (я оставил твой вывод ТОЛЬКО нечетных элементов, чтоб было легче контролировать результаты, хотя в принципе массив 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]

логично)...
спасибо...