[kaizer131]

Доброго времени суток!

Разбираюсь со стеками и очередями на примере следующей задачи:

”Дан стек, элементами которого являются действительные числа. Сформировать структуру данных очередь, в которую включить значения тех элементов из стека, которые не превосходят uz. Элементы с найденными значениями из стека исключить. А также получить:
(uz+r)/(uz+s),
где
r- сумма всех тех значений элементов, которые не превосходят u,
s- сумма значений элементов, больших u.”

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

Ниже привожу свой код, укажите на ошибки.

Я пока не могу понять, почему при первом выводе стека на экран он обнуляется. И потом просто программа вылетает с ошибкой, как я понимаю как раз из за того, что стек стал пустым и последующее обращение к нему приводит к падению программы

Код:

program new_stack;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
 Stack =^Еlеm;
         Еlеm = Record
           inf : integer;
           next : Stack;
          end;

  Ocher =^och;
      och = record
           inf : integer;
           next : Ocher;
         end;

/////////////////////// Добавляем в стек ///////////////////////////////////////

Procedure In_stak(Var Beg:Stack; Sim:integer);
Var x:Stack;
Begin
    New(X);
    X^.inf:=Sim;
    X^.next:=Beg;
    Beg:=X;
End;

//////////////////////////// Достаём верхний элемент стека /////////////////////

procedure Out_stak(Var Beg: Stack; Var Flag: Boolean);
Var x: Stack;
Begin
	If   Beg= Nil  then  Flag:= false   else
		    Begin
			Flag:=true;
			X:=Beg;
			Beg:=Beg^.next;
			Dispose(x);
		     End;
End;
//////////////////////////////////////////////////////////////////////////////////



//////////////////////// Занесение в очередь ///////////////////////////////////
 Procedure writeO(Var BeginO, EndO : Ocher; c : integer);
Var
  Elem : Ocher;
Begin
  new(Elem);
  Elem^.inf := c;
  Elem^.Next := Nil;
  if BeginO = Nil {проверяем, пуста ли очередь}
    then
      BeginO := Elem {ставим указатель начала очереди на первый созданный элемент}
    else
      EndO^.Next := Elem; {ставим созданный элемент в конец очереди}
  EndO := Elem; {переносим указатель конца очереди на последний элемент}
End;

///////////////////////////// Чтение из очереди /////////////////////////////////
Procedure readO(Var BeginO : Ocher; Var INF : integer);
Var
  Elem : Ocher;
Function FreeO(x1 : Ocher): boolean;
Begin
  FreeO := (x1 = Nil);
End;
Begin
  if FreeO(BeginO)
    then
      writeln('Очередь пуста')
    else
      begin
        INF := BeginO^.inf; {считываем искомое значение в переменную с}
        Elem := BeginO; {ставим промежуточный указатель на первый элемент очереди}
        BeginO := BeginO^.Next;{указатель начала переносим на следующий элемент}
        dispose(Elem); {освобождаем память, занятую уже ненужным первым элементом}
      end;
End;

var
MY,MY2:Stack;
INF,I,uz,R,S:integer;
BeginO, EndO , O:Ocher;
IO:Boolean;
begin
 R:=0;
 S:=0;
 Randomize;
 write ('Input Uz :');
 readln(uz);



 MY:=nil;
 BeginO:=nil; EndO :=nil;
for I := 0 to 10 do
  begin
  In_stak(MY, random(100));
  end;



   write ('Ishodn stack :');
    while MY <> Nil do
    begin
    write (My^.inf);
    write ('-->');
    MY:=My^.next;

    end;


   readln;


  while MY <> Nil do

  Begin
  Out_stak(My,IO); // из основного стека достали

   if MY^.inf <uz then

    begin
    R:=MY^.inf;
    writeO( BeginO, EndO , MY^.inf); {помещаем элемент в очередь }
    end
    else

    begin
     if MY^.inf >=uz then
    begin
    S:=MY^.inf;
    In_stak(MY2, MY^.inf);
    end;


    End;
     MY := MY^.next;
  End;


/////////////// Вывод стека ////////////////////////////////////////////////
 while MY2 <> nil do
 begin
 write (MY2^.inf);
 MY2:=MY2^.next;
 end;

 /////////////// Вывод Очереди ////////////////////////////////////////////////
 while O <> nil do
 begin
 write (O^.inf);
 O:=O^.next;
 end;


/////////////// Вывод итогового числа ////////////////////////////////////////////////
 writeln ('Iskomoe chislo :');
 write ((uz+r)/(uz+s)) ;

 readln;
end. 

[AlexSku]

Сообщение от kaizer131

Доброго времени суток!

Разбираюсь со стеками и очередями ...[/code]

Советую подключить модуль Contnrs, там есть классы TStack и TQueue со всеми нужными методами.

[kaizer131]

я то не против применения готовых методов, но это нужно будет сдавать на сессии, да и к тому же сам хочу разобраться в реализации, просто зашёл в тупик при решении

[guranvir]

Посмотртите задачник Шеня, книгу С.Окулова Основы программирования там как раз эти темы на pascal с примерами разбираются

[kaizer131]

Сообщение от guranvir

Посмотртите задачник Шеня, книгу С.Окулова Основы программирования там как раз эти темы на pascal с примерами разбираются

В Окулове стеки описанны на 2х страницах , причем одна из них это определения , вы считаете что этого достаточно для понимания этого вопроса?
Задачник пока не нашёл...

[AlexSku]

Не смотрел всю программу, но по-моему эта вещь нехорошая:

Код:

Procedure In_stak(Var Beg:Stack; Sim:integer);
Var x:Stack;
Begin
    New(X);
    X^.inf:=Sim;
    X^.next:=Beg;
->    Beg:=X;
End;

Переменная Х - локальная и по завершении процедуры уничтожается автоматически, так что после выхода Beg будет указывать на мусор. Лучше Х объявлять как глобальную переменную или поле какого-нибудь объекта.

[Asinkrit]

Сообщение от AlexSku

Не смотрел всю программу, но по-моему эта вещь нехорошая:

Код:

Procedure In_stak(Var Beg:Stack; Sim:integer);
Var x:Stack;
Begin
    New(X);
    X^.inf:=Sim;
    X^.next:=Beg;
->    Beg:=X;
End;

Переменная Х - локальная и по завершении процедуры уничтожается автоматически, так что после выхода Beg будет указывать на мусор. Лучше Х объявлять как глобальную переменную или поле какого-нибудь объекта.

Во первых, x должна быть ссылкой на какой либо тип, в данном случае на элемент стека,
во вторых, переменные созданные методом New, не уничтожаются, после выхода из процедуры, к их уничтожению необходим метод Dispose();
А сама процедура явно написано неверено, так как все добавляемые элементы привязываются к первому.
А автору вопроса, советую почитать теорию, так как, пока не придет понимания работы стэка и очереди, писать код не имеет смысла.

[kaizer131]

Сообщение от Asinkrit

А автору вопроса, советую почитать теорию, так как, пока не придет понимания работы стэка и очереди, писать код не имеет смысла.

Если не сложно, скиньте ссылки на хорошие материалы по стекам, только без обьяснений на примере детских пирамид.
То что при работе со стеком мы можем брать только верхний элемент я знаю. вопрос в том как их не потерять при работе

[kaizer131]

Вот допустим

Код:

Procedure readStack(Var u : EXST; Var i : integer);
Var
  x : EXST;
Begin
  i := u^.Data; {считываем значение поля данных в переменную}
  x := u; {запоминаем адрес вершины стека}
  u := u^.Next; {переносим вершину стека на следующий элемент}
  dispose(x); {освобождаем память, занятую уже ненужным элементом стека}
End. 

Я так понимаю, что при применении такой процедуры мы потеряем элемент стека, но для его сохранения мы можем перед
u := u^.Next; {переносим вершину стека на следующий элемент}
занести этот элемент во второй стек .
Или я не прав ?

[s0Creator]

Сообщение от kaizer131

...
”Дан стек, элементами которого являются действительные числа. Сформировать структуру данных очередь, в которую включить значения тех элементов из стека, которые не превосходят uz. Элементы с найденными значениями из стека исключить. А также получить:
(uz+r)/(uz+s),
где
r- сумма всех тех значений элементов, которые не превосходят u,
s- сумма значений элементов, больших u.”

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

Ниже привожу свой код, укажите на ошибки.

Пара вопросов:
- На какой Delphi проходит обучение?
- Можно ли пользоваться классами?

У Тебя в секции type объявлены только элементы стека или очереди ( причем одинаковые ).

У самих стеков или очередей должны быть реализованы минимум 3 метода - Push, Pop, Peek. Которые описываются в классах, а в последних версиях Delphi можно и в структурах.

[kaizer131]

Обучение проходит на Delphi 7
но дома делаю на Delphi 2009, просто главное чтоб был работающий exe шник и файл с исходным кодом.
По поводу классов точно незнаю , так как ООП еще не проходили (эту тему осваиваю пока самостоятельно) но думаю их применение не запрещенно , главное уметь обьяснить принцип работы.
В type обьявленн стек и очередь.
Главная моя проблема это в процедуре взятия элемента стека , не могу понять почему они после этого пропадают (даже если в процедуре уберу строку dispose (x))
Главное не использовать массивов для хранения указателей и готовых решений типа TStack и TQueue

[s0Creator]

Будем посмотреть, постараюсь без классов и с минимумом переделок.

Плохо - у Тебя Elem и тип записи и переменная. тип записи обзову TElem.

[s0Creator]

У Тебя по заданию "действительные числа" - а это real а не integer.
меняю и смотрю дальше

[kaizer131]

Сообщение от s0Creator

У Тебя по заданию "действительные числа" - а это real а не integer.
меняю и смотрю дальше

оО оу мой косяк, не заметил

[s0Creator]

В общем тоже не ахти - давно с такими примитивами не работал и старался изменения по минимуму - но вроде работает

Код:

program new_stack;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  PElem = ^TElem;
  TElem = record // структура элемента
    inf: real;
    next: PElem;
  end;

  TStack = record
    first: PElem;
  end;

  TOcher = record
    first: PElem;
    last: PElem;
  end;

  /////////////////////// Добавляем в стек ///////////////////////////////////////

procedure Push_stak(var Stack: TStack; Sim: real);
var
  x: PElem;
begin
  New(X);
  X^.inf := Sim;
  X^.next := Stack.first;
  Stack.first := X;
end;

//////////////////////////// Достаём верхний элемент стека /////////////////////

function Pop_stak(var Stack: TStack; var INF: real): Boolean;
var
  x: PElem;
begin
  if Stack.first = nil then
    Result := false
  else
  begin
    Result := true;
    X := Stack.first;
    Stack.first := X^.next;
    INF := X^.inf;
    Dispose(x);
  end;
end;

//////////////////////////// Удаляем элемент стека /////////////////////

procedure Remove_stak(var Stack: TStack; Elem: PElem);
var
  x: PElem;
begin

  if Stack.first = Elem then
    Stack.first := Elem^.next
  else
  begin
    X := Stack.first;
    while X^.next <> nil do
    begin
      if X^.next = Elem then
      begin
        X^.next := Elem^.next;
        break;
      end;
      X := X^.next;
    end;

    Dispose(Elem);
  end;
end;
//////////////////////////////////////////////////////////////////////////////////

//////////////////////// Занесение в очередь ///////////////////////////////////

procedure Push_Ocher(var Ocher: TOcher; c: real);
var
  Elem: PElem;
begin
  new(Elem);
  Elem^.inf := c;
  Elem^.Next := nil;
  if Ocher.first = nil {проверяем, пуста ли очередь} then
    Ocher.first := Elem {ставим указатель начала очереди на первый созданный элемент}
  else
    Ocher.last^.next := Elem; {ставим созданный элемент в конец очереди}
  Ocher.last := Elem; {переносим указатель конца очереди на последний элемент}
end;

///////////////////////////// Чтение из очереди /////////////////////////////////

function Pop_Ocher(var Ocher: TOcher; var INF: real): Boolean;
var
  Elem: PElem;
begin
  if Ocher.first = nil then
    Result := false
      //    writeln('Очередь пуста')
  else
  begin
    Result := true;
    Elem := Ocher.first; {ставим промежуточный указатель на первый элемент очереди}
    INF := Elem^.inf; {считываем искомое значение в переменную с}
    Ocher.first := Elem^.Next; {указатель начала переносим на следующий элемент}
    if Elem^.Next = nil then {очередь пуста}
      Ocher.last := nil;
    dispose(Elem); {освобождаем память, занятую уже ненужным первым элементом}
  end;
end;

var
  MY: TStack;
  TmpElem, NextElem: PElem;
  I: Integer;
  uz, R, S: real;
  Ocher: TOcher;
begin
  R := 0;
  S := 0;
  Randomize;
  write('Input Uz :');
  readln(uz);

  MY.first := nil;
  Ocher.first := nil;
  Ocher.last := nil;

  for I := 0 to 10 do
  begin
    Push_stak(MY, random(10000) / 100);
  end;

  write('Ishodn stack :');

  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');
  readln;

  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    NextElem := TmpElem^.next;
    if TmpElem^.inf <= uz then // не превосходят, значит <= а было <
    begin
      R := R + TmpElem^.inf;
      Push_Ocher(Ocher, TmpElem^.inf); {помещаем элемент в очередь }
      Remove_stak(MY, TmpElem); {удаляем из стека}
    end
    else // значит больше
    begin
      S := S + TmpElem^.inf;
    end;
    TmpElem := NextElem;
  end;

  /////////////// Вывод стека ////////////////////////////////////////////////
  write('Stack :');
  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');

  /////////////// Вывод Очереди ////////////////////////////////////////////////
  write('Ocher :');
  TmpElem := Ocher.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');

  /////////////// Вывод итогового числа ////////////////////////////////////////////////
  write('Iskomoe chislo : ');
  write((uz + R) / (uz + S));

  ///// очищаем
  while Pop_stak(MY, R) do ;
  while Pop_Ocher(Ocher, R) do ;

  readln;
end.

Смотри - если что не так или вопросы процитируй отвечу.
( я не очень люблю много коментов - ленивый )