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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.11.2017, 15:13   #1
Romeshek
Пользователь
 
Регистрация: 29.09.2017
Сообщений: 33
По умолчанию [Pascal ABC.NET] операции со стеком

Код:
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.
Подскажите, как сделать, чтобы из второго стека выводило числа кратные двум в третий стек. А потом то, что получилось отсортировала по убыванию? И что-бы в стеках не было ноликов, просто числа шли друг за другом.

Последний раз редактировалось Аватар; 01.11.2017 в 15:34.
Romeshek вне форума Ответить с цитированием
Старый 01.11.2017, 16:48   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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

Код:
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.

Последний раз редактировалось Serge_Bliznykov; 01.11.2017 в 16:50.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.11.2017, 17:45   #3
Romeshek
Пользователь
 
Регистрация: 29.09.2017
Сообщений: 33
По умолчанию

Вполне, спасибо большое!
Romeshek вне форума Ответить с цитированием
Старый 01.11.2017, 17:55   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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

обращаю внимание на то, что сортировки там в коде никакой нет, если нужна - то потребуется доработать код.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 01.11.2017, 18:24   #5
Romeshek
Пользователь
 
Регистрация: 29.09.2017
Сообщений: 33
По умолчанию

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


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
pascal abc.net алексей костиков Помощь студентам 0 12.10.2017 20:02
Pascal ABC.NET gogomon93 Помощь студентам 4 01.12.2013 17:56
Pascal ABC Net sarkisova_elena Паскаль, Turbo Pascal, PascalABC.NET 2 07.02.2012 00:40
Pascal ABC.NET BuTaJI Помощь студентам 1 26.04.2011 20:10
Pascal ABC .NET no4_sniper Паскаль, Turbo Pascal, PascalABC.NET 0 17.10.2009 00:21