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


Гость






Люди!!! Помогите... sad.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Perl. Just code it!
******

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

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


вот вроде похожая задача : ссылка


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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


Гость






Цитата
Существует дофига типов сортировки!

yes2.gif Но НЕ ВСЕ применимы к односвязным спискам, никогда об этом не забывай...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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


Гость






Сравни и увидишь...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Цитата(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.



Неработает он у тебя, зачем выставлять не проверив
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гуру
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской
Ада: Разработчик
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик

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


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

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

 



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