前回はSEND+MORE=HONEYという覆面算を解くプログラムを作ってみました。
これを変更すれば任意の覆面算を解くことが可能ですが、変更箇所が結構多いので面倒です。
覆面算の式を書き変えるだけで済むようにしようというのが今回の目標です。
足し算だけではなく掛け算や割り算も使えるようにしたいです。
(A+B)*(C+D)=EFG
のような括弧を含む式も使えるようにしたいです。
きんが+しんねん=2017
のように数字を含む覆面算もありますので、これにも対応できるようにします。
まずは、式の構造を把握するところを考えます。
式の構造は演算の実行順序が決まれば決まります。
例えばA+B+C+Dという式はどう計算しても結果は同じですが、普通は左から順に計算します。
((A+B)+C)+D
という構造とみなせます。
右から計算する場合は、A+(B+(C+D))という構造になります。
3つ目、1つ目、2つ目の+の順に計算する場合、(A+B)+(C+D)という構造になります。
足し算の場合はどのような順番に計算しても結果は同じですが、引き算の場合は結果が異なります。
1-2-3-4=-8は ((1-2)-3)-4という計算をしています。
右から計算すると、1-(2-(3-4)))=-2 となります。
括弧のついてない引き算は必ず左から計算しないといけません。
演算子の実行順序を決定する方法を考えてみましょう。
使用する演算子は+,-,*,/の4つとします。
各演算子に優先度を設定します。
通常は乗除先行で、掛け算・割り算が優先されますので、
+,-の優先度は1、*,/の優先度は2とします。
(優先度が大きい方を優先します)
優先度が同じ演算子は左から順に実行します。
A-B*C+D/E
という式では、各演算子の優先度が、左から順に1,2,1,2となります。
優先度の最小値は1ですので、最後に実行される演算子は3番目の+と分かります。
()を含む式の場合、()内の計算が優先されます。
()が多くついているほど優先度が高いです。
式を左から順に見ていき、「(」が現れたら優先度を+10、「)」が現れたら優先度を-10とすれば
各演算子の順序付けができます。
((A+B)-C)*(D+E*(F-G)+H)
という式の場合、各演算子の優先度は21,11,2,11,12,21,11と計算できます。
3個目の*が優先度最小ですので最後に計算されます。
この式は、第一項目(A+B)-C、第二項目D+E*(F-G)+H、演算子*の
二項演算とみなすことができます。
(A+B)-Cは同様の計算をすることによって、
第一項目A+B、第二項目C、演算子-の二項演算と考えられます。
これを繰り返すと、各項目が単独の記号の二項演算に分解できます。
この分解には再帰呼び出しが使えます。
覆面算の場合はA+B=C+Dのような等式になっていますので、必ず=が含まれます。
式を変形して、A+B-(C+D)という形式にして=を除外することにします。
式の値が0になれば成立、0でなければ不成立と判定します。
=が複数ある場合は考えません。
括弧の対応等のチェックもしません。
正しく数式を書いた時に正しく計算されれば十分です。
正しく書かれていないときにどうなるのかは気にしないことにします。
-A+B+Cのような-が最初にある式の場合、上記の方法ではうまくいきません。
このような式でも扱えるようにするため、最初が-の場合はその前に0をつけてやります。
0-A+B+C
式が与えられたら、まずブランクを除去し、最初に-がついていたらその前に0を追加します。
=を-(で置き換え、最後に)を追加します。
右から1文字ずつ見ていって、
・(,)は優先度に加算する値を調整
・+,-,*,/は演算子
・0～9は数字
・その他の文字は(数字を置き換えた)記号とみなします
各演算子の優先度を計算し、優先度が最小のものを見つけます。
(優先度最小のものが複数ある場合は最も左のものを選びます)
その演算子の左側が第一項目、右側が第二項目です。
この二項演算を1番として記憶します。
第一項目、第二項目について同様の処理を行い、演算子を含まなくなるまで分解します。
式の構造の把握と同時に、使われている記号も取得します。
最上位の数字で0にはならない記号もここでチェックしておきましょう。
各記号の値を決めて、式が成立するかどうかチェックします。
記号の値を決めるところは前回作成したプログラムと同じ方法でいけます。
0が入らない記号については0を除外して、式が成立するかどうかチェックします。
成立チェックは式の値を計算する関数を作って、値が0だったら成立とみなします。
式の値を計算する関数は再帰呼び出しを使えば簡単にできます。
演算子を含む場合は、第一項目、第二項目それぞれについて関数を呼び出して値を計算し、
演算子に従って足し算、引き算、掛け算、割り算を行って値を求めます。
演算子を含まない場合は、その項目の値を計算します。
数字または記号だけでできていますので、記号のところにその記号の値をあてはめてやればよいです。
割り算を含まないときはこれで問題ないと思いますが、
割り算を含む場合は、丸め誤差によって誤判定される可能性があります。
例えば電卓で1÷3を計算すると、0.333･･･となり、
それを3倍すると、0.999・・・となり、1になりません。
このような誤差が生じないように、分数で計算することにします。
一つの数値を分子と分母の二つの数として記憶するのです。
というようなことを考えてプログラムを作ってみました(最後に貼り付けておきます)。
行き当たりばったりに作りましたので、統一感のないプログラムになっていますが、
動けばいいんです！
ERASE EQの後に
EQ(1)= "SEND+MORE=HONEY"
というように式を書けば任意の覆面算が解けます。
配列になっているのは連立覆面算も解けるようにしたためで、
EQ(1) = "1/(A+B-C)=12/BC"
EQ(2) = "A+B+C=10"
というように複数の式を書くと、すべての式を成立させる組み合わせを探します。
このプログラムでは最大10個まで指定できます。
使える演算子は+,-,*,/の4つ。()も使えます。
式の長さに制限はありませんが、数の桁数が大きいとオーバーフローエラーになります。
10桁以内の計算であれば大丈夫だと思います。
分数計算についてはTYPEを定義して関数の結果として渡せるようにしようとしたのですが、
なぜか実行するとオートメーションエラーとなって使えませんでした。
仕方ないのでPUBLIC変数を使って渡しています。
目標は達成しましたが、解くのにちょっと時間がかかるのが不満です。
記号が10種類の覆面算だと1分弱かかります。
途中で(応答不能)になるかと思いますが、待っていればきちんと終わります。
(応答不能)になるのが嫌な人はDoEventsを適当な場所に書けば出なくなります。
が、これをつけると速度ががくんと落ちますのでおすすめはしません。
時間がかかるといっても私が手作業で解くよりは圧倒的に早いですが、まだまだ満足できません。
人間の欲望は果てしないものなのですね。
再帰呼び出しをやめれば早くなるような気がしますが、面倒なのであまりやる気になれません。
実は、割り算がなければ早くすることは簡単なのですが、割り算はなくてもいいでしょうか？
1/A+1/B+1/C=1
という式は、
B*C+C*A+B*A=A*B*C
という式とほぼ同じですよね。
こういう形に変形して覆面算を解いて、分母が0になるものを除外すればいいですよね。
割り算を含む覆面算なんてめったに見ないですからね。
というわけで次回は足し算、引き算、掛け算で構成された覆面算を高速で解くことに挑戦です。
◇◇◇
Public PA(100) As Double
Public PB(100) As Double
Public VSU As Integer
Public VLIST As String
Public ESU As Integer
Public FSU As Integer
Public FORM(100) As String
Public ELM1(100) As Integer
Public ELM2(100) As Integer
Public OPR(100) As String
Public INTE(100) As Integer
Public DECI(100) As Integer
Public USE(10) As Integer
Public NONZERO(10) As Integer
Public OUTRAW As Integer
Public SU(9) As Integer
Public EFNO(10) As Integer
Sub SOLVE()
Dim EQ(10) As String
Erase EQ
EQ(1) = "1/(A+B-C)=12/BC"
EQ(2) = "1/(A-1)=1/(A-1)"
STARTTIME = Time
Dim FNO As Integer
FSU = 1
Erase FORM, ELM1, OPR, ELM2, USE, NONZERO
VSU = 0: VLIST = ""
ENO = 1: ESU = 0
Do While EQ(ENO) <> ""
SIKI = EQ(ENO)
SIKI = Replace(SIKI, " ", "")
If InStr(SIKI, "=") > 0 Then SIKI = Replace(SIKI, "=", "-(") + ")"
If Mid(SIKI, 1, 1) = "-" Then SIKI = "0" + SIKI
FSU = FSU + 1
FORM(FSU) = SIKI: EFNO(ENO) = FSU
SPLIT (FSU)
ENO = ENO + 1
Loop
If VSU <= 0 Or VSU > 10 Then
MsgBox ("入力エラー")
End If
FORM(0) = VLIST
ESU = ENO - 1
OUTRAW = 1
Cells(OUTRAW, 1) = VLIST
CHECK (0)
OUTRAW = OUTRAW + 1
ACOUNT = OUTRAW - 2
Cells(OUTRAW, 1) = "答えは" + Format(ACOUNT, "#0") + "個"
Cells(OUTRAW + 1, 1) = ""
SYORITIME = Time - STARTTIME
Debug.Print Minute(SYORITIME) & "分" & second(SYORITIME) & "秒"
End Sub
Function CHECK(ByVal VNO As Integer)
Dim FNO As Integer
Dim ENO As Integer
Dim ERRFLAG As Integer
If VNO = VSU Then
ENO = 1: ERRFLAG = 0
Do While ENO <= ESU And ERRFLAG = 0
FNO = EFNO(ENO)
EVAL (FNO)
If PA(FNO) <> 0 Or PB(FNO) = 0 Then ERRFLAG = 1
ENO = ENO + 1
Loop
If ERRFLAG = 0 Then
OUTRAW = OUTRAW + 1
EVAL (0)
Cells(OUTRAW, 1) = "'" + Format(PA(0), Mid("0000000000", 1, VSU))
End If
Else
For NM = 0 To 9
If USE(NM) = 0 Then
If NM <> 0 Or NONZERO(VNO) = 0 Then
USE(NM) = 1
SU(VNO) = NM
CHECK (VNO + 1)
USE(NM) = 0
End If
End If
Next NM
End If
End Function
Function EVAL(ByVal FNO As Integer)
Dim ERRFLAG As Integer
Dim I As Integer
Dim FUGO As Integer
Dim BUNSI As Long, BUNBO As Long, GC As Long
ERRFLG = 0
If OPR(FNO) = "" Then
SIKI = FORM(FNO)
ATAI = 0
For I = 1 To Len(SIKI)
CHARA = Mid(SIKI, I, 1)
Select Case CHARA
Case " "
Case "0" To "9"
ATAI = ATAI * 10 + Val(CHARA)
Case Else
CNO = InStr(VLIST, CHARA) - 1
ATAI = ATAI * 10 + SU(CNO)
End Select
Next I
PA(FNO) = ATAI: PB(FNO) = 1
If ERRFLG = 1 Then PB(FNO) = 0
Else
EVAL (ELM1(FNO))
B1 = PB(ELM1(FNO))
If B1 = 0 Then
PB(FNO) = 0
Else
EVAL (ELM2(FNO))
B2 = PB(ELM2(FNO))
If B2 = 0 Then
PB(FNO) = 0
Else
A1 = PA(ELM1(FNO)): A2 = PA(ELM2(FNO))
Select Case OPR(FNO)
Case "+"
BUNSI = A1 * B2 + B1 * A2: BUNBO = B1 * B2
Case "-"
BUNSI = A1 * B2 - B1 * A2: BUNBO = B1 * B2
Case "*"
BUNSI = A1 * A2: BUNBO = B1 * B2
Case "/"
BUNSI = A1 * B2: BUNBO = B1 * A2
End Select
FUGO = Sgn(BUNSI) * Sgn(BUNBO)
BUNSI = Abs(BUNSI): BUNBO = Abs(BUNBO)
If BUNSI = 0 Then BUNBO = 1
If FUGO <> 0 Then
GC = GCD(BUNSI, BUNBO)
BUNSI = BUNSI / GC: BUNBO = BUNBO / GC
End If
PA(FNO) = FUGO * BUNSI: PB(FNO) = BUNBO
End If
End If
End If
End Function
Function GCD(ByVal BUNSI As Long, ByVal BUNBO As Long)
Dim WW As Long
If BUNSI > BUNBO Then
WW = BUNSI: BUNSI = BUNBO: BUNBO = WW
End If
WW = BUNBO Mod BUNSI
If WW = 0 Then
GCD = BUNSI
Else
GCD = GCD(BUNSI, WW)
End If
End Function
Function SPLIT(ByVal FNO As Integer)
Dim SAVENO As Integer, SAVEPRI As Integer, SAVEPOS As Integer
Dim SCOUNT As Integer
Dim SIKI As String
Dim PAIR As Integer
Dim CHARA As String
Dim VNO As Integer
SAVENO = -1: SCOUNT = 0
SAVEPRI = 0: SAVEPOS = 0
SIKI = FORM(FNO)
PAIR = 0
For I = 1 To Len(SIKI)
PRI = 0
CHARA = Mid(SIKI, I, 1)
Select Case CHARA
Case " "
Case "+": PRI = 1
Case "-": PRI = 1
Case "*": PRI = 2
Case "/": PRI = 2
Case "(": PAIR = PAIR + 1
Case ")": PAIR = PAIR - 1
Case "0" To "9"
SCOUNT = SCOUNT + 1
Case Else
SCOUNT = SCOUNT + 1
VNO = InStr(VLIST, CHARA) - 1
If VNO < 0 Then
VSU = VSU + 1: VLIST = VLIST + CHARA
VNO = VSU
End If
If SCOUNT = 1 Then SAVENO = VNO
End Select
If PRI > 0 Then
PRI = PRI + PAIR * 10
If PRI <= SAVEPRI Or SAVEPRI = 0 Then
SAVEPRI = PRI: SAVEPOS = I
End If
End If
Next I
If SAVEPOS > 0 Then
OPR(FNO) = Mid(SIKI, SAVEPOS, 1)
FSU = FSU + 1
ELM1(FNO) = FSU
FORM(FSU) = Mid(SIKI, 1, SAVEPOS - 1)
FSU = FSU + 1
ELM2(FNO) = FSU
FORM(FSU) = Mid(SIKI, SAVEPOS + 1)
SPLIT (ELM1(FNO))
SPLIT (ELM2(FNO))
Else
OPR(FNO) = ""
FORM(FNO) = Replace(FORM(FNO), "(", "")
FORM(FNO) = Replace(FORM(FNO), ")", "")
If SAVENO >= 0 And SCOUNT > 1 Then NONZERO(SAVENO) = 1
End If
End Function
0 件のコメント:
コメントを投稿