Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

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

Здравствуйте. Помогите,пожалуйста, исправить программу.
Код:
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 в 07:38.
Karina2000 вне форума Ответить с цитированием
Старый 09.05.2019, 23:05   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

так устроит?
Код:
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, 10:00   #3
Karina2000
 
Регистрация: 09.05.2019
Сообщений: 4
По умолчанию

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

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

Вы написали функцию целого типа
Цитата:
Сообщение от Karina2000 Посмотреть сообщение
Код:
function Chisla(List1,List2:Tlist):integer;
Для чего? Что должна возвращать функция?

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

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


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