2018-11-25

文章問題を自動生成するその3_1 ひながた (worとnumの個数を考慮)

VBA VBA-中学数学計算プリント

はじめに
均したい部分
自動でやってみる
- 扱う文章
- コード
まとめ

はじめに

前回現れた多くの課題を解決していきます。
「その1」と「その2」で扱った二つの文章に、できるだけ対応できる関数を作ることが「その3」の目的です。
なので抽象的な話が多くなります。

均したい部分

前回コードを変更した部分を再びあげます。

「wor1」を書き換える候補を手書きで加えた。
「wor2」を新たに加えた。「wor」配列の個数を変更した。「num1」「num2」の値の範囲を変更した。
「num3」の求め方を変えた。
「wor」を書き換える構文を変更した。

今回は、「wor」と「num」の個数を考慮してくれる仕様にします。

自動でやってみる

扱う文章

「その1」で使ったものを一部変更します。

1 3 '-------------------------- '問題文 '-------------------------- wor1が1個num1円で売られています。 wor1をnum2つ買う時の値段はいくらでしょう｡

'-------------------------- '解き方 '-------------------------- num2×num1=num3 よってnum3円

1行目にworの数を、2行目にnumの数を打ち込みました。

コード

Sub 文章題生成_3_1()
'--------------------------
'文章第の一部を書き換える
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim str() As String        '文章
 Dim path As String         'メモ帳のアドレス
 Dim tmp As Integer         '一時的な保管変数
 Dim box As Variant         'ワードの候補
 Dim wor() As String        'ワード入れ替え用の変数
 Dim num() As Integer       '数値入れ替え用の変数
 Dim trgt As String         '数値入れ替え用の変数
 Dim i As Integer           '繰り返しの制御変数
 Dim j As Integer           '繰り返しの制御変数
 
'--------------------------
'文章の読み込み
'--------------------------
 path = ThisWorkbook.path & "\text\text1_1.txt"
 str = txt_input(path)

'--------------------------
'書き換えの用意
'--------------------------

'--------------------------
'worとnumの配列数を取得
'--------------------------
 tmp = Val(str(0))
 ReDim wor(1 To tmp)
 
 tmp = Val(str(1))
 ReDim num(1 To tmp)

 box = Array("りんご", "みかん", "なし", "もも", "かき")
 tmp = Rnd_Num(0, UBound(box))
 wor(1) = box(tmp)
 
 num(1) = Rnd_Num(1, 5) * 10 + 100
 num(2) = Rnd_Num(3, 7)
 num(3) = num(1) * num(2)
 
'--------------------------
'問題文を変更
'--------------------------
 For i = LBound(str) + 2 To UBound(str)
    For j = 1 To Val(str(0))
        trgt = "wor" & 1
        str(i) = Replace(str(i), trgt, wor(1))
        str(i) = Replace(str(i), trgt, wor(1))
    Next
    For j = 1 To Val(str(1))
        trgt = "num" & j
        str(i) = Replace(str(i), trgt, num(j))
        str(i) = Replace(str(i), trgt, num(j))
    Next
 Next
 
 
'--------------------------
'文章の書き出し
'--------------------------
 For i = LBound(str) + 2 To UBound(str)
    Call Insert_Equation(20, 30 * (i + 1), str(i))
 Next
 
 path = ThisWorkbook.path & "\text\text1_2.txt"
 Call txt_output(str, path)
End Sub

まとめ

地味ですが、恩恵は大きいです。
これで文章が変わっても関数の構造自体は変更せずに済みます。

こんな調子で少しずつ課題をつぶしていきます。

2018-11-24

文章問題を自動生成するその2 ぜんぶでいくつ？（変更点をみつける）

VBA VBA-中学数学計算プリント

はじめに
手動でやってみる
- 問題
- 解き方
書き換えの準備
自動でやってみるPart1
- 生成した文章Part1
- 考察Part1
自動でやってみるPart2
まとめ

はじめに

今回は新しい文章を扱います。
前回作成した関数をそのまま流用できるのだろうか……

手動でやってみる

問題

だいご君はあめを3つもっています。
いま、さらに5つのあめをもらいました。
もっているあめはぜんぶでいくつでしょうか。

解き方

3＋5=8
よって8つ

書き換えの準備

まずは文章にマークを付けないといけません。
ワードは「あめ」
数値は「3」と「5」と「8」
をマーキングします。

この作業は今のところ手動です。
目で見て、手でひとつひとつ書き換えています。

'-------------------------- '問題文 '-------------------------- だいご君はwor1をnum1つもっています。
いま、さらにnum2つのwor1をもらいました。
もっているwor1はぜんぶでいくつでしょうか。

'-------------------------- '解き方 '-------------------------- num1＋num2=num3
よってnum3つ

自動でやってみるPart1

前回作成した「文章題生成_3」に投げてみます。
メモ帳のアドレスなどは手動で書き換えています。

生成した文章Part1

'-------------------------- '問題文 '-------------------------- だいご君はももを110つもっています。
いま、さらに5つのももをもらいました。
もっているももはぜんぶでいくつでしょうか。

'-------------------------- '解き方 '-------------------------- 110＋5=550
よって550つ

考察Part1

んー。すごいおかしいですね。
おかしな点をリストアップ。

ももを110個持っているのは多すぎる。
110つではなく110個と表記してほしい。
計算が間違っている。

致命的な欠点は計算が間違っていること。

これは「num3」の求め方が「num1×num2」となっているからです。
この部分を「num1＋num2」とすれば解決はするのですが。
今回はそれで。

「num1」と「num2」は乱数の範囲を書き換えます。
ここも妥協。

あ、あとせっかくなので「だいご君」も書き換えられるようにしましょう。

自動でやってみるPart2

扱う文章題

'--------------------------
'問題文
'--------------------------
wor1はwor2をnum1つもっています。
いま、さらにnum2つのwor2をもらいました。
もっているwor2はぜんぶでいくつでしょうか。

'--------------------------
'解き方
'--------------------------
num1＋num2=num3
よってnum3つ

コードPart2

Sub 文章題生成_4() '-------------------------- '文章第の一部を書き換える '--------------------------

'-------------------------- '変数の定義 '-------------------------- Dim str() As String '文章 Dim path As String 'メモ帳のアドレス Dim box As Variant 'ワードの候補 Dim wor(1 To 2) As String 'ワード入れ替え用の変数 Dim num(1 To 3) As Integer '数値入れ替え用の変数 Dim trgt As String '数値入れ替え用の変数 Dim i As Integer '繰り返しの制御変数 Dim j As Integer '繰り返しの制御変数

'-------------------------- '文章の読み込み '-------------------------- path = ThisWorkbook.path & "\text\text2_1.txt" str = txt_input(path)

'-------------------------- '書き換えの用意 '-------------------------- box = Array("だいご君", "ひかる君", "むつこちゃん", "うらべ君") tmp = Rnd_Num(0, UBound(box)) wor(1) = box(tmp) box = Array("あめ", "りんご", "みかん", "なし", "もも", "かき") tmp = Rnd_Num(0, UBound(box)) wor(2) = box(tmp)

num(1) = Rnd_Num(1, 6) num(2) = Rnd_Num(3, 7) num(3) = num(1) + num(2)

'-------------------------- '問題文を変更 '-------------------------- For i = LBound(str) To UBound(str) For j = 1 To 2 trgt = "wor" & j str(i) = Replace(str(i), trgt, wor(j)) str(i) = Replace(str(i), trgt, wor(j)) Next For j = 1 To 3 trgt = "num" & j str(i) = Replace(str(i), trgt, num(j)) str(i) = Replace(str(i), trgt, num(j)) Next Next

'-------------------------- '文章の書き出し '-------------------------- For i = LBound(str) To UBound(str) Call Insert_Equation(20, 30 * (i + 1), str(i)) Next

path = ThisWorkbook.path & "\text\text2_2.txt" Call txt_output(str, path) End Sub

生成した文章Part2

'--------------------------
'問題文
'--------------------------
むつこちゃんはなしを4つもっています。
いま、さらに4つのなしをもらいました。
もっているなしはぜんぶでいくつでしょうか。

'--------------------------
'解き方
'--------------------------
4＋4=8
よって8つ

考察Part2

新たに手を加えた部分をリストアップします。

感覚的には相当書き換えたな、という感じです。

まとめ

「文章題生成3」はぜんぜん汎用性のない関数であることが分かりました。
当然ながら「文章題生成4」も同様です。

文章題を変えるたびにコードのあちこちを変更するのは疲れるので、できるだけ手間を減らすことが次の課題です。
つぶせるものからひとつずつつぶしていきましょう。

2018-11-23

文章問題を自動生成するその1_3 りんごの値段は？（文章の入出力）

VBA VBA-中学数学計算プリント

はじめに
文章の管理
コード
- 文章題生成_3
生成した文章
まとめ

はじめに

いままではコード内やイミディエイトウィンドウで文章を管理していました。
それだと「文章の切り替え」に弱いので、今回は文章の管理について書きます。

文章の管理

コード内でないところで文章を管理する。
ぱっと思いつくのはExcelのシートですが、今回はメモ帳で管理することにします。シートで管理しようとするとごちゃごちゃになりそうな気がするので。
ここはおそらく趣味の問題だと思います。

コード

文章題生成_3

まだ「ひながた」がないので、最初に書いた「文章題生成_1」をちょっとずつ更新しています。

Sub 文章題生成_3()
'--------------------------
'文章第の一部を書き換える
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim str() As String        '文章
 Dim path As String         'メモ帳のアドレス
 Dim box As Variant         'ワードの候補
 Dim wor(1) As String       'ワード入れ替え用の変数
 Dim num(1 To 3) As Integer '数値入れ替え用の変数
 Dim trgt As String         '数値入れ替え用の変数
 Dim i As Integer           '繰り返しの制御変数
 Dim j As Integer           '繰り返しの制御変数
 
'--------------------------
'文章の読み込み
'--------------------------
 path = ThisWorkbook.path & "\text\text1.txt"
 str = txt_input(path)

'--------------------------
'書き換えの用意
'--------------------------
 box = Array("りんご", "みかん", "なし", "もも", "かき")
 tmp = Rnd_Num(0, UBound(box))
 wor(1) = box(tmp)
 
 num(1) = Rnd_Num(1, 5) * 10 + 100
 num(2) = Rnd_Num(3, 7)
 num(3) = num(1) * num(2)
 
'--------------------------
'問題文を変更
'--------------------------
 For i = LBound(str) To UBound(str)
        trgt = "wor" & 1
        str(i) = Replace(str(i), trgt, wor(1))
        str(i) = Replace(str(i), trgt, wor(1))
    For j = 1 To 3
        trgt = "num" & j
        str(i) = Replace(str(i), trgt, num(j))
        str(i) = Replace(str(i), trgt, num(j))
    Next
 Next
 
 
'--------------------------
'文章の書き出し
'--------------------------
 For i = LBound(str) To UBound(str)
    Call Insert_Equation(20, 30 * (i + 1), str(i))
 Next
 
 path = ThisWorkbook.path & "\text\text2.txt"
 Call txt_output(str, path)
End Sub

変更点をつらつらと。
文章の入力をメモ帳からするようにした。
文章の「ワード」と「数値」を変更する仕様にした。
変更した文章をシート上に出力するようにした。
変更した文章をメモ帳に保管するようにした。

生成した文章

'--------------------------
'問題文
'--------------------------
りんごが1個140円で売られています。
りんごを7つ買う時の値段はいくらでしょう｡

'--------------------------
'解き方
'--------------------------
7×140=980
よって980円

まとめ

これで文章の管理が楽になりました。

次回は扱う文章を変えてみます。
知らず知らずのうちに「この文章専用のコード」になってしまっているので
新しい問題を扱うことでその枷を外しましょう。

2018-11-22

文章問題を自動生成するその1_2 りんごの値段は？（数値を変更）

VBA VBA-中学数学計算プリント

はじめに
ひながたの問題
- 問題
- 解き方
自動でやってみる
生成結果
まとめ

はじめに

前回は文章題の「解き方にかかわらない部分」を書き換えました。
今回は「解き方にかかわる部分」を書き換えてみます。

ひながたの問題

書き換えるもとになる文章です。

問題

りんごが1個100円で売られています。
りんごを3つ買う時の値段はいくらでしょう。

解き方

3×100=300
よって300円。

自動でやってみる

今回は「問題文」と「解き方」の両方を書き換える必要があります。
さらに「解き方」では数値の再計算をする必要があります。

Sub 文章題生成_2()
'--------------------------
'文章第の一部を書き換える
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim strA(1 To 2) As String '問題文
 Dim strB(1 To 2) As String '解き方
 Dim num(1 To 3) As Integer '入れ替え用の変数
 Dim trgt As String         '入れ替え用の変数
 Dim i As Integer           '繰り返しの制御変数
 Dim j As Integer           '繰り返しの制御変数
 
'--------------------------
'問題文のひながた
'--------------------------
 strA(1) = "りんごが1個num1円で売られています。"
 strA(2) = "りんごをnum2つ買う時の値段はいくらでしょう｡ "
     
'--------------------------
'解き方のひながた
'--------------------------
 strB(1) = "num1×num2=num3"
 strB(2) = "よってnum3円"
 
'--------------------------
'問題文を変更
'--------------------------
 num(1) = Rnd_Num(1, 5) * 10 + 100
 num(2) = Rnd_Num(3, 7)
 num(3) = num(1) * num(2)
 
 
 For i = 1 To 3
    trgt = "num" & i
    For j = 1 To 2
        strA(j) = Replace(strA(j), trgt, num(i))
        strB(j) = Replace(strB(j), trgt, num(i))
    Next
 Next
 
 
'--------------------------
'Debug
'--------------------------
 For i = 1 To 2
 Debug.Print strA(i)
 Next
 
 For i = 1 To 2
 Debug.Print strB(i)
 Next
End Sub

ひながたとなる文章の一部を変更しました。
書き換えたい部分をあらかじめマークしておくと、簡単に処理できるみたいです。

生成結果

せっかくなので生成された文章を載せておきます。

りんごが1個130円で売られています。
りんごを4つ買う時の値段はいくらでしょう｡

130×4=520
よって520円

まとめ

簡単な文章題を一問だけ手動で作れば、それに似た問題を自動生成できるようになりました。
意外と簡単でしたね。

次回はひながたの文章と書き換えた文章の管理について書きます。

2018-11-21

文章問題を自動生成するその1_1 りんごの値段は？（りんごを変更）

VBA VBA-中学数学計算プリント

はじめに
手動でやってみる
- 問題
- 解き方
文章題の生成について
自動でやってみる
まとめ

はじめに

今回からしばらく文章題を扱います。
ノリとしては「計算プリントを自動生成する」と同じなのですが
文章題と計算プリントってちょっと違うよなーと思ってタイトルを変えました。

「計算プリント系」で書いたことを前提として進めていきます。

「その1」は慣らしです。
とりあえず取り組んでみて、どんなことを考えればいいかをとらえます。

手動でやってみる

とりあえず手動でやってみましょう。
自分で問題を一問生成します。

問題

りんごが1個100円で売られています。
りんごを3つ買う時の値段はいくらでしょう。

解き方

3×100=300
よって300円。

文章題の生成について

とりあえず1問作ってみて思ったこと。

「問題文」と「解き方」の2つをつくる必要がある。
「問題文」は文字を乱数で並べたものではない。
「解き方」は問題文の意味を読み取って作る。

何もない状態から上のような問題を作成して、さらにその解き方を作成するのは難しそう。
なので、手動で作ったものの一部を書き換えることで生成をします。

自動でやってみる

今回は、りんごを別の果物に書き換えるコードにします。

Sub 文章題生成_1()
'--------------------------
'文章第の一部を書き換える
'--------------------------

'--------------------------
'変数の定義
'--------------------------
 Dim strA(1 To 2) As String '問題文
 Dim strB(1 To 2) As String '解き方
 Dim box As Variant         'くだもの
 Dim tmp As Integer         'くだものを選ぶ変数
 Dim trgt As String         '書き換え変数
 Dim i As Integer           '繰り返しの制御変数
'--------------------------
'問題文のひながた
'--------------------------
 strA(1) = "りんごが1個100円で売られています。"
 strA(2) = "りんごを3つ買う時の値段はいくらでしょう｡ "
     
'--------------------------
'解き方のひながた
'--------------------------
 strB(1) = "3×100=300"
 strB(2) = "よって300円"
 
'--------------------------
'問題文を変更
'--------------------------
 box = Array("りんご", "みかん", "なし", "もも", "かき")
 tmp = Rnd_Num(0, UBound(box))
 trgt = box(tmp)
 
 For i = 1 To 2
    strA(i) = Replace(strA(i), "りんご", trgt)
 Next
 
'--------------------------
'Debug
'--------------------------
 For i = 1 To 2
 Debug.Print strA(i)
 Next
 
 For i = 1 To 2
 Debug.Print strB(i)
 Next
End Sub

とりあえずつらつらと。
一回動かしてみたら、「りんご」から「もも」に変わっていました笑

まとめ

文章の「解き方にかかわらない部分」の書き換えは思った以上に簡単でした。
次回はりんごの値段をと買う個数を書き換えてみましょう。

2018-11-20

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

VBA VBA-中学数学計算プリント

はじめに
コードの修正
まとめ

はじめに

これらの記事は一週間分くらい書き溜めてからブログに予約投稿しているのですが。
前回の記事とコードを書いてから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

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

まとめ

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

これで一区切り。

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

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

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

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

2018-11-19

計算プリントを自動生成するその14_3 3数の計算（答えから問題を変える）

VBA VBA-中学数学計算プリント

はじめに
最初に謝罪
狙った計算式を作成
自動でやってみる
Fractionクラス
- Int_Str_Make
- Int_Str_Analyze
まとめ

はじめに

前回、ランダムな計算式作成とその計算式を解く関数を作成しました。
今回はその求めた答えを利用して、狙った計算式を作成します。

最初に謝罪

今回のコードはめちゃくちゃ読みにくいです。
力不足なせいで、とにかく形にするだけになってしまいました。

狙った計算式を作成

今まで(その13まで)は演算子によって適切な数値を決めて、答えを求めて、それを計算式にして……
のように行っていました。
「きれいな」やり方です。

それに比べると今回は「きたない」やり方かもしれません。

とりあえず適当に計算式を作ってみる
答えを解く
答えが欲しいものと違った場合には計算式を少しいじる
２,3を繰り返す
答えが適切になったらそれを計算式にする

という手順を踏みます。
今までと全然違うアプローチです。

ランダム作成関数と解析関数はすでに手持ちにあるので、今回は答えの判定とそれによる問題の修正について考えます。

自動でやってみる

Fractionクラス

前回のFractionクラスに不満があったので書き換えます。

Public Va As Integer    '分子
Public Vb As Integer    '分母
Public str As String    '計算式

Private Sub Class_Initialize()
 Va = 0
 Vb = 1
 str = ""
 
End Sub

Function ConS()
'--------------------
'分子と分母からFractionを構成
'--------------------
 Call Fit
 
 If Va = 0 Then
    str = "0"
 ElseIf Vb = 1 Then
    str = Va
 Else
    
    str = Va & "/" & Vb
 End If
End Function

Function ConV()
'-------------------
'文字式から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
 
 If stock = "" Then
    Vb = 1
 Else
    Vb = Val(stock)
 End If
 
 Call ConS
 
End Function
Function Fit()
'---------------------
'約分
'---------------------
 Dim L As Integer   '最大公約数
 If Va * Vb = 0 Then Exit Function
 L = Application.WorksheetFunction.Gcd(Abs(Va), Abs(Vb))
 Va = Va / L
 Vb = Vb / L
End Function

ちょっと使いやすくなったけども、まだ微妙です。
改善の余地はかなりあり。

Int_Str_Make

前回の「Int_Rnd_Str」をあちこち書き換えました。

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

'------------------
'boxの指定
'------------------
 box = Array("＋", "－", "×", "÷")
 
'------------------
'数式を仮決め
'------------------
ReSelect:
'------------------
'opeの値を指定
'------------------
 For i = 1 To NN - 1
    tmp = Rnd_Num(0, 3)
    ope(i) = box(tmp)
 Next
 
'------------------
'numの値を仮決め
'------------------
 For i = 1 To NN
    num(i) = Rnd_Num(1, 9)
 Next

cnt = 0


ReCal:
'------------------
'ループしている場合
'------------------
If cnt > 20 Then
    str = ""
    GoTo ReSelect
End If

'------------------
'ansを作成
'------------------
 For i = 1 To NN
    str = str & num(i) & ope(i)
 Next
 
 Set ans = Int_Str_Analyze(str)
  
'------------------
'繰り返すかの判定
'------------------
 If ans.Va < 0 Then
    cnt = cnt + 1
    str = ""
    num(1) = num(1) + Abs(ans.Va) \ 4
    For i = 1 To NN - 1
        Select Case ope(i)
            Case Is = "＋"
                num(i + 1) = num(i + 1) + 1
            Case Is = "－"
                num(i + 1) = Application.WorksheetFunction.Max(2, num(i + 1) - 1)
        End Select
    Next
    GoTo ReCal
 End If
 
 If ans.Vb > 1 Then
    cnt = cnt + 1
    str = ""
    num(1) = num(1) * ans.Vb
    
    For i = 1 To NN - 1
       If ope(i) = "＋" Or ope(i) = "－" Then
           num(i + 1) = num(i + 1) * ans.Vb
       End If
    Next
    GoTo ReCal
 End If
    
 If ans.Va > 100 Then
    cnt = cnt + 1
    str = ""
    For i = 1 To NN - 1
        If ope(i) <> "÷" Then
            num(i) = Application.WorksheetFunction.Max(2, num(i) \ 2)
        End If
    Next
    num(i) = Application.WorksheetFunction.Max(2, num(i) - ans.Va \ 3)
    GoTo ReCal
    
 End If
'------------------
'strを再構成
'------------------
 Debug.Print cnt
 str = str & "=" & ans.str
 
 Int_Str_Make = str
End Function

先ほど、今回の制約、で説明した通りのコードです。

Int_Str_Analyze

こちらは前回の解析関数を書き換えたものです。
求めた答えを上の関数で考慮する際の手間を考えて、関数の型を「Fraction」にしました。

本筋とは関係ありませんが、オブジェクト系の関数の扱い方がよくわからなくて苦戦しました。

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    '計算のアシスト変数
 
 
Rtrn:
'----------------------
'変数の初期化
'----------------------
 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).str = stock
            num(cnt).ConV
            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).str = stock
    num(cnt).ConV
    stock = ""
 End If
 
'----------------------
'条件を満たしている場合は終了
'----------------------
 If cnt = 0 Then
    Set ans = New Fraction
    ans.str = str
    ans.ConV
    
    Set Int_Str_Analyze = ans
 
    Exit Function
 End If
 
'----------------------
'計算を行う
'----------------------
 trgt2 = ""
 For i = 0 To UBound(ope)
    Select Case ope(i)
        Case "×"
            trgt2 = num(i).str & ope(i) & num(i + 1).str
            ans.Va = num(i).Va * num(i + 1).Va
            ans.Vb = num(i).Vb * num(i + 1).Vb
            ans.ConS
            str = Replace(str, trgt2, ans.str, , 1)
            GoTo Rtrn
            
        Case "÷"
            trgt2 = num(i).str & ope(i) & num(i + 1).str
            ans.Va = num(i).Va * num(i + 1).Vb
            ans.Vb = num(i).Vb * num(i + 1).Va
            ans.ConS
            str = Replace(str, trgt2, ans.str, , 1)
            GoTo Rtrn
    End Select
 Next
 
 For i = 0 To cnt
    Select Case ope(i)
        Case "＋"
            trgt2 = num(i).str & ope(i) & num(i + 1).str
            ans.Va = num(i).Va * num(i + 1).Vb + num(i).Vb * num(i + 1).Va
            ans.Vb = num(i).Vb * num(i + 1).Vb
            ans.ConS
            str = Replace(str, trgt2, ans.str, , 1)
            GoTo Rtrn
            
        Case "－"
            trgt2 = num(i).str & ope(i) & num(i + 1).str
            ans.Va = num(i).Va * num(i + 1).Vb - num(i).Vb * num(i + 1).Va
            ans.Vb = num(i).Vb * num(i + 1).Vb
            ans.ConS
            str = Replace(str, trgt2, ans.str, , 1)
            GoTo Rtrn
    End Select
 Next
 
'----------------
'予期せぬ処理の場合はSTOP
'----------------
 Stop
 
End Function

まとめ

余裕がなかったのでかなりわかりにくい関数たちになってしまいました。
次回にもうちょっと形を整えます。