Помощь - Поиск - Пользователи - Календарь
Полная версия: Сортировка слиянием
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
DOG-Paul
Всё вроде делаю правильно, но никак не сортируется... 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.

DOG-Paul
Люди!!! Помогите... sad.gif
klem4
вот вроде похожая задача : ссылка
DOG-Paul
Это моя задача и совсем другая!
Существует дофига типов сортировки! Мне нужно слиянием...
Т.е. мы рекурсивно делим список пока не останется один эдемент, потом отсортирвоали, вернулись обратно, отсортировали 2, вернулись, отсортировали 3 и пока так до конца не вернёмся...
Поидее алгоритм врный, но что-то никак не прёт! sad.gif
volvo
Цитата
Существует дофига типов сортировки!

yes2.gif Но НЕ ВСЕ применимы к односвязным спискам, никогда об этом не забывай...
volvo
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.
Guest
А в моём варианте что не так?
volvo
Сравни и увидишь...
Гость
Цитата(volvo @ 3.12.2005 17:46) *

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.



Неработает он у тебя, зачем выставлять не проверив
IUnknown
Цитата
выставлять не проверив
Ну-ну... Все прекрасно работает. Надо только правильно ВЫЗВАТЬ функцию сортировки. это тебе задачка на сообразительность, чтоб жизнь медом не казалась. А то привыкли - придут, вывалят задачи и потом только ходят и собирают. Да еще и недовольны. Халяву в другом месте искать будешь, здесь надо хоть чуть-чуть мозгами пошевелить.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.