{*******************************************************************************
********************************************************************************

    Stackklasse, welche die Funktionalität des Stacks veranschaulicht

                  Erstellt am 14.03.2007 Matthias Lorenz

{*******************************************************************************
*******************************************************************************}

unit Stack;

interface

uses classes, sysutils;

{*******************************************************************************
                      // Typen für die Stackklasse
*******************************************************************************}

type TZeichen = (PLUS,MINUS,MAL,GETEILT);
type TZahlen = (NULL,EINS,ZWEI,DREI,VIER,FUENF,SECHS,SIEBEN,ACHT,NEUN);

type Zeiger = ^Stack_Speicher;

Stack_Speicher = Record
   Wert : Integer;
   Next : Zeiger;
   Prev : Zeiger;
end;

{*******************************************************************************
                            // Stack Klasse
*******************************************************************************}

type TStack = class(TObject)
private
 FStackAnfang : Zeiger;
 FNeuesElement : Zeiger;
 FStackTop : Zeiger;
 FStackCount : Integer;

public

Constructor Create;
Destructor Destroy; override;
procedure Push (Element : Integer);
function Pop () : Integer;
function Top () : Integer;
function Stack_Elemente_Anzahl () : Integer;
function Infix_Postfix ( Text : String ) : String;

end;

implementation

{*******************************************************************************
*******************************************************************************}

{ Stack }

constructor TStack.Create;
begin
 FStackCount := 0;
 FStackAnfang := Nil;
end;

{*******************************************************************************
*******************************************************************************}

destructor TStack.Destroy;
var Neues_Letztes_Element : Zeiger;
begin // Liste durchlaufen, bis der Prev- Zeiger auf Nil zeigt ( Listenende )
 if (FStackTop = nil) then exit;
  Neues_Letztes_Element := FStackTop;

   while (Neues_Letztes_Element.Prev <> nil) do
    begin
     Neues_Letztes_Element := FStackTop^.Prev;
     Neues_Letztes_Element^.Next := nil;
     Dispose(FStackTop);
     FStackTop := Neues_Letztes_Element;
    end;

end;

{*******************************************************************************
*******************************************************************************}

function TStack.Pop() : Integer; // Vom Stack löschen
var Neues_Letztes_Element : Zeiger;
begin
 result := 0;
 if ( FStackCount = 0 ) then
 begin
  result := 0;
  exit;
 end;

  if ( FStackCount = 1 ) then // Nur wenn noch 1 Element auf dem Stack
   begin
    result := FStackTop^.Wert;
    Dispose(FStackAnfang);
    FStackAnfang^.Next := nil;
    FStackAnfang^.Prev := nil;
    FStackAnfang := nil;
    FStackTop := FStackAnfang;
    FStackCount := 0;
   end
    else
     begin // Ansonsten oberste Element auf dem Stack entfernen }

      if ( FStackTop.Prev = nil ) then
       begin
        FStackTop := FStackAnfang;
        exit;
       end;
        result := FStackTop^.Wert;
        Neues_Letztes_Element := FStackTop^.Prev;
        Neues_Letztes_Element^.Next := nil;
        Dispose(FStackTop);
        FStackTop := Neues_Letztes_Element;
        FStackCount := FStackCount - 1;
     end;

end;

{*******************************************************************************
*******************************************************************************}

procedure TStack.Push(Element: Integer); // Auf den Stack legen
begin
  if ( FStackCount = 0 ) then // Sonderfall ( Erstes Element )
   begin
    New(FNeuesElement);
    FStackAnfang := FNeuesElement;
    FStackAnfang^.Wert := Element;
    FStackAnfang^.Next := Nil;
    FStackAnfang^.Prev := Nil;
    FStackTop := FStackAnfang;
    FStackCount := FStackCount +1;
   end
    else // Sonst nur Elemente verknüpfen
     begin
      New(FNeuesElement);
      FNeuesElement^.Next := Nil;
      FNeuesElement^.Prev := FStackTop;
      FNeuesElement^.Wert := Element;
      FStackTop^.Next := FNeuesElement;
      FStackTop := FNeuesElement;
      FStackCount := FStackCount +1;
     end;
end;

{*******************************************************************************
*******************************************************************************}

function TStack.Stack_Elemente_Anzahl: Integer;
begin
 result := FStackCount;
end;

{*******************************************************************************
*******************************************************************************}

function TStack.Top(): Integer;
begin // Oberstes Element zurückliefern
 result := 0;
  if ( FStackCount = 1 ) then result := FStackAnfang^.Wert;
   if ( FStackCount > 1 ) then result := FStackTop^.Wert;
end;

{*******************************************************************************
*******************************************************************************}

function TStack.Infix_Postfix(Text: String): String;
var Term : String;
    i : Integer;
    Zahl1, Zahl2, Ergebnis : Double;
    Zahlenmenge : Shortint;

begin
 Zahlenmenge := 0;
 Term := StringReplace(Text,' ','',[rfReplaceAll]);
 result := Term;

 for i := 1 to Length(Term) do
  begin

     // Prototyp [ sollte auch mit in [ 0..9] funktionieren
    case (Term[i]) of
     '1': Push(1);
     '2':
       begin
        Push(2);
        Zahlenmenge := Zahlenmenge + 1;
       end;
     '3': Push(3);
     '4':
      begin
       Push(4);
       Zahlenmenge := Zahlenmenge + 1;
      end;
     '5': Push(5);
     '6': Push(6);
     '7': Push(7);
     '8': Push(8);
     '9': Push(9);
    end;


    if ( Zahlenmenge = 2 ) then
     begin

     // Prüfen, welcher Operator im Term vorhanden ist
    case (Term[i]) of
     '+':
      begin
       Zahl2 := Pop();
       Zahl1 := Pop();
       Ergebnis := Zahl1 + Zahl2;
       result := FloattoStr(Ergebnis);
      end;
     '-':
      begin
       Zahl2 := Pop();
       Zahl1 := Pop();
       Ergebnis := Zahl1 - Zahl2;
       result := FloattoStr(Ergebnis);
      end;
     '*':
      begin
       Zahl2 := Pop();
       Zahl1 := Pop();
       Ergebnis := Zahl1 * Zahl2;
       result := FloattoStr(Ergebnis);
      end;
     '/':
      begin
       Zahl2 := Pop();
       Zahl1 := Pop();
       Ergebnis := Zahl1 / Zahl2;
       result := FloattoStr(Ergebnis);
      end;
    end;
  end;

     end;