支持函数的算术表达式解析模块
从某位元老的C#代码改的，感谢那位分我就不送了 --------------------编程问答-------------------- 那我贴出来好了
Imports System--------------------编程问答--------------------
Public Module SimpleRPN
''' <summary>
''' SimpleRPN 的摘要说明。
''' Shisoft 修改版，支持多种函数 (C)2007 Shisoft @ www.shisoft.net
''' </summary>
''' <summary>
'''
''' Reverse Polish Notation
''' 算术逆波兰表达式.生成.
''' </summary>
''' <param name="s"></param>
''' <returns></returns>
Private Function BuildingRPN(ByVal s As String) As String
Dim sk As New System.Collections.Stack()
Dim re As New System.Text.StringBuilder()
Dim c As Char = " "c
'Shisoft:将函数名替换为函数代号
s = s.Replace("abs", "a")
s = s.Replace("acos", "q")
s = s.Replace("asin", "w")
s = s.Replace("exp", "e")
s = s.Replace("atan", "r")
s = s.Replace("cosh", "i")
s = s.Replace("floor", "f")
s = s.Replace("sqrt", "o")
s = s.Replace("log", "l")
s = s.Replace("sin", "s")
s = s.Replace("cos", "c")
s = s.Replace("ctg", "T")
s = s.Replace("tg", "t")
Dim sb As New System.Text.StringBuilder(s)
Dim tb As Char
For i As Integer = 0 To sb.Length - 1
'sb.Replace(" ","");//一开始,我只去掉了空格.后来我不想不支持函数和常量能滤掉的全OUT掉.
c = sb(i)
If Char.IsDigit(c) Then
re.Append(c)
'数字当然要了.
End If
'if(char.IsWhiteSpace(c)||char.IsLetter(c))//如果是空白,那么不要.现在字母也不要.
'continue;
Select Case c
Case "+"c, "-"c, "*"c, "/"c, "%"c, "^"c, _
"!"c, "("c, ")"c, "."c, "s"c, "c"c, "t"c, "T"c _
, "a"c, "q"c, "w"c, "e"c, "r"c, "i"c, "f"c, "o"c, "l"c, "u"c
'如果是其它字符...列出的要,没有列出的不要.
re.Append(c)
Exit Select
Case Else
Continue For
End Select
Next
sb = New System.Text.StringBuilder(re.ToString())
Dim ia As String = re.ToString
For i As Integer = 0 To sb.Length - 2
If sb(i) = "-"c AndAlso (i = 0 OrElse sb(i - 1) = "("c) Then
sb(i) = "!"c
End If
Next
re = New System.Text.StringBuilder()
For i As Integer = 0 To sb.Length - 1
If Char.IsDigit(sb(i)) OrElse sb(i) = "."c Then
'如果是数值.r
'加入后缀式
tb = sb(i)
re.Append(tb)
ElseIf sb(i) = "+"c OrElse sb(i) = "-"c OrElse sb(i) = "*"c OrElse sb(i) = "/"c OrElse sb(i) = "%"c _
OrElse sb(i) = "^"c OrElse sb(i) = "!"c _
OrElse sb(i) = "s"c OrElse sb(i) = "c"c OrElse sb(i) = "t"c OrElse sb(i) = "T"c _
OrElse sb(i) = "a"c OrElse sb(i) = "q"c OrElse sb(i) = "w"c OrElse sb(i) = "e"c OrElse sb(i) = "r"c OrElse sb(i) = "i"c _
OrElse sb(i) = "f"c OrElse sb(i) = "o"c OrElse sb(i) = "l"c OrElse sb(i) = "u"c Then
'.
While sk.Count > 0
'栈不为空时
c = CChar(sk.Pop())
'将栈中的操作符弹出.
If c = "("c Then
'如果发现左括号.停.
sk.Push(c)
'将弹出的左括号压回.因为还有右括号要和它匹配.
'中断.
Exit While
Else
If Power(c) < Power(sb(i)) Then
'如果优先级比上次的高,则压栈.
sk.Push(c)
Exit While
Else
re.Append(" "c)
re.Append(c)
'如果不是左括号,那么将操作符加入后缀式中.
End If
End If
End While
tb = sb(i)
sk.Push(tb)
'把新操作符入栈.
re.Append(" "c)
ElseIf sb(i) = "("c Then
'基本优先级提升
sk.Push("("c)
re.Append(" "c)
ElseIf sb(i) = ")"c Then
'基本优先级下调
While sk.Count > 0
'栈不为空时
c = CChar(sk.Pop())
'pop Operator
If c <> "("c Then
re.Append(" "c)
re.Append(c)
'加入空格主要是为了防止不相干的数据相临产生解析错误.
re.Append(" "c)
Else
Exit While
End If
End While
Else
re.Append(sb(i))
End If
Next
While sk.Count > 0
'这是最后一个弹栈啦.
re.Append(" "c)
re.Append(sk.Pop())
End While
re.Append(" "c)
Return FormatSpace(re.ToString())
'在这里进行一次表达式格式化.这里就是后缀式了.
End Function
''' <summary>--------------------编程问答-------------------- 如有错误请指出。
''' 算术逆波兰表达式计算.
''' </summary>
''' <param name="s"></param>
''' <returns></returns>
Public Function ComputeRPN(ByVal s As String) As Double
s = LCase(BuildingRPN(s)) 'Shisoft:全部小写
Dim tmp As String = ""
Dim sk As New System.Collections.Stack()
Dim c As Char = " "c
Dim Operand As New System.Text.StringBuilder()
Dim x As Double, y As Double
For i As Integer = 0 To s.Length - 1
c = s(i)
If Char.IsDigit(c) OrElse c = "."c Then
'数据值收集.
Operand.Append(c)
ElseIf c = " "c AndAlso Operand.Length > 0 Then
tmp = Operand.ToString()
If tmp.StartsWith("-") Then
'负数的转换一定要小心...它不被直接支持.
'现在我的算法里这个分支可能永远不会被执行.
sk.Push(-CDbl(Convert.ToDouble(tmp.Substring(1, tmp.Length - 1))))
Else
sk.Push(Convert.ToDouble(tmp))
End If
Operand = New System.Text.StringBuilder()
ElseIf c = "+"c OrElse c = "-"c OrElse c = "*"c OrElse c = "/"c OrElse c = "%"c OrElse c = "c"c OrElse c = "s"c OrElse c = "t"c OrElse c = "T"c OrElse c = "^"c _
OrElse c = "a"c OrElse c = "q"c OrElse c = "w"c OrElse c = "e"c OrElse c = "r"c OrElse c = "i"c _
OrElse c = "f"c OrElse c = "o"c OrElse c = "l"c Then
'运算符处理.双目运算处理.
If sk.Count > 0 Then
'如果输入的表达式根本没有包含运算符.或是根本就是空串.这里的逻辑就有意义了.
y = CDbl(sk.Pop())
Else
sk.Push(0)
Exit For
End If
If c = "c"c OrElse c = "s"c OrElse c = "t"c OrElse c = "T"c _
OrElse c = "a"c OrElse c = "q"c OrElse c = "w"c OrElse c = "e"c OrElse c = "r"c OrElse c = "i"c _
OrElse c = "f"c OrElse c = "o"c OrElse c = "l"c Then
'Shisoft:这里判断函数
Select Case c
Case "c"c
sk.Push(System.Math.Cos(y))
Exit Select
Case "s"c
sk.Push(System.Math.Sin(y))
Exit Select
Case "t"c
sk.Push(System.Math.Tan(y))
Exit Select
Case "T"c
sk.Push(1 / System.Math.Tan(y))
Exit Select
''''''''''''''''''''''''''''''''''
Case "a"c
sk.Push(System.Math.Abs(y))
Exit Select
Case "q"c
sk.Push(System.Math.Acos(y))
Exit Select
Case "w"c
sk.Push(System.Math.Asin(y))
Exit Select
Case "e"c
sk.Push(System.Math.Exp(y))
Exit Select
Case "r"c
sk.Push(System.Math.Atan(y))
Exit Select
Case "i"c
sk.Push(System.Math.Cosh(y))
Exit Select
Case "f"c
sk.Push(System.Math.Floor(y))
Exit Select
Case "o"c
sk.Push(System.Math.Sqrt(y))
Exit Select
Case "l"c
sk.Push(System.Math.Log(y))
Exit Select
End Select
Else
If sk.Count > 0 Then
x = CDbl(sk.Pop())
Else
sk.Push(y)
Exit For
End If
Select Case c
Case "+"c
sk.Push(x + y)
Exit Select
Case "-"c
sk.Push(x - y)
Exit Select
Case "*"c
sk.Push(x * y)
Exit Select
Case "/"c
sk.Push(x / y)
Exit Select
Case "%"c
sk.Push(x Mod y)
Exit Select
Case "^"c
sk.Push(System.Math.Pow(x, y))
Exit Select
End Select
End If
ElseIf c = "!"c Then
'单目取反.)
sk.Push(-CDbl(sk.Pop()))
End If
Next
If sk.Count > 1 Then
Throw New Exception()
End If
If sk.Count = 0 Then
Throw New Exception()
End If
Return sk.Pop().ToString()
End Function
''' <summary>
''' 优先级别测试函数.
''' </summary>
''' <param name="opr"></param>
''' <returns></returns>
Private Function Power(ByVal opr As Char) As Integer
Select Case opr
Case "+"c, "-"c
Return 1
Case "*"c, "/"c
Return 2
Case "%"c, "^"c, "!"c, "s"c, "c"c, "t"c, "T"c _
, "a"c, "q"c, "w"c, "e"c, "r"c, "i"c, "f"c, "o"c, "l"c, "u"c
Return 3
Case Else
Return 0
End Select
End Function
''' <summary>
''' 规范化逆波兰表达式.
''' </summary>
''' <param name="s"></param>
''' <returns></returns>
Private Function FormatSpace(ByVal s As String) As String
Dim ret As New System.Text.StringBuilder()
For i As Integer = 0 To s.Length - 1
If Not (s.Length > i + 1 AndAlso s(i) = " "c AndAlso s(i + 1) = " "c) Then
ret.Append(s(i))
Else
ret.Append(s(i))
End If
Next
Return ret.ToString()
'.Replace('!','-');
End Function
End Module
'这里给出的测试用例虽然不多.但如都能成功计算也不容易.
'(6+9-8+5-8)*(2+5+8)/7+5
'(1+2+3+4+5+6+7+8+9)*(1+2+3+4+5+6+7+8+9)/(9+8+7+6)*3-2-2+5/7-3
'(-3+4+9)*(-3)*7/(-5*2)
'-(6+9-8+5-8)*(2+5+8)
'1+2+3+4+5+6+7+8+9
'1*2*3*4*5*6*7*8*9
'1-2-3-4-5-6-7-8-9
'1/2/3/4/5/6/7/8/9
'(6+9-8+5-8)*(2+5+8)
'
'Shisoft:
'sin(cos(10))+1
好像Ctg有点问题
补充：.NET技术 , VB.NET
