【PB】实现表达式计算的两个步骤
本帖最后由 cyycoish 于 2015-2-13 11:10 编辑最近在研究表达式的处理，顺手写了这么一款小程序。
为了实现表达式计算，本程序使用了两个步骤：1.中缀转后缀 2.计算后缀表达式（逆波兰式）
表达式支持 + - * / \ ^ 共6中运算符分别为 加、减、乘、除、模、幂。均是标准的双目运算符。
输入一个中缀表达式，形如 “1+1”程序可以自动转换为相应后缀表达式“1 1 +”
在中缀表达式之前加“@”符号，可以计算该中缀表达式。在逆波兰式之前加“#”可以计算逆波兰
式的值。支持小数，负数，括号。{} 花括号 [] 方括号 （） 圆括号 可以混搭。
程序可以识别 括号不匹配 非法字符 缺少运算符 缺少操作数 4 种错误。
下面上图：
原理如下：
该程序由powerbasic10 编译而成 源代码：
header.bi
MACRO CONST = MACRO
CONST N = 100 '数栈大小
CONST M = 100 '符栈大小
CONST O = 6 '运算符个数
GLOBAL ERRNUM AS INTEGER '错误标识符
GLOBAL ScanIdxAS LONG '扫描索引
TYPE OPRTYPE '运算符
opname AS STRING * 10 '运算符字符串表示
levelAS INTEGER '运算符优先级
indexAS INTEGER '运算符标识
END TYPE
TYPE NUMSTACK '数栈定义
stack(N) AS DOUBLE'数栈栈体
top AS INTEGER '数栈栈顶
END TYPE
TYPE OPRSTACK '符栈定义
stack(M) AS OPRTYPE '符栈栈体
top AS INTEGER '符栈栈顶
END TYPE
GLOBAL Oper() AS OPRTYPE '运算符表
SUB InitNumStack(BYREF numStk AS NUMSTACK) '数栈初始化
numStk.top = 0 '栈顶为0栈为空
END SUB
SUB PushNum(BYREF numStk AS NUMSTACK, BYVAL v AS DOUBLE) '数栈压栈
IF numStk.top = N - 1 THEN '若数栈达到存贮上限
ERRNUM = 1 '溢出报错
ELSE
numStk.top = numStk.top + 1 '向上堆
numStk.stack(numStk.top) = v '数字进栈
END IF
END SUB
SUB PopNum(BYREF numStk AS NUMSTACK, BYREF v AS DOUBLE) '数栈出栈
IF numStk.top = 0 THEN '若栈空
ERRNUM = 5 '数栈触底报错
ELSE
v = numStk.stack(numStk.top) '数字出栈
numStk.top = numStk.top - 1 '向下落
END IF
END SUB
SUB InitOprStack(BYREF oprStk AS OPRSTACK) '符栈初始化
oprStk.top = 0 '设栈空
END SUB
SUB PushOpr(BYREF oprStk AS OPRSTACK, BYVAL sign AS OPRTYPE) '符栈压栈
IF oprStk.top = M THEN '达到上限
ERRNUM = 1 '符栈溢出
ELSE
oprStk.stack(oprStk.top) = sign '操作符进栈
oprStk.top = oprStk.top + 1 '向上堆
END IF
END SUB
SUB PopOpr(BYREF oprStk AS OPRSTACK, BYREF rtn AS OPRTYPE) '符栈出栈
IF oprStk.top = 0 THEN
ERRNUM = 2 '符栈触底
ELSE
oprStk.top = oprStk.top - 1 '符栈向下落
rtn.opname = TRIM$(oprStk.stack(oprStk.top).opname) '出栈
rtn.level = oprStk.stack(oprStk.top).level
rtn.index = oprStk.stack(oprStk.top).index
END IF
END SUB
SUB PeekOpr(BYVAL oprStk AS OPRSTACK, BYREF rtn AS OPRTYPE) '看符栈栈顶
IF oprStk.top > 0 THEN '若符栈不为空
rtn.opname = TRIM$(oprStk.stack(oprStk.top - 1).opname) '传递栈顶运算符参数
rtn.level = oprStk.stack(oprStk.top - 1).level
rtn.index = oprStk.stack(oprStk.top - 1).index
END IF
END SUB
SUB InitOprTable() '初始化运算符表
DIM Oper(O) AS GLOBAL OPRTYPE '初始化运算符表载体数组
Oper(0).opname = "+": Oper(0).level =1: Oper(0).index = 1
Oper(1).opname = "*": Oper(1).level =2: Oper(1).index = 2
Oper(2).opname = "/": Oper(2).level =2: Oper(2).index = 3
Oper(3).opname = "\": Oper(3).level =2: Oper(3).index = 4
Oper(4).opname = "^": Oper(4).level =3: Oper(4).index = 5
Oper(5).opname = "(": Oper(5).level = -1: Oper(5).index = 6
Oper(6).opname = ")": Oper(6).level = -1: Oper(6).index = 7
'运算符名称 运算符优先级 运算符索引标识
END SUB
FUNCTION HandelOpr(BYVAL a AS DOUBLE, BYVAL b AS DOUBLE, BYVAL index AS INTEGER) AS DOUBLE '定义运算符运算过程
LOCAL ans AS DOUBLE '定义运算结果
SELECT CASE index '按索引区分运算符
CASE 1 '加法运算
ans = a + b
CASE 2 '乘法运算
ans = a * b
CASE 3 '除法运算
ans = a / b
CASE 4 '取模运算
ans = a MOD b
CASE 5 '幂运算
ans = a ^ b
END SELECT
FUNCTION = ans '函数返回值
END FUNCTION
FUNCTION IsOper(BYREF oprStk AS OPRSTACK, BYVAL s AS STRING, BYREF level AS INTEGER, _
BYREF ioper AS OPRTYPE) AS INTEGER '判定是否为运算符函数
LOCAL i AS INTEGER
FUNCTION = 0
FOR i = 0 TO O '遍历运算符表
IF s = TRIM$(oper(i).opname) THEN '找到相似运算符
level = oper(i).level '传递运算符优先级
ioper = oper(i) '传递运算符本身
FUNCTION = oper(i).index '返回运算符索引标识
EXIT FUNCTION '退出函数
END IF
NEXT
END FUNCTION
FUNCTION PreProcessor(BYVAL str AS STRING) AS STRING '预处理器
str = TRIM$(str) '去入口字符串两端空格
REPLACE "-" WITH "+-" IN str '将减去一个数变为加上一个数的相反数
REPLACE ANY "{[" WITH "((" IN str '将左括号统一
REPLACE ANY "}]" WITH "))" IN str '统一右侧括号
IF LEFT$(str, 2) = "+-" THEN str = MID$(str, 2) '如果表达式第一个数为负数,消除替换符号后的副作用
FUNCTION = str '返回处理完毕后的字符串
END FUNCTION
SUB Compute(BYREF xp AS STRING) '将源表达式转为逆波兰式
LOCAL oprStk AS OPRSTACK '定义符栈
LOCAL opr0 AS OPRTYPE'定义临时操作符1
LOCAL opr AS OPRTYPE'定义临时操作符2
LOCAL tmpEle AS STRING '临时表达式元素
LOCAL tmpXpAS STRING '临时表达式
LOCAL iAS INTEGER '计数器
LOCAL jAS INTEGER '计数器
LOCAL nb AS INTEGER '为数字时该值为1,否则为0
LOCAL lAS INTEGER '临时存放优先级
LOCAL pAS STRING '临时存放空格
ScanIdx = 0 '初始扫描索引
CALL InitOprTable() '初始化运算符表
CALL InitOprStack(oprStk) '初始化符栈
xp = PreProcessor(xp) '预处理表达式字符串
FOR i = 1 TO LEN(xp) '从预处理后的表达式开始到结束
ScanIdx = i: tmpEle = "" '设置扫描索引,临时元素设空
tmpEle = TRIM$(tmpEle & MID$(xp, i, 1))
nb = 1 '数字标记为真
IF IsOper(oprStk, tmpEle, l, opr0) = 0 THEN '若不是运算符
FOR j = 1 TO LEN(tmpEle) '逐个扫描元素
LOCAL char AS INTEGER
char = ASC(MID$(tmpEle, j, 1)) '记录元素内各个字符的asc码
IF (char >= 48 AND char <= 57) OR char = 46 OR char = 45 THEN '如果是数字,小数点,负号
nb = 1 '数字标记为真
ELSE '否则
nb = 0 '数字标记为假
EXIT FOR '不是数字立即退出循环
END IF
NEXT
IF nb = 1 THEN tmpXp = tmpXp & p & tmpEle: p = "" '将数字存入临时逆波兰式
ELSEIF IsOper(oprStk, tmpEle, l, opr0) >= 1 AND nb = 1 THEN '如果前一个为数字,当前为运算符
IF opr0.index <> 6 AND opr0.index <> 7 THEN '如果不是括号
CALL PeekOpr(oprStk, opr) '看符栈栈顶
WHILE opr.level >= opr0.level AND oprStk.top > 0 '当当前运算符优先级大于等于栈顶优先级并且符栈不为空
CALL PopOpr(oprStk, opr) '出栈一个运算符
tmpXp = tmpXp & " " & TRIM$(opr.opname) & " " '将运算符存入逆波兰式
CALL PeekOpr(oprStk, opr) '再看符栈栈顶
WEND
CALL PushOpr(oprStk, opr0) '将当前运算符压入符栈
ELSEIF opr0.index = 6 THEN '如果是左括号
CALL PushOpr(oprStk, opr0) '将左括号无条件进栈
ELSEIF opr0.index = 7 THEN '如果是右括号
CALL PeekOpr(oprStk, opr) '看符栈栈顶
WHILE opr.level <> -1 AND oprStk.top > 0 '一直循环直到遇到左括号,或者栈空
CALL PopOpr(oprStk, opr) '出栈一个运算符
tmpXp = tmpXp & " " & TRIM$(opr.opname) & " " '存入逆波兰式
CALL PeekOpr(oprStk, opr) '继续看符栈栈顶
WEND
CALL PopOpr(oprStk, opr) '将左括号出栈并抛弃
ELSE
ERRNUM = 3 '非法字符
EXIT SUB '退出子程式
END IF
tmpEle = "" '将临时元素清空
p = " " '将逆波兰式元素间隔符设为一个空格
ELSE
ERRNUM = 3 '非法字符
EXIT SUB '结束子程序运行
END IF
NEXT
WHILE oprStk.top > 0 '一直循环直到栈空
CALL PeekOpr(oprStk, opr0) '看栈顶
IF opr0.level = -1 THEN '还有剩余左括号未出栈
ERRNUM = 4 '括号不匹配报错
EXIT LOOP'退出循环
END IF
CALL PopOpr(oprStk, opr) '将运算符出栈
tmpXp = tmpXp & " " & TRIM$(opr.opname) & " " '存入逆波兰式
WEND
xp = TRIM$(tmpXp) '去掉逆波兰式两侧空格
REPLACE "" WITH " " IN xp '将逆波兰式中连续两个空格替换为一个空格
END SUB
FUNCTION IsNumeric(BYVAL str AS STRING) AS INTEGER '判断字符串是否是数字类型
LOCAL i AS INTEGER
LOCAL c AS INTEGER
FUNCTION = 1
FOR i = 1 TO LEN(str)
c = ASC(MID$(str, i, 1))
IF NOT ((c >= 48 AND c <= 57) OR c = 46 OR c = 45) THEN
FUNCTION = 0 '所检测字符串中有一个不是合法的字符该字符串就不是数字类型
EXIT FUNCTION
END IF
NEXT
END FUNCTION
FUNCTION Calculate(BYVAL expr AS STRING) AS DOUBLE '计算已经格式化的逆波兰式得到答案
LOCAL oprStk AS OPRSTACK '定义符栈
LOCAL numStk AS NUMSTACK '定义数栈
LOCAL opr AS OPRTYPE'临时运算符
LOCAL tmpEle AS STRING '临时元素
LOCAL ts AS STRING '临时字符串
LOCAL i AS INTEGER '计数器
LOCAL z AS INTEGER '临时整型变量
LOCAL x AS DOUBLE '第一个操作数
LOCAL y AS DOUBLE '第二个操作数
LOCAL a AS DOUBLE '运算结果数
LOCAL b AS INTEGER '数字输入完毕 标记
LOCAL d AS INTEGER '上一个为数字 标记
CALL InitOprTable() '初始化运算符表
CALL InitOprStack(oprStk) '初始化符栈
CALL InitNumStack(numStk) '初始化数栈
expr = expr & " " '将逆波兰式表达式末尾加上一个空格作为结束标记
FOR i = 1 TO LEN(expr) '从表达式开始扫描至结束
ScanIdx = i '设置扫描索引
ts = MID$(expr, i, 1) '临时字符串为表达式中间一个字符
IF ts <> " " THEN '若这个字符不是空格
tmpEle = tmpEle & ts '临时表达式元素累积
IF IsOper(oprStk, tmpEle, z, opr) = 0 AND IsNumeric(tmpEle) = 1 THEN '若该元素不是运算符并且是数字
d = 1 '上一个字符为数字的标记为真
ELSEIF IsOper(oprStk, tmpEle, z, opr) > 0 THEN '若该元素是运算符
CALL PopNum(numStk, x) '出栈一个操作数
CALL PopNum(numStk, y) '出栈另一个操作数
CALL PushNum(numStk, HandelOpr(y, x, IsOper(oprStk, tmpEle, z, opr))) '将操作数进行运算得到答案
d = 0 '数字标记为假
ELSE '其他情况
ERRNUM = 3 '触发非法字符错误
EXIT FUNCTION '退出函数
END IF
ELSE '如果当前字符是空格
IF d = 1 THEN CALL PushNum(numStk, CDBL(VAL(tmpEle))) '如果数字标记为真,将数字压入数栈
b = 1: tmpEle = "" '数字输入完毕,标记为真.清空临时元素
END IF
NEXT
CALL PopNum(numStk, a) '将最后一个数字弹出数栈
FUNCTION = a '将该数字设为函数返回值
END FUNCTION '函数封闭
'===========代码结束===========
main.bas
#COMPILE EXE "XT.EXE"
#DIM ALL
#INCLUDE ONCE "header.bi"
FUNCTION PBMAIN () AS LONG
DIM xp AS STRING
DIM rAS STRING
DIM tAS STRING
xp = "?"
DO
ERRNUM = 0
xp = INPUTBOX$("PLEASE INPUT A" & $LF & "EXPRESSION" & $LF & t, "WCMC-XT", xp)
r = xp
IF LEFT$(xp, 1) = "@" THEN
xp = MID$(xp, 2)
CALL Compute(xp)
xp = TRIM$(STR$(Calculate(xp)))
ELSEIF LEFT$(xp, 1) = "#" THEN
xp = MID$(xp, 2)
xp = TRIM$(STR$(Calculate(xp)))
ELSEIF LEFT$(xp, 1) = "?" THEN
MSGBOX "(C) 2015 CYYCOISH" & $LF & " 201502130730" & _
$LF & " @" & $LF & " #", , "WCMC-XT"
ELSE
CALL Compute(xp)
END IF
SELECT CASE ERRNUM
CASE 0
t = ""
CASE 1
t = "Error 101 At " & STR$(ScanIdx) & " :Overflow."
CASE 2
t = "Error 102 At " & STR$(ScanIdx) & " :Missing Operator."
CASE 3
t = "Error 103 At " & STR$(ScanIdx) & " :Illegal Character."
CASE 4
t = "Error 104 At " & STR$(ScanIdx) & " :Missing Brackets."
CASE 5
t = "Error 105 At " & STR$(ScanIdx) & " :Missing Number."
END SELECT
IF xp = "" THEN xp = r
LOOP UNTIL r = ""
FUNCTION = 0
END FUNCTION
具体实现有详尽的代码注释，大家可以在此贴讨论该算法
这里将代码与程序资源打包发布在这里，请各位踊跃讨论不要潜水：
**** Hidden Message *****
@元始天尊
没用C++等，用的是BASIC语言但
不知道您对这个算法有没有兴趣
{:soso_e100:} {:soso_e130:}熬了一宿来调试程序
这里必须感谢站长@0xAA55
是他给了我很大的鼓励
{:soso_e181:} cyycoish 发表于 2015-2-13 11:22
@元始天尊
没用C++等，用的是BASIC语言但
不知道您对这个算法有没有兴趣
不得不说，1年前研究过，现在都不太会了^_^，另外不要称“您”，吓着我了^_^。。。。我记着你不是写过一个比较完整的吗，那个就挺好的
这个图好像没有提出什么新算法 看看原理来 看看原理来
页:
[1]