空腹おやじのログと備忘録

VBA(主にExcel)でいろいろな実験的な事とか、Linuxのコマンドとか設定とかについて忘れないように、あれこれと・・・

【VBA】導関数を求める

Twitter でのお題
「y = 5x^3 + 2x^2 + 7x + 5」の導関数を求めろ!
を解いてみた。

正規表現を使って、必要なデータを取り出して、ゴニョゴニョしました。

使用したパターンは、以下の通り。
"([+-]?)(\d*)x(\^([+-]?\d+))?"

大雑把な説明
x に対して、

[+-]? 符号 + または、- が付く場合がある
\d* 任意の正の整数の係数が付く場合がある
(\^([+-]?\d+))? 冪乗指数が付く場合がある
[+-]? 冪乗指数には、符号 + または、- が付く場合がある
\d+ 冪乗指数は、正の整数である

係数、指数を
正の整数
としているのは、
符号部と数値部を別に判定しているためです。


参照設定は、お約束の通り。

Private Type xItem
    xiSign   As String
    xiCoefficient   As Long
    xiPower         As Long
End Type

Public Sub hoge()

    Dim sFormula    As String

    sFormula = "y = 5x^3 + 2x^2 + 7x + 5"
    Debug.Print sFormula
    Debug.Print getDerivative改(sFormula)
    Debug.Assert getDerivative改(sFormula) = "y=15x^2+4x+7"

    sFormula = "y = 7x - 5x^3 + 2x^2"
    Debug.Print sFormula
    Debug.Print getDerivative改(sFormula)
    Debug.Assert getDerivative改(sFormula) = "y=7-15x^2+4x"

    sFormula = "y = 7x^+9-3x^5+12x^-3-x^2+10x+4"
    Debug.Print sFormula
    Debug.Print getDerivative改(sFormula)
    Debug.Assert getDerivative改(sFormula) = "y=63x^8-15x^4-36x^-4-2x+10"

    sFormula = "y = 7x^9-3x^5-22x^-3+4x^2+x+4"
    Debug.Print sFormula
    Debug.Print getDerivative改(sFormula)
    Debug.Assert getDerivative改(sFormula) = "y=63x^8-15x^4+66x^-4+8x+1"

    sFormula = "y = 5"
    Debug.Print sFormula
    Debug.Print getDerivative改(sFormula)
    Debug.Assert getDerivative改(sFormula) = ""

End Sub

Private Function getDerivative改(ByVal sFormula As String) As String

    Dim xi()        As xItem
    Dim sFormulaW   As String
    Dim sItem       As String
    Dim sSign       As String
    Dim sResult     As String
    Dim i           As Long

    sFormulaW = Replace$(sFormula, " ", "")

    If Not getItemInfo改(sFormulaW, xi) Then
        Debug.Print "Not matched."

        Exit Function
    End If

    For i = 0 To UBound(xi)
        With xi(i)
            If (.xiSign = "-") Eqv (Sgn(.xiPower) < 0) Then
                sSign = "+"
            Else
                sSign = "-"
            End If

            sItem = sSign & CStr(.xiCoefficient * Abs(.xiPower)) & "x"

            '指数部の値による処理の振り分け
            Select Case .xiPower
            Case 0
                '何も付加しない
            Case 1
                '符号、係数部のみ使用し、"x"および指数部は付加しない
                sResult = sResult & .xiSign & CStr(.xiCoefficient)
            Case 2
                '指数部は1なので、"^"以降は省略する
                sResult = sResult & sItem
            Case Else
                '指数部が2より大きい or 0未満
                sResult = sResult & sItem & "^" & CStr(.xiPower - 1)
            End Select
        End With
    Next i

    If Left$(sResult, 1) = "+" Then
        sResult = Mid$(sResult, 2)
    End If

    getDerivative改 = "y=" & sResult

End Function

Private Function getItemInfo改(ByVal sFormula As String, ByRef xi() As xItem) As Boolean

    Dim re  As New RegExp
    Dim mc  As MatchCollection
    Dim i   As Long

    With re
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "([+-]?)(\d*)x(\^([+-]?\d+))?"
    End With

    Set mc = re.Execute(sFormula)

    If mc.Count = 0 Then
        Exit Function
    End If

    ReDim xi(mc.Count - 1)

    For i = 0 To mc.Count - 1
        With xi(i)
            .xiSign = mc.Item(i).SubMatches(0)

            If mc.Item(i).SubMatches(1) = "" Then
                .xiCoefficient = 1
            Else
                .xiCoefficient = CLng(mc.Item(i).SubMatches(1))
            End If

            If mc.Item(i).SubMatches(3) = "" Then
                .xiPower = 1
            Else
                .xiPower = CLng(mc.Item(i).SubMatches(3))
            End If
        End With
    Next i

    getItemInfo改 = True

End Function

実行結果

y = 5x^3 + 2x^2 + 7x + 5
y=15x^2+4x+7
y = 7x - 5x^3 + 2x^2
y=7-15x^2+4x
y = 7x^+9-3x^5+12x^-3-x^2+10x+4
y=63x^8-15x^4-36x^-4-2x+10
y = 7x^9-3x^5-22x^-3+4x^2+x+4
y=63x^8-15x^4+66x^-4+8x+1
y = 5
Not matched.

Not matched.

ちなみに、同じく正規表現を使用た方法は、こちらにも。
infoment.hatenablog.com