Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Вниз

Реализация стеков и очередей   Найти похожие ветки 

 
kaizer131   (2010-02-25 14:59) [0]

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

Разбираюсь со стеками и очередями на примере следующей задачи:
 
  “Дан стек, элементами которого являются действительные числа. Сформировать структуру данных очередь, в которую включить значения тех элементов из стека, которые не превосходят 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.


 
KilkennyCat ©   (2010-02-25 15:39) [1]

Ты из Одессы?


 
Сергей М. ©   (2010-02-25 16:44) [2]

И к чему этот геморрой с собственной реализацией стека и очереди, если Delphi предоставляет готовые реализации стека и очереди  - TStack и TQueue ?
Тем более что в задании про обязательность этого геморроя ничего не сказано ?


 
KilkennyCat ©   (2010-02-25 17:16) [3]


> Сергей М. ©   (25.02.10 16:44) [2]

В Одессе в каком-то учебном заведении(ях) сейчас такие задачки.


 
kaizer131   (2010-02-26 07:36) [4]

Нет я не из одессы, про TStack и TQueue знаю , но мне нужно реализовать это БЕЗ ГОТОВЫХ РЕАЛИЗАЦИЙ так как это зачётная задача


 
Palladin ©   (2010-02-26 08:44) [5]

А встроенным отладчиком тебя пользоваться не научили?


 
kaizer131   (2010-02-26 09:12) [6]

Ну почему же, научили  с его помощью и узнал что при выводе на экран стек обнуляется + уже исправил несколько ошибок в часности с неправильным назначением переменных S и R, но отлов ошибк не закончен.
Поэтому задаю вопрос более опытным программистам почему при изьятии верхнего элемента стека в процедуре
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;

Он теряется даже если я убераю строку  Dispose(x);


 
Сергей М. ©   (2010-02-26 09:27) [7]


> нужно реализовать это БЕЗ ГОТОВЫХ РЕАЛИЗАЦИЙ так как это
> зачётная задача


Да не проблема)

Препод наверняка про эти классы не знает (оно ему надо ?), так что можно смело передрать код этих классов в свой код.

А если и знает, то ничто не мешает изменить этот код до неузнаваемости, сохранив при этом функциональность.


 
brother ©   (2010-02-26 09:34) [8]

> А если и знает, то ничто не мешает изменить этот код до
> неузнаваемости,

ога, главное имена переменных красиво обозвать: a,s,d,fer,w, vremenno, norm итд итп)


 
kaizer131   (2010-02-26 10:01) [9]

Я не нашёл код  методов класса TStack в файле Contnrs

там есть обьявления
{ TStack class }

 TStack = class(TOrderedList)
 protected
   procedure PushItem(AItem: Pointer); override;
 end;

{ TObjectStack class }

 TObjectStack = class(TStack)
 public
   function Push(AObject: TObject): TObject;
   function Pop: TObject;
   function Peek: TObject;
 end;


но самого исполняемого кода не нашёл, может не там ищу?


 
Сергей М. ©   (2010-02-26 10:32) [10]


> самого исполняемого кода не нашёл


Ну если ты будешь закрывать глаза на раздел implementation, то никогда не найдешь)

К тому же следует обратить на внимание на иерархию TStack <- TOrderedList <- TList.


 
Anatoly Podgoretsky ©   (2010-02-26 10:59) [11]

> kaizer131  (26.02.2010 07:36:04)  [4]

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


 
Anatoly Podgoretsky ©   (2010-02-26 11:00) [12]

> kaizer131  (26.02.2010 09:12:06)  [6]

Потому что локальная переменная.


 
Anatoly Podgoretsky ©   (2010-02-26 11:01) [13]

> Сергей М.  (26.02.2010 10:32:10)  [10]

О, ему еще и понятие иерархии изучать?


 
Сергей М. ©   (2010-02-26 20:59) [14]


> Anatoly Podgoretsky ©   (26.02.10 11:01) [13]


Ну а в чем ништяк "сдал и забыл как кошмар" ?)
Нет уж, мы такой ништяк допустить не вправе)



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.06 c
2-1265397112
И. Павел
2010-02-05 22:11
2010.08.27
Как проиграть несколько звуков из ресурса?


15-1269974235
Masolin_gazin
2010-03-30 22:37
2010.08.27
Почем Delphi 7 не произвести компиляцию.


15-1266269405
Юрий
2010-02-16 00:30
2010.08.27
С днем рождения ! 16 февраля 2010 вторник


2-1269587670
Свободный художник
2010-03-26 10:14
2010.08.27
Захват окна


2-1268672321
NBAH1990
2010-03-15 19:58
2010.08.27
IP сканер





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский