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

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

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

> Методы сортировок. Вставка, выбор + ...
CORS@R
сообщение 18.02.2006 23:58
Сообщение #1


Новичок
*

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

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

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


uses crt;
const n=6;
var i,j,peres,k,temp,srav,otv:integer;
a: array [1..n] of integer;
procedure puzyr;
begin
    peres:=0;
    srav:=0;
    writeln('Vvedi elem mas: ');
    for i:=1 to n do
	readln(a[i]);
    for  i := 2  to n  do
	begin
	    for  j := n  downto  i  do
		begin
		    inc(srav);
		    if  a[j-1] > a[j]  then
			begin
			    temp := a[j-1];
			    a[j-1] := a[j];
			    a[j] := temp;
			    inc(peres);
			end;
		end;
	end;
    writeln('Sortirovka');
    for i:=1 to n do
	writeln(a[i]);
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    readln;
end;

procedure vstavka;
begin
    peres:=0;
    srav:=0;
    writeln('Vvedi elem mas: ');
    for i:=1 to n do
	readln(a[i]);
    for  i :=  2  to  n  do
	begin
	    temp := a [i];
	    j := i-1;
	    While  (j > 0) and (temp < a [j] )  do
		begin
		    a [j+1] := a [j];
		    j := j-1;
		    inc(peres);
		end;
	    a [j+1] := temp;
	end;
    writeln('Sortirovka');
    for i:=1 to n do
	writeln(a[i]);
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    readln;
end;

procedure vybor;
begin
    peres:=0;
    srav:=0;
    writeln('Vvedi elem mas: ');
    for i:=1 to n do
	readln(a[i]);
    for  i := 1  to  n-1  do
	begin
	    k := i;
	    temp := a [i];
	    for  j := i+1  to  n  do
		begin
		    inc(srav);
		    if  a [j] < temp  then
			begin
			    k := j;
			    temp := a [j];
			end;
		end;
	    a [k] := a [i];
	    a [i] := temp;
	end;
    writeln('Sortirovka');
    for i:=1 to n do
	writeln(a[i]);
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    readln;
end;

begin
    clrscr;
    repeat
	begin
	    writeln('1-Puzyr  2-Vstavka  3-Vybor   4-Exit ');
	    readln(otv);
	    case otv of
		1:puzyr;
		2:vstavka;
		3:vybor;
		4:end;
	end;
    until otv=4;
end.



Забыл написать что должно получиться для массива 15-33-42-07-12-19: метод вставок 12 сравнений и 8 перестановок, метод выбора 15 сравнений, 4 перестановки

Сообщение отредактировано: CORS@R - 19.02.2006 0:06
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
  Ответить  Открыть новую тему 
Ответов(1 - 8)
volvo
сообщение 19.02.2006 0:17
Сообщение #2


Гость
метод вставки - элементарно:
procedure vstavka;

  { Определяешь свою функцию сравнения... }
  function less(a, b: integer): boolean;
  begin
    inc(srav);
    less := a < b;
  end;

begin
    peres:=0;
    srav:=0;
    writeln('Vvedi elem mas: ');
    for i:=1 to n do
	readln(a[i]);
    for  i :=  2  to  n  do
	begin
	    temp := a [i];
	    j := i-1;
	    While  (j > 0) and less(temp, a[j]) do
		begin
		    a [j+1] := a [j];
		    j := j-1;
		    inc(peres);
		end;
	    a [j+1] := temp;
	end;
    writeln('Sortirovka');
    for i:=1 to n do
	writeln(a[i]);
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    readln;
end;

Сейчас гляну метод выбора...
 К началу страницы 
+ Ответить 
CORS@R
сообщение 19.02.2006 0:26
Сообщение #3


Новичок
*

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

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

За метод вставок спасибо good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
CORS@R
сообщение 19.02.2006 14:17
Сообщение #4


Новичок
*

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

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

С этим выбором ну никак не получается, получается только или 5 или 6. А должно быть 4.

	а1	а2	а3	а4	а5	а6	Выполняемые операции
шаг 1	15	33	42	07	12	19	сравнение 15 и 33, min = 15
	15	33	42	07	12	19	сравнение 15 и 42, min = 15
	15	33	42	07	12	19	сравнение 15 и 07, min = 07
	15	33	42	07	12	19	сравнение 07 и 12, min = 07
	15	33	42	07	12	19	сравнение 07 и 19, min = 07, обмен 15 и 07
шаг 2	07	33	42	15	12	19	сравнение 33 и 42, min = 33
	07	33	42	15	12	19	сравнение 33 и 15, min = 15
	07	33	42	15	12	19	сравнение 15 и 12, min = 12
	07	33	42	15	12	19	сравнение 12 и 19, min = 12, обмен 33 и 12
шаг 3	07	12	42	15	33	19	сравнение 42 и 15, min = 15
	07	12	42	15	33	19	сравнение 15 и 33, min = 15
	07	12	42	15	33	19	сравнение 15 и 19, min = 15, обмен 42 и 15
шаг 4	07	12	15	42	33	19	сравнение 42 и 33, min = 33
	07	12	15	42	33	19	сравнение 33 и 19, min = 19, обмен 42 и 19
шаг 5	07	12	15	19	33	42	сравнение 33 и 42, min = 33, обмена нет, все готово
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 19.02.2006 14:37
Сообщение #5


Гость






 
procedure vybor;
begin
    peres:=0;
    srav:=0;
    writeln('Vvedi elem mas: ');
    for i:=1 to n do
	readln(a[i]);
    for  i := 1  to  n-1  do
	begin
	    k := i;
	    temp := a [i];
	    for  j := i+1  to  n  do
		begin
		    inc(srav);
		    if  a [j] < temp  then
			begin
			    k := j;
			    temp := a [j];
			end;
		end;
	    a [k] := a [i];
            if k <> i then inc(peres); { Перестановка будет ТОЛЬКО в этом случае !!! }
	    a [i] := temp;
	end;
    writeln('Sortirovka');
    for i:=1 to n do
	writeln(a[i]);
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    readln;
end;
 К началу страницы 
+ Ответить 
CORS@R
сообщение 19.02.2006 19:08
Сообщение #6


Новичок
*

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

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

Danke good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
CORS@R
сообщение 4.03.2006 19:01
Сообщение #7


Новичок
*

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

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

Препод сказал что нужно сделать тоже самое и для улучшенных методов.

Код

uses crt;
const n=15;
var
a:array [1..n] of integer;
b:array [1..n] of integer;
peres,srav:longint;
i:integer;
otv:char;

procedure menu;
begin
     writeln('1-Puzyrek');
     writeln;
     writeln('2-Vstavka');
     writeln;
     writeln('3-Vybor');
     writeln;
     writeln('4-Shell');
     writeln;
     writeln('5-Bystraya sortirovka');
     writeln;
     writeln('6-Piramida');
     writeln;
     writeln('7-Sozdat massiv');
     writeln;
     writeln('8-Exit');
     writeln;
     otv:=readkey;
end;

procedure vyvod;
begin
     writeln('Ishodnyj massiv');
     writeln;
     for i:=1 to n do
     write(' ',b[i]);
     writeln;
     writeln;
     writeln('Posle sortirovki');
     writeln;
     for i:=1 to n do
     write(' ',a[i]);
     writeln;
     writeln;
end;

function sravnenie(a, b: integer): boolean;
begin
     inc(srav);
     sravnenie := a < b;
end;

procedure sozd_mas;
var i:integer;
begin
     writeln('vvedite elem mas');
     for i:=1 to n do
         readln(b[i]);
     writeln('Massiv sozdan');
     writeln;
end;

procedure puzyr;
var i,j,temp:integer;
begin
    writeln;
    writeln(' METOD ny3bIpbKA ');
    writeln;
    peres:=0;
    srav:=0;
    for i:=1 to n do
    a[i]:=b[i];
    for i := 2  to n  do
    begin
        for j:=n downto i do
        begin
            inc(srav);
            if  a[j-1] > a[j]  then
            begin
                temp := a[j-1];
                a[j-1] := a[j];
                a[j] := temp;
                inc(peres);
            end;
        end;
    end;
    vyvod;
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    writeln;
    readln;
end;

procedure vstavka;
var i,j,temp:integer;
begin
    writeln;
    writeln(' METOD BCTABOK');
    writeln;
    peres:=0;
    srav:=0;
    for i:=1 to n do
    a[i]:=b[i];
    for i:=2 to n do
    begin
        temp:=a[i];
        j:=i-1;
        While (j>0) and (sravnenie(temp, a[j])) do
        begin
            a[j+1]:=a[j];
            dec(j);
            inc(peres);
        end;
        a[j+1]:=temp;
    end;
    vyvod;
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    writeln;
    readln;
end;

procedure vybor;
var i,j,k,temp:integer;
begin
    writeln;
    writeln('METOD BbI6OPA');
    writeln;
    peres:=0;
    srav:=0;
    for i:=1 to n do
    a[i]:=b[i];
    for  i:=1 to n-1 do
    begin
        k:=i;
        temp:=a[i];
        for j:=i+1 to n do
        begin
            inc(srav);
            if a[j]<temp then
            begin
                k:=j;
                temp:=a[j];
            end;
        end;
        a[k]:=a[i];
        if k<>i then inc(peres);
        a [i]:=temp;
    end;
    vyvod;
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    writeln;
    readln;
end;

procedure Shell;
var h:array [1..n] of integer;
t,m,i,j,k,temp:integer;
begin
    writeln;
    writeln(' METOD Shella ');
    writeln;
    peres:=0;
    srav:=0;
    for i:=1 to n do
    a[i]:=b[i];
    write('Chislo shagov: ');
    readln(t);
    for i:=1 to t do
    begin
        write(i,'-y shag = ');
        readln(h[i]);
    end;
    for m:=1 to t do
    begin
        k:=h[m];
        for i:=k+1 to n do
        begin
            temp:=a[i];
            j:=i-k;
            while (j>0) and (temp<a[j]) do
            begin
                a[j+k]:=a[j];
                dec(j,k);
                inc(srav);
            end;
            a[j+k]:=temp;
            inc(peres);
        end;
    end;
    vyvod;
    writeln('Chislo perestanovok = ',peres);
    writeln('Chislo sravneniy = ',srav);
    writeln;
    readln;
end;


Procedure QuickSort(left,right:integer);
var i,j:integer;
sred,temp:integer;
begin
    i:=left;
    j:=right;
    sred:=a[(left+right) div 2];
    repeat
     while (a[i]<sred) do
         begin
         inc(i);
         inc(srav);
         end;
     while (a[j]>sred) do
         begin
         dec(j);
         inc(srav);
         end;
     if i<=j then
        begin
        temp:=a[i];
        a[i]:=a[j];
        a[j]:=temp;
        inc(i);
        dec(j);
        inc(srav);
        end;
    until i>j;
    if left<j then
       begin
       inc(peres);
       QuickSort(left,j);
       end;
    if i<right then
       begin
       inc(peres);
       QuickSort(i,right);
       end;
end;


Procedure Sito(al,ar:word);
var i,j,x:integer;
begin
    i:=al;
    j:=2*al;
    x:=a[al];
    inc(srav);
    if (j<ar) and (a[j+1]>a[j]) then  inc(j);
    while (j<=ar) and (a[j]>x) do
    begin
        a[i]:=a[j];
        i:=j;
        j:=2*j;
        inc(srav);
        inc(peres);
        if (j<ar) and (a[j+1]>a[j]) then
           begin
           inc(j);
           inc(srav);;
        end;
    end;
    a[i]:=x;
end;

procedure piramida;
var left,right,temp:integer;
begin
    left:=(n div 2)+1;
    right:=n;
    while left>1 do
    begin
        left:=left-1;
        Sito(left,right);
    end;
    while right>1 do
    begin
        temp:=a[1];
        inc(srav);
        inc(peres);
        a[1]:=a[right];
        a[right]:=temp;
        right:=right-1;
        Sito(left,right);
    end;
end;

begin
     clrscr;
     randomize;
     repeat
         begin
         menu;
         case otv of
             '1':puzyr;
             '2':vstavka;
             '3':vybor;
             '4':Shell;
             '5':begin
                 writeln;
                 writeln(' METOD Bystroy sortirovki ');
                 writeln;
                 peres:=0;
                 srav:=0;
                 for i:=1 to n do
                     a[i]:=b[i];
                 QuickSort(1,n);
                 vyvod;
                 writeln('Chislo perestanovok = ',peres);
                 writeln('Chislo sravneniy = ',srav-1);
                 writeln;
                 readln;
                 end;
             '6':begin
                 writeln;
                 writeln('Piramidalnaya sortirovka');
                 writeln;
                 peres:=0;
                 srav:=0;
                 for i:=1 to n do
                     a[i]:=b[i];
                 piramida;
                 vyvod;
                 writeln('Chislo perestanovok = ',peres);
                 writeln('Chislo sravneniy = ',srav);
                 writeln;
                 readln;
                 end;
             '7':sozd_mas;
             '8':end;
         end;
     until otv='8';
end.


Исходный массив для метода Шелла: 15 33 42 7 12 19. 2 шага шруппировки: 3 и 1. должно быть 8 сравнений и 5 перестановок.
Для быстрой сортировки: 13 42 28 17 9 25 47 31 39 15 20. 22 сравнения и 6 перестановок. Считает все правильно но может быть результаты подогнаны?
Для пирамидалььной сортировки: 45 40 28 25 30 44 33 22 60 15 55 47 66 20 50. 73 сравнения и 49 перестановок.
Помогите пожалуйста посчитать сравнения и перестановки. Заранее спасибо
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 4.03.2006 19:05
Сообщение #8


Гость
Ты мне можешь объяснить, ЗАЧЕМ ты постишь программу целиком? Что, у нас нет этих методов сортировки? А вдруг у тебя они сбоят? А придет человек, скопирует ТВОЙ метод (из-за заголовка), у него не сработает, и он будет засыпать МЕНЯ (как модератора) гневными письмами "Отстой! Не работает! Фтопку такой сайт!"

А ведь в FAQ-е примеры тестируются не 1 и даже не 100 раз, и на любых значениях...
 К началу страницы 
+ Ответить 
CORS@R
сообщение 4.03.2006 19:42
Сообщение #9


Новичок
*

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

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

Программа работает. Она же все таки сортирует, но как сосчитать перестановки и сравнения? В примерах в факе нет этого или я просто не вижу
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
« Предыдущая тема · Задачи · Следующая тема »
 

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

 

Режим отображения: Переключить на: Стандартный · Линейный · Переключить на: Древовидный

Подписка на тему · Сообщить другу · Версия для печати · Подписка на этот форум

- Текстовая версия 20.07.2025 3:03
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"