Версия для печати темы

Автор: DOG-Paul 2.12.2005 22:57

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

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 3.12.2005 15:42

Люди!!! Помогите...

Автор: klem4 3.12.2005 15:52

вот вроде похожая задача : http://forum.pascal.net.ru/index.php?showtopic=7060&hl=%F1%EE%F0%F2%E8%F0%EE%E2%EA%E0+%F1%EF%E8%F1%EA%E0

Автор: DOG-Paul 3.12.2005 20:20

Это моя задача и совсем другая!
Существует дофига типов сортировки! Мне нужно слиянием...
Т.е. мы рекурсивно делим список пока не останется один эдемент, потом отсортирвоали, вернулись обратно, отсортировали 2, вернулись, отсортировали 3 и пока так до конца не вернёмся...
Поидее алгоритм врный, но что-то никак не прёт!

Автор: volvo 3.12.2005 20:45

Автор: volvo 3.12.2005 21: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.

Автор: Guest 3.12.2005 22:59

А в моём варианте что не так?

Автор: volvo 3.12.2005 23:04

Сравни и увидишь...

Автор: Гость 6.05.2012 20:09

Цитата(volvo @ 3.12.2005 17:46)

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 6.05.2012 21:28