計算プリントを自動生成する 3項以上の文字式の計算 その1 （とりあえず作る）
はじめに
基本的には「3数の計算」と同じ考え方です。
以前に「3数の計算」と書いてしまいましたが、「3項の計算」としたほうが良かったですね。。
文字式の計算の特徴
関数を書くときに考慮した文字式の計算の特徴は以下の通りです。
足し合わせない関係の項もある。
答えが多項式になることもある。
答えの多項式の並びを気にする必要がある。
特に答えが多項式になりうるところが厄介ですね。
自動でやってみる
Literal2クラス
新たに「rank」変数を加えました。
項の並び替えに使っています。
Public Va As Integer Public Vb As Integer Private La_ As String Private Lb_ As String Private element(1 To 26) As Integer Private Sub Class_Initialize() Va = 0 Vb = 1 End Sub Property Get rank() As Long '------------------ 'sortで用いる変数を作成 '------------------ Dim i As Integer Dim ans As Long For i = 1 To 3 ans = ans + element(i) * 10 ^ (3 - i) Next rank = ans End Property Function Conversion(str) '------------------- '文字列からLiteral2を構成 '------------------- '------------------- '変数の定義 '------------------- Dim ans(1 To 2) As String Dim tmp As Integer '------------------- '分子と分母に分割 '------------------- tmp = InStr(str, "/") If tmp <> 0 Then ans(1) = Mid(str, 1, tmp - 1) ans(2) = Mid(str, tmp + 1) Else ans(1) = str ans(2) = "" End If '------------------- '分子の取得 '------------------- trgt = ans(1) tmp = Val(trgt) If tmp <> 0 Then Va = tmp La = Replace(trgt, tmp, "", , 1) Else If Mid(trgt, 1, 1) = "-" Then Va = -1 La = Replace(trgt, "-", "", , 1) Else Va = 1 La = trgt End If End If '------------------- '分母の取得 '------------------- trgt = ans(2) If trgt = "" Then Vb = 1 Exit Function End If tmp = Val(trgt) If tmp <> 0 Then Vb = tmp Lb = Replace(trgt, tmp, "", , 1) Else If Mid(trgt, 1, 1) = "-" Then Vb = -1 Lb = Replace(trgt, "-", "", , 1) Else Vb = 1 Lb = trgt End If End If Call Fit End Function Property Get La() As String La = La_ End Property Property Let La(str As String) La_ = str Dim i As Integer '繰り返しの制御変数 Dim trgt As String 'element作成のアシスト変数 Dim num As Integer 'element作成のアシスト変数 '--------------- 'elementの初期化 '--------------- For i = 1 To 26 element(i) = 0 Next '--------------- 'elementに仕分け '--------------- For i = 1 To Len(str) trgt = Mid(str, i, 1) num = Asc(trgt) - 96 Select Case num Case Is < 1 Stop Case Is < 27 element(num) = element(num) + 1 Case Else Stop End Select Next End Property Property Get Lb() As String Lb = Lb_ End Property Property Let Lb(str As String) Lb_ = str Dim i As Integer '繰り返しの制御変数 Dim trgt As String 'element作成のアシスト変数 Dim num As Integer 'element作成のアシスト変数 '--------------- 'elementに仕分け '--------------- For i = 1 To Len(str) trgt = Mid(str, i, 1) num = Asc(trgt) - 96 Select Case num Case Is < 1 Stop Case Is < 27 element(num) = element(num) - 1 Case Else Stop End Select Next End Property Function Fit() '-------------- '整形 '-------------- '-------------- '変数の定義 '-------------- Dim i As Integer '繰り返しの制御変数 Dim L As Integer '約分のアシスト変数 Dim ansa As String '文字分配のアシスト変数 Dim ansb As String '文字分配のアシスト変数 Dim trgt As String '文字分配のアシスト変数 '-------------- '正負の考慮 '-------------- If Vb < 0 Then Va = Va * -1 Vb = Vb * -1 End If '-------------- '約分 '-------------- If Va = 0 Then Exit Function End If L = Application.WorksheetFunction.Gcd(Abs(Va), Abs(Vb)) Va = Va / L Vb = Vb / L '--------------- '文字の分配 '--------------- For i = 1 To 26 trgt = Chr(96 + i) Select Case element(i) Case Is < -1 ansb = ansb & trgt & "^" & Abs(element(i)) Case Is = -1 ansb = ansb & trgt Case Is = 1 ansa = ansa & trgt Case Is > 1 ansa = ansa & trgt & "^" & element(i) End Select Next La_ = ansa Lb_ = ansb End Function Property Get S() As String '----------------- 'V,L_からSを作成 '----------------- '----------------- '変数の定義 '----------------- Dim ansa As String '分子 Dim ansb As String '分母 Call Fit Select Case True Case La_ = "" ansa = Va Case Va = 0 ansa = "" Case Va = 1 ansa = La_ Case Va = -1 ansa = "-" & La_ Case Else ansa = Va & La_ End Select Select Case True Case Lb_ = "" If Vb = 1 Then ansb = "" Else ansb = Vb End If Case Vb = 0 Stop Case Vb = 1 ansb = Lb_ Case Vb = -1 ansb = "-" & Lb_ Case Else ansb = Vb & Lb_ End Select If ansa = "" Then S = 0 ElseIf ansb = "" Then S = ansa Else S = ansa & "/" & ansb End If End Property
実は「rank」変数には大きな欠点があり、現状では「a,b,c」の三つの文字しか考慮できません。
ここは保留で。
Lit_Str_Make
以前は2を添えていましたが、今回から外します。
Function Lit_Str_Make(NN) As String '------------------- '文字式の計算式を作成する '------------------- '------------------ '変数の定義 '------------------ Dim ope() As String '演算子 Dim kou() As Literal2 '数値 Dim i As Integer '繰り返しの制御変数 Dim box As Variant '演算子決定のアシスト変数 Dim tmp As Integer '演算子決定のアシスト変数 Dim str As String '計算式 Dim ans As String '計算式の答え '------------------ 'opeとnumの配列数を指定 '------------------ ReDim ope(1 To NN) ReDim kou(1 To NN) '------------------ 'opeの値を指定 '------------------ box = Array("＋", "－", "×", "÷") For i = 1 To NN - 1 tmp = Rnd_Num(0, 1) ope(i) = box(tmp) Next '------------------ 'kouの値を指定 '------------------ box = Array("", "a", "b") For i = 1 To NN Set kou(i) = New Literal2 kou(i).Va = Rnd_Num(1, 3) tmp = Rnd_Num(0, 1) kou(i).La = box(tmp) Next '------------------ 'strを作成 '------------------ For i = 1 To NN str = str & kou(i).S & ope(i) Next '------------------ 'ansを計算 '------------------ ans = Lit_Str_Analyze(str) '------------------ '戻り値を作成 '------------------ str = str & "=" & ans Lit_Str_Make = str End Function
Lit_Str_Analyze
整数系に倣って、今回も解析関数を作りました。
項のソート、足し算の処理の仕方、あたりが特徴です。
ソートはよく知らないので、（たぶん）クイックソートにしました。
Function Lit_Str_Analyze(ByVal str As String) As String '--------------------- '文字式の計算 '--------------------- '--------------------- '変数の定義 '--------------------- Dim kou() As Literal2 '項 Dim ope() As String '演算子 Dim i As Integer '繰り返しの制御変数 Dim j As Integer '繰り返しの制御変数 Dim trgt As String '仕分けのアシスト変数 Dim stock As String '仕分けのアシスト変数 Dim cnt As Integer '仕分けのアシスト変数 Dim swap As Literal2 'ソートのアシスト変数 '---------------------- 'strをopeとnumに分ける '---------------------- For i = 1 To Len(str) trgt = Mid(str, i, 1) Select Case trgt Case Is = "＋", "－", "×", "÷" ReDim Preserve kou(cnt) ReDim Preserve ope(cnt) Set kou(cnt) = New Literal2 kou(cnt).Conversion (stock) ope(cnt) = trgt stock = "" cnt = cnt + 1 Case Else stock = stock & trgt End Select Next If stock <> "" Then ReDim Preserve kou(cnt) Set kou(cnt) = New Literal2 kou(cnt).Conversion (stock) stock = "" End If '----------------------- '－の処理 '----------------------- For i = 0 To UBound(ope) If ope(i) = "－" Then ope(i) = "＋" kou(i + 1).Va = kou(i + 1).Va * -1 End If Next '----------------------- '計算を行う '----------------------- Rtrn: '掛け算と割り算 For i = 0 To UBound(kou) - 1 Select Case ope(i) Case Is = "×" kou(i).Va = kou(i).Va * kou(i + 1).Va kou(i).Vb = kou(i).Vb * kou(i + 1).Vb kou(i).La = kou(i).La & kou(i + 1).La kou(i).Lb = kou(i).Lb & kou(i + 1).Lb Call V_Shift(ope, i) Call O_Shift(kou, i + 1) GoTo Rtrn Case Is = "÷" kou(i).Va = kou(i).Va * kou(i + 1).Vb kou(i).Vb = kou(i).Vb * kou(i + 1).Va kou(i).La = kou(i).La & kou(i + 1).Lb kou(i).Lb = kou(i).Lb & kou(i + 1).La Call V_Shift(ope, i) Call O_Shift(kou, i + 1) GoTo Rtrn End Select Next '項をソートする Set swap = New Literal2 For i = 0 To UBound(kou) - 1 For j = i To UBound(kou) If kou(i).rank < kou(j).rank Then Set swap = kou(i) Set kou(i) = kou(j) Set kou(j) = swap End If Next Next Rtrn2: '足し算と引き算 For i = 0 To UBound(kou) - 1 If kou(i).La = kou(i + 1).La And kou(i).Lb = kou(i + 1).Lb Then kou(i).Va = kou(i).Va * kou(i + 1).Vb + kou(i).Vb * kou(i + 1).Va kou(i).Vb = kou(i).Vb * kou(i + 1).Vb Call V_Shift(ope, i) Call O_Shift(kou, i + 1) GoTo Rtrn2 End If Next '---------------------- '戻り値の作成 '---------------------- kou(0).Fit ans = kou(0).S If ope(0) <> "END" Then For i = 0 To UBound(ope) kou(i + 1).Fit If kou(i + 1).Va <> 0 Then ans = ans & ope(i) & kou(i + 1).S End If Next End If '-------------------- '特殊な処理 '-------------------- If Len(ans) > 1 Then If left(ans, 2) = "0＋" Then ans = Mid(ans, 3) End If End If ans = Replace(ans, "＋-", "－") ans = Replace(ans, "－-", "＋") Lit_Str_Analyze = ans End Function
「特殊な処理」のところは正直言って甘えです。
良い解決策が見つかったから消したいですね。
まとめ
とりあえず作れはしました。
現状だと「Str_Make」の関数に機能をいろいろつけすぎだと思うので、次回にちょっと整えます。
