Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 09.05.2019, 08:31   #1
Karina2000
Новичок
 
Регистрация: 09.05.2019
Сообщений: 3
Репутация: 10
По умолчанию Линейные списки в Паскаль

Здравствуйте. Помогите,пожалуйста, исправить программу.
Код:

Type EXS =^S; 
		S=Record
		Data:Integer;
		Next:EXS; 
End; 
TList = record
    PFirst:EXS ;
    PLast:EXS;
  end;
  
 Var u1,y:EXS;
  List, List1, List2: TList;
  L:integer;
  
Procedure Init(Var u: Exs);          {создание списка}
Var x, y: Exs;
Digit: Integer; {значение информационной части элемента списка}
Begin
Writeln(' Введите список ');
	u:= Nil; {список пуст} 
WriteLn('Bвeдитe элементы списка. Конец ввода 0');
	Read( Digit);
While Digit<>0 Do Begin
	New(y);        {формирование элемента списка}
	y^.Next:=Nil; Y^.Data:=Digit;
If u=nil Then u:=y {вставляем первый элемент списка}
Else x^.Next:=y; {вставляем элемент в конец списка}
x:=y; {переносим значение указателя на последний элемент списка}
Read(Digit);  
End; 
Writeln ('Список сформирован'); 
End; 

//Добавление элемента в конец списка.
procedure AddL(var aList : TList; const aEXS:EXS);
begin
  if aEXS = nil then Exit;
 
  aEXS^.Next := nil;
  if aList.PFirst = nil then begin
    aList.PFirst := aEXS;
    aList.PLast := aEXS
  end else begin
    aList.PLast^.Next := aEXS;
    aList.PLast := aEXS;
  end;
end;
 function Chisla(List1,List2:Tlist):integer;
 Var PElem,PNew:EXS;
   //Составление списков чётных и нечётных чисел.
   begin
    PElem:= List.PFirst;
    while PElem <> nil do begin
      New(PNew);
      PNew^.Data := PElem^.Data;
      if PElem^.Data mod 2 = 0 then
        AddL(List1, PNew)
      else
        AddL(List2, PNew);
      PElem:= PElem^.Next;
    end;
 
    //Распечатка составленных списков.
 
    Writeln('Список чётных чисел:');
    PElem := List1.PFirst;
    while PElem <> nil do begin
      if PElem <> List1.PFirst then Write(', ');
      Write(PElem^.Data);
      PElem := PElem^.Next;
    end;
    Writeln;
 
    Writeln('Список нечётных чисел:');
    PElem := List2.PFirst;
    while PElem <> nil do begin
      if PElem <> List2.PFirst then Write(', ');
      Write(PElem^.Data);
      PElem := PElem^.Next;
    end;
    Writeln;
    end;

begin
  List.PFirst := nil;
  List.PLast := nil;
  List1.PFirst := nil;
  List1.PLast := nil;
  List2.PFirst := nil;
  List2.PLast := nil;
 Init(u1);
 While u1<>Nil Do
 Begin
	Write(u1^. Data:4);
	u1:=u1^.Next;
	end;
writeln;
 L:=Chisla(List1,List2);
end.


Последний раз редактировалось Аватар; 09.05.2019 в 08:38.
Karina2000 вне форума   Ответить с цитированием
Старый 10.05.2019, 00:05   #2
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 25,403
Репутация: 5596
По умолчанию

так устроит?
Код:

Type
	EXS =^S;
	S=Record
	  Data:Integer;
	  Next:EXS;
	End;


procedure PrintList( u : EXS);
var tmp : EXS;
begin
  if u = nil Then Write('Список пуст')
  else begin
    tmp := u;
    while tmp<>nil do begin
    	write(tmp^.data,' ');
    	tmp := tmp^.next
    end;
  end;
  WriteLn;
end;

Procedure Init(Var u: Exs);          {создание списка}
Var 	x, y: Exs;
 	Digit: Integer; {значение информационной части элемента списка}
Begin
	Writeln(' Введите список ');
	u:= Nil; {список пуст}
	WriteLn('Bвeдитe элементы списка. Конец ввода 0');
	Read( Digit);
	While Digit<>0 Do Begin
		New(y);        {формирование элемента списка}
		y^.Next:=Nil; Y^.Data:=Digit;
		If u=nil Then u:=y {вставляем первый элемент списка}
		Else x^.Next:=y; {вставляем элемент в конец списка}
		x:=y; {переносим значение указателя на последний элемент списка}
		Read(Digit);
	End;
	Writeln ('Список сформирован');
End;

//Добавление элемента в конец списка.
procedure AddL(var Head, Tail : Exs; const aData:integer);
var x : Exs;
begin
  if Head=nil then begin
    New(Head);
    Head^.Next := nil;
    Head^.Data := aData;
    Tail := Head;
  end
  else begin
     New(x);
     x^.Next := nil;
     x^.Data := aData;
     Tail^.Next := x;
     Tail := x
  end;
end;


 //Составление списков чётных и нечётных чисел.
procedure Chisla(var u, List1,List2 : EXS);
var tmp, tail1, tail2 : EXS;
begin
  List1 := nil;
  List2 := nil;
  tmp := u;
  while tmp<>nil do begin
	if odd(tmp^.data)
	//нечётное число добавляем в конец 2-го списка
	then AddL(List2, Tail2, tmp^.data)
	// чётное число добавляем в конец 1-го списка
        else AddL(List1, Tail1, tmp^.data);
	tmp := tmp^.next
  end;
end;

procedure FreeList(var u:EXS);
var tmp:EXS;
begin
 while u<>nil do begin
	tmp:=u;
	u:=u^.Next;
	dispose(tmp);
 end;
end;


Var
  u1, List1, List2: EXS;

begin

  Init(u1);

  Write('Исходный список:');
  PrintList(u1);

  Chisla(u1,List1,List2);
  FreeList(u1);  // очистим память исходного списка u1

  Writeln('Список чётных чисел:');
  PrintList(List1);

  Writeln('Список нечётных чисел:');
  PrintList(List2);

  FreeList(List1);  // очистим память списка чётных чисел
  FreeList(List2);  // очистим память списка нечётных чисел

end.

Serge_Bliznykov вне форума   Ответить с цитированием
Старый 14.05.2019, 11:00   #3
Karina2000
Новичок
 
Регистрация: 09.05.2019
Сообщений: 3
Репутация: 10
По умолчанию

Нужно именно через функцию сделать распределение чётных и нечётных.
Karina2000 вне форума   Ответить с цитированием
Старый 14.05.2019, 11:46   #4
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 25,403
Репутация: 5596
По умолчанию

Цитата:
Сообщение от Karina2000 Посмотреть сообщение
Нужно именно через функцию сделать распределение чётных и нечётных.
Вы знаете, чем процедура отличается от функции?
Тем, что функция возвращает значение.

Вы написали функцию целого типа
Цитата:
Сообщение от Karina2000 Посмотреть сообщение
Код:

function Chisla(List1,List2:Tlist):integer;

Для чего? Что должна возвращать функция?

Разбирайтесь, что Вам нужно и делайте.

Будут вопросы - задавайте.
Serge_Bliznykov вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Линейные списки. Rediska512 Паскаль 1 30.03.2012 21:54
Линейные списки. Паскаль Yelisey Паскаль 2 21.04.2011 16:41
Линейные списки svt Помощь студентам 1 20.11.2010 09:22
Линейные списки ManU Помощь студентам 1 03.11.2008 22:20


11:47.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru