滝の音

滝の音

名こそ流れてなお聞こえけれ

計算プリントを自動生成する その14_4 関数の形を整える

はじめに

これらの記事は一週間分くらい書き溜めてからブログに予約投稿しているのですが。
前回の記事とコードを書いてから2,3日たってだいぶ落ち着いてきたので。
改めて修正をしたいと思います。

コードの修正

Fractionクラス

Public va As Integer    '分子
Public vb As Integer    '分母
Public S As String      '文字列

Private Sub Class_Initialize()
 va = 0
 vb = 1
 
End Sub


Function Conversion(str)
'-------------------
'文字式からFractionを構成
'-------------------

 Dim trgt As String
 Dim stock As String
 Dim i As Integer
 
 If str = "" Then Exit Function
 
 If InStr(str, "/") = 0 Then
    va = Val(str)
    Exit Function
 End If
 
 For i = 1 To Len(str)
    trgt = Mid(str, i, 1)
    If trgt = "/" Then
        va = Val(stock)
        stock = ""
    Else
        stock = stock & trgt
    End If
 Next
 
 vb = Val(stock)
 
 Call Fit
 
 
End Function
Function Fit()
'---------------------
'約分してStrを作成
'---------------------

 If va = 0 Then
    S = "0"
 End If
 
 L = Application.WorksheetFunction.Gcd(Abs(va), Abs(vb))
 va = va / L
 vb = vb / L
 
 If vb = 1 Then
    S = va
 Else
    S = va & "/" & vb
 End If
End Function

やはり多少奇妙な感じがするのですが、こちらのほうが使い勝手がいいのでそうします。

Int_Str_Make

この関数には「計算式を作成するための骨格」という役割を持たせることにしました。
以降のサブ関数たちの戻り値を使って式を作成する関数です。

まだ機能をサブ関数に与え切れていないのですが、前回よりは見やすいと思います。

Function Int_Str_Make(NN, version) As String
'------------------
'変数の定義
'------------------
 Dim ope() As String    '演算子
 Dim num() As Fraction  '数値
 Dim i As Integer       '繰り返しの制御変数
 Dim box As Variant     '演算子決定のアシスト変数
 Dim tmp As Integer     '演算子決定のアシスト変数
 Dim str As String      '計算式
 Dim ans As Fraction    '数式の解を管理
 Dim cnt As Integer     'loop管理の変数
 Dim flag As Boolean    'loop管理の変数
'------------------
'opeとnumの配列数を指定
'------------------
 ReDim ope(1 To NN)
 ReDim num(1 To NN)

'------------------
'boxの指定
'------------------
 box = Array("+", "-", "×", "÷")
 
'------------------
'数式を仮決め
'------------------
ReSelect:
 cnt = 0
 
'------------------
'opeの値を指定
'------------------
 For i = 1 To NN - 1
    tmp = Rnd_Num(0, 3)
    ope(i) = box(tmp)
 Next
 
'------------------
'numの値を仮決め
'------------------
 For i = 1 To NN
    Set num(i) = New Fraction
   Set num(i) = Int_Num_Select()
Next

'-------------------
'numの値を本決め
'-------------------

Do
    '------------------
    'loopの初期設定
    '------------------
    flag = False
    str = ""
    
    '------------------
    '停滞している場合
    '------------------
    If cnt > 20 Then
        GoTo ReSelect
    End If
    
    '------------------
    'ansを作成
    '------------------
     For i = 1 To NN
        num(i).Fit
        str = str & num(i).S & ope(i)
     Next
     
     Set ans = Int_Str_Analyze(str)
      
    '------------------
    '繰り返すかの判定
    '------------------
     flag = Int_ReDo_Jdg(num, ope, ans)
     cnt = cnt + 1
 
 Loop While flag = True
 
'------------------
'strを再構成
'------------------

 str = str & "=" & ans.S
 
 Int_Str_Make = str
End Function

数値の指定、答えの解析、答えの判定、をサブ関数に行わせています。
前回はサブ関数への仕分けが下手だったので汚くなってしまったのかなと思います。

仕分けは機能を俯瞰して見られていれば簡単なのですが、関数を書くことにいっぱいいっぱいになっているとなかなかできないですね。

Int_Num_Select

後のことも考えて、型をFractionにしています。

Function Int_Num_Select() As Fraction

 Dim num As Fraction    '戻り値

 Set num = New Fraction
 num.va = Rnd_Num(1, 10)
 num.Fit

 Set Int_Num_Select = num
End Function

Int_Str_Analyze

前回よりも理にかなったコードになったと思います。
ただそのためにサブ関数が増えました。

Function Int_Str_Analyze(ByVal str As String) As Fraction
'----------------------
'整数の計算式の答えを求める
'----------------------

'----------------------
'変数の定義
'----------------------
 
 Dim num() As Fraction  '数字を仕分ける変数
 Dim ope() As String    '演算子を仕分ける変数
 Dim i As Integer       '繰り返しの制御変数
 Dim trgt As String     '仕分けのアシスト変数
 Dim stock As String    '仕分けのアシスト変数
 Dim cnt As Integer     '仕分けのアシスト変数
 Dim trgt2 As String    '計算のアシスト変数
 Dim ans As Fraction    '計算のアシスト変数
 
'----------------------
'変数の初期化
'----------------------
 cnt = 0
 stock = ""
 trgt = ""
 trgt2 = ""
 ReDim num(cnt)
 ReDim ope(cnt)
 Set ans = New Fraction
'----------------------
'strをopeとnumに分ける
'----------------------
 For i = 1 To Len(str)
 
    trgt = Mid(str, i, 1)
    Select Case trgt
        Case Is = "+", "-", "×", "÷"
        
            ReDim Preserve num(cnt)
            ReDim Preserve ope(cnt)
            Set num(cnt) = New Fraction
            num(cnt).Conversion (stock)
            ope(cnt) = trgt

            stock = ""
            cnt = cnt + 1
            
        Case Else
            stock = stock & trgt
    End Select
 Next

 If stock <> "" Then
    ReDim Preserve num(cnt)
    Set num(cnt) = New Fraction
    num(cnt).Conversion (stock)
    stock = ""
 End If
 
 
 
Rtrn:

'----------------------
'条件を満たしている場合は終了
'----------------------
If ope(UBound(ope)) = "END" Then
    num(0).Fit
    Set Int_Str_Analyze = num(0)
    Exit Function
End If

'----------------------
'計算を行う
'----------------------
 trgt2 = ""
 For i = 0 To UBound(ope)
    Select Case ope(i)
        Case "×"
            num(i).va = num(i).va * num(i + 1).va
            num(i).vb = num(i).vb * num(i + 1).vb
            Call V_Shift(ope, i)
            Call O_Shift(num, i + 1)
            GoTo Rtrn
            
        Case "÷"
            num(i).va = num(i).va * num(i + 1).vb
            num(i).vb = num(i).vb * num(i + 1).va
            Call V_Shift(ope, i)
            Call O_Shift(num, i + 1)
            GoTo Rtrn
    End Select
 Next
 
 For i = 0 To UBound(ope)
    Select Case ope(i)
        Case "+"
            num(i).va = num(i).va * num(i + 1).vb + num(i).vb * num(i + 1).va
            num(i).vb = num(i).vb * num(i + 1).vb
            Call V_Shift(ope, i)
            Call O_Shift(num, i + 1)
            GoTo Rtrn
            
        Case "-"
            num(i).va = num(i).va * num(i + 1).vb - num(i).vb * num(i + 1).va
            num(i).vb = num(i).vb * num(i + 1).vb
            Call V_Shift(ope, i)
            Call O_Shift(num, i + 1)
            GoTo Rtrn
    End Select
 Next
 
'----------------
'予期せぬ処理の場合はSTOP
'----------------
 Stop
 
End Function

Shift系

これらは専用ツールみたいな感じです。

まずはV_Shift

Function V_Shift(trgt, num)

For i = num To UBound(trgt) - 1
    trgt(i) = trgt(i + 1)
Next

If UBound(trgt) > 0 Then
    ReDim Preserve trgt(LBound(trgt) To UBound(trgt) - 1)
Else
    trgt(0) = "END"
End If

End Function

次にO_Shift

Function O_Shift(trgt, num)

For i = num To UBound(trgt) - 1
    Set trgt(i) = trgt(i + 1)
Next

ReDim Preserve trgt(LBound(trgt) To UBound(trgt) - 1)


End Function

Int_ReDo_Jdg

前回はこの機能を関数に仕分けていなかったのが良くなかった。

Function Int_ReDo_Jdg(num, ope, ans) As Boolean
'-------------------------
'ansを考慮して
'必要な場合はnumの値を変更
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim i As Integer
 
'--------------------------
'ansが負の数の場合
'--------------------------
If ans.va < 0 Then
    num(1).va = num(1).va + Abs(ans.va) \ 4
    For i = 1 To NN - 1
        Select Case ope(i)
            Case Is = "+"
                num(i + 1).va = num(i + 1).va + 1
            Case Is = "-"
                num(i + 1).va = Application.WorksheetFunction.Max(2, num(i + 1).va - 1)
        End Select
    Next
    Int_ReDo_Jdg = True
    Exit Function
    
 End If
 
'--------------------------
'ansが分数の場合
'--------------------------
 If ans.vb > 1 Then
    num(1).va = num(1).va * ans.vb
    
    For i = 1 To NN - 1
       If ope(i) = "+" Or ope(i) = "-" Then
           num(i + 1).va = num(i + 1).va * ans.vb
       End If
    Next
    Int_ReDo_Jdg = True
    Exit Function
 End If
   
'--------------------------
'ansが100より大きい場合
'--------------------------
 If ans.va > 100 Then
    For i = 1 To NN - 1
        If ope(i) <> "÷" Then
            num(i).va = Application.WorksheetFunction.Max(2, num(i).va \ 2)
        End If
    Next
    num(i).va = Application.WorksheetFunction.Max(2, num(i).va - ans.va \ 3)
    Int_ReDo_Jdg = True
    Exit Function
    
 End If
End Function

この条件を書き換えることで分数の計算や負の数の計算にも対応できます。
ただまだまだ考える余地はありますが。

まとめ

言うほどきれいには整えられませんでしたが、とりあえず自分の頭はすっきりしました。

これで一区切り。

つぎはどこに石を打とうか、というところですね。

この関数の強化か
文章題への進出か
文字式への進出か
図形への進出か

どれもいつかはやるので
興味のあるものからやりましょう。

次回は文章題へ進出します。