怎么计算一个数的3次开方(50分)

  • 主题发起人 主题发起人 seaerwang
  • 开始时间 开始时间
S

seaerwang

Unregistered / Unconfirmed
GUEST, unregistred user!
delphi6有函数吗?
 
没人知道?
 
exp(y*ln(1/3));
 
不就是 27^(1/3) = 3 吗?
好办。
留下EMail我发给你。
 
D5里的math.pas中不是有个power函数吗?在D6中没有了吗?
 
unit Parser;

//公式解析
interface

uses
{$IFDEF Win32}
Windows,
{$ELSE}
WinProcs, Wintypes,
{$ENDIF}
SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type
TGetVarEvent = procedure(Sender: TObject; VarName: string; var
Value: Extended; var Found: Boolean) of object;

TParseErrorEvent = procedure(Sender: TObject; ParseError: Integer)
of object;

TGetMyFunEvent = procedure(FunName: string; var
Value: Extended; DataName: string; var Found: Boolean) of object;

const
ParserStackSize = 15;
MaxFuncNameLen = 5;
MaxStrLength = 256;
ExpLimit = 11356;
SqrLimit = 1E2466;
MaxExpLen = 4;
TotalErrors = 7;
ErrParserStack = 1;
ErrBadRange = 2;
ErrExpression = 3;
ErrOperator = 4;
ErrOpenParen = 5;
ErrOpCloseParen = 6;
ErrInvalidNum = 7;

type
ErrorRange = 0..TotalErrors;

TokenTypes = (Plus, Minus, Times, Divide, Expo, OParen, CParen, Num,
Func, EOL, Bad, ERR, Modu, Str, MyFun);

TokenRec = record
State: Byte;
case Byte of
0: (Value: Extended);
2: (FuncName: string[MaxFuncNameLen]);
end; { TokenRec }

type
TMathParser = class(TComponent)
private
{ Private declarations }
FInput: string;
FOnGetVar: TGetVarEvent;
FOnParseError: TParseErrorEvent;
FOnMyFun: TGetMyFunEvent;
protected
{ Protected declarations }
CurrToken: TokenRec;
MathError: Boolean;
Stack: array[1..ParserStackSize] of TokenRec;
StackTop: 0..ParserStackSize;
TokenError: ErrorRange;
TokenLen: Word;
TokenType: TokenTypes;
function GotoState(Production: Word): Word;
function IsFunc(S: string): Boolean;
function IsVar(var Value: Extended): Boolean;
function NextToken: TokenTypes;
procedure Push(Token: TokenRec);
procedure Pop(var Token: TokenRec);
procedure Reduce(Reduction: Word);
procedure Shift(State: Word);
public
{ Public declarations }
Position: Word;
ParseError: Boolean;
ParseValue: Extended;
StrParseValue: string;
constructor Create(AOwner: TComponent);override;
procedure Parse;
published
{ Published declarations }
property OnGetVar: TGetVarEvent read FOnGetVar write FOnGetVar;
property OnGetMyFun: TGetMyFunEvent read FOnMyFun write FOnMyFun;
property OnParseError: TParseErrorEvent read FOnParseError
write FOnParseError;
property ParseString: string read FInput write FInput;
end;

procedure Register;

implementation
 
这是文件头啦
后面的不知为何贴上来就保存失败?!
 
const
Letters : set of Char = ['A'..'Z', 'a'..'z'];
// Numbers : set of Char = ['0'..'9'];

constructor TMathParser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{ defaults }
FInput := '';
end;

function TMathParser.GotoState(Production: Word): Word;
{ Finds the new state based on the just-completed production and the
top state. }
var
State : Word;
begin
GotoState := 0;
State := Stack[StackTop].State;
if (Production <= 3) then
begin
case State of
0: GotoState := 1;
9: GotoState := 19;
20: GotoState := 28;
end; { case }
end
else if Production <= 6 then
begin
case State of
0, 9, 20: GotoState := 2;
12: GotoState := 21;
13: GotoState := 22;
end; { case }
end
else if (Production <= 8) or (Production = 100) then
begin
case State of
0, 9, 12, 13, 20: GotoState := 3;
14: GotoState := 23;
15: GotoState := 24;
16: GotoState := 25;
40: GotoState := 80;
end; { case }
end
else if Production <= 10 then
begin
case State of
0, 9, 12..16, 20, 40: GotoState := 4;
end; { case }
end
else if Production <= 12 then
begin
case State of
0, 9, 12..16, 20, 40: GotoState := 6;
5: GotoState := 17;
end; { case }
end
else
begin
case State of
0, 5, 9, 12..16, 20, 40: GotoState := 8;
end; { case }
end;
end; { GotoState }

function TMathParser.IsFunc(S: string): Boolean;
{ Checks to see if the parser is about to read a function }
var
P, SLen : Word;
FuncName : string;
begin
P := Position;
FuncName := '';
while (P <= Length(FInput)) and (FInput[P] in ['A'..'Z', 'a'..'z', '0'..'9',
'_']) do
begin
FuncName := FuncName + FInput[P];
Inc(P);
end; { while }
if Uppercase(FuncName) = S then
begin
SLen := Length(S);
CurrToken.FuncName := UpperCase(Copy(FInput, Position, SLen));
Inc(Position, SLen);
IsFunc := True;
end { if }
else
IsFunc := False;
end; { IsFunc }

function TMathParser.IsVar(var Value: Extended): Boolean;
var
VarName : string;
VarFound : Boolean;
begin
VarFound := False;
VarName := '';
while (Position <= Length(FInput)) and ((FInput[Position] in ['A'..'Z',
'a'..'z', '0'..'9', '_', '.']) or (Ord(FInput[Position]) > 128)) do
begin
VarName := VarName + FInput[Position];
Inc(Position);
end; { while }
if Assigned(FOnGetVar) then
FOnGetVar(Self, VarName, Value, VarFound);
IsVar := VarFound;
end; { IsVar }

function TMathParser.NextToken: TokenTypes;
{ Gets the next Token from the Input stream }
var
NumString : string[80];
TLen, NumLen : Word;
Check : Integer;
Ch : Char;
Decimal : Boolean;
begin
NextToken := EOL;
while (Position <= Length(FInput)) and (FInput[Position] = ' ') do
Inc(Position);
TokenLen := Position;
if Position > Length(FInput) then
begin
NextToken := EOL;
TokenLen := 0;
Exit;
end; { if }
Ch := UpCase(FInput[Position]);
if Ch in ['!'] then
begin
NextToken := ERR;
TokenLen := 0;
Exit;
end; { if }
if Ch in ['0'..'9', '.'] then
begin
NumString := '';
TLen := Position;
Decimal := False;
while (TLen <= Length(FInput)) and
((FInput[TLen] in ['0'..'9']) or
((FInput[TLen] = '.') and (not Decimal))) do
begin
NumString := NumString + FInput[TLen];
if Ch = '.' then
Decimal := True;
Inc(TLen);
end; { while }
if (TLen = 2) and (Ch = '.') then
begin
NextToken := BAD;
TokenLen := 0;
Exit;
end; { if }
if (TLen <= Length(FInput)) and (UpCase(FInput[TLen]) = 'E') then
begin
NumString := NumString + 'E';
Inc(TLen);
if FInput[TLen] in ['+', '-'] then
begin
NumString := NumString + FInput[TLen];
Inc(TLen);
end; { if }
NumLen := 1;
while (TLen <= Length(FInput)) and (FInput[TLen] in ['0'..'9']) and
(NumLen <= MaxExpLen) do
begin
NumString := NumString + FInput[TLen];
Inc(NumLen);
Inc(TLen);
end; { while }
end; { if }
if NumString[1] = '.' then
NumString := '0' + NumString;
Val(NumString, CurrToken.Value, Check);
if Check <> 0 then
begin
MathError := True;
TokenError := ErrInvalidNum;
Inc(Position, Pred(Check));
end { if }
else
begin
NextToken := NUM;
Inc(Position, System.Length(NumString));
TokenLen := Position - TokenLen;
end; { else }
Exit;
end { if }
else if (Ch in Letters) or (Ord(CH) > 128) then
begin
if IsFunc('ABS') or
IsFunc('ATAN') or
IsFunc('COS') or
IsFunc('EXP') or
IsFunc('LN') or
IsFunc('ROUND') or
IsFunc('SIN') or
IsFunc('SQRT') or
IsFunc('SQR') or
IsFunc('TRUNC') then //My Add
begin
NextToken := FUNC;
TokenLen := Position - TokenLen;
Exit;
end; { if }
if IsFunc('SUM') then
begin
NextToken := MyFun;
TokenLen := Position - TokenLen;
Exit;
end;
if IsFunc('STR') then
begin
NextToken := Str;
TokenLen := Position - TokenLen;
Exit;
end;
if IsFunc('MOD') then
begin
NextToken := MODU;
TokenLen := Position - TokenLen;
Exit;
end; { if }
if IsVar(CurrToken.Value) then
begin
NextToken := NUM;
TokenLen := Position - TokenLen;
Exit;
end { if }
else
begin
if CurrToken.FuncName = 'STR' then
NextToken := EOL
else
NextToken := BAD;
TokenLen := 0;
Exit;
end; { else }
end { if }
else
begin
case Ch of
'+': NextToken := PLUS;
'-': NextToken := MINUS;
'*': NextToken := TIMES;
'/': NextToken := DIVIDE;
'^': NextToken := EXPO;
'(': NextToken := OPAREN;
')': NextToken := CPAREN;
else
begin
NextToken := BAD;
TokenLen := 0;
Exit;
end; { case else }
end; { case }
Inc(Position);
TokenLen := Position - TokenLen;
Exit;
end; { else if }
end; { NextToken }

procedure TMathParser.Pop(var Token: TokenRec);
{ Pops the top Token off of the stack }
begin
Token := Stack[StackTop];
Dec(StackTop);
end; { Pop }

procedure TMathParser.Push(Token: TokenRec);
{ Pushes a new Token onto the stack }
begin
if StackTop = ParserStackSize then
TokenError := ErrParserStack
else
begin
Inc(StackTop);
Stack[StackTop] := Token;
end; { else }
end; { Push }

procedure TMathParser.Parse;
{ Parses an input stream }
var
FirstToken : TokenRec;
Accepted : Boolean;
iM : Integer;
DataName : string;
Found : Boolean;
begin
Position := 1;
StackTop := 0;
TokenError := 0;
MathError := False;
ParseError := False;
Accepted := False;
FirstToken.State := 0;
FirstToken.Value := 0;
Push(FirstToken);
TokenType := NextToken;
repeat
case Stack[StackTop].State of
0, 9, 12..16, 20, 40:
begin
if TokenType = NUM then
Shift(10)
else if TokenType = FUNC then
Shift(11)
else if TokenType = MINUS then
Shift(5)
else if TokenType = OPAREN then
Shift(9)
else if TokenType = ERR then
begin
MathError := True;
Accepted := True;
end { else if }
else if TokenType = Str then //My Add
begin
ParseError := False;
StrParseValue := Copy(ParseString, 5, Length(ParseString) - 4);
Exit;
end
else if TokenType = MyFun then
begin
if Assigned(FOnMyFun) then
begin
//
iM := Position + 1;
DataName := '';
while (iM <= Length(FInput)) and ((FInput[iM] in ['A'..'Z',
'a'..'z', '0'..'9', '_', '.'])) do
begin
DataName := DataName + FInput[iM];
Inc(iM);
end; { while }
OnGetMyFun(CurrToken.FuncName, CurrToken.Value, DataName, Found);
if not Found then
MathError := True
end
else
CurrToken.Value := 0;
Exit;
end
else
begin
TokenError := ErrExpression;
Dec(Position, TokenLen);
end; { else }
end; { case of }
1:
begin
if TokenType = EOL then
Accepted := True
else if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else
begin
TokenError := ErrOperator;
Dec(Position, TokenLen);
end; { else }
end; { case of }
2:
begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(3);
end; { case of }
3:
begin
if TokenType = MODU then
Shift(40)
else
Reduce(6);
end; { case of }
4:
begin
if TokenType = EXPO then
Shift(16)
else
Reduce(8);
end; { case of }
5:
begin
if TokenType = NUM then
Shift(10)
else if TokenType = FUNC then
Shift(11)
else if TokenType = OPAREN then
Shift(9)
else
begin
TokenError := ErrExpression;
Dec(Position, TokenLen);
end; { else }
end; { case of }
6: Reduce(10);
7: Reduce(13);
8: Reduce(12);
10: Reduce(15);
11:
begin
if TokenType = OPAREN then
Shift(20)
else
begin
TokenError := ErrOpenParen;
Dec(Position, TokenLen);
end; { else }
end; { case of }
17: Reduce(9);
18: raise Exception.Create('错误的状态!');
19:
begin
if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else if TokenType = CPAREN then
Shift(27)
else
begin
TokenError := ErrOpCloseParen;
Dec(Position, TokenLen);
end;
end; { case of }
21:
begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(1);
end; { case of }
22:
begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(2);
end; { case of }
23: Reduce(4);
24: Reduce(5);
25: Reduce(7);
26: Reduce(11);
27: Reduce(14);
28:
begin
if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else if TokenType = CPAREN then
Shift(29)
else
begin
TokenError := ErrOpCloseParen;
Dec(Position, TokenLen);
end; { else }
end; { case of }
29: Reduce(16);
80: Reduce(100);
end; { case }
until Accepted or (TokenError <> 0);
if TokenError <> 0 then
begin
if TokenError = ErrBadRange then
Dec(Position, TokenLen);
if Assigned(FOnParseError) then
FOnParseError(Self, TokenError);
end; { if }
if MathError or (TokenError <> 0) then
begin
ParseError := True;
ParseValue := 0;
Exit;
end; { if }
ParseError := False;
ParseValue := Stack[StackTop].Value;
end; { Parse }

procedure TMathParser.Reduce(Reduction: Word);
{ Completes a reduction }
var
Token1, Token2 : TokenRec;
begin
case Reduction of
1:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurrToken.Value := Token1.Value + Token2.Value;
end;
2:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurrToken.Value := Token2.Value - Token1.Value;
end;
4:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurrToken.Value := Token1.Value * Token2.Value;
end;
5:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
if Token1.Value = 0 then
MathError := True
else
CurrToken.Value := Token2.Value / Token1.Value;
end;

{ MOD operator }
100:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
if Token1.Value = 0 then
MathError := True
else
CurrToken.Value := Round(Token2.Value) mod Round(Token1.Value);
end;

7:
begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
if Token2.Value <= 0 then
MathError := True
else if (Token1.Value * Ln(Token2.Value) < -ExpLimit) or
(Token1.Value * Ln(Token2.Value) > ExpLimit) then
MathError := True
else
CurrToken.Value := Exp(Token1.Value * Ln(Token2.Value));
end;
9:
begin
Pop(Token1);
Pop(Token2);
CurrToken.Value := -Token1.Value;
end;
11: raise Exception.Create('非法约束');
13: raise Exception.Create('非法约束');
14:
begin
Pop(Token1);
Pop(CurrToken);
Pop(Token1);
end;
16:
begin
Pop(Token1);
Pop(CurrToken);
Pop(Token1);
Pop(Token1);
if Token1.FuncName = 'ABS' then
CurrToken.Value := Abs(CurrToken.Value)
else if Token1.FuncName = 'ATAN' then
CurrToken.Value := ArcTan(CurrToken.Value)
else if Token1.FuncName = 'COS' then
begin
if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
MathError := True
else
CurrToken.Value := Cos(CurrToken.Value)
end {...if Token1.FuncName = 'SIN' }
else if Token1.FuncName = 'EXP' then
begin
if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
MathError := True
else
CurrToken.Value := Exp(CurrToken.Value);
end
else if Token1.FuncName = 'LN' then
begin
if CurrToken.Value <= 0 then
MathError := True
else
CurrToken.Value := Ln(CurrToken.Value);
end
else if Token1.FuncName = 'ROUND' then
begin
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
MathError := True
else
CurrToken.Value := Round(CurrToken.Value);
end
else if Token1.FuncName = 'SIN' then
begin
if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
MathError := True
else
CurrToken.Value := Sin(CurrToken.Value)
end {...if Token1.FuncName = 'SIN' }
else if Token1.FuncName = 'SQRT' then
begin
if CurrToken.Value < 0 then
MathError := True
else
CurrToken.Value := Sqrt(CurrToken.Value);
end
else if Token1.FuncName = 'SQR' then
begin
if (CurrToken.Value < -SQRLIMIT) or (CurrToken.Value > SQRLIMIT) then
MathError := True
else
CurrToken.Value := Sqr(CurrToken.Value);
end
else if Token1.FuncName = 'TRUNC' then
begin
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
MathError := True
else
CurrToken.Value := Trunc(CurrToken.Value);
end;
end;
3, 6, 8, 10, 12, 15: Pop(CurrToken);
end; { case }
CurrToken.State := GotoState(Reduction);
Push(CurrToken);
end; { Reduce }

procedure TMathParser.Shift(State: Word);
{ Shifts a Token onto the stack }
begin
CurrToken.State := State;
Push(CurrToken);
TokenType := NextToken;
end; { Shift }

procedure Register;
begin
RegisterComponents('zhaqiong', [TMathParser]);
end;

end.
 
power(27,1/3)=3;

别忘了uses 上math单元!
 
贴上去了,dfw不太稳定!
这是别人的一个单元文件,涉及到计算我都用她,功能不错。

给邮箱的话就发例子给你,或自己看:
procedure TForm1.Button1Click(Sender: TObject);
var
x: extended;
begin
MathParser1.ParseString := self.Edit1.Text;
MathParser1.Parse;
if not MathParser1.ParseError then
begin
x := MathParser1.ParseValue;
showmessage(floattostr(x));
end
else
begin
showmessage('表达式错误!');
end;

end;

 
拜托,zhaqiong,人家问是怎么开方,又不是表达式计算器。

power就可以了啦!
modula-2的方法是VB的吧!n^(1/3)
人在昆明的方法可以,但还是用power比较好。exp(y*ln(1/3));
dangbochang连例子都写出来了。

分数应该由我、人在昆明和dangbochang来分吧![:D][:D][:D][:D][:D][:D][:D]
 
怎么把string转成extended?
[Error] FmSmud.pas(1090): Incompatible types: 'String' and 'Extended'

strtofloat('234')=234;
 
showmessage(floattostr(exp(27*ln(1/3))))<>3
怎么不对啊
 
showmessage(floattostr(exp(27*ln(1/3))))<>3

肯定不对!
 
那怎么对啊?
 
to 人在昆明 :mail分给你了,
说说这个这么做?
 
后退
顶部