【VBA】Twitter お題「ねこちゃんの数を数える」を解いてみた
Twitter で、ほえほえ氏から提示されたお題「ねこちゃんの数を数える」を解いてみた。
少しお題を考えたので投稿してみます。お題のためのお題ということで少し不自然だし、簡単な解法があるかもしれませんがご容赦を。発展型で言ってみます。
— ほえほえ＠LWP (@hoehoe1234) 2020年2月23日
お題 ねこちゃんの数を数える
です。（つづく）
ざっくり言えば、「親猫」、「子猫」、「猫又」・・・といった文字が並んでいて、
それぞれ何匹いるのかを数えるというもの。
take 1からtake 7まであって、
それぞれに条件がついています。
| Take | 条件 | 文字列 |
|---|---|---|
| 1 | 親猫と子猫を数えて（数と種類を報告）ください。 | 親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫 |
| 2 | 簡潔に書くために同じ種類の猫が連続する場合は「猫」一文字で代用することにしました。 「親猫猫子猫猫」は、親猫が２匹、子猫が２匹です。 |
親猫猫猫子猫猫猫猫猫猫親猫子猫猫 |
| 3 | せっかく簡潔に書く記法を開発したのに適当に書くやつが現れました。そのせいで繰り返しの代わりに元の記法もOKになりました。 親猫が３匹の場合下のいづれもOKとします。 親猫親猫親猫 親猫猫親猫 親猫猫猫 |
子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫 |
| 4 | なんと列に「猫又」が混じってしまいました。親猫、子猫、猫又の数を数えてください。 | 子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫 |
| 5 | いままでは親猫子猫猫又でしたがいろいろな種類の猫がが混じってしまいました。 ただし猫の名前は２文字で最後に「猫」がつくのは同じです。 例で白猫黒猫がいますが実際はもっとたくさんの種類がいます。（青猫、緑猫とか） |
子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫 |
| 6 | なんと不条理な上司！登場。あろうことか、「猫又が二匹現れたらその時点で猫の種類と数を報告して作業を終了せよ」といわれました。どうしよう。。。 上司によると猫又２匹とは「累計して２匹」現れたらとのことで、連続２匹ということではない模様です。 "子猫猫又親猫猫又" "子猫親猫猫又猫" はともに最後の猫又で「累計２匹」なのでそこで報告して作業終了です。 |
子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫 |
| 7 | 最後の試練。上司が逆ギレしています。どうやら先程の指示は上司の意図ではなかったようです。彼によると 「猫又が不吉なのは『きっちり２匹だけ並んだ』ときだけだ！」 とのことです。累計でもないしなんと猫又が３匹並んでもそれはOK（カウント継続）だそうです。数えられるかな、、、、 |
コード
手っ取り早いので、正規表現で・・・
メイン処理
参照設定は、いつものやつ。
Microsoft VBScript Regular Expressions 5.5
メイン処理で使っているパターンは、
親猫を数える場合を例に取ると
(?:親)(猫*?)(?=(?:猫又|[^猫]|$))
猫に続く猫又を分けなければいけないので
肯定先読みを使用している。
"親猫又"
がある場合には、
猫又
を優先している。
親猫を優先したい場合には、
"(猫*?)"を"(猫+?)"に変えればいい（はず）。
(?:親)(猫+?)(?=(?:猫又|[^猫]|$))
親の部分が変わるだけで、
Take 1 から、Take 7 まで全て同じパターンで処理している。
Public Function 猫5改2(ByVal sCats As String, ByRef sCatType() As String, ByRef lCatCount() As Long) As Long Dim re As RegExp Dim mc As MatchCollection Dim lCount As Long Dim lNekomata As Long Dim sResult As String Dim sTypes() As String Dim lElems As Long Dim i As Long Dim j As Long ReDim sCatType(lCount) ReDim lCatCount(lCount) '猫又 lNekomata = (Len(sCats) - Len(Replace$(sCats, "猫又", ""))) \ 2 If lNekomata > 0 Then ReDim Preserve sCatType(lCount) sCatType(lCount) = "猫又" ReDim Preserve lCatCount(lCount) lCatCount(lCount) = lNekomata lCount = lCount + 1 End If 猫5改2 = lCount '猫と又を消して、猫の種類の文字のみにする sResult = Replace$(sCats, "猫", "") sResult = Replace$(sResult, "又", "") ReDim sTypes(0) lElems = -1 '"猫"の前に付く文字を抜き出す（"又"は含まれない） Do Until Len(sResult) = 0 lElems = lElems + 1 ReDim Preserve sTypes(lElems) sTypes(lElems) = Left$(sResult, 1) sResult = Replace$(sResult, sTypes(lElems), "") Loop If lElems < 0 Then Exit Function End If Set re = New RegExp With re .Global = True For i = LBound(sTypes) To UBound(sTypes) .Pattern = "(?:" & sTypes(i) & ")(猫*?)(?=(?:猫又|[^猫]|$))" Set mc = .Execute(sCats) sResult = "" For j = 0 To mc.Count - 1 sResult = sResult & mc.Item(j).SubMatches(0) Next j CONTINUE_LOOP: If sCats Like "*" & sTypes(i) & "猫*" Then '"親子猫"のような場合、"親猫"は無いので出力しない If Not sCats Like "*" & sTypes(i) & "猫又*" Then '"子猫又"のような場合、"子猫"を出力しない ReDim Preserve sCatType(lCount) sCatType(lCount) = sTypes(i) & "猫" ReDim Preserve lCatCount(lCount) lCatCount(lCount) = Len(sResult) - Len(Replace$(sResult, "猫", "")) lCount = lCount + 1 End If End If Next i End With 猫5改2 = lCount End Function
Take 6、Take 7用補助処理
Public Function get猫6Source(ByVal sCats As String) As String Dim re As RegExp Dim mc As MatchCollection Dim sSource As String Dim lResult As Long Dim i As Long Set re = New RegExp With re .Pattern = "^(.*?猫又){2}" .Global = False Set mc = .Execute(sCats) If mc.Count > 0 Then sSource = mc.Item(0) Else sSource = sCats End If End With get猫6Source = sSource End Function Public Function get猫7Source(ByVal sCats As String) As String Dim re As RegExp Dim mc As MatchCollection Dim sSource As String Set re = New RegExp With re .Pattern = "^.*?[^又]猫又猫又(?!猫又)" .Global = True Set mc = .Execute(sCats) If mc.Count > 0 Then sSource = mc.Item(0) Else sSource = sCats End If End With get猫7Source = sSource End Function
テスト
Public Sub 猫てすと() Dim sCatType() As String Dim lCatCount() As Long Dim sCats As String Dim lResult As Long '----- take1 ----- Erase sCatType, lCatCount sCats = "親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take2 ----- Erase sCatType, lCatCount sCats = "親猫猫猫子猫猫猫猫猫猫親猫子猫猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take3 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 9 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 '----- take4 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 3 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 4 Debug.Assert sCatType(2) = "親猫" Debug.Assert lCatCount(2) = 4 '----- take5 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 5 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 4 Debug.Assert sCatType(4) = "親猫" Debug.Assert lCatCount(4) = 4 '----- take6-1 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫" sCats = get猫6Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 4 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 1 '----- take6-12 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫青猫親猫猫猫猫" sCats = get猫6Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 1 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 5 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 5 '----- take7-1 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫" sCats = get猫7Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 5 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 4 '----- take7-2 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫又青猫親猫猫猫猫又猫" sCats = get猫7Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 4 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 1 Debug.Print "Done." End Sub
Debug.Assert で済ませたので、イミディエイトウィンドウに
Done.
と出て、終わり。
ちなみに、イミディエイトウィンドウに出力すると、こんな感じ。
以上。
「改2」は、バージョンです。ツッコまないでくださいwww
正規表現を使わないバージョン（2020/3/1追加）
- Take 1～5 限定です。
- 正規表現バージョンより、精度が低いです。
- お題で提示されているデータは、クリアしますが、元になる猫データが変わると、要件をクリアできない場合があります。
- 正規表現バージョンとは、出力順が違います。
コード
Public Function 猫猫(ByVal sCats As String, ByRef sCatType() As String, ByRef lCatCount() As Long) As Long Dim dicCount As Dictionary Dim lLength As Long Dim lStartPos As Long Dim lOffset As Long Dim sCurrentType As String Dim sType As String Dim lCount As Long lLength = Len(sCats) If lLength < 2 Then Exit Function End If Set dicCount = New Dictionary 'グループ開始位置 lStartPos = 1 lOffset = 0 '現在の猫の種類 sCurrentType = "" sType = Mid$(sCats, lStartPos, 1) Do While True Select Case sType Case "猫" If Mid$(sCats, lStartPos + lOffset + 1, 1) <> "又" Then '猫又ではない lCount = lCount + 1 lOffset = lOffset + 1 Else '猫又 lStartPos = lStartPos + lOffset + 2 lOffset = 0 If dicCount.Exists("又") = True Then dicCount.Item("又") = dicCount.Item("又") + 1 Else dicCount.Add "又", 1 End If If Len(sCurrentType) > 0 Then If dicCount.Exists(sCurrentType) = True Then dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If End If sCurrentType = "" End If Case Else If sCurrentType <> sType Then '猫の種類が変わった lStartPos = lStartPos + lOffset + 1 lOffset = 0 If dicCount.Exists(sCurrentType) = True Then 'カウントアップ dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If If Len(sType) > 0 Then If dicCount.Exists(sType) = False Then '新しい猫の種類を追加 dicCount.Add sType, 0 End If End If '現在の猫の種類を更新 sCurrentType = sType 'カウントクリア lCount = 0 Else lOffset = lOffset + 1 End If End Select sType = Mid$(sCats, lStartPos + lOffset, 1) '終了判定（lStartPos + lOffset > lLength で、sType = ""となる） If Len(sType) = 0 Then If Len(sCurrentType) > 0 Then '有効データならカウントアップ dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If Exit Do End If Loop '-------------------------------------------------- Dim v As Variant Dim lElems As Long ReDim sCatType(dicCount.Count - 1) ReDim lCatCount(dicCount.Count - 1) For Each v In dicCount If Len(v) > 0 Then If dicCount.Item(v) > 0 Then If v <> "又" Then sCatType(lElems) = v & "猫" Else sCatType(lElems) = "猫" & v End If lCatCount(lElems) = dicCount.Item(v) lElems = lElems + 1 End If End If Next v If dicCount.Count <> lElems Then '未登録データが有れば、排除 ReDim Preserve sCatType(lElems - 1) ReDim Preserve lCatCount(lElems - 1) End If 猫猫 = lElems End Function
テスト
Public Sub 猫猫テスト() Dim sCatType() As String Dim lCatCount() As Long Dim sCats As String Dim lResult As Long '----- take1 ----- Erase sCatType, lCatCount sCats = "親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take2 ----- Erase sCatType, lCatCount sCats = "親猫猫猫子猫猫猫猫猫猫親猫子猫猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take3 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 9 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 '----- take4 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 3 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 Debug.Assert sCatType(2) = "猫又" Debug.Assert lCatCount(2) = 3 '----- take5 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 5 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "白猫" Debug.Assert lCatCount(1) = 1 Debug.Assert sCatType(2) = "黒猫" Debug.Assert lCatCount(2) = 4 Debug.Assert sCatType(3) = "親猫" Debug.Assert lCatCount(3) = 4 Debug.Assert sCatType(4) = "猫又" Debug.Assert lCatCount(4) = 3 Debug.Print "Done." End Sub
