|
'程序版本:V1.0 (Test)
Function Simplify (Expr)
Dim fds, SHX, Arr, i, Res, Xishu, Canshu, j, k, l, w, w2, Cans(100), Xis(100), Xi2(100), Can2(100), Xi_ON, Can_On
Arr = Split(Replace(LCase(Expr), " ", ""), "+")
Res = ""
SHX = ""
k = 0
For Each i In Arr
VZ = instr(i, "sq")
If VZ <> 0 Then
If VZ > 1 Then
xishu = CDbl(Mid(i, 1, VZ - 1))
Else
xishu = 1
End If
Canshu = CDbl(Mid(i, VZ + 3, InStr(VZ, i, ")") - VZ - 3))
For j = 1024 To 2 Step -1
If Canshu Mod (j * j) = 0 Then
xishu = xishu * j
Canshu = Canshu / (j * j)
End If
Next
Cans(k) = Canshu
Xis(k) = Xishu
Else
Cans(k) = 1
Xis(k) = CDbl(i)
'Res = Res & "+" & i
End If
K = K + 1
Next
l = 0
For i = 0 To UBound(Arr)
Xi_on = Xis(i)
Can_on = Cans(i)
If Can_on <> 0 Then
For j = 0 To UBound(Arr)
If Cans(j) = Can_on And j <> i Then
Xi_on = Xi_on + Xis(j)
Cans(j) = 0
Xis(j) = 0
End If
Next
Xi2(l) = Xi_on
Can2(l) = Can_on
l = l + 1
End If
Next
For i = 0 To l
Canshu = Can2(i)
XiShu = Xi2(i)
If Canshu > 1 Then
If Xishu = 1 Then
Res = Res & "+√" & Canshu
Else
Res = Res & "+" & Xishu & "√" & Canshu
End If
Else
Res = Res & "+" & Xishu
End If
Next
If Mid(Res, 1, 1) = "+" Then Res = Mid(Res, 2, Len(Res) - 1)
w = 1
w2 = 1
fds = 0
While InStr(w + 1, Res, "√") <> 0
w = InStr(w, Res, "√") + 1
shx = shx & string(w - w2, " ")
w2 = InStr(w, Res, "+")
shx = shx & string(w2 - w + 1, "_")
'fds = fds + 1
Wend
If Mid(Res, Len(Res), 1) = "+" Then Res = Mid(Res, 1, Len(Res) - 1)
Simplify = shx & vbCrLf & Res
End Function
ExpIn = inputbox ("輸入表達(dá)式。根號(hào):sq(x)或sqrt(x)", "√", "")
Msgbox " " & ExpIn & String(2, vbCrLf) & "=" & vbCrLf & Simplify (ExpIn), , "Sqrt Simplify"
以上代碼保存為*.vbs即可運(yùn)行。(360請(qǐng)無(wú)視。。)
這個(gè)代碼十分的絞盡腦汁。(用記事本編程很不方便。。)。目前也只實(shí)現(xiàn)了自然書寫、根號(hào)的化簡(jiǎn)、根號(hào)的加減法,還不能做乘除法運(yùn)算。。(有可能存在潛在的BUG)
另外這程序做的很差,跟CAS(計(jì)算機(jī)代數(shù)系統(tǒng))沒有可比性。。大家將就著看看吧。。
至于自然書寫是怎么實(shí)現(xiàn)的——這個(gè)……那個(gè)“上劃線”實(shí)際上是在數(shù)字的上一行添加下劃線。。。(絞盡腦汁的方案)
效果測(cè)試:







|
|