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

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

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

 
 Ответить  Открыть новую тему 
> Естественное двухпутевое слияние, нужен исходник!!!
Юлия
сообщение 13.09.2005 14:27
Сообщение #1


Гость






Люди!!! Очень нужен исходник!!!
Почему-то по просто двухпутевому слиянию - материала море, а про "естественное" - ни слова.
ХЕЛП!!!
 К началу страницы 
+ Ответить 
volvo
сообщение 13.09.2005 15:05
Сообщение #2


Гость






Цитата(Юлия @ 13.09.05 14:27)
Почему-то по просто двухпутевому слиянию - материала море, а про "естественное" - ни слова.

Правда?
http://www.asu.pstu.ac.ru/book/pol/p934.htm
 К началу страницы 
+ Ответить 
Юлия
сообщение 13.09.2005 15:18
Сообщение #3


Гость






ПААААААСИБА!!!
 К началу страницы 
+ Ответить 
Юлия
сообщение 13.09.2005 15:29
Сообщение #4


Гость






Суровый Профи! А может, подскажешь где найти сортировку двухпутевыми вставками? Над ней уже вторую неделю сижу...........голова моя тупая совсем........:-\
 К началу страницы 
+ Ответить 
Jill
сообщение 16.09.2005 14:30
Сообщение #5


Пионер
**

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

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


подниму тему с вашего разрешения

СУТЬ: задание состоит из двух подзаданий:
Разработать программы, реализующие сортировки:
1. Методом Шелла
2. Естественным двухпутевым слиянием
Исследовать работу программы на сортировке n чисел, если они:
a) расположены случайным образом;
B) отсортированы;
c) отсортированы в обратном порядке;
С первым подзаданием справилась:
uses Crt,Dos;
const ARRAYSIZE=5000;
type arrayType=array[1..ARRAYSIZE] of integer;
var
A:arrayType;{Сортируемый вектор}
n:integer;{Количество точек в сортируемом векторе}
exp:integer;{Количество проводимых экспирементов}
point:byte;{Количество точек требуемое для построения графика}
step:integer;{Шаг для построения графика}
i,j,k:integer;{Переменные цикла}
c:integer;{Вспомогательная переменная для обмена двух элементов}
f:text;{Файловая переменная для записи результатов}
t:real;{Время сортировки вектора}
aver_time:array[1..3]of real;{среднее время сортировки при разном расположении}
{элементов (1-случайный порядок, 2-обратный,3-прямой)}

procedure InsertionSort(Size:integer;var theArray:arrayType; var time:real);
var
newPos:integer;{Начальная позиция вставляемого на место элемента}
newValue:integer;{Значение вставляемого на место элемента}
currentPos:integer;{Позиция вставляемого эл. в упорядоченном векторе}
hour,min,sec,hund:word;{текущее время (час, мин, сек, сотые}
start_time,finish_time:real;{время начала и окончания сортировки вектора}
h,t,s:word;
begin
{Вычисление шага сортировки}
t:=1;
h:=1;
While h<Size do
begin
t:=t+1;
h:=3*h+1;
end;
if t>2 then begin
t:=t-2;
h:=round(h/3);
end;

GetTime(hour,min,sec,hund); {фиксируем время начала сортировки}
start_time:=sec+hund*0.01+min*60+hour*3600; {переводим время в секунды}
{Алгоритм сортировки}
for s:=t downto 1 do
begin
h:=round(h/3);
for newPos:=h+1 to SIZE do
begin
newValue:=theArray[newPos];
currentPos:=newPos-h;
while (currentPos>=1)and(theArray[currentPos]>newValue)do
begin
theArray[currentPos+h]:=theArray[currentPos];
currentPos:=currentPos-h;
end;
theArray[currentPos+h]:=newValue;
end;
end;
GetTime(hour,min,sec,hund);{фиксируем время окончания сортировки}
finish_time:=sec+hund*0.01+min*60+hour*3600;{переводим время в секунды}
time:=finish_time-start_time;{определяем фактическое время сортировки}
end;{InsertionSort}

procedure Vector(SIZE,MAX:integer;var theArray:arrayType);
var i:integer;{Номер текущего элемента вектора}
begin
randomize;
for i:=1 to SIZE do
theArray[i]:=random(MAX);
end;{Vector}

{Основной модуль}
begin
ClrScr;
assign(f,'c:\primer\ins');{инициализация выходного файла}
rewrite(f);
write('Введите необходимое количество точек для построения графика ->');
readln(point);
step:=round(ARRAYSIZE/point);
write('Введите количество экспериментов ->');
readln(exp);
{Формирование заголовка таблицы}
writeln(f,'Среднее время сортировки элементов:');
writeln(f,' кол-во ',' случайные',' обратное',' сортиров.');
writeln(f,'элементов');
for k:=1 to point do
begin
n:=step*k;{определение длины вектора для k шага}
for i:=1 to 3 do
aver_time[i]:=0.0; {обнуление времени}
for j:=1 to exp do
begin
vector(n,ARRAYSIZE,a);{формирование произвольного вектора длинны n}
InsertionSort(n,a,t);{сортировка произвольного вектора}
{накопление времени для определения среднего}
aver_time[1]:=aver_time[1]+t;
{формирование вектора в обратном порядке}
for i:=1 to n div 2 do
begin
c:=a[i];
a[i]:=a[n-i+1];
a[n-i+1]:=c;
end;
InsertionSort(n,a,t);{сортировка обратно сортированного вектора}
aver_time[2]:=aver_time[2]+t;
InsertionSort(n,a,t);{сортировка упорядоченного вектора}
aver_time[3]:=aver_time[3]+t;
end;
{нахождение среднего времени сортировки, исходя из m экспериментов}
for i:=1 to 3 do
aver_time[i]:=aver_time[i]/exp;
{заполнения таблицы результатов в файле}
write(f,n:7,' ');
for i:=1 to 3 do
write(f,aver_time[i]:7:2,' ');
writeln(f);
end;
close(f);
end.


а вот со вторым - ни в какую!!! sad.gif смысл тот же, а вот с примером, ссылка на который приведена выше, разобраться не могу sad.gif
не понимаю, зачем там необходимы целых ТРИ внешних файла? и как переписать его так, чтобы этих внешних файлов не было вообще - просто случайный вектор, просто сортировка / внешний файл - только один - с результатами подсчета времени.
помогите, пожалуйста!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 16.09.2005 14:42
Сообщение #6


Гость






Цитата(Jill @ 16.09.05 14:30)
не понимаю, зачем там необходимы целых ТРИ внешних файла?

Понимаешь, в чем дело ... Алгоритм сортировки естественным слиянием относится к внешней сортировке (сортировке файлов) по определению. Поэтому и используется 3 файла - 2 исходных, и результат.

Кстати, что значит
Цитата
а вот со вторым - ни в какую!!!
? Что именно ты считаешь вторым подзаданием? Сортировку уже отсортированных чисел? Или метод слияний вообще?

Цитата
как переписать его так, чтобы этих внешних файлов не было вообще - просто случайный вектор
Если на то пошло, то НЕ ОДИН, а 2 вектора, т.к. тебе надо делать слияние...
 К началу страницы 
+ Ответить 
Jill
сообщение 16.09.2005 14:50
Сообщение #7


Пионер
**

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

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


Цитата(volvo @ 16.09.05 14:42)
Поэтому и используется 3 файла - 2 исходных, и результат.

в том примере исходный - ОДИН файл! точно smile.gif а два остальных...промежуточные наверное

Цитата
Что именно ты считаешь вторым подзаданием? Сортировку уже отсортированных чисел? Или метод слияний вообще?


второе подзадание - это метод слияний / по аналогии с первой программой надо сделать вторую / не получается sad.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 16.09.2005 16:11
Сообщение #8


Гость






По аналогии и не получится... smile.gif Не пишутся программы по аналогии... Вот так я бы реализовал метод естественных слияний:
Исходный код
const
arr_size = 50;
type
ttype = integer;
tvector = array[0 .. pred(arr_size)] of ttype;

var
B: tvector;

procedure merge(var A : array of ttype; p, q, r : longint);
var
k, i, j : longint;
begin
for k := 0 to r - p do
B[k] := A[k+p];

i := 0;
j := q-p+1;
for k := 0 to r - p do begin

if (i > q-p) or (j > r-p) then begin
if i > q-p then begin
A[p+k] := B[j];
inc(j);
end
else begin
A[p+k] := B[i];
inc(i);
end;

continue;
end;

if B[i] > B[j] then begin
A[p+k] := B[j];
Inc(j);
end
else begin
A[p+k] := B[i];
Inc(i);
end;

end;
end;


procedure merge_sort(var arr: array of ttype; p, r: longint);
var
q: longint;
begin

if p < r then begin
q := (p + r) div 2;

MergeSort(A, p, q);
MergeSort(A, q+1, r);
Merge(A, p, q, r);
end;

end;

procedure create_vector(var vec: array of ttype;
n: integer);
var i: integer;
begin
for i := 0 to pred(n) do
vec[i] := random(100);
end;
procedure print_vector(var vec: array of ttype;
n: integer);
var i: integer;
begin
for i := 0 to pred(n) do
write(vec[i]:5);
end;

var
arr: tvector;

begin
writeln; writeln('before:');
create_vector(arr, arr_size);
print_vector(arr, arr_size);

writeln; writeln('after:');
merge_sort(arr, 0, pred(arr_size));
print_vector(arr, arr_size);
end.

Попробуй преобразовать это в процедуру, и сделать то, что тебе нужно...

P.S. Я бы немного изменил твою программу. Ты производишь однотипные действия неоднократно. Имеет смысл в таком случае вынести их в функцию. Смотри:
Function GetSeconds: Real;
Var hour, min, sec, hund: word;
Begin
GetTime(hour,min,sec,hund);
GetSeconds := sec+hund*0.01+min*60+hour*3600;
End;
...
{ и теперь при вызове InsertionSort делать так: }
vector(n, ARRAYSIZE, a); {формирование произвольного вектора длинны n}
T := GetSeconds;
InsertionSort(n, a); { сортировка произвольного вектора }
T := GetSeconds - T; { T = время выполнения сортировки в секундах }

А из самой InsertSort все, что связано с вычислением времени - убрать...

Во-первых, программа станет проще для понимания. Во-вторых - процедура сортировки не перегружается лишними вычислениями, а делает ТОЛЬКО то, что должна делать. В третьих, эту же функцию GetSeconds можно применять и при определении быстродействия других методов сортировки... Подумай над этим ;)
 К началу страницы 
+ Ответить 
Jill
сообщение 16.09.2005 16:26
Сообщение #9


Пионер
**

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

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


Цитата(volvo @ 16.09.05 16:11)
Подумай над этим ;)

кст, думала ;)
там действительно много повторов


так все несложно получается...не то, что с теми внешними файлами...здорово! smile.gif
ПАСИБА!!! :zdorov:
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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