計算プリントを自動生成する 文字式への代入
はじめに
記事をためて書いておいて、一週間くらいおきにまとめて投稿しているのですが、なぜかこの回は「はじめに」が空欄でした。
なんでだろう？？
コード
Literal2クラス
今回気が付きましたが、コード全体を無造作に載せるより、追加部分や変更部分のみを載せたほうが見やすいですね。
Substitution関数を追加しました。
プライベート変数のelementが役に立っています。
Function Substitution(char, num) '---------------- '文字に数字を代入 '---------------- trgt = element(Asc(char) - 96) Select Case trgt Case Is = 0 Case Is > 0 Va = Va * num * trgt La_ = Replace(La_, char, "") Case Is < 0 Vb = Vb * num * trgt Lb_ = Replace(Lb_, char, "") End Select element(Asc(char) - 96) = 0 End Function
Lit_Str_Division
文字列を「kou」と「ope」に分割する関数を作りました。
もともとは「Analyze系」の関数内に入れていたのですが、「代入」の関数にも同じ機能が欲しいと思い、サブ関数に分けました。
Function Lit_Str_Divide(str, ByRef kou, ByRef ope) '---------------------- 'strをopeとkouに分ける '---------------------- '---------------------- '変数の定義 '---------------------- Dim trgt As String '仕分けのアシスト変数 Dim stock As String '仕分けのアシスト変数 Dim cnt As Integer '仕分けのアシスト変数 '---------------------- '分割 '---------------------- 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 End Function
Lit_Str_Substitution
文字列で与えられた文字式について、指定された文字に指定された数値を代入する関数です。
Function Lit_Str_Substitution(ByVal str As String, char As String, num As Integer) As Literal2() '--------------------- '変数の定義 '--------------------- Dim kou() As Literal2 '項 Dim ope() As String '演算子 Dim i As Integer '繰り返しの制御変数 Dim j As Integer '繰り返しの制御変数 '---------------------- 'strをopeとkouに分ける '---------------------- Call Lit_Str_Divide(str, kou, ope) '---------------------- '代入 '---------------------- For i = LBound(kou) To UBound(kou) Call kou(i).Substitution(char, num) Next Lit_Str_Substitution = kou() End Function
「Analyze」系の関数もそうですが、それ単独でも使える仕様にしているため、「文字列」⇔「kou」の変換が頻繁に起きています。
そうすることで「計算プリントを自動生成する」の本筋からはずれてしまっているのですが、それでもそうしたいなーと思っています。
まとめ
前回、関数の整理をした甲斐もあって、なかなかスムーズに実装できたかなと思います。
とりあえず「文字式の計算」はここで打ち止め。
次に何をしようか迷いますね。
「文章問題」を扱うために「数列」を実装したくて、そのために「文字列の計算」をこなしました。
ただ「文章問題」はわざわざ「数列」を使わなくとも解決できそうなんですよね。
んー。
このあたりでいったん「統合」しておきますか。
いろいろ関数を作りっぱなしになっているので。
計算プリントを生成する 3項以上の文字式の計算 その2（関数を整える）
はじめに
今回は「機能を関数に割り振る」ことをします。
コード
Lit_Formula_Make
前回までの「Lit_Str_Make」です。
ちょっと名前がおかしいと思ったので変更しました。
あと、この関数にいろいろやらせすぎていると感じたので、いくつかの機能をサブ関数に割り振りました。
Function Lit_Formula_Make(NN) As String '------------------- '文字式の計算式を作成する '------------------- '------------------ '変数の定義 '------------------ Dim ope() As String '演算子 Dim kou() As Literal2 '数値 Dim i As Integer '繰り返しの制御変数 Dim str As String '計算式 Dim str1 As String Dim str2 As String Dim ans() As Literal2 '計算式の答え '------------------ 'kou,opeを指定 '------------------ Call Lit_kou_ope_Select(NN, kou, ope) '------------------ 'str1を作成 '------------------ str1 = Lit_Str_Make(kou, ope) '------------------ 'ansを配列で取得 '------------------ ans = Lit_Str_Analyze(str1) '------------------ 'str2を作成 '------------------ ReDim ope(LBound(ans) To UBound(ans)) For i = LBound(ans) To UBound(ans) - 1 ope(i) = "＋" Next str2 = Lit_Str_Make(ans, ope) '------------------ 'str2の修飾 '------------------ If left(str2, 2) = "0＋" Then str2 = Mid(str2, 3) End If If Right(str2, 1) = "＋" Then str2 = left(str2, Len(str2) - 1) End If str2 = Replace(str2, "＋-", "－") '------------------ '戻り値を作成 '------------------ str = str1 & "=" & str2 Lit_Formula_Make = str End Function
これでだいぶ見やすくなったかなと思います。
Lit_kou_ope_Select
「kou」と「ope」の値を決める変数です。
ここが実質的に問題の内容を作っています。
Function Lit_kou_ope_Select(NN, ByRef kou, ByRef ope) '----------------- 'kou,opeの値を指定 '----------------- '----------------- '変数の定義 '----------------- Dim box As Variant '値決定のアシスト変数 Dim tmp As Integer '値決定のアシスト変数 '------------------ '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 End Function
Lit_Str_Make
「kou」と「ope」を文字式に起こす関数です。
この機能をサブ関数化することで、個人的にはコードの流れが見やすくなったと思います。
Function Lit_Str_Make(kou, ope) '----------------- 'kou,opeを文字列に起こす '----------------- '----------------- '変数の定義 '----------------- Dim i As Integer '繰り返しの制御変数 Dim ans As String '戻り値 ans = kou(LBound(kou)).S For i = LBound(kou) + 1 To UBound(kou) If Not (kou(i).S = "0" And ope(i - 1) = "＋") Then ans = ans & ope(i - 1) & kou(i).S End If Next Lit_Str_Make = ans End Function
ただ、このコード自体はあまりきれいじゃないです。
Lit_Str_Analyze
関数の型を「Literal2」にして、「kou」の配列を戻り値にしました。
それ以外は変更していないので、コードは省略で。
まとめ
関数の名前の変更とサブ関数の作成をしました。
悪い癖かもしれませんが、「名前」がしっくりこないと気分が悪くなってしまいます。
そういうこだわりはまだ持たなくていい、と思いつつも取り払えないですね。
「修飾」の部分を上手に書けないせいで、全体的にぎこちない見た目になっています。
これはもうちょっとスキルを上げないと解決できなさそうなのでながーく保留。
さて、これで「3項以上の文字式の計算」を一段落です。
次は文字式への「代入」を行います。
計算プリントを自動生成する 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」の関数に機能をいろいろつけすぎだと思うので、次回にちょっと整えます。
計算プリントを生成する 文字式の計算 その2（2aと3a^2の四則の計算）
はじめに
今回は2aと3a2の四則の計算を行います。
ちょっとややこしいところです。
手動でやってみる
文章題で思いましたが、手動でやってみることって大事ですね。
癖が見えてきます。
| 計算式 | 答え |
|---|---|
| 2a＋3a2 | 2a＋3a2 |
| 2a－3a2 | 2a－3a2 |
| 2a×3a2 | 6a3 |
| 2a÷3a2 | 2/3a |
難解な点が二か所。
答えが多項式になるところ（足し算と引き算）と
答えが分数になり分母に文字が来るところ（割り算）です。
この2つをクリアすることが今回の課題です。
自動でやってみる
正直まだ理解しきれていないところがあって、とにかくコードが複雑です。
Literal2クラス
分数にも対応しているLiteralクラスです。
一応Literalクラスと別に作成しました。
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 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 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
Lit_Str_Make_2
Literal2クラスに対応した関数です。
Function Lit_Str_Make_2(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) '------------------ 'boxの指定 '------------------ box = Array("＋", "－", "×", "÷") '------------------ 'opeの値を指定 '------------------ For i = 1 To NN - 1 tmp = Rnd_Num(0, 3) ope(i) = box(tmp) Next ope(2) = "=" '------------------ 'kouの値を指定 '------------------ Set kou(1) = New Literal2 kou(1).Va = 2 kou(1).La = "a" Set kou(2) = New Literal2 kou(2).Va = 3 kou(2).La = "aa" '------------------ 'ansを計算 '------------------ ans = Lit_Calculation_2(kou, ope) '------------------ 'ansを作成 '------------------ For i = 1 To NN str = str & kou(i).S & ope(i) Next str = str & ans Lit_Str_Make_2 = str End Function
Lit_Calculation_2
こちらもLiteral2クラス対応の関数。
2項の計算専用にしているため、あまり汎用性はありません。
Function Lit_Calculation_2(ByVal kou, ope) As String '------------------ '2項の文字式の計算 '------------------ Dim ans As Literal2 Dim ans2 As String Set ans = New Literal2 Select Case ope(1) Case Is = "＋" If kou(1).La = kou(2).La And kou(1).Lb = kou(2).Lb Then ans.Va = kou(1).Va * kou(2).Vb + kou(1).Vb * kou(2).Va ans.Vb = kou(1).Vb * kou(2).Vb ans.La = kou(1).La ans.Lb = kou(1).Lb Else ans2 = kou(1).S & ope(1) & kou(2).S Lit_Calculation_2 = ans2 Exit Function End If Case Is = "－" If kou(1).La = kou(2).La And kou(1).Lb = kou(2).Lb Then ans.Va = kou(1).Va * kou(2).Vb - kou(1).Vb * kou(2).Va ans.Vb = kou(1).Vb * kou(2).Vb ans.La = kou(1).La ans.Lb = kou(1).Lb Else ans2 = kou(1).S & ope(1) & kou(2).S Lit_Calculation_2 = ans2 Exit Function End If Case Is = "×" ans.Va = kou(1).Va * kou(2).Va ans.Vb = kou(1).Vb * kou(2).Vb ans.La = kou(1).La & kou(2).La ans.Lb = kou(1).Lb & kou(2).Lb Case Is = "÷" ans.Va = kou(1).Va * kou(2).Vb ans.Vb = kou(1).Vb * kou(2).Va ans.La = kou(1).La & kou(2).Lb ans.Lb = kou(1).Lb & kou(2).La End Select Lit_Calculation_2 = ans.S End Function``` ここはかなり汎用性を削っています。 それでも2項の計算ならできるので良しとします。 できる範囲でとにかく作る。が大事だと思っています。 ###まとめ これでとりあえず2a,3a^2の四則の計算はクリアです。 ついでにどんな2項の計算でも（たぶん）できるようになりました。 次にやることは迷いますね。 右の道は楽の看板。 文字式への代入です。 左の道は覚悟の看板。 3項以上の文字式の計算です。 んー。 今勢いに乗っているので、3項以上の文字式の計算をやりましょう。 無理そうだったらできるところまでで凍結しますが、現時点で出来るところまでやりましょう。
計算プリントを生成する 文字式の計算 その1（2aとaの四則の計算）
はじめに
想像より早く「計算プリント」に戻ってきました。
今回は項をa,2aに絞って、それらの四則の計算を行います。
あとタイトルのナンバリングについて。
今まで通りなら15_1なのですが、それってわかりやすいか？と思い、ちょっと変更しました。
手動でやってみる
| 計算式 | 答え |
|---|---|
| 2a＋a | 3a |
| 2a－a | a |
| 2a×a | 2a2 |
| 2a÷a | 2 |
これを見るだけでも文字式に必要そうな要素は見えてきますね。
自動でやってみる
Literalクラス
分数と同様にクラスを作ります。
Public V As Integer Private L_ As String Private element(1 To 26) As Integer Private Sub Class_Initialize() V = 0 End Sub Property Get L() As String L = L_ End Property Property Let L(str As String) L_ = 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() '-------------- 'L_の表記を整える '-------------- '変数の定義 '-------------- Dim i As Integer '繰り返しの制御変数 Dim trgt As String 'fitのアシスト変数 Dim num As Integer 'fitのアシスト変数 Dim asn As String 'fitのアシスト変数 '--------------- 'elementの反映 '--------------- For i = 1 To Len(L_) trgt = Chr(i + 96) num = element(i) Select Case num Case Is = 0 Case Is = 1 ans = ans & trgt Case Else ans = ans & trgt & "^" & num End Select Next L_ = ans End Function Property Get S() As String '----------------- 'V,L_からStrを作成 '----------------- '----------------- '考慮が必要ない場合の対処 '----------------- If L_ = "" Then S = V Exit Property End If Select Case True Case V = 0 S = 0 Case V = 1 S = L_ Case V = -1 S = "-" & L_ Case Else S = V & L_ End Select End Property
「element」が特徴かなと思います。
Lit_Str_Make
「Int_Str_Make」を参考にしました、サブ関数がまだ充実していないのでかなり機能は制限されています。
Function Lit_Str_Make(NN) As String '------------------- '文字式の計算式を作成する '------------------- '------------------ '変数の定義 '------------------ Dim ope() As String '演算子 Dim kou() As Literal '数値 Dim i As Integer '繰り返しの制御変数 Dim box As Variant '演算子決定のアシスト変数 Dim tmp As Integer '演算子決定のアシスト変数 Dim str As String '計算式 '------------------ 'opeとnumの配列数を指定 '------------------ ReDim ope(1 To NN + 1) ReDim kou(1 To NN + 1) '------------------ 'boxの指定 '------------------ box = Array("＋", "－", "×", "÷") '------------------ 'opeの値を指定 '------------------ For i = 1 To NN - 1 tmp = Rnd_Num(0, 3) ope(i) = box(tmp) Next ope(2) = "=" '------------------ 'kouの値を指定 '------------------ For i = 1 To NN Set kou(i) = New Literal kou(i).V = Rnd_Num(1, 9) kou(i).L = "a" Next kou(1).V = 2 kou(2).V = 1 '------------------ 'kou3を計算 '------------------ Set kou(3) = New Literal Select Case ope(1) Case Is = "＋" If kou(1).L = kou(2).L Then kou(3).V = kou(1).V + kou(2).V kou(3).L = kou(1).L End If Case Is = "－" If kou(1).L = kou(2).L Then kou(3).V = kou(1).V - kou(2).V kou(3).L = kou(1).L End If Case Is = "×" kou(3).V = kou(1).V * kou(2).V kou(3).L = kou(1).L & kou(2).L Case Is = "÷" If kou(1).L = kou(2).L Then kou(3).V = kou(1).V / kou(2).V kou(3).L = "" End If End Select kou(3).Fit '------------------ 'ansを作成 '------------------ For i = 1 To NN + 1 str = str & kou(i).S & ope(i) Next Lit_Str_Make = str End Function
まとめ
今回は項を2a,aに設定することで、難しい問題をいくつか回避しています。
次回は項を2a,3a2に設定して同じことを行います。
文章問題を生成する その3_4 ひながた （計算をする）
はじめに
ひとつのコーナーが4回続くのは初めてかもしれません。
だんだん枷は外れてきていますが、サブ関数をあまり設置していないので、コードが長いですね。
均したい部分
まだ均せていない部分は以下の通り。
「num1」「num2」の値の範囲を変更した。
「num3」の求め方を変えた。
今回は「num3」を自動で取得できるようにします。
自動でやってみる
今回はかなり簡単。
ほんとうは簡単ではないのですが、遺産があるので。
「解析関数」を使います。
「解析関数」を使いやすい環境を設定することが今回のミッション。
コード
Sub 文章題生成_3_2() '-------------------------- '文章第の一部を書き換える '-------------------------- '-------------------------- '変数の定義 '-------------------------- Dim str() As String '文章 Dim path As String 'メモ帳のアドレス Dim worlist As Variant 'ワード群の選択 Dim box() As String 'ワードの候補 Dim wor() As String 'ワード入れ替え用の変数 Dim num() As Integer '数値入れ替え用の変数 Dim sss As String '計算式 Dim ans As Fraction '計算式の答え Dim trgt As String '数値入れ替え用の変数 Dim tmp As Integer '一時使用 Dim i As Integer '繰り返しの制御変数 Dim j As Integer '繰り返しの制御変数 '-------------------------- '文章の読み込み '-------------------------- path = ThisWorkbook.path & "\text\text1_1.txt" str = txt_input(path) '-------------------------- 'worlistの作成 '-------------------------- worlist = Split(str(0), " ") '-------------------------- 'worとnumの配列数を取得 '-------------------------- tmp = Val(worlist(0)) ReDim wor(1 To tmp) tmp = Val(str(1)) ReDim num(1 To tmp) '-------------------------- 'worを指定 '-------------------------- For i = 1 To UBound(worlist) path = ThisWorkbook.path & "\wor\" & worlist(i) & ".txt" box = txt_input(path) tmp = Rnd_Num(0, UBound(box)) wor(i) = box(tmp) Next '-------------------------- 'numを指定 '-------------------------- num(1) = Rnd_Num(1, 5) * 10 + 100 num(2) = Rnd_Num(3, 7) sss = str(2) For i = 1 To UBound(num) - 1 sss = Replace(sss, "num" & i, num(i)) Next Set ans = New Fraction Set ans = Int_Str_Analyze(sss) num(3) = Val(ans.S) '-------------------------- '問題文を変更 '-------------------------- For i = LBound(str) + 3 To UBound(str) For j = 1 To Val(str(0)) trgt = "wor" & j str(i) = Replace(str(i), trgt, wor(j)) str(i) = Replace(str(i), trgt, wor(j)) 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) + 3 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
たぶん最適ではないのですが、こんな感じにしましょう。
「num1」「num2」の設定をいじれない理由
言い訳コーナーです笑
言い訳をして、それをつぶすことにしましょう笑
残る枷はnum1,2の設定のみなのですが、ちょっともやもやしています。
数字の範囲を選択することが難しい理由は「刻み」です。
たとえば果物ひとつの値段。
100～150からランダムに数字を選択、は結構簡単なのですが。
実際は110,120,130,140,150のどれかから欲しいですよね。
このような10刻み。
コードに起こせないことはないのですが、これってあるものに似ていますよね。
そう、数列です。
等差数列です。
ここで無理やりコードを書くよりは、数列の環境を整えて、そこで作られた関数を使いたいなーと思っているのです。
ただ数列には文字が出てくるから、それをやるためには文字式の計算（具体的には代入）を実装しないといけないんだよなーとも思っているのです。
。。。
言い訳はこんな感じです。
書いたら結論は出ました。
文章問題はここで一回凍結。
数列の計算プリントを作成して、その過程で等差数列を扱う。
そこでつくるであろう関数を用いてnum1.2の設定をする。
そのためにまずは文字式の計算を実装する。
こうします。
まとめ
まさかの文章問題の凍結です笑
まだ一週間分くらいしかやっていませんが笑
でもどうしても気が変わってしまったので、それに従います。
というわけで次回からまた「計算プリント」に復帰します。
扱う内容は「文字式」。
文字式は面倒くさいなーと思って放置していたのですが。
必要性を感じてすごくやる気が出てきました笑
不思議ですね笑
文章問題を生成する その3_2 ひながた （worのストック）
はじめに
地味な回が続きます。
書くのは意外と難しいのですが。
均したい部分
まだ均せていない部分は以下の通り。
「wor1」を書き換える候補を手書きで加えた。
「wor2」を新たに加えた。
「num1」「num2」の値の範囲を変更した。
「num3」の求め方を変えた。
今回は「wor」のストックを作ります。
worのストック
ちょっとまえに「文章をコード内で管理するのはよくない」と書きました。
「wor」でも同じ対応をとります。
「wor」の候補たちをメモ帳で管理しておく、というやり方です。
今回はフルーツのファイル、人名のファイルを作ります。
ただ「fruit.txt」にフルーツの名前を列挙するだけですが笑
人名も同様に。
そしてまた「text」のほうも一部書き換えます。
自動でやってみる
扱う文章
2 name fruit
3
'--------------------------
'問題文
'--------------------------
wor1はwor2をnum1つもっています。
いま、さらにnum2つのwor2をもらいました。
もっているwor2はぜんぶでいくつでしょうか。
'--------------------------
'解き方
'--------------------------
num1＋num2=num3
よってnum3つ
コード
先ほどの考えを踏まえてコードを書き換えます。
前回は「文章題生成3」を変えたので、今回は「文章題生成4」を変えます。
もちろん前回の変更点は踏んでいます。
Sub 文章題生成_4_1() '-------------------------- '文章第の一部を書き換える '-------------------------- '-------------------------- '変数の定義 '-------------------------- Dim str() As String '文章 Dim path As String 'メモ帳のアドレス Dim worlist As Variant 'ワード群の選択 Dim box() As String 'ワードの候補 Dim wor() As String 'ワード入れ替え用の変数 Dim num() As Integer '数値入れ替え用の変数 Dim trgt As String '数値入れ替え用の変数 Dim tmp As Integer '一時使用 Dim i As Integer '繰り返しの制御変数 Dim j As Integer '繰り返しの制御変数 '-------------------------- '文章の読み込み '-------------------------- path = ThisWorkbook.path & "\text\text2_1.txt" str = txt_input(path) '-------------------------- 'worlistの作成 '-------------------------- worlist = Split(str(0), " ") '-------------------------- 'worとnumの配列数を取得 '-------------------------- tmp = Val(worlist(0)) ReDim wor(1 To tmp) tmp = Val(str(1)) ReDim num(1 To tmp) '-------------------------- 'worを指定 '-------------------------- For i = 1 To UBound(worlist) path = ThisWorkbook.path & "\wor\" & worlist(i) & ".txt" box = txt_input(path) tmp = Rnd_Num(0, UBound(box)) wor(i) = box(tmp) Next '-------------------------- 'numを指定 '-------------------------- num(1) = Rnd_Num(1, 6) num(2) = Rnd_Num(3, 7) num(3) = num(1) + num(2) '-------------------------- '問題文を変更 '-------------------------- For i = LBound(str) + 2 To UBound(str) For j = 1 To (worlist(0)) trgt = "wor" & j str(i) = Replace(str(i), trgt, wor(j)) str(i) = Replace(str(i), trgt, wor(j)) 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\text2_2.txt" Call txt_output(str, path) End Sub
パスの設定が少し汚いですが。。
そこは保留。
まとめ
これでまたひとつ枷が外れました。
「計算プリント」系に比べてひながたづくりが大変ですね。
