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

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

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

> Сортировка слиянием, что-то никак не получается
сообщение
Сообщение #1


Гость






Всё вроде делаю правильно, но никак не сортируется... sad.gif
Помогите ради бога! smile.gif
Спасибо заранее...

program lab1_2;
uses crt;
type
plist = ^tlist;
tlist = record
info: integer;
link: plist;
end;
var first1, posl1: plist;
procedure print(p: plist);
begin
while p <> nil do
begin
write(p^.info);
p := p^.link
end;
writeln;
end;
procedure vvod (var first, last: plist);
var s: integer;
p: plist;
begin
last := first;
repeat
write('Введите следующий элемент: ');
readln(s);
if s <> -999 then
begin
new(p);
p^.info := s;
p^.link := nil;
if first = nil
then
first := p
else last^.link := p;
last := p;
end;
until s = -999;
end;
procedure sort (var first1: plist);
var second, p, t: plist;
begin
if first1^.link = nil then exit;
second:= first1^.link;
sort (second);
p:=second;
if second^.info>first1^.info
then
begin
first1^.link:=second;
exit;
end;
while p^.link <> nil do
begin
t:=p^.link;
if t^.info>first1^.info
then
begin
writeln ('assdfsd sd fsd fsdf ');
first1^.link:=p^.link;
p^.link:=first1;
first1:=second;
break;
end;
p:=p^.link;
end;
end;
begin
clrscr;
writeln('Первый список:');
first1:=nil;
vvod (first1, posl1);
print(first1);
sort (first1);
writeln('Отсортированный список:');
print(first1);
readkey;
end.

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


Гость






DOG-Paul,
Хотя, если вот так... Это тоже MergeSort (сортировка слияниями):
program lab1_2;
uses crt;
type
plist = ^tlist;
tlist = record
info: integer;
link: plist;
end;


var
first1, posl1: plist;

procedure print(p: plist);
begin

while p <> nil do begin
write(p^.info:4);
p := p^.link
end;
writeln;

end;

procedure vvod (var first, last: plist);
var
s: integer;
p: plist;
begin
last := first;
repeat

write('Введите следующий элемент: ');
readln(s);
if s <> -999 then begin
new(p);
p^.info := s;
p^.link := nil;
if first = nil then first := p
else last^.link := p;
last := p;
end;

until s = -999;
end;


function merge(s, t: plist): plist;
begin
if s^.info < t^.info then with s^ do
if link = nil then begin link := t; merge := s end
else begin link := merge(link, t); merge := s end

else with t^ do
if link = nil then begin link := s; merge := t end
else begin link := merge(s, link); merge := t end;
end;

function mergesort(s: plist): plist;
var t, u: plist;
begin
if (s = nil) or (s^.link = nil) then mergesort := s
else begin
u := s; t := u^.link^.link;
while (t <> nil) and (t^.link <> nil) do begin
u := u^.link; t := t^.link^.link;
end;
t := u^.link; u^.link := nil;
mergesort := merge(mergesort(s), mergesort(t));
end;
end;


begin
clrscr;
writeln('Первый список:');
first1:=nil;
vvod (first1, posl1);
print(first1);
mergesort (first1);
writeln('Отсортированный список:');
print(first1);
readkey;
end.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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