ギャンブルにおけるKelly基準:実装

確率論

概要

 Kelly基準を実際に使ってみたいという人もいるかもしれないので、VBAとpythonによるソースコードを載せておく。コードがポンコツなのは気にしてはならない。詳しいロジックの説明は以下の記事を参照。

ギャンブルにおけるKelly基準シリーズはおそらくこれで最後である。

VBA

素のKelly基準を実装したコード:

Public Function kelly(ByVal n As Long, ByRef p() As Double, ByRef alpha() As Double) As Double()
    Dim i As Long
    Dim sumP As Double, sumQ As Double, b As Double, minB As Double
    ReDim r(n) As Double
    ReDim idx(n) As Double
    ReDim f(n) As Double
    
    For i = 1 To n
        r(i) = p(i) * alpha(i)
        idx(i) = i
    Next i
    Call qsort(r, idx, 1, n)

    sumP = 0
    sumQ = 0
    minB = 1
    For i = 1 To n
        sumP = sumP + p(idx(i))
        sumQ = sumQ + 1# / alpha(idx(i))
        If sumQ < 1# Then
            b = (1# - sumP) / (1# - sumQ)
        Else
            b = 1
        End If
        If b < minB Then
            minB = b
        End If
    Next i
    
    For i = 1 To n
        f(i) = p(i) - minB / alpha(i)
        If f(i) < 0 Then f(i) = 0
    Next i
    kelly = f
End Function

クイックソートは並び替えた元の配列のインデックスを返すように修正したコードを使用。

Sub qsort(ByRef x() As Double, ByRef idx() As Double, ByVal l As Long, ByVal u As Long)
    Dim i As Long
    Dim j As Long
    Dim m As Variant
    Dim tmp As Variant
    m = x(Int((l + u) / 2))
    i = l
    j = u
    Do
        Do While x(i) > m
            i = i + 1
        Loop
        Do While x(j) < m
            j = j - 1
        Loop
        If i >= j Then Exit Do
        tmp = x(i)
        x(i) = x(j)
        x(j) = tmp
        tmp = idx(i)
        idx(i) = idx(j)
        idx(j) = tmp
        i = i + 1
        j = j - 1
    Loop
    If (l < i - 1) Then
        Call qsort(x, idx, l, i - 1)
    End If
    If (u > j + 1) Then
        Call qsort(x, idx, j + 1, u)
    End If
End Sub

Excelのセル式から呼び出す場合は以下のような入り口(Facade)を付ければよいだろう。

Public Function kellyFacade(ByRef rngP As Range, ByRef rngAlpha As Range) As Variant
    Dim i As Long, j As Long, n As Long
    Dim f() As Double
    n = rngP.Rows.Count
    ReDim p(n) As Double
    ReDim alpha(n) As Double
    For i = 1 To n
        p(i) = rngP.Cells(i, 1)
        alpha(i) = rngAlpha.Cells(i, 1)
    Next i
    f = kelly(n, p, alpha)
    
    ReDim ret(0 To UBound(f) - 1, 0 To 0) As Variant
    For i = 0 To UBound(f) - 1
        ret(i, 0) = f(i + 1)
    Next i
    kellyFacade = ret
End Function

最後はCRRA型効用関数に拡張したKelly基準。\(\small \gamma\)は相対的リスク回避度である。フラクショナルケリーの比率の値を入れればよい(ハーフケリーなら2、1/3ケリーなら3など)。一応計算の工夫をしているが、発散するときは発散する。

Public Function kellyCRRA(ByVal n As Long, ByRef p() As Double, ByRef alpha() As Double, _
                          ByVal gamma As Double) As Double()
    Dim i As Long
    Dim sumP As Double, sumQ As Double, sumPQ As Double
    Dim b As Double, minB As Double, minK As Double, kgamma As Double
    ReDim r(n) As Double
    ReDim idx(n) As Double
    ReDim f(n) As Double
    
    For i = 1 To n
        r(i) = p(i) * alpha(i)
        idx(i) = i
    Next i
    Call qsort(r, idx, 1, n)
    
    If gamma <= 0.0 Then
        For i = 1 To n
            f(i) = 0
        Next i
        If r(1) > 1 Then f(idx(1)) = 1
    Else
        sumP = 0
        sumQ = 0
        sumPQ = 0
        minB = 1
        minK = 1
        For i = 1 To n
            sumP = sumP + p(idx(i))
            sumQ = sumQ + 1# / alpha(idx(i))
            If p(idx(i)) > 0 Then
                sumPQ = sumPQ + Exp(Log(p(idx(i))) / gamma - Log(alpha(idx(i))) * (gamma - 1#) / gamma)
            End If
            If sumQ < 1# Then
                kgamma = (sumPQ + ((1# - sumP) / (1# - sumQ)) ^ (1# / gamma) * (1# - sumQ))
                b = ((1# - sumP) / (1# - sumQ)) ^ (1# / gamma) / kgamma
            Else
                b = 1
            End If
            If b < minB Then
                minB = b
                minK = kgamma
            End If
        Next i
        
        For i = 1 To n
            f(i) = Exp(Log(p(i)) / gamma - Log(alpha(i)) * (gamma - 1#) / gamma) / minK - minB / alpha(i)
            If f(i) < 0 Then f(i) = 0
        Next i
    End If
    
    kellyCRRA = f
End Function

Public Function kellyCRRAFacade(ByRef rngP As Range, ByRef rngAlpha As Range, _
                                ByVal gamma As Double) As Variant
    Dim i As Long, j As Long, n As Long
    Dim f() As Double
    n = rngP.Rows.Count
    ReDim p(n) As Double
    ReDim alpha(n) As Double
    For i = 1 To n
        p(i) = rngP.Cells(i, 1)
        alpha(i) = rngAlpha.Cells(i, 1)
    Next i
    f = kellyCRRA(n, p, alpha, gamma)
    
    ReDim ret(0 To UBound(f) - 1, 0 To 0) As Variant
    For i = 0 To UBound(f) - 1
        ret(i, 0) = f(i + 1)
    Next i
    kellyCRRAFacade= ret
End Function

Python

最初からCRRA型効用関数に対応したバージョンを示す。素のKelly基準にする場合は、gamma=1にするか、引数を省略すればよい。使い方はmain関数を参照。

import numpy as np
import math

def kelly(p, alpha, gamma = 1):
    n = len(p)
    r = [0] * n
    f = [0] * n
    for i in range(0, n):
        r[i] = p[i] * alpha[i]
    idx = np.argsort(r).tolist()
    idx.reverse()
    
    if gamma <= 0.0:
        for i in range(0, n):
            f[i] = 0
        if r[idx[0]] > 1.0:
            f[idx[0]] = 1.0
        return f
    
    sumP = 0
    sumQ = 0
    sumPQ = 0
    minB = 1
    minK = 1
    for i in range(0, n):
        sumP += p[idx[i]]
        sumQ += 1.0 / alpha[idx[i]]
        if p[idx[i]] > 0:
            sumPQ += math.exp(math.log(p[idx[i]]) / gamma - math.log(alpha[idx[i]]) * (gamma - 1.0) / gamma)
        
        if sumQ < 1.0:
            kgamma = sumPQ + (((1.0 - sumP) / (1.0 - sumQ)) ** (1.0 / gamma)) * (1.0 - sumQ)
            b = (((1.0 - sumP) / (1.0 - sumQ)) ** (1.0 / gamma)) / kgamma
        else:
            b = 1
            kgamma = 1
            
        if b < minB:
            minB = b
            minK = kgamma
    
    for i in range(0, n):
        f[i] = math.exp(math.log(p[i]) / gamma - math.log(alpha[i]) * (gamma - 1.0) / gamma) \
                / minK - minB / alpha[i]
        if f[i] < 0 or minB == 1:
            f[i] = 0
    
    return f

if __name__ == '__main__':
    p = [0.5, 0.3, 0.15, 0.05]
    alpha = [1.325, 4, 5, 22]
    f = kelly(p, alpha)
    print(f)