[Pascal ABC.NET] операции со стеком

[Romeshek]

program apple;
uses crt;
type
  Tptr = ^Telem;{указательный тип данных на элемент Стека}
  Telem = record  {запись, состоящая из двух полей, описывающая элемент Стека}
    inf: integer;  {информационное поле - хранит символы}
    link: Tptr;    {указательное поле - ссылка на следующий элемент Стека}
  end;
  Tptr2 = ^Telem;
  Tptr3 = ^Telem;
  
var
  top: Tptr;
  top2: Tptr2;
  top3: Tptr3;  {глобальная переменная - указатель на вершину Стека}
  m: byte;
  lg: boolean;
  {Процедура: добавление элемента в вершину Стека}
procedure push;
var
  p: Tptr;{вспомогательный указатель, ссылающийся на добавляемый элемент}
i:integer;
begin
  new(p); {выделение памяти под добавляемый элемент} 
  p^.link := nil; {"привязали" линковочное поле к NIL, чтобы не было висячей ссылки} 
  write('Введите значение добавляемого элемента: '); {ввод значения информационного поля элемента с клавиатуры} 
  readln(i); {указатель добавляемого элемента поставили на первый элемент Стека}
  if i mod 2 = 0 then
  begin
    p^.inf := i;
  end;
  p^.link := top; {указатель на вершину Стека top поставили на только что добавленный элемент.
  В итоге, Стек находится в согласованном состоянии после добавления элемента}
  top := p;
end;
{Процедура: печать элементов Стека от вершины в конец}
procedure printFromTop;
var
  p: Tptr;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  p := top; {устанавливаем указатель р на первый элемент Стека}
  {выпечатываем на экран диалог}
  write('Элементы стека имеют вид: '); {устанавливаем указатель р на первый элемент Стека}
  {до тех пор, пока указатель р не выйдет за последний элемент Стека}
  while(p <> nil) do
  begin
    write(p^.inf, ' '); {печатаем на экран пользователя информационное поле текущего элемента Стека}
    p := p^.link; {переход на следующий элемент Стека}
  end;
end;

procedure sozdanie1;
var
  p: Tptr;
  p2: Tptr2;
  p3: Tptr3;
  integer: integer;
begin
  p := top;
  while(p <> nil) do
   begin
    m := ord(p^.inf);
    if (m mod 2=0)
     then
     begin
     new(p3); {выделение памяти под добавляемый элемент}
p3^.link := nil; {"привязали" линковочное поле к NIL, чтобы не было висячей ссылки}
integer := p^.inf;
p3^.inf := integer;
p3^.link := top3; {указатель на вершину Стека top поставили на только что добавленный элемент.
В итоге, Стек находится в согласованном состоянии после добавления элемента}
top3 := p3;
     end;
  end;
  p2 := top;
  while(p2 <> nil) do
    m := ord(p2^.inf);
p := p^.link; {переход на следующий элемент Стека}
  end;

procedure printFromTop2;
var
  p: Tptr2;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  p := top2; {устанавливаем указатель р на первый элемент Стека}
  {выпечатываем на экран диалог}
  write('Элементы стека имеют вид: '); {устанавливаем указатель р на первый элемент Стека}
  {до тех пор, пока указатель р не выйдет за последний элемент Стека}
  while(p <> nil) do
  begin
    write(p^.inf, ' '); {печатаем на экран пользователя информационное поле текущего элемента Стека}
    p := p^.link; {переход на следующий элемент Стека}
  end;
end;
procedure printFromTop3;
var
  p: Tptr3;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  p := top3; {устанавливаем указатель р на первый элемент Стека}
  {выпечатываем на экран диалог}
  write('Элементы стека имеют вид: '); {устанавливаем указатель р на первый элемент Стека}
  {до тех пор, пока указатель р не выйдет за последний элемент Стека}
  while(p <> nil) do
  begin
    write(p^.inf, ' '); {печатаем на экран пользователя информационное поле текущего элемента Стека}
    p := p^.link; {переход на следующий элемент Стека}
  end;
end;
var
  i: integer;
begin
  i := 0;
  repeat
    push; {вставка элемента в вершину Стека} 
    i := i + 1;
  until (i = 10);
  writeln; {оповещение пользователя об успешном завершении операции}
  writeln('Добавление новых элементов успешно проведено!');
  if(top = nil) then {если в Стеке нет элементов, то вызываем диалог для пользователя}
    write('Печать элементов невозможна, так как Стек пуст!')
  else
    printFromTop; {печать элементов Стека от вершины вниз}
end.

Подскажите, как сделать, чтобы из второго стека выводило числа кратные двум в третий стек. А потом то, что получилось отсортировала по убыванию? И что-бы в стеках не было ноликов, просто числа шли друг за другом.

[Serge_Bliznykov]

такой вариант (для затравки) устроит?

program StackOne;
uses crt;
type
  Tptr = ^Telem;{указательный тип данных на элемент Стека}
  Telem = record  {запись, состоящая из двух полей, описывающая элемент Стека}
    inf: integer;  {информационное поле - хранит символы}
    link: Tptr;    {указательное поле - ссылка на следующий элемент Стека}
  end;


{Процедура: добавление элемента в вершину Стека}
procedure push(var topstek : Tptr; element : integer);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на добавляемый элемент}
begin
  new(p); {выделение памяти под добавляемый элемент} 
  p^.inf := element;
  p^.link := topstek; {указатель на вершину Стека top поставили на только что добавленный элемент.
                       В итоге, Стек находится в согласованном состоянии после добавления элемента}
  topstek := p;
end;

{Процедура: печать элементов Стека от вершины в конец}
procedure PrintFromTop(topstek : Tptr);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  if topstek = nil then WriteLn('Стек пуст')
  else begin
    p := topstek; {устанавливаем указатель р на первый элемент Стека}
    {выпечатываем на экран диалог}
    write('Элементы стека имеют вид: '); {устанавливаем указатель р на первый элемент Стека}
    {до тех пор, пока указатель р не выйдет за последний элемент Стека}
    while(p <> nil) do
    begin
      write(p^.inf, ' '); {печатаем на экран пользователя информационное поле текущего элемента Стека}
      p := p^.link; {переход на следующий элемент Стека}
    end;
  end;
  WriteLn
end;


procedure InputStack(var topstek : Tptr);
var n, elem: integer;
begin
  topstek := nil;
  WriteLn('Укажите, сколько элементов стека Вы хотите ввести:');
  ReadLn(n);
  for var i:=1 to n do begin
    write('Введите значение добавляемого элемента: '); {ввод значения информационного поля элемента с клавиатуры} 
    ReadLn(elem);
    // if i mod 2 = 0 then если нужно, чтобы вставлялись только чётные - можно расскоментировать
    push( topstek, elem) ; {вставка элемента в вершину Стека} 
  end;
  writeln; {оповещение пользователя об успешном завершении операции}
  writeln('Добавление новых элементов успешно проведено!');
end;
  
{копировать чётные элементы в новый стек}  
procedure CopyEvenToOtherStack( const topstek1 : Tptr; var topstek2 : Tptr);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  topstek2 := nil;
  p := topstek1; {устанавливаем указатель р на первый элемент Стека}
  {до тех пор, пока указатель р не выйдет за последний элемент Стека}
  while(p <> nil) do
    begin
      if p^.inf mod 2 = 0 then 
           push( topstek2, p^.inf);
      p := p^.link; {переход на следующий элемент Стека}
    end;
end;


var
  top1, top2 : Tptr;

begin
  InputStack( top1 ); {ввод с клавиатуры элементов стека}
  
  WriteLn('Содержимое первого стека.');
  PrintFromTop( top1 ); {печать элементов Стека от вершины вниз}
  
  CopyEvenToOtherStack( top1, top2);
  
  WriteLn('Содержимое второго стека.');
  PrintFromTop( top2 ); {печать элементов Стека от вершины вниз}

end.

[Romeshek]

Вполне, спасибо большое!

[Serge_Bliznykov]

да пожалуйста.

обращаю внимание на то, что сортировки там в коде никакой нет, если нужна - то потребуется доработать код.

[Romeshek]

Я думаю, что не потребуется, но если вдруг что, то я буду знать к кому обратиться)