Упростить дерево-формулу! Опции

[Веталь]

Формулу вида
<формула >::=<терминал >|(<формула ><знак><формула >)
<знак>::= + | – | * | /
<терминал >::=<переменная>|<цифра >
<переменная>::=a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z
<цифра >::=0|1|2|3|4|5|6|7|8|9
можно представить в виде двоичного дерева по следующим правилам:
формула из одного терминального символа (цифры или переменной )
представляется деревом, состоящим из одной вершины, содержащей этот
символ, а формула вида (f1 s f2) — деревом, в котором корень — это знак s, а
левое и правое поддеревья — это соответствующие представления формул
f1 и f2. О писать подпрограмму, которая:
преобразует дерево-формулу, заменяя в нем все поддеревья,
соответствующие формулам ((f1 +- f2) * f3) и (f1 * (f2 + - f3)), на поддеревья,
соответствующие формулам ((f1 * f3) +-(f2 * f3)) и ((f1 * f2) +-(f1 * f3));

есть несколько готовых методов:
модуль создания корня дерева, здесь функция создания узла

unit UParentKnot;

interface


type
  PNode = ^TNode;
  TNode = object
  private
    FLeft,
    FRight: PNode;

  public
    
    constructor InitEmpty;

    Procedure Print; virtual;

    function LoadFromStr (var str : string ; var i : integer) : boolean; virtual;
    Procedure SaveToText(var F: Text); virtual;

    {-}function Calculate: real; virtual;

    procedure Clear;
    destructor done; virtual;

    Function GetLeft: PNode;
    Function GetRight: PNode;

    procedure SetLeft(ANode : PNode);
    procedure SetRight(ANode : PNode);


  end;

  function NewNode (var str : string; var i : integer): PNode;


implementation

uses
  SysUtils,
  UIntKnot,
  UVarNameKnot,
  USignKnot;

  function NewNode(var str: string; var i: integer): PNode;
  begin
    While (i<=Length(str)) and (str[i]=' ') do
      inc(i); 
    if i>Length(str)
    then Result:=nil
    else
      begin
        case str[i] of
          '0','1'..'9': Result:=New(PIntNode, InitEmpty); 
          'a'..'z': Result:=New(PVarNode, InitEmpty);
          '(':  Result:=New(PSignNode, InitEmpty);
        else Result:=nil
        end;
        if Result<> nil
        then
          if not result.LoadFromStr(str,i)
          then
            begin
              dispose(Result);
              Result:=nil;
            end;
      end;
  end;

добавление числа в дерево

uses
  UParentKnot, SysUtils;

type
  TElem = integer;
  PIntNode = ^TIntNode;
  TIntNode = object(TNode)
  private
    FInf: TElem;

  public
    constructor InitEmpty;
    constructor Init(AInf: TElem);

    procedure Input; virtual;
    procedure Print; virtual;

    function LoadFromStr (var str : string ; var i : integer) : boolean; virtual;
    Procedure SaveToText(var f: TextFile);  virtual;

  {-}function Calculate: real; virtual;

    Function GetInf: TElem;
    Procedure SetInf(AInf: TElem);

  end;

добавление переменной в дерево

  TElem = string; 
    PVarNode = ^TVarNode;  
    TVarNode = object(TNode)
      private
        FInf: TElem;

      public
        Constructor InitEmpty;
        constructor Init(AInf: TElem);

        procedure Input; virtual;
        procedure Print; virtual;

        function LoadFromStr (var str : string ; var i : integer) : boolean; virtual;
        Procedure SaveToText(var F: TextFile); virtual;

        function Calculate: real; virtual;

        Function GetInf: TElem;
        Procedure SetInf(AInf: TElem);
      end; {object}

добавление знака в дерево

  type
    TSign = (add,subtr,mult,divide,empty);
    TElem = TSign;
    PSignNode = ^TSignNode;  
    TSignNode = object (TNode)
      private
        FInf: TElem;
      public

        constructor InitEmpty;
        constructor Init(AInf: TElem);

        Procedure Input; virtual;
        procedure Print; virtual;

        function LoadFromStr (var str : string ; var i : integer) : boolean; virtual;
        Procedure SaveToText(var f: TextFile); Virtual;

        function Calculate: real; virtual;

        Function GetInf: TElem;
        Procedure SetInf(AInf: TElem);
      end;{object}

  const
    NameSign: array [TSign] of char = ('+', '-', '*', '/', '?');

    procedure ReadSign (var Sign: TSign);
    function StrToSign(ch:char):TSign;

И, собственно, загрузка формулы из файла

Type
  TFormula = object
    Private
      FRoot: PNode;

    Public
      constructor Init;

      Procedure LoadFromText(FName: string);
      Function LoadFromStr(str: string): boolean;

      Procedure SaveToText (FName: string);
      Procedure Print;

      Function Calculate: real;

      Procedure Clear;
    end;


function TIntNode.LoadFromStr (var str : string ; var i : integer) : boolean;
  var d: string;
  begin
    d:='';
    While  (i<=length(str)) and (str[i] in ['0'..'9']) do
      begin
        d:=d+str[i];
        inc(i);
      end;
    FInf:=StrToInt(d);
    Result:=true;
  end;


  function TVarNode.LoadFromStr (var str : string ; var i : integer) : boolean;
  var c: string;
  begin
    c:='';
    While (i<=length(str))and(str[i] in ['a'..'z']) do
      begin
        c:=c+str[i];
        inc(i);
      end;
    FInf:=c;
    VarMas.Add(FInf);
    Result:=true;
  end;

  function TSignNode.LoadFromStr (var str : string ; var i : integer) : boolean;
  begin
    Result:=true;
    if (i>Length(str)) then
      Result:=false
    else
      if str[i]<>'(' then
        Result:=false
      else
        begin
          i:=i+1;
          While (i<=Length(str)) and (str[i]=' ') do
            inc(i);  
          SetLeft(NewNode(str,i));
          if GetLeft=nil
          Then result:=false
          else
            begin
              While (i<=Length(str)) and (str[i]=' ') do
                inc(i);  
              if (i>Length(str)) or not (Str[i] in ['+','-','*','/']) then
                Result:=false
              else
                begin
                  FInf:=StrToSign(Str[i]);
                  i:=i+1; 
                  While (i<=Length(str)) and (str[i]=' ') do
                    inc(i);
                  SetRight(NewNode(str,i));
                  if GetRight=nil then
                    Result:=false
                  else
                    begin
                      While (i<=Length(str)) and (str[i]=' ') do
                        inc(i);
                      if (i>Length(str)) or (str[i]<>')') then
                        Result:=false
                      else
                        i:=i+1;
                    end;
                end
            end;
         end;
  end;

  Procedure TFormula.LoadFromText(FName: string);
  var
    F: Text;
    s, str: string;
  begin
    AssignFile(F,FName);
    reset(f);
    str:='';
    while not eof(f) do
      begin
        readln(f, s);
        str:=str+s
      end;
    close(f);
    if not LoadFromStr(str)
    then writeln;
  end;

Помогите пожалуйста дописать нехватающие методы и оформить задачу. Заранее спасибо, кто поможет

Сообщение отредактировано: Веталь - 17.04.2009 16:36