VBAで中学数学の問題を扱おう! その4 (多項式)×(多項式)の計算
今回は多項式同士の計算です。
今回はケースに合わせて少しずつコードを修正していくのではなく
必要だと思う機能を書き出してから
それらをひとつづつコードにしていきます。
新スタイル。
はたしてできるだろうか・・・
あ。
今回からコード全部を載せるのはやめにします。
その1から読んでいる人はそろそろ自分で考えたいかなというのと。
全部載せると分量がめちゃ多くなってしまうので。。
ぜひコメントに答えを書いてみてください～
- 必要な機能
(a+b)(a+2b+5c)^2
について考えて見ましょう。
これを計算するためには何が必要か。
それぞれの多項式を認識する
それらを掛け合わせる
同類項をまとめる
まぁこの3つですよね。
それぞれについてひとことずつ。
それぞれの多項式を認識するには括弧と累乗記号が肝かなと。
それらを掛け合わせるのは掛け合わせる単項式を指定して
前に作った単項式の計算の関数を用いればいいかなと。
同類項をまとめるコードはすでに前回作ったのでそれを流用。
こんな感じです。
- 概要デザイン
Private Sub CB1_Click()
Dim siki As String
Dim answer As String
'-------------------------
'式の認識
'-------------------------
siki = TB1
'-------------------------
'多項式に分解
'-------------------------
Dim takou() As String
Call 多項式に分解(takou, siki)
'-------------------------
'展開
'-------------------------
answer = expantion(takou)
'-------------------------
'同類項をまとめる
'-------------------------
answer = Similar_Terms_Culculation(answer)
'-------------------------
'表記
'-------------------------
TB2 = answer
End Sub
このように概要を書くことはとてもいいような気がします。
関数間の連携をとりやすくなるというか。
それぞれはうまく機能しているけどうまくつながらないコードを修正するときって
自分の無能さをのろいながら行うので精神的によくないですし。
そういうつまらないことは起きない方がいいですよねー。
- それぞれの多項式を認識する
認識系のコードはもう何回も書いているので余裕ですねｗ
Sub 多項式に分解(trgt, kou)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim stock As String '処理用の箱
Dim n As Integer 'あて先の指定
Dim minus As Integer '-の処理用の箱
Dim flag(1) As Boolean
Dim h As String '累乗の処理
n = 0
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -56 '(の場合
If stock <> "" Then
ReDim Preserve kou(n)
kou(n) = stock
n = n + 1
stock = ""
End If
If flag(1) = True Then
stock = kou(n - 1)
For k = 2 To Val(h)
ReDim Preserve kou(n)
kou(n) = stock
n = n + 1
Next
stock = ""
h = ""
flag(1) = False
End If
flag(0) = True
Case -55 ')の場合
flag(0) = False
ReDim Preserve kou(n)
kou(n) = stock
stock = ""
n = n + 1
Case -51, -53 '-,+の場合
stock = stock & char
Case -2 '^の場合
If flag(0) = True Then
stock = stock & char
Else
flag(1) = True
End If
Case -48 To -39 '0~9の場合
If flag(1) = True And n > 0 Then
h = h & char
Else
stock = stock & char
End If
Case 1 To 26 'アルファベットの場合
stock = stock & char
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If flag(1) = True Then
stock = kou(n - 1)
For k = 2 To Val(h)
ReDim Preserve kou(n)
kou(n) = stock
n = n + 1
Next
stock = ""
End If
End Sub
うーん。
まだうまいことかけない。。
select caseで一文字ずつ対応を変えて
さらにflagで前後関係に対応する
のが今のやり方ですが。
なんだか妙に複雑なコード。。。
もう少しシンプルにできないものか。。。
- それらを掛け合わせる
一つ目のコードによってtakouの配列に多項式が含まれています。
それらを掛け合わせるのが次のコード。
takouの配列の数によらないコードを書くためにいろいろ考えたのですが。
takouから式をひとつ取り出して
それらを掛け合わせる
そしてまた次の式を取り出して
という方式にしようかなと思います。
takouの式をいっぺんに処理するには
forの数をtakouの数に合わせないといけなくて
そういったコードの書き方がよくわからないので
今回はひとつずつ式で行こうと思います。
展開コードの概要。
Sub 展開(takou, keeper)
Dim adder() As String
Dim trgt As String
Dim tmp As String
trgt = kou(0)
Call 単項式に分解(trgt, keeper)
For i = 1 To UBound(kou)
trgt = kou(i)
Call 単項式に分解(trgt, adder)
Call 掛け合わせ(keeper, adder)
Next
End Sub
「単項式に分解」で多項式を単項式に分解
「掛け合わせ」で展開後の各項を個別にkeeperに格納しています
関数とsubプロシージャはクイズに。
- 同類項をまとめる
これは前回に書いたから流用～
と。
思ったら。
信じられないくらい互換性が悪い。。。
いや。
流用することはできなくはなかったのですが
おんなじ意味を持つ処理を繰り返し行うことになってしまい
気持ち悪すぎるので書き直しました。
前回書いた「同類項をまとめる」はマジで無駄だったなぁ。。。
多項式を単項式に分解して同時に係数と文字の間にカンマを入れる
同類項をまとめると同時に特定の係数に対応する
多項式に復元する
この「同時」というところが肝。
ひとつの関数やプロシージャに「同時」が増えるほどに汎用性は薄れます。
それぞれの関数に入力するための形式は限られてしまいます。
今回どのようなことが起きたかというと。
展開をしてそれぞれの項を単項式として配列に格納
同類項にまとめるために形式を整える(せっかく分けた単項式を多項式に復元する)
それを単項式に分解しながら特別な処理をする
同類項をまとめながら係数の処理をする
またそれを多項式に復元する
というおばかなやり方。
これを結構がんばって修正しました。
単項式に分解する
特別な処理をする
同類項につつ係数の処理をする
多項式に復元する
3つ目の処理は分解するとむしろ面倒になりそうなので。
あとでまた後悔するのだろうか。。。
だとしたら「同類項をまとめる」コードを書いた当時はこれを"よかれ"と思って書いたわけで
それがあだになるとわかるということは
成長の証なのかも？
まず概要
Dim co() As String
Call 加工処理(keeper, co)
Call 同類項をまとめる(keeper, co)
answer = line_restoration3(keeper)
それぞれの関数やsubプロシージャはクイズで。
- まとめ
試行錯誤したあとの概要はこんな感じ。
Private Sub CB1_Click()
Dim siki As String
Dim answer As String
'-------------------------
'式の認識
'-------------------------
siki = TB1
'-------------------------
'多項式に分解
'-------------------------
Dim takou() As String
Call 多項式に分解(siki, takou)
'-------------------------
'展開
'-------------------------
Dim keeper() As String
Call 展開(takou, keeper)
'-------------------------
'同類項をまとめる
'-------------------------
Dim co() As String
Call 加工処理(keeper, co)
Call 同類項をまとめる(keeper, co)
answer = line_restoration3(keeper)
'-------------------------
'表記
'-------------------------
TB2 = answer
End Sub
んー。
書きながら成長しているから仕方がないのですが。
それぞれの処理の深さが一致していないですね。。。
原因は最初の概要の考え方がぬるいこと。
はて。
あっているのかわからん。。。
ちょっと式を簡単にしましょう。
うん。
あってますね。
そろそろユーザーフォームに出力するのも限界ですねー。
- 思ったこと
ひとつの関数で複数の事を行おうとするとろくなことにならない。
流用できないので結局細かく再分解することになる。
これに実感したことが一番の収穫です。
知ってはいたはずなのですがなぜか実践できていませんでした。
- 次回の予定
ユーザーフォームへの出力に限界を感じているので
次回はシートに見やすく出力するコードを書きましょう。
VBAで中学数学の問題を扱おう! その3 同類項をまとめる
中学数学の問題を扱おうのその3は「足し算」です。
正確には「同類項をまとめる」ですが。
その1,2で単項式の掛け算を行いましたが
その知識を使う場面はあるだろうかないだろうか。。。
今回も簡単なケースを考えてそれを処理できるコードを書いていくようにします。
- 同類項をまとめるとは？
同じ文字式の単項式を
それらの係数を用いて計算する。
ということで。
- ケース1 3+8
方針としては。
式を単項式に分ける。
同類項をまとめる。
表記する。
という感じ。
式を単項式に分けるための仕組みは
前回の「文字式の仕分け」プロシージャに似ているのでそれをちょっと修正する感じで。
Sub 単項式への分解(trgt, kou)
Dim char As String '処理用の箱
Dim stock As Integer '処理用の箱
Dim n As Integer 'kouの数を指定
Dim minus As Integer '-の処理用の箱
minus = 1
n = 0
ReDim Preserve kou(n)
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
Select Case Asc(char) - 96
Case -51 '-の場合
If n <> 0 Then
Call 項の切り替え(n, kou, stock, minus)
End If
minus = -1
Case -53 '+の場合
Call 項の切り替え(n, kou, stock, minus)
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
n = UBound(kou)
kou(n) = stock * minus
End Sub
ーーーーーーーーーーーーーー
Sub 項の切り替え(n, kou, stock, minus)
n = UBound(kou)
kou(n) = stock * minus
stock = 0
minus = 1
ReDim Preserve kou(n + 1)
End Sub
ちょっと今回の処理には高級すぎるコードですが
変に劣化させて書くのもなーと思ったのでこんな感じに。
おそらくこの部分は最後まで大きな変化なく終えるでしょう。
前がんばったのでこれくらいはいいよねｗ
次は同類項をまとめる処理。
こちらは始めて書くコードなのでどんどん変化させていくことになるでしょう。
Sub 同類項をまとめる(kou, cul)
For i = 0 To UBound(kou)
cul = cul + Val(kou(i))
Next
End Sub
われながら低級なコードですが。
3+5+4-8みたいな複数の単項式の計算にも耐えられる設計なのはほめられるところ。
まとめてみると。
Private Sub CB1_Click()
Dim siki As String
Dim kou() As String
Dim cul As Integer
Dim answer As String
siki = TB1
trgt = siki
Call 単項式への分解(trgt, kou)
Call 同類項をまとめる(kou, cul)
answer = Format(cul)
TB2 = answer
End Sub
ーーーーーーーーーーーーーーーーーーー
Sub 単項式への分解(trgt, kou)
Dim char As String '処理用の箱
Dim stock As Integer '処理用の箱
Dim n As Integer 'kouの数を指定
Dim minus As Integer '-の処理用の箱
minus = 1
n = 0
ReDim Preserve kou(n)
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
Select Case Asc(char) - 96
Case -51 '-の場合
If n <> 0 Then
Call 項の切り替え(n, kou, stock, minus)
End If
minus = -1
Case -53 '+の場合
Call 項の切り替え(n, kou, stock, minus)
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
n = UBound(kou)
kou(n) = stock * minus
End Sub
Sub 項の切り替え(n, kou, stock, minus)
n = UBound(kou)
kou(n) = stock * minus
stock = 0
minus = 1
ReDim Preserve kou(n + 1)
End Sub
ーーーーーーーーーーーーーーーーー
Sub 同類項をまとめる(kou, cul)
For i = 0 To UBound(kou)
cul = cul + Val(kou(i))
Next
End Sub
- ケース2 a+2a
もうはいはいって感じですねｗ
前回起きた問題と大体同じ。
文字を認識する。
aの係数が1とする。
がクリアすべき問題。
今回のやり方はなんだか回りくどい感じがするのですが
現状の自分の力ではこれよりうまくかけないですね。。
まずは単項式に分解する際に一工夫。
文字への対応のためにstock_lineを足しました。
Sub 単項式への分解(trgt, kou)
Dim char As String '処理用の箱
Dim stock As Integer '処理用の箱
Dim stock_line As String '処理用の箱
Dim n As Integer 'kouの数を指定
Dim minus As Integer '-の処理用の箱
minus = 1
n = 0
ReDim Preserve kou(n)
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
Select Case Asc(char) - 96
Case -51 '-の場合
If n <> 0 Then
Call 項の切り替え(n, kou, stock, stock_line, minus)
End If
minus = -1
Case -53 '+の場合
Call 項の切り替え(n, kou, stock, stock_line, minus)
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
stock_line = stock_line & char
End Select
Next
n = UBound(kou)
kou(n) = Format(stock * minus) & "," & stock_line
End Sub
ーーーーーーーーーーーーーーーー
Sub 項の切り替え(n, kou, stock, stock_line, minus)
If stock = 0 Then stock = 1
If stock_line = "" Then stock_line = "0"
n = UBound(kou)
kou(n) = Format(stock * minus) & "," & stock_line
stock = 0
stock_line = ""
minus = 1
ReDim Preserve kou(n + 1)
End Sub
これによって
kou(0)=1,a
kou(1)=2,a
というように係数と文字式の間にカンマが入ります。
つぎにcoという配列を使ってkouの係数と文字式を別の箱に入れます。
これは次の処理を書きやすくするため。
次の処理とは。
同じ文字式の係数を計算すること。
この処理のこなし方が下手だなという気がするのですが
ちょっと改善の方法がわからないので今回はこんな感じで。
Sub 同類項をまとめる(kou)
Dim trgt As String
Dim tmp As Integer
Dim co() As String
Dim n As Integer
ReDim co(UBound(kou), 1)
For i = 0 To UBound(kou)
trgt = kou(i)
tmp = InStr(trgt, ",")
co(i, 0) = Mid(trgt, 1, tmp - 1)
co(i, 1) = Mid(trgt, tmp + 1)
Next
For j = 0 To UBound(kou) - 1
For i = j + 1 To UBound(kou)
If co(j, 1) = co(i, 1) Then
co(i, 0) = Val(co(i, 0)) + Val(co(j, 0))
co(j, 0) = ""
End If
Next
Next
n = 0
ReDim kou(n)
For i = 0 To UBound(co, 1)
If co(i, 1) <> "" Then
ReDim Preserve kou(n)
kou(n) = co(i, 1) & co(i, 2)
n = n + 1
End If
Next
End Sub
最後に計算結果を出すための関数restoration2について。
そのうち名前を変えるかもですｗ
シンプルな機能なのでコードを読んでください。
Function restoration2(kou) As String
For i = 0 To UBound(kou)
If Left(kou(i), 1) <> "-" And i > 0 Then
tmp = tmp & "+"
End If
tmp = tmp & kou(i)
Next
restoration2 = tmp
End Function
なんか。
うまく書けたーと思うことがあるんですが。
自分で条件を難しくしてそれをがんばってクリアしているだけなことがあって。
やっぱり格好いいコードはシンプルなんだろうなぁと思います。
今回のコードはぜんぜんシンプルじゃないｗ
最後にまとめると。
Private Sub CB1_Click()
Dim siki As String
Dim kou() As String
Dim cul As Integer
Dim answer As String
siki = TB1
trgt = siki
Call 単項式への分解(trgt, kou)
Call 同類項をまとめる(kou)
answer = restoration2(kou)
TB2 = answer
End Sub
ーーーーーーーーーーーーーーーーーーー
Sub 単項式への分解(trgt, kou)
Dim char As String '処理用の箱
Dim stock As Integer '処理用の箱
Dim stock_line As String '処理用の箱
Dim n As Integer 'kouの数を指定
Dim minus As Integer '-の処理用の箱
minus = 1
n = 0
ReDim Preserve kou(n)
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
Select Case Asc(char) - 96
Case -51 '-の場合
If n <> 0 Then
Call 項の切り替え(n, kou, stock, stock_line, minus)
End If
minus = -1
Case -53 '+の場合
Call 項の切り替え(n, kou, stock, stock_line, minus)
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
stock_line = stock_line & char
End Select
Next
n = UBound(kou)
kou(n) = Format(stock * minus) & "," & stock_line
End Sub
Sub 項の切り替え(n, kou, stock, stock_line, minus)
If stock = 0 Then stock = 1
If stock_line = "" Then stock_line = "0"
n = UBound(kou)
kou(n) = Format(stock * minus) & "," & stock_line
stock = 0
stock_line = ""
minus = 1
ReDim Preserve kou(n + 1)
End Sub
ーーーーーーーーーーーーー
Sub 同類項をまとめる(kou)
Dim trgt As String
Dim tmp As Integer
Dim co() As String
Dim n As Integer
ReDim co(UBound(kou), 1)
For i = 0 To UBound(kou)
trgt = kou(i)
tmp = InStr(trgt, ",")
co(i, 0) = Mid(trgt, 1, tmp - 1)
co(i, 1) = Mid(trgt, tmp + 1)
Next
For j = 0 To UBound(kou) - 1
For i = j + 1 To UBound(kou)
If co(j, 1) = co(i, 1) Then
co(i, 0) = Val(co(i, 0)) + Val(co(j, 0))
co(j, 0) = ""
End If
Next
Next
n = 0
ReDim kou(n)
For i = 0 To UBound(co, 1)
If co(i, 1) <> "" Then
ReDim Preserve kou(n)
kou(n) = co(i, 1) & co(i, 2)
n = n + 1
End If
Next
End Sub
ーーーーーーーーーーーーーーーーーーーー
Function restoration2(kou) As String
For i = 0 To UBound(kou)
If Left(kou(i), 1) <> "-" And i > 0 Then
tmp = tmp & "+"
End If
tmp = tmp & kou(i)
Next
restoration2 = tmp
End Function
- ケース3 2a^2 +4a^2
これが今回の最後かな。
現状のコードでは答えが空欄になってしまいます。
が。
ちょっとした工夫をするだけで簡単にクリアできます。
んー。
じゃあこれはクイズにしておきますｗ
興味のある方は考えてみてください。
あ。
コードを動かしていて気づいたのですが。
1bをbと表記するコードを入れ忘れていました。
じゃあそれの書き方もクイズにしておきます。
これは前回のブログでふれた気がするので気になる方は前回のものを読んでみてください。
今回は分数の処理は処理は省略で。
二項の計算なら見やすくかけるのですが
それより多い項数の計算は醜くなってしまうので。。。
ふう。
結構疲れてきました。。
また近いうちに。
VBAで中学数学の問題を扱おう! その1 (単項式)×(単項式)の計算(後半)
とりあえず前回の復習
ケース1: 2×3
ケース2: 2a×3
ケース3: 2b×ac
以上をクリアできるコード
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(1, 26) As String '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = element(j, tmp) & trgt
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
'未定義のkazuを1と定義
For i = 0 To 1
If element(i, 0) = "" Then
element(i, 0) = 1
End If
Next
Dim pre As String
For i = 1 To 26
pre = pre & element(0, i) & element(1, i)
Next
answer = Val(element(0, 0)) * Val(element(1, 0))
answer = answer & pre
TB3 = answer
End Sub
- ケース4 ab×ab
現状のコードでは答えが1aabbになってしまいます。
これをどうやってa^2b^2にするか。
a^2b^2って見にくいですが我慢しましょうｗ
いずれ見やすくします。
まずは文字のほうの処理。
この解決策は言われてみれば簡単。
今まではaをaと記録していましたが
これからはaを1と記録すればよい。
a,b,cそれぞれのアルファベットは別の場所に記録される仕組みを取っているのでそれでも不都合は起こりません。
siki(0)とsiki(1)を数値で認識してす。
とりあえずここまでのコードを。
Dim element(1, 26) As Integer '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
それらの数値を処理します。
For i = 1 To 26
tmp = element(0, i) + element(1, i)
If tmp = 1 Then
pre = pre & Chr(96 + i)
ElseIf tmp > 1 Then
pre = pre & Chr(96 + i) & "^" & tmp
End If
Next
これでとりあえず答えが1a^2b^2になります。
この1を消すのが次の問題ですが。
これはもっと簡単。
answer = Val(element(0, 0)) * Val(element(1, 0))
If Abs(Val(answer)) = 1 And pre <> "" Then
answer = Replace(answer, 1, "")
End If
answer = answer & pre
たったこれだけでオッケー。
文字が存在して数値が+1か-1のときには1という表記を消す。
ということです。
コードをまとめます。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(1, 26) As Integer '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
'未定義のkazuを1と定義
For i = 0 To 1
If element(i, 0) = 0 Then
element(i, 0) = 1
End If
Next
Dim pre As String
For i = 1 To 26
tmp = element(0, i) + element(1, i)
If tmp = 1 Then
pre = pre & Chr(96 + i)
ElseIf tmp > 1 Then
pre = pre & Chr(96 + i) & "^" & tmp
End If
Next
answer = Val(element(0, 0)) * Val(element(1, 0))
If Abs(Val(answer)) = 1 And pre <> "" Then
answer = Replace(answer, 1, "")
End If
answer = answer & pre
TB3 = answer
End Sub
- ここでいったんコードを整理
ちょっとコードを整えましょう。
書き始めたときには気づかなかったところ
コードを付け足した際に汚くなってしまっているところ
そのあたりをきれいに～
今回は機能的にというよりは見栄えを整える感じです。
まず現状のコードの機能面を書いていきます。
テキストボックスに書かれた式を認識する。
それぞれをの式を一文字ずつ処理する。
element(0,1)やelement(1,1)が未定義の場合は1とする。
文字を処理する。
数字を処理して文字を付け足す。
となっています。
まずは一文字ずつ処理をする。の箇所を直します。
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
まずsiki(j)があちこちに書かれている部分がいやですね。
それ以外の文字列を処理したい場合に不都合が出るのでそこを書き直し。
For j = 0 To 1
trgt = siki(j)
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
If char Like "[a-z]" Then
tmp = Asc(char) - 96
element(j, tmp) = 1
Else
element(j, 0) = element(j, 0) & Val(char)
End If
Next
Next
続いてはifの部分。
文字かどうかを判別してからAscの関数を使っていますが
これは二度手間です。
Ascの値が一定の領域にあればおのずとそれはa~zのどれかなので。
For j = 0 To 1
trgt = siki(j)
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
Next
コードが膨らんできたことと
この処理を後のどこかで使うかもしれないことを考慮して
この処理を別のsubプロシージャとして書き直します。
For j = 0 To 1
trgt = siki(j)
Call 文字列を仕分ける(trgt, element)
Next
ーーーーーーーーーーーーー
Sub 文字列を仕分ける(trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
End Sub
これでオッケー。
おそらくですが
このコードは単項式同士の足し算や因数分解に役立つんじゃないかなと思います。
あ。
あとは未定義のelement(0,0)などの処理も「文字列を処理する」プロシージャに入れてしまいましょう。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
続いては文字の処理および数字の処理。
これらは変数preとanswerを用いて行っていますが
めちゃくちゃ見栄えが悪いですね。
element(1,26)をelement(2,26)に拡張して
elemetn(0,k)とelement(1,k)の処理結果をelement(2,k)に入れる
それから処理を行うことにします。
文字の処理はこれからもあちこちで使いそうなので
関数化します。
element(2, 0) = Val(element(0, 0)) * Val(element(1, 0))
For i = 1 To 26
element(2, i) = element(0, i) + element(1, i)
Next
answer= line_restoration(element)
ーーーーーーーーーーーーーーーーーー
Function line_restoration(element)
Dim n As Integer
Dim trgt As String
For i = 1 To 26
n = element(2, i)
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
If Abs(Val(element(2, 0))) = 1 And trgt <> "" Then
tmp = Replace(element(2, 0), 1, "")
Else
tmp = element(2, 0)
End If
line_restoration = tmp & trgt
End Function
こんな感じです。
はい。
修正したコードを載せます。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
'-------------------------
'式を認識
'-------------------------
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(2, 26) As Integer '数と文字を割り振る
'-------------------------
'一文字ずつ処理
'-------------------------
For j = 0 To 1
trgt = siki(j)
Call 文字列を仕分ける(j, trgt, element)
Next
'-------------------------
'数字と文字の処理
'-------------------------
element(2, 0) = Val(element(0, 0)) * Val(element(1, 0))
For i = 1 To 26
element(2, i) = element(0, i) + element(1, i)
Next
answer = line_restoration(element)
TB3 = answer
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case 1 To 26
element(j, tmp) = 1
Case Else
element(j, 0) = element(j, 0) & Val(char)
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
Function line_restoration(element)
Dim n As Integer
Dim trgt As String
Dim tmp As String
For i = 1 To 26
n = element(2, i)
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
If Abs(element(2, 0)) = 1 And trgt <> "" Then '数字が+-1で文字列が存在する場合の処理
tmp = Replace(element(2, 0), 1, "")
Else
tmp = element(2, 0)
End If
line_restoration = tmp & trgt
End Function
これ以上「見やすく」すると「これにしか使えなく」なる気がするので修正はこれくらいに。
ただ数字が+-1で～の処理はちょっときたないですね。。
- ケース4 -a × -a^2
はい。
もう何が起きているんだかって結果ですねｗ
マイナスと累乗は現状のコードでは考慮されていないので
なんか変な風に処理されてこうなっているんですねｗ
これらの処理を担当するのは「文字列を仕分ける」プロシージャなのでそこを修正しましょう。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51
Case -48 To -39
element(j, 0) = element(j, 0) & Val(char)
Case -2
Case 1 To 26
element(j, tmp) = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If element(j, 0) = 0 Then 'element(j,0)が未定義の場合は1とする
element(j, 0) = 1
End If
End Sub
これで-と^が認識されます。
そして想定しない文字が出てきた場合はstopする仕様にしました。
後はそれぞれの処理を書くだけ。
現状は文字が出てきたらその文字を担当する箱に1を入れていましたが
累乗を考慮するためにはそうは行かないですね。
数字が出てきたらとりあえずストックする。
-が出てきたら出てきたことを覚えておく。
文字が出てきたら。
ストックが0の場合は1とする。
ストックした数字に場合によっては-1をかけてから箱に入れる
箱を切り替える。
こんな感じにしますか。
Sub 文字列を仕分ける(j, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim stock As Integer '処理用の箱
Dim reference_number As Integer 'あて先の指定
Dim minus As Integer '-の処理用の箱
minus = 1
reference_number = 0
For i = 1 To Len(trgt)
char = Mid(trgt, i, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51 '-の場合
minus = -1
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
If stock = 0 Then
stock = 1
End If
element(j, reference_number) = minus * stock
reference_number = tmp
stock = 0
minus = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If stock = 0 Then
stock = 1
End If
element(j, reference_number) = minus * stock
End Sub
処理のおかげでelement(k,0)への特別な処理を省くことができました。
いや。
省けたわけではないのですが。
なんていうんだろう。
はみ出た感じが引っ込んだというか。。。
^の文字が出たときにスルーするというやり方、格好良くないですか？ｗ
この処理を思いついたときはテンションがあがりました。
まぁ。
まだそのレベルの人間ということでｗ
やったね。
- 分数の計算
これは結構悩みました。
実はシート上での分数の計算は表記法まで確立させているのですが
ユーザーフォームではどうしようかなーと。。
ただせっかくだし実装はしたいよなーと。。
ほんとにいろいろ考えたのですが。。。
ってしつこいですねｗ
整数の形と分数の形をひとつのユーザーフォームで見栄え良くこなすのは難しいと思ったので。
ユーザーフォームをあと2つ足すことにしました。
選択画面と分数の計算画面です。
分数への解決方法はほんとに何通りもあって
どれを選ぶかはセンスだと思います。
正直に言うと。
複数のユーザーフォームによる処理を書いたことがないのでやってみたくなったという気持ちが大きいのですが。。。
分数の計算の実装の概要を書きます。
分子で文字と数字の処理
分母で文字と数字の処理
約分の処理
表記
基本的には整数のときと同じで
いくつかの配列を分数用に拡張しています。
約分についてだけちょっとだけ。
element(0,k)とelement(1,k)でelement(4,k)を
element(2,k)とelement(3,k)でelement(5,k)を
やり方は整数のときと同じ。
element(4,k)とelement(5,k)でelement(6,k)を
詳しくはコードを読んでください。
element(6,k)にelement(4,k)とelement(5,k)の最大公約数を入れたところがグッドポイントかなと思っていますｗ
あとはpを使ってうまいことやっていますw
Private Sub CB1_Click()
Dim siki(3) As String '扱う式を代入
Dim answer(1) As String '答え
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(6, 26) As Integer '数と文字を割り振る
'-------------------------
'式を認識
'-------------------------
siki(0) = TB1
siki(1) = TB2
siki(2) = TB4
siki(3) = TB5
'-------------------------
'一文字ずつ処理
'-------------------------
For i = 0 To 3
trgt = siki(i)
Call 文字列を仕分ける(i, trgt, element)
Next
'-------------------------
'数字と文字の処理
'-------------------------
For i = 0 To 1
element(4 + i, 0) = Val(element(2 * i, 0)) * Val(element(2 * i + 1, 0))
For j = 1 To 26
element(4 + i, j) = element(2 * i, j) + element(2 * i + 1, j)
Next
Next
'-------------------------
'約分
'-------------------------
For i = 1 To 26
tmp = element(4, i) - element(5, i)
element(6, i) = tmp
Next
element(6, 0) = WorksheetFunction.Gcd(element(4, 0), element(5, 0))
p = 1
answer(0) = line_restoration(element, p)
p = -1
answer(1) = line_restoration(element, p)
TB3 = answer(0)
TB6 = answer(1)
End Sub
ーーーーーーーーーーーーーーーーーーーー
Sub 文字列を仕分ける(i, trgt, element)
Dim char As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim stock As Integer '処理用の箱
Dim reference_number As Integer 'あて先の指定
Dim minus As Integer '-の処理用の箱
minus = 1
reference_number = 0
For j = 1 To Len(trgt)
char = Mid(trgt, j, 1)
tmp = Asc(char) - 96
Select Case tmp
Case -51 '-の場合
minus = -1
Case -48 To -39 '0~9の場合
stock = stock & Val(char)
Case -2 '^の場合
Case 1 To 26 'アルファベットの場合
If stock = 0 Then
stock = 1
End If
element(i, reference_number) = minus * stock
reference_number = tmp
stock = 0
minus = 1
Case Else
MsgBox "考慮されていない文字が入っています"
Stop
End Select
Next
If stock = 0 Then
stock = 1
End If
element(i, reference_number) = minus * stock
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーー
Function line_restoration(element, p)
Dim n As Integer
Dim trgt As String
Dim tmp As String
For i = 1 To 26
n = element(6, i) * p
If n = 1 Then
trgt = trgt & Chr(96 + i)
ElseIf n > 1 Then
trgt = trgt & Chr(96 + i) & "^" & n
End If
Next
q = 4.5 - 0.5 * p
If Abs(element(q, 0)) = 1 And trgt <> "" Then '数字が+-1で文字列が存在する場合の処理
tmp = Replace(element(q, 0), 1, "")
Else
tmp = element(q, 0) / element(6, 0)
End If
line_restoration = tmp & trgt
End Function
ふう。
これで(単項式)×(単項式)の計算はクリアです。
根号式やsinやlogには対応していませんがそれはまた別枠ですかね。
プログラミングの面白いところは
(単項式)×(単項式)は簡単だけどlogの計算は難しい
とかはないところですかも。
VBAで中学数学の問題を扱おう! その1 (単項式)×(単項式)の計算(前半)
こんばんは～。
VBAのことをブログに書いてからちょっとだけブログアクセス数が増えました。
ありがたいことです。
意外と需要があるのかな？？？
さて。
今回から数回にわたって「中学数学の問題を扱おう!」の記事を書きたいと思います。
ひとくちに中学数学といってもいろいろあると思いますが。。
今回はその中でも根幹に来るであろう「計算」について。
特に(単項式)×(単項式)について書きたいと思います。
今回からの記事ではできるだけコードについて説明を書いていこうと思っています。
とりあえずざっくりと単項式について定義して。
その後にいくつかのケースを解決するコードを書いてみようかなと。
- 単項式って？
単項式は掛け算のみからなる式。
ということにしましょう！
- ケース1 2×3
つまりは(数字)×(数字)ですね。
Sub ケース1()
Dim siki(1) As Integer '扱う式を代入
Dim answer As Integer '答え
siki(0) = 2
siki(1) = 3
answer = siki(0) * siki(1)
End Sub
ま。
この処理ができないのに今回のブログを書こうとは思わないですよねｗ
これで処理できますが。
とりあえずユーザーフォーム仕様にでもしよう。
。。。
Private Sub CB1_Click()
Dim siki(1) As Integer '扱う式を代入
Dim answer As Integer '答え
siki(0) = Val(TB1)
siki(1) = Val(TB2)
answer = siki(0) * siki(1)
TB3 = answer
End Sub
テキストボックスを左からTB1,TB2,TB3
計算と表記されているコマンドボタンをCB1
と定義しています。
コード自体は最初に書いたものとほとんどおんなじです。
せっかく作ったことですし。
以降はユーザーフォームを使っていきましょうか。。
正直ユーザーフォームは初心者だからうまく使えるか不安。。
- ケース2 2a×3
つまりは(文字式)×(数字)ですね。
文字式が入ってくると少しずつ難しくなってきます。。
まずはsikiとanswerをintegerからstringに変更します。
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
ここからはいろいろな処理方法があると思いますが。
僕が取ろうと思っている処理は。
それぞれの式を数字と文字に分ける。
数字同士を処理する。
文字同士を処理する。
です。
新しくmoji(1)とkazu(1)を定義します。
あとtrgtも定義します。これは処理用の仮箱？
Dim trgt As String
Dim kazu(1) As String
Dim moji(1) As String
次にsiki(0)とsiki(1)をkazuとmojiに分けます。
一気に書くとわかりにくいのでとりあえずsiki(0)だけ処理しましょう。
j = 0
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
moji(j) = moji(j) & trgt
Else
kazu(j) = kazu(j) & trgt
End If
Next
次の処理を簡単に書くためにj=0として書きました。
中身にチラッと触れると。
trgtにsiki(0)の1文字目を入れる。
それがアルファベットだったらmojiに追加。
それ以外だったらkazuに追加。
です。
じつはこの処理にはめちゃくちゃ問題があるのですが。。。
少なくともケース2は処理できるので良しとします。
というか。
いきなり強すぎるコードを載せちゃうとつまらないですよねw
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
moji(j) = moji(j) & trgt
Else
kazu(j) = kazu(j) & trgt
End If
Next
Next
これでsiki(0)とsiki(1)に処理を施しました。
次はmojiとkazuを処理します。
answer = Val(kazu(0)) * Val(kazu(1))
answer = answer & moji(0) & moji(1)
ちょっと横着しちゃいました。
とりあえずこれでケース2をクリア。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim kazu(1) As String '数を割り振る
Dim moji(1) As String '文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
moji(j) = moji(j) & trgt
Else
kazu(j) = kazu(j) & trgt
End If
Next
Next
answer = Val(kazu(0)) * Val(kazu(1))
answer = answer & moji(0) & moji(1)
TB3 = answer
End Sub
- ケース3 2b×ac
これは(文字式)×(文字式)
とりあえずケース2のコードで処理してみました。
ん？？？
いろいろ突っ込みどころがありますねｗ
まず本筋と違うところで。
画像が見にくいですねｗ
次から気をつけますｗ
次は本筋で。
なぜか数が0になっている。
文字の順番がアルファベット順になっていない。
2b×ac=2abc
でないとだめですよね。
逆に言うと上に書いた二つの問題をクリアすればケース3も合格なのですが。
まずは簡単なほうから修正しますか。
なぜか数が0になっていることから。
これは初期値が原因です。
kazuの初期値は""です。
今回はkazu(1)は""のまま。
そのせいでVal(kazu(0)) * Val(kazu(1))の結果が""になってしまいます。
解決策は初期値を変えること。
For i = 0 To 1
If kazu(i) = "" Then
kazu(i) = 1
End If
Next
。。。
うそついちゃいました。
初期値を変えるのはその後の処理が大きく変わってしまいそうなので。
未定義のkazuを1と定義することにしました。
2b×ac=2bac
修正1は完了。
次は文字をアルファベット順に並べます。
この解決策はわれながら頭いいなーと思っちゃいますｗ
なんちって
sikiの割り振りかたを大幅に変更。
moji(1)をmoji(1,26)と定義します。
26にピンとくるひともいるかな？
そう。アルファベットの数です。
siki(0)について
一文字ずつ処理。
もしも数字だったら今までどおりkazuに入れる。
もしも文字だったら。
aならmoji(0,1)に、cからmoji(0,3)に、xならmoji(0,24)に入れる。
Dim tmp As Integer
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
moji(j, tmp) = moji(j, tmp) & trgt
Else
kazu(j) = kazu(j) & trgt
End If
Next
Next
ローカルウィンドウを見るとこんな感じになります。
この処理方法は。。
Dim pre As String
For i = 1 To 26
pre = pre & moji(0, i) & moji(1, i)
Next
answer = Val(kazu(0)) * Val(kazu(1))
answer = answer & pre
いえーい。
クリア。
もしかするとめちゃくちゃ効率の悪い定義法なのかもしれませんが。
これなら確実に文字をアルファベット順に処理できます。
あー。
ついでにkazuの処理も変更しますか。
kazuという変数を除去してmoji(0,0)とmoji(1,0)に代用させます。
これは表記の問題なのですが変数は少ないほうが何かと楽かなと思います。
こうするとmojiという変数で数字を処理するのも気持ち悪いので。
moji(1,26)をelement(1,26)に変更しましょう。
ケース3を処理するコード。
Private Sub CB1_Click()
Dim siki(1) As String '扱う式を代入
Dim answer As String '答え
siki(0) = TB1
siki(1) = TB2
Dim trgt As String '処理用の箱
Dim tmp As Integer '処理用の箱
Dim element(1, 26) As String '数と文字を割り振る
For j = 0 To 1
For i = 1 To Len(siki(j))
trgt = Mid(siki(j), i, 1)
If trgt Like "[a-z]" Then
tmp = Asc(trgt) - 96
element(j, tmp) = element(j, tmp) & trgt
Else
element(j, 0) = element(j, 0) & trgt
End If
Next
Next
'未定義のkazuを1と定義
For i = 0 To 1
If element(i, 0) = "" Then
element(i, 0) = 1
End If
Next
Dim pre As String
For i = 1 To 26
pre = pre & element(0, i) & element(1, i)
Next
answer = Val(element(0, 0)) * Val(element(1, 0))
answer = answer & pre
TB3 = answer
End Sub
ちょっと疲れてきたので。
今日はここまで。
一気に書くつもりでしたが。。
後半は後日ということで。。
VBAで将棋をつくろう！その2 とりあえず動かせるようになりました
今日は暇だったのでぽちぽちとプログラミングを書いて
さっき完成しましたー。
いくつか冗長な部分もある気がしますが
見直す気になれません笑
テストで答えの確認をしない子供みたいな感じ？笑
- コード
メイン
Dim n As Integer '盤面の大きさ
Dim rp As Range '定点の定義
Dim field As Range 'フィールド領域の定義
Dim motigoma As Range 'モチゴマ領域の定義
Dim c As Range 'カウンターの定義
Dim d(2) As Variant '方向を定義
Dim e(3) As Variant 'targetとpre_targetの位置関係を定義
Dim pre_target As Range '動かすターゲットの定義
Dim pre As Range
Dim koma As Variant 'コマの定義
Dim turn As Variant 'ターンの定義
Dim flag As Boolean
Private Sub Worksheet_Activate()
Cells.ClearContents
Call 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
Call フィールドの形成(field)
Call フィールド初期化(n, rp, c, koma, motigoma, turn)
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Call 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
d(0) = turn(c Mod 2)
d(1) = turn*1
t = tmp.End(xlDown).Row - tmp.Row
If t = 0 Then
tmp = ""
Else
Application.EnableEvents = False
a = Range(tmp.Offset(1, 0), tmp.Offset(t, 0))
Range(tmp.Offset(0, 0), tmp.Offset(t, 0)) = ""
Range(tmp.Offset(0, 0), tmp.Offset(t - 1, 0)) = a
Application.EnableEvents = True
End If
c = c + 1
Exit Sub
End If
If pre = "" Then
If Right(target, 1) = d(1) Then GoTo syori 'preが未定の場合はそれを指定
pre = target
pre.Offset(1, 0) = target.Row
pre.Offset(2, 0) = target.Column
Exit Sub
End If
'------------------------------------
'以降はpre_targetが既定の場合
'------------------------------------
'モチゴマをおく場合
If Right(target, 1) = d(0) Then GoTo syori 'targetが自分のコマの場合は終了
'方向を定義
e(0) = target.Row - pre.Offset(1, 0)
e(0) = e(0) * d(2)
e(1) = target.Column - pre.Offset(2, 0)
e(2) = func1(e(0)) '方向ベクトル
e(3) = func1(e(1)) '方向ベクトル
Set pre_target = Cells(pre.Offset(1, 0), pre.Offset(2, 0))
If InStr(pre, "成") = 0 Then '成り金の処理
jdg = Left(pre, Len(pre) - 1)
Else
jdg = "金"
End If
Select Case jdg 'コマが動かせるかの判定
Case koma(2), koma(3), koma(4), koma(5) '銀、金、王、歩兵の判定
If Abs(e(0)) + Abs(e(1)) > 2 Then GoTo syori
flag = move_jdg1(jdg, koma, e)
Case koma(1) '桂馬の判定
If e(0) = 2 & Abs(e(1)) = 1 Then
flag = True
End If
Case Is = koma(0), koma(6), koma(8) '香車、飛車の判定
If Not (e(0) = 0 Or e(1) = 0) Then GoTo syori
tmp = WorksheetFunction.CountA(Range(target.Offset(e(2) * d(2), e(3)), pre_target))
If tmp = 1 Then
flag = True
End If
Case Is = koma(7), koma(9) '角の判定
If Abs(e(0)) <> Abs(e(1)) Then GoTo syori
Set tmp = pre_target
If Abs(e(0)) = 1 Then
flag = True
Else
For i = 1 To Abs(e(0)) - 1
Set tmp = tmp.Offset(e(2) * d(2), e(3))
If tmp <> "" Then GoTo syori
Next
flag = True
End If
End Select
If flag = True Then 'コマが動かせる場合
If target <> "" Then 'targetが相手のコマの場合
Call モチゴマにする(target, koma, c, d, motigoma)
End If
pre_target = ""
target = pre
c = c + 1
If (4 - (target.Row - rp.Row)) * d(2) * -1 > 1 Then '成りの処理
target = nari(target, koma, d)
End If
End If
syori:
Range(pre, pre.Offset(2, 0)) = ""
End Sub
サブ
Sub 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
n = 9 - 1
Set rp = Cells(2, 4)
Set field = Range(rp, rp.Offset(n, n))
Set motigoma = rp.Offset(n + 2, 0)
Set c = rp.Offset(0, 2 * n)
Set pre = rp.Offset(1, 2 * n)
koma = Array("香車", "桂馬", "銀", "金", "王", "歩", "飛車", "角", "龍", "馬")
turn = Array("-", "+")
End Sub
Sub フィールドの形成(field)
field.Rows.RowHeight = 30
field.Columns.ColumnWidth = 6
field.Borders.LineStyle = xlContinuous
End Sub
Sub フィールド初期化(n, rp, c, koma, motigoma, turn)
Cells.ClearContents
c = 0
Range(motigoma, motigoma.Offset(0, 1)) = "もちごま"
m = n / 2
With rp
.Offset(m - 3, m - 3) = koma(6) & turn(1)
.Offset(m + 3, m + 3) = koma(6) & turn(0)
.Offset(m - 3, m + 3) = koma(7) & turn(1)
.Offset(m + 3, m - 3) = koma(7) & turn(0)
For i = 0 To 8
tmp = WorksheetFunction.Min(i, n - i)
.Offset(m - 4, i) = koma(tmp) & turn(1)
.Offset(m + 4, i) = koma(tmp) & turn(0)
.Offset(m - 2, i) = koma(5) & turn(1)
.Offset(m + 2, i) = koma(5) & turn(0)
Next
End With
End Sub
Function move_jdg1(jdg, koma, e) As Boolean 'コマが動かせるかの判定の続き
Select Case jdg
Case Is = koma(2) '銀の判定
If e(0) = 0 Then
ElseIf e(0) = -1 And e(1) = 0 Then
Else
move_jdg1 = True
End If
Case Is = koma(3) '金の判定
If e(0) = -1 And e(1) = 1 Then
Else
move_jdg1 = True
End If
Case Is = koma(4) '王の判定
move_jdg1 = True
Case Is = koma(5) '歩兵の判定
If e(0) = 1 And e(1) = 0 Then
move_jdg1 = True
End If
End Select
End Function
Function func1(e) As Integer '方向ベクトルの取得
If e = 0 Then
func1 = 0
Else
func1 = e / Abs(e)
End If
End Function
Function nari(target, koma, d) As String
Select Case Left(target, Len(target) - 1)
Case Is = koma(6), koma(8)
nari = koma(6) & d(0)
Case Is = koma(7), koma(9)
nari = koma(9) & d(0)
Case Is = koma(3), koma(4)
nari = target
Case InStr(target, "成") = 0
nari = "成" & target
Case Else
nari = target
End Select
End Function
Sub モチゴマにする(target, koma, c, d, motigoma)
Dim tmp As Range
target = Replace(target, d(1), "")
Select Case target
Case Is = koma(8)
target = koma(6)
Case Is = koma(9)
target = koma(7)
Case InStr(target, "成") <> 0
target = Replace(target, "成", "")
End Select
target = target & d(0)
Set tmp = motigoma.Offset(0, c Mod 2)
If tmp.Offset(1, 0) = "" Then
tmp.Offset(1, 0) = target.Value
Else
t = tmp.End(xlDown).Row - tmp.Row
tmp.Offset(t + 1, 0) = target.Value
End If
End Sub
- 思ったこと
今回はkoma配列単体では何もできない仕様で書きました。
それが僕が考えた「シンプルに書く方法」です。
komaにいくつかの文字を付け足して盤面で動かす。
認識の際にはそれらをはずすorそれを付けた効果を発揮した状態にする。
という感じです。
今回の主な反省点はコメントの書き方。
将棋のプログラミングくらいになるとどうしてもコードが長くなってしまう。
'------------
'ここは００です
'------------
上のコメント文。
ネットではよく見ていたのですが自分で使ったのは初めてでした。
コードを書いている後半になんとなく書いてみたら
めちゃくちゃ見やすくなりました。
ただほかの部分のコメントを書き直す気分になれなかったので
今回は全体を通しては扱えませんでしたが。。
次回からは積極的に使っていこうと思います。
ほかはなんだろうなー。
将棋の成りをコードで書くことに特に苦労しました。
結果としてはなかなかシンプルにかけたのでは？と思っているのですが
道中では「こりゃどうすりゃええんじゃああああ」って苦しんでいました。
シンプルな文字列を適宜改変してゆく。
という概念は今回得た思わぬ収穫でした。
- 次回の予定
将棋はひとまず終わりにします。
どっちももう頭の中では出来上がっているので
今回の将棋のように苦しむことはないかなと思っています。
ではでは。
*1:c + 1) Mod 2)
d(2) = (-1) ^ ((c Mod 2) + 1)
If Application.Intersect(target, field) Is Nothing Then 'targetが番外の場合
If Right(target, 1) = d(0) Then 'targetがモチゴマの場合
pre.Offset(0, 1) = target
pre.Offset(1, 1) = target.Row
pre.Offset(2, 1) = target.Column
End If
Exit Sub
End If
If pre.Offset(0, 1) <> "" And target = "" Then 'preがモチゴマの場合
target = pre.Offset(0, 1)
pre.Offset(0, 1) = ""
Set tmp = Cells(pre.Offset(1, 1), pre.Offset(2, 1
VBAで将棋をつくろう! その1
VBAで○○をつくろう。
第一弾はオセロでしたが
今回第二段は将棋です！！！
その1ではコードは書きません。
将棋を選んだ理由とどうやって将棋をつくるのかを
できるだけ日本語で書きたいと思います。
じつはこの工程こそがプログラミングの肝なんじゃないかとちょっと感じています。
- なぜ将棋？
それは将棋が数種類の駒を動かす種目だからです。
一文ですが要素が二つ。
まずは数種類の駒。
これは後にキャラクターになりますね。
そして駒を動かす。
これが将棋をつくるうえの肝かなと思っています。
一度にひとつのことしかできないコンピュータにどうやって「駒を動かす」をさせるかというと。
動かす駒を選ぶ。
動かす先を選ぶ。
というふたつの工程を踏むことで行わせます。
。。。
これが将棋のプログラミングにおけるほぼすべてなのかなーとか思ったり。
- どうやって将棋をつくるの？
将棋を一手指すことを分解して考えてみます。
動かす駒を選ぶ(盤上or持ち駒)
動かす先を選ぶ
そこに動かすことができるか調べる
可能な場合は動かす
動かした先に相手の駒があった場合は駒をとる
動かした先が相手の領域だった場合は成る（駒をひっくり返す）
6工程
ちなみにオセロだと。
置く場所を選ぶ
置くことができるか調べる
置いて条件にあったところをひっくり返す
3工程
将棋のほうが工程が多いですね。
プラスで。
ご存知のとおり将棋には駒が数種類あります。
それぞれの駒が指定された場所に移動できるかどうかを調べる処理はどうしてもいくつかの具体的なことを書かないと実装できません。
オセロの場合は「自分の石」と「相手の石」の二種類しかなかったので
駒の種類が増えた場合の対応の仕方を考えないといけませんね。
あー。
オセロをつくろうのどこかのページで書いたのですが。
それを作ることは簡単だがシンプルに作ることは難しい。
と思うんです(たぶんフレーズは違いますが同じ概念のことを書いたと思います)。
将棋の場合はとりあえず駒が40個なので
40個すべてについて処理を書いていけばつくることはできます。
ただ面倒だしシンプルじゃない。
先に行ってしまいますが。
現在の自分のスキルでは将棋をすっげぇシンプルに書くことはできないと思っています。
いかにシンプルにつくるかはもちろん攻めますが。
一度つくってから二週間もすればぜんぜん違う様式でもっとシンプルにつくれると思います。
でも一度つくらないとその成長は約束されないのでつくります。
んー。
なんか日本語っぽくなくなってきたのでこれくらいに。
- どうやってつくるか(もうちょっと詰めて)
上の章で書いた6工程それぞれをどうやって実装するのか。
もうちょっと詰めて書きます。
動かす駒を選ぶ(盤上or持ち駒)
fieldとmotigomaという領域を定義して
それらのうち自分が使用権を持つものがクリックされた場合に
selectという領域にその駒の名前を位置を書き込みます
動かす先を選ぶ
selectに情報が書き込まれている場合に発動します
新たにクリックされた場所を動かす先として認識します
具体的にいうとそのセルをtargetとします
そこに動かすことができるか調べる
selectとtargetからどの駒をどこからどこへ動かすつもりなのかがわかります
なのでそれが可能かどうかを調べます
ここが一番の難所かな
その駒が何かによって異なる処理を選びます
その処理でその駒をtargetへ動かすことができるか調べます
異なる処理。というところをもう少し突っ込みます。
ここをシンプルに書くことが僕がこのタイミングで将棋をつくる一番の理由です。
すべての駒に個別の処理を書く
→80通り(駒が40枚でそれぞれに表裏があるため)
自分の駒20枚の処理で相手の駒の処理もこなす
→40通り(80を2で割って)
王,飛車,龍,角,馬,金,銀,桂馬,香車,歩の処理を書いてそれぞれの駒の処理をこなす
→10通り
(飛車,龍,角,馬,香車),(王,金,銀,桂馬,歩)について()に入った駒はできるだけ同じ処理でこなす
ここだけちょっと説明。。。
()の前者は動線に駒があると動けない駒たち
後者は動線がない(1マスしか進めない)ものか動線に駒があっても関係のない駒たち
実は前者は条件が後者よりひとつ多いんです。
ただその条件を調べる方法がどれも似ている(と感じる)ので()にくくりました。
→2*5通り(ひとつ上のものよりシンプルなはず。。)
これでkomaは10種類でこの工程での分岐は2*5にまで絞れました。
この工程での分岐がもっと削れるんじゃないかと思うんですけど。
まぁ今の自分には思いつかないです。
あとはふるいを上手に設けて処理を簡略化するところで勝負します。
可能な場合は動かす
駒を動かせる場合にselectの情報からその位置にある駒を消して
targetに書き直します
動かした先に相手の駒があった場合は駒をとる
targetが相手の駒でありそこに自分の駒を動かせる場合は
targetに自分の駒を書き換える前に
相手の駒を自分のmotigoma領域に書きます
そしてtargetを書き換えます
動かした先が相手の領域だった場合は成る（駒をひっくり返す）
ここも難しい。
動かした先が相手の領域だった場合はその駒を書き換えるだけなので
上の工程がかけたならそのスキルで何とかできます。
問題はその先。
もしも成った駒が相手に取られた場合。
これは成る前の駒を相手に与えないといけませんよね。
これをどう実装するか。。。
ここは自分にとって面白い(つまり答えを知らない)のでいくつか案を出してみましょう。
えっと前提として駒はkomaという配列を使って表現するつもりです。
簡略化のために駒は「歩」「飛車」「王」の三種類だけとしましょう。
成る駒が2つと成らない駒が1つですね。
array関数を使う場合
一次元で詰め込む場合
(歩,金,飛車,龍,王,王)と詰める
koma(o),koma(2)など基本は偶数のみを扱う
成ったらkoma(0)をkoma(0+1)とする
とられたらkoma(0)はkoma(0)としてkoma(1)はkoma(1-1)とする
んー複雑そう。。
二次元で詰め込む場合
これはこの記事を書きながら思いつきました。
*1と詰める
基本はkoma(1,0),koma(2,0)を使う
成ったらkoma(1,1)にしてとられたらkoma(1,0)にする
んー。上よりはよいか？？
シートを使う場合
これも今思いついたやつなのですがトリッキーに感じる。。。
あらかじめkomaシートに書いておく
1列目に駒の表面を2列目に駒の裏面を記入しておく
駒が成る場合にkomaシート参照してそれが一列目であった場合には二列目のものに書き換える
駒がとられた場合にkomaシートを参照してそれが二列目であった場合には一列目のものに書き換える
んー。
残念ながら結論をうまく日本語で表現することができないのですが
現時点では表面と特殊な裏面(龍と馬?)だけarrayで宣言して
成る場合と取られる場合にシート参照するのが良いかなと思います。
正直けっこう感覚で喋っているので実際に書いているうちに気持ちが変わるかもしれません。
- さいごに
はて。
ところどころ意味不明なことを書いている気がしますが。
とりあえずめちゃくちゃ疲れました。
でもプログラミングの道筋はほぼ見えました。
あとはいかにシンプルにするかだけ。
道筋を日本語で書く工程はめちゃくちゃ疲れるけどやはり大事な気がする。
なんだろ。
上位概念からのアクセスな感じがします。
おわり
*1:歩,金),(飛車,龍),(王,王
VBAでオセロをつくろう! その3 とりあえず敵を設定できました！
キレッキレだったのでその2に続いて投稿。
今日は調子よさそう笑
毎回書く項目をしっかり決めないと。。
その1でもその2でもぜんぜん違う書き方になっていますね。。
- 前回からの変更点
簡単に言うとタイトルの通り。
敵を設定しました。
どうやったかの説明をつらつらと。
前回のブログに書いた、星をつける、の機能をちょっと書き換えました。
一番おく価値のある場所のセル番地を返す関数を定義
そのセルに石を置いてひっくり返せる石は返す
というコードを書くことで敵の指す手を表現しました。
。。。
日本語で説明するの難しいですね。。
正直自分で書いていても概念が言葉より早く動いている感じがします。
あくまで処理においては言葉より数式？コード？のほうがアクセスが早いのだろうか。。。
とにかく。
いままでどおり自分がクリックしたところが正常な位置なら石を置いて周りをひっくり返す。
プラスで。
それに対応して石を自動で置いてそれに準じたひっくりかえしを行う。
自分が黒を持つときは素直にその通りに。
白を持つときは一手間加えます。
特別なセルを指定して、"後攻で～～"と記入しておきます。
僕はシートがアクティベイトされたときに自動でかかれるようにコードを書きました。
そしてそのセルがクリックされたらコンピューターが自動で一手指す使用に。
つまりコンピューターが黒を打って、自分は白を打つという風にひとつずらすことができます。
- コード
メイン
Dim rp As Range 'フィールド形成の定点の定義
Dim n As Integer '盤面の大きさの定義
Dim field As Range 'rpとnでフィールドの定義
Dim c As Range 'カウントセルの定義
Dim stone As Variant '黒石と白石の定義
Dim turn As Variant '手番プレートの定義
Private Sub Worksheet_Activate()
'シートの状態を設定
Cells.ClearContents
Call 基礎値共有(rp, n, field, c, stone, turn)
Call フィールド形成(rp, field, stone, turn, c, n)
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Call 基礎値共有(rp, n, field, c, stone, turn)
If target = c.Offset(3, 1) And c = 0 Then GoTo koukou
Dim flag As Boolean 'flagはプロシージャを抜ける判定に使う
Dim saizen As String
Dim q(1) As String 'q0が自分の石でq(1)が相手の石
q(0) = stone(c Mod 2)
q(1) = stone*1
Set c = rp.Offset(0, n + 2)
stone = Array("●", "○")
turn = Array("黒番", "白番")
End Sub
Sub フィールド形成(rp, field, stone, turn, c, n)
'フィールドの見た目を定義
With field
.ClearContents
.Rows.RowHeight = 50
.Columns.ColumnWidth = 8
.Interior.Color = RGB(200, 200, 200)
.Borders().LineStyle = xlContinuous
End With
'最初の4石を置く
With rp
.Offset(n / 2 - 1, n / 2 - 1) = stone(0)
.Offset(n / 2, n / 2) = stone(0)
.Offset(n / 2 - 1, n / 2) = stone(1)
.Offset(n / 2, n / 2 - 1) = stone(1)
End With
'カウントセルと手番の表示
c.Value = 0
c.Offset(1, 0) = turn(0)
c.Offset(3, 1) = "後攻ではじめる"
End Sub
Function flag_p_rec(target, q) As Boolean
Dim tmp As Range '周辺認識用
Dim stock As Range '周辺認識用
Dim d(1) As Integer '周辺認識用
'iでターゲットの周辺を認識
For i = 0 To 8
d(0) = i Mod 3 - 1
d(1) = i \ 3 - 1
Set tmp = target.Offset(d(0), d(1))
Set stock = tmp
If stock <> q(1) Then GoTo L1
'周辺マスが敵の石だった場合の処理
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp.Value
Case Is = q(0)
stock = q(0)
target = q(0)
flag_p_rec = True
Case Is = q(1)
Set stock = Union(stock, tmp)
Case Else
Exit Do
End Select
Loop
L1:
Next
End Function
Function cp_select(stone, field, c, q) As String
Dim target As Range
Dim first As Range
Dim found As Range
Dim d(1) As Integer
Dim cnt As Integer
Dim cnt_tmp As Integer
Dim pre As Integer
Dim hozon As String
Set target = field.Find("")
If target Is Nothing Then
Exit Function
Else
Set first = target
End If
Do
cnt = 0
Set target = field.FindNext(target)
For i = 0 To 8
cnt_tmp = 0
d(0) = i Mod 3 - 1
d(1) = i \ 3 - 1
Set tmp = target.Offset(d(0), d(1))
If tmp <> q(1) Then GoTo L1
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp.Value
Case Is = q(0)
cnt = cnt + cnt_tmp + 1
Debug.Print cnt_tmp + 1
If cnt >= pre Then
hozon = target.Address(False, False, xlA1, False)
pre = cnt
End If
Exit Do
Case Is = q(1)
cnt_tmp = cnt_tmp + 1
Case Else
Exit Do
End Select
Loop
L1:
Next
If target.Address = first.Address Then
Exit Do
End If
Loop
If hozon = "" Then
Exit Function
End If
cp_select = hozon
End Function
- 次の予定
んー。
もうオセロはあんまりやる気ないです。
それよりほかのゲームに触れてみたい。
もしオセロに手を加えるとしたらコンピューターの手を強化することになりますが。僕自身がオセロが弱いので面倒くさいんですよね。。
ではでは。
ｋ
*1:c + 1) Mod 2)
'targetがフィールド外であればプロシージャから抜ける
If Application.Intersect(target, field) Is Nothing Then
Exit Sub
End If
'石が置けるかの判定および処理
flag = flag_p_rec(target, q)
'Call 周辺認識(target, q, flag)
'石が置けなかった場合はプロシージャから抜ける
If flag = False Then
Exit Sub
End If
flag = False
'クリック数と手番の更新
c.Value = c.Value + 1
'cpの手の定義
koukou:
q(0) = stone(c Mod 2)
q(1) = stone((c + 1) Mod 2)
saizen = cp_select(stone, field, c, q)
If saizen <> "" Then
Set target = Range(saizen)
flag = flag_p_rec(target, q)
End If
c.Value = c.Value + 1
c.Offset(1, 0) = turn(c Mod 2)
End Sub
サブ
Sub 基礎値共有(rp, n, field, c, stone, turn)
'ここで数値を指定する
Set rp = Cells(2, 2)
n = 8
Set field = Range(rp, rp.Offset(n - 1, n - 1
