四则运算代数式转换为浮点数

作 者: cailu_888(想你~★) 2001-03-07 13:17:46 :0 :0 将一个包括多重扩号的四则运算代数式转换为浮点数，经典算法是用运算符后置法，再用栈原理计算。小苦想到了一种新颖的算法，用嵌套调用和递归也可以把结果算出来。小苦写成动态链接库TxtToF.dll，VB,Delphi,C++Builder,Visual C++,Java等可以调用。
源代码如下：
　
//动态连接库TxtToF.dll
library TxtToF;
uses
SysUtils;
　
//删除字符串S中的子串SubStr
function DeleteSubStr(S, SubStr: String): String;
begin
while Pos(SubStr, S) <> 0 do
Delete(S, Pos(SubStr, S), Length(SubStr));
Result := S;
end;
//删除字符串中的所有扩号
function DeleteK(S: String): String;
begin
S := DeleteSubStr(S, '(');
S := DeleteSubStr(S, ')');
Result := S;
end;
//返回字符串代数式的第一个运算符的整形序号
function GetOpIndex(S: String): Integer;
var
iAdd, iSub, iMu, iDiv: Integer;
begin
iAdd := Pos('+', S);
iSub := Pos('-', S);
iMu := Pos('*', S);
iDiv := Pos('/', S);
if iAdd = 0 then iAdd := 1000;
if iSub = 0 then iSub := 1000;
if iMu = 0 then iMu := 1000;
if iDiv = 0 then iDiv := 1000;
if (iAdd < iSub) and (iAdd < iMu) and
(iAdd < iDiv) then Result := iAdd else
if (iSub < iAdd) and (iSub < iMu) and
(iSub < iDiv) then Result := iSub else
if (iMu < iAdd) and (iMu < iSub) and
(iMu < iDiv) then Result := iMu else
if (iDiv < iAdd) and (iDiv < iSub) and
(iDiv < iMu) then Result := iDiv
else
Result := 0;
end;
//消除一个浮点数的前面的多重负号，如"__2"返回"2"，"___2"返回"_2"
function DeleteMinus(S: String): String;
var
bMinus: Boolean;
begin
bMinus := False;
while S[1] = '_' do
begin
Delete(S, 1, 1);
bMinus := not(bMinus);
end;
if bMinus then Result := '_' + S
else Result := S;
end;
//计算单运算符的代数式，返回浮点数字符串，负号为"_"
function SingleCal(S: String): String;
var
strTemp, strResult: String;
fLeft, fRight: Double;
i, iOpIndex: Integer;
begin
if S[1] = '-' then S[1] := '_';
iOpIndex := GetOpIndex(S);
//要是没有运算符的话，S就是结果
if (iOpIndex = 0) then
begin
Result := S;
exit;
end;
strTemp := ' ';
for i := 0 to iOpIndex - 1 do
strTemp := S;
strTemp := Trim(strTemp);
strTemp := DeleteMinus(strTemp);
if strTemp[1] = '_' then
begin
Delete(strTemp, 1, 1);
fLeft := - StrToFloat(strTemp);
end else
fLeft := StrToFloat(strTemp);
strTemp := ' ';
for i := iOpIndex + 1 to Length(S) do
strTemp := S;
strTemp := Trim(strTemp);
strTemp := DeleteMinus(strTemp);
if strTemp[1] = '_' then
begin
Delete(strTemp, 1, 1);
fRight := - StrToFloat(strTemp);
end else
fRight := StrToFloat(strTemp);
if S[iOpIndex] = '+' then
strResult := FloatToStr(fLeft + fRight)
else if S[iOpIndex] = '-' then
strResult := FloatToStr(fLeft - fRight)
else if S[iOpIndex] = '*' then
strResult := FloatToStr(fLeft * fRight)
else if S[iOpIndex] = '/' then
strResult := FloatToStr(fLeft / fRight);
if strResult[1] = '-' then
strResult[1] := '_';
Result := strResult;
end;
//计算只有加号或减号的多运算符代数式，返回浮点数字符串，负号为"_"
function AddSubCal(S: String): String;
var
strTemp: String;
iOpIndex, iLeft, iRight, i: Integer;
begin
if S[1] = '-' then S[1] := '_';
//要是没有运算符号，S就是结果
iOpIndex := GetOpIndex(S);
if (iOpIndex = 0) then
begin
Result := SingleCal(S);
exit;
end;
//计算第一条单运算符式子的左浮点数起始位置iLeft
iLeft := iOpIndex - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;
//计算第一条单运算符式子的右浮点数起始位置iRight
iRight := iOpIndex + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;
strTemp := ' ';
for i := iLeft to iRight do
strTemp := S;
strTemp := Trim(strTemp);
Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);
//递归调用AddSubCal
//每调用一次AddSubCal，消除式中的一个运算符，知道没有运算符为止
Result := AddSubCal(S);
end;
//计算无扩号的多运算符代数式，返回浮点数字符串，负号为"_"
function NoKCal(S: String): String;
var
strTemp: String;
iOpIndex, iMu, iDiv, iLeft, iRight, i: Integer;
begin
if S[1] = '-' then S[1] := '_';
iOpIndex := GetOpIndex(S);
//要是没有运算符号，S就是结果
if (iOpIndex = 0) then
begin
Result := AddSubCal(S);
exit;
end;
//将负数的负号转为'_'
if (iOpIndex = 1) and (S[1] = '-') then
S[1] := '_';
//------------首先考虑运算符等级高的乘号和除号---------------
iMu := Pos('*', S);
iDiv := Pos('/', S);
if (iMu <> 0) or (iDiv <> 0) then
begin
//乘法运算
if ((iMu < iDiv) and (iMu <> 0)) or ((iMu <> 0) and (iDiv = 0)) then
begin
iLeft := iMu - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;
iRight := iMu + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;
strTemp := ' ';
for i := iLeft to iRight do
strTemp := S;
strTemp := Trim(strTemp);
Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);
//递归调用NoKCal
Result := NoKCal(S);
exit;
end;
//除法运算
if (iDiv < iMu) and (iDiv <> 0) or ((iDiv <> 0) and (iMu = 0)) then
begin
iLeft := iDiv - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;
iRight := iDiv + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;
strTemp := ' ';
for i := iLeft to iRight do
strTemp := S;
strTemp := Trim(strTemp);
Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);
//递归调用NoKCal，直到没有*号和/号为止
Result := NoKCal(S);
exit;
end;
end else
//---------------------------------------------------------------
Result := AddSubCal(S);//S只剩下加号或减号了
end;
//计算复杂的代数式字符串，返回浮点数字符串，负号为"_"
function Cal(S: String): String;
var
strTemp, strOp: String;
iLeftK, iRightK, iTemp, i: Integer;
begin
//删除空格
S := DeleteSubStr(S, ' ');
//要是式子为不带扩号的简单运算式的话
if Pos('(', S) = 0 then
begin
Result := NoKCal(S);
exit;
end;
// 计算出式中最后一个左扩号的位置iLeftK，并把它前面的字符串和它都删除
strTemp := S;
iTemp := Pos('(', strTemp);
iLeftK := - iTemp;
while iTemp <> 0 do
begin
iLeftK := iLeftK + iTemp;
iTemp := Pos('(', strTemp);
Delete(strTemp, 1, iTemp);
end;
//strOp是包含左、右扩号的多运算符符式，把扩号删除后交由NoKCal计算
strOp := ' ';
iRightK := Pos(')', strTemp);
for i := 0 to iRightK do
strOp := strTemp;
strOp := '(' + Trim(strOp);
//删除多运算符式，用其计算结果代替
Delete(S, iLeftK, iRightK+1);
strOp := DeleteK(strOp);//删除扩号
Insert(NoKCal(strOp), S, iLeftK);
//递归调用Cal
//每调用一次Cal，式中就计算出式中优先级最高的一对扩号中
//多运算符代数式的值，知道没有扩号为止
Result := Cal(S);
end;
//将Cal算出的结果转化为双精度浮点数
//此函数符合stdcall约定
function TxtToFloat(S: String): Double; stdcall;
begin
S := Cal(S);
S := DeleteMinus(S);
if S[1] = '_' then
begin
Delete(S, 1, 1);
Result := - StrToFloat(S);
end else
Result := StrToFloat(S);
end;
//引出函数
exports
TxtToFloat;
begin
end.