VPF::[Delphi]Создание бинарного дерева

asokmin

Дата 17.3.2011, 10:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 17.3.2011

Репутация: нет
Всего: нет

Нужно представить арифметическое выражение ( d*(f/j)+a/c-g*((R1*R5)/b)+e ) в виде бинарного дерева и обеспечить работу с этим бинарным деревом ( добавить вершину, изъять вершину, обчислить арифметическое выражнеие). Зарание спасибо.

v4v4n

Дата 21.3.2011, 14:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 45
Регистрация: 26.9.2008

Репутация: 2
Всего: 4

Нууу, начать можно так:

Код


unit BinaryTree;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  PElem =^TElem;
  TElem = record
      IsOp : Boolean;
      value: string[2];
      O1,O2:PElem;
  end;
Const
   Op = ['+','-','*','/'];

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CountOfOp(s : string):byte;
var i,count:byte;
Begin
    count:=0;
    for i:=1 to length(s) do begin
        if s[i] in Op then inc(count);
    end;
    result:=count;
End;
function GetMinPrior(s : string):byte;
const maxlvl=$FF;
var i, prior, mini, minlvl : byte;
    procedure Check(lvl:byte);
    begin
        if (lvl<=minlvl) then begin
           minlvl:=lvl;
           mini:=i;
        end;
    end;
Begin
    prior:=0; minlvl:=maxlvl; mini:=0;
    for i:=1 to length(s) do begin
        case s[i] of
        '(' : inc(prior);
        ')' : dec(prior);
        '*','/': Check(prior*2+1);
        '+','-': Check(prior*2);
        end;
    end;
    result:=mini;
End;
function ClearOperand(s:string):string;
Begin
    if (copy(s,1,1)='(')and(copy(s,length(s),1)=')') then result:=copy(s,2,length(s)-2) else result:=s;
End;
function GetOperand1(s:string;i:byte):string;
Begin
    result:=ClearOperand(copy(s,1,i-1));
End;
function GetOperand2(s:string;i:byte):string;
Begin
    result:=ClearOperand(copy(s,i+1,length(s)));
End;
function LoadBinaryTree(s:string):PElem;
var Elem:PElem; n :byte;
Begin
    new(Elem);
    Elem.IsOp:=CountOfOp(s)>0;
    if Elem.IsOp then begin
       n:=GetMinPrior(s);
       Elem.value:=s[n];
       Elem.O1:=LoadBinaryTree(GetOperand1(s,n));
       Elem.O2:=LoadBinaryTree(GetOperand2(s,n));
    end else begin
       Elem.value:=s;
       Elem.O1:=nil;
       Elem.O2:=nil;
    end;
    result:=Elem;
End;
procedure FreeBinaryTree(Elem:PElem);
Begin
    if Elem.O1<>nil then FreeBinaryTree(Elem.O1);
    if Elem.O2<>nil then FreeBinaryTree(Elem.O2);
    Dispose(Elem);
End;
function GetBinaryTree(Elem:PElem):string;
var s : string;
Begin
    s:='';
    if Elem.O1<>nil then s:='('+GetBinaryTree(Elem.O1);
    s:=s+Elem.value;
    if Elem.O2<>nil then s:=s+GetBinaryTree(Elem.O2)+')';
    result:=s;
End;
procedure TForm1.FormCreate(Sender: TObject);
begin
    Memo1.Clear;
    Edit1.Text:='d*(f/j)+a/c-g*((R1*R5)/b)+e';
end;

procedure TForm1.Button1Click(Sender: TObject);
var root:PElem;
procedure ShowBinaryTree(Elem:PElem);
var s :string;
Begin
    s:='';
    if Elem.O1<>nil then s:=GetBinaryTree(Elem.O1);
    s:=s+Elem.value;
    if Elem.O2<>nil then s:=s+GetBinaryTree(Elem.O2);
    Memo1.Lines.Add(s);
End;
begin
    root:=LoadBinaryTree(Edit1.Text);
    ShowBinaryTree(root);
    FreeBinaryTree(root)
end;

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »