一連の最高周波数からZipfの法則係数を計算する方法は？

クエリの頻度はいくつかありますが、Zipfの法則の係数を推定する必要があります。これらはトップ周波数です：

26486
12053
5052
3033
2536
2391
1444
1220
1152
1039

更新 @whuberの提案に従って、最尤推定量でコードを更新しました。対数理論的確率と対数頻度の差の二乗和を最小化することは、何らかのM推定量であることを示すことができれば、答えを出すことは統計的手順になります。残念ながら、同じ結果が得られるものは考えられませんでした。

これが私の試みです。私は周波数の対数を計算し、この式で与えられる理論的確率の対数に当てはめようとします。最終結果は合理的なようです。これがRのコードです。

fr <- c(26486, 12053, 5052, 3033, 2536, 2391, 1444, 1220, 1152, 1039)

p <- fr/sum(fr)

lzipf <- function(s,N) -s*log(1:N)-log(sum(1/(1:N)^s))

opt.f <- function(s) sum((log(p)-lzipf(s,length(p)))^2)

opt <- optimize(opt.f,c(0.5,10))

> opt
$minimum
[1] 1.463946

$objective
[1] 0.1346248

その場合、最適な2次近似はです。$s=1.47$

Rの最尤法は、mle関数（stats4パッケージから）を使用して実行できます。これにより、標準誤差が計算されます（正しい負の最尤法関数が提供されている場合）。

ll <- function(s) sum(fr*(s*log(1:10)+log(sum(1/(1:10)^s))))

fit <- mle(ll,start=list(s=1))

> summary(fit)
Maximum likelihood estimation

Call:
mle(minuslogl = ll, start = list(s = 1))

Coefficients:
  Estimate  Std. Error
s 1.451385 0.005715046

-2 log L: 188093.4 

これは、対数目盛での適合のグラフです（これも@whuberが提案したとおりです）。

s.sq <- opt$minimum
s.ll <- coef(fit)

plot(1:10,p,log="xy")
lines(1:10,exp(lzipf(s.sq,10)),col=2)
lines(1:10,exp(lzipf(s.ll,10)),col=3)

赤い線は平方和の合計、緑の線は最尤近似です。

いくつかの問題がで私たちの前にあり、任意の推定問題：

1. パラメーターを推定します。

2. その見積もりの​​品質を評価します。

3. データを探索します。

4. フィットを評価します。

理解とコミュニケーションのために統計的方法を使用する人にとって、最初の方法は他者なしで決して実行されるべきではありません。

以下のための推定には、使用すると便利ですmaximimum見込み（ML）を。周波数が非常に大きいため、よく知られている漸近特性が保持されることが期待できます。MLは、想定されるデータの確率分布を使用します。ジップの法則はのための確率を想定しに比例しているI - のいくつかの定電力のための（通常はS > 0）。これらの確率は合計して統一する必要があるため、比例定数は合計の逆数です。$i=1,2,\ldots,n$$i^{-s}$$s$$s\gt 0$

$$H_s(n)=\frac{1}{1^s} + \frac{1}{2^s} + \cdots + \frac{1}{n^s}.$$

その結果、1とnの間の結果確率の対数は$i$$1$$n$

$$\log(\Pr(i)) = \log\left(\frac{i^{-s}}{H_s(n)}\right) = -s\log(i) - \log(H_s(n)).$$

$f_i, i=1,2,\ldots, n$

$$\Pr(f_1,f_2,\ldots,f_n) = \Pr(1)^{f_1}\Pr(2)^{f_2}\cdots\Pr(n)^{f_n}.$$

したがって、データの対数確率は

$$\Lambda(s) = -s \sum_{i=1}^n{f_i \log(i)} - \left(\sum_{i=1}^n{f_i}\right) \log\left(H_s(n)\right).$$

データを固定と見なし、これを関数として明示的に表現すると、対数尤度になります。$s$

$\hat{s} = 1.45041$$\Lambda(\hat{s}) = -94046.7$$\hat{s}_{ls} = 1.463946$$\Lambda(\hat{s}_{ls}) = -94049.5$

$s$$[1.43922, 1.46162]$

Zipfの法則の性質を考えると、この近似をグラフ化する正しい方法は、log-logプロット上にあります。ここで、近似は（定義により）線形になります。

適合度を評価してデータを調べるには、残差を調べます（データ/適合、対数軸のログ）。

$\chi^2 = 656.476$

---

残差はランダムに見えるため、一部のアプリケーションでは、周波数の大まかな説明ではありますが、Zipfの法則（およびパラメーターの推定値）を受け入れられることに満足する場合があります。ただし、この分析は、この推定値がここで調べたデータセットの説明的または予測的な値を持っていると仮定するのは間違いであることを示しています。

$s$

PyMC3などの確率的プログラミング言語の1つは、この推定を比較的簡単にします。他の言語には、優れた機能と支援コミュニティを持つStanが含まれます。

OPデータ（Githubにも）に適合したモデルのPython実装は次のとおりです。

import theano.tensor as tt
import numpy as np
import pymc3 as pm
import matplotlib.pyplot as plt

data = np.array( [26486, 12053, 5052, 3033, 2536, 2391, 1444, 1220, 1152, 1039] )

N = len( data )

print( "Number of data points: %d" % N )

def build_model():
    with pm.Model() as model:
        # unsure about the prior...
        #s = pm.Normal( 's', mu=0.0, sd=100 )
        #s = pm.HalfNormal( 's', sd=10 )
        s = pm.Gamma('s', alpha=1, beta=10)

        def logp( f ):
            r = tt.arange( 1, N+1 )
            return -s * tt.sum( f * tt.log(r) ) - tt.sum( f ) * tt.log( tt.sum(tt.power(1.0/r,s)) )

        pm.DensityDist( 'obs', logp=logp, observed={'f': data} )

    return model


def run( n_samples=10000 ):
    model = build_model()
    with model:
        start = pm.find_MAP()
        step = pm.NUTS( scaling=start )
        trace = pm.sample( n_samples, step=step, start=start )

    pm.summary( trace )
    pm.traceplot( trace )
    pm.plot_posterior( trace, kde_plot=True )
    plt.show()

if __name__ == '__main__':
    run()

$s$$s$

いくつかの基本的なサンプリング診断を提供するために、トレースに構造が表示されていないため、サンプリングが「うまく混合されている」ことがわかります。

コードを実行するには、TheanoおよびPyMC3パッケージがインストールされたPythonが必要です。

@ w-huberのすばらしい回答とコメントに感謝します！

データを近似し、VGAMを使用して結果を評価および調査する私の試みは次のとおりです。

require("VGAM")

freq <- dzipf(1:100, N = 100, s = 1)*1000 #randomizing values
freq <- freq  + abs(rnorm(n=1,m=0, sd=100)) #adding noize

zdata <- data.frame(y = rank(-freq, ties.method = "first") , ofreq = freq)
fit = vglm(y ~ 1, zipf, zdata, trace = TRUE,weight = ofreq,crit = "coef")
summary(fit)

s <- (shat <- Coef(fit)) # the coefficient we've found
probs <- dzipf(zdata$y, N = length(freq), s = s) # expected values
chisq.test(zdata$ofreq, p = probs) 
plot(zdata$y,(zdata$ofreq),log="xy") #log log graph
lines(zdata$y, (probs)*sum(zdata$ofreq),  col="red") # red line, num of predicted frequency

    Chi-squared test for given probabilities

data:  zdata$ofreq
X-squared = 99.756, df = 99, p-value = 0.4598

この場合、カイ二乗の帰無仮説は、データがzipfの法則に従って分布しているということです。したがって、より大きなp値は、データがそれに応じて分布しているという主張をサポートします。非常に大きなp値であっても、証拠ではなく単なる指標であることに注意してください。

$x = 1$$\hat{w_{x=1}}$ その場合、対応する相対頻度を示し、

$$\hat{s_{UWSE}} = H_{10}^{-1}(\frac{1}{\hat{w_{x=1}}})$$

この場合、 $\hat{w_{x=1}} = 0.4695599775$、 我々が得る：

$$\hat{s_{UWSE}} = 1.4$$

繰り返しになりますが、UWSEは一貫した推定値のみを提供します-信頼区間はありません。精度のトレードオフが見られます。上記のmpiktasのソリューションはUWSEのアプリケーションでもありますが、プログラミングが必要です。エスティメータの詳細な説明については、https：//paradsp.wordpress.com/-一番下をご覧ください。

私の解決策は、Pythonで実装を行うmpiktasとwhuberによって提供される答えを補完しようとします。周波数と範囲xは次のとおりです。

freqs = np.asarray([26486, 12053, 5052, 3033, 2536, 2391, 1444, 1220, 1152, 1039])
x = np.asarray([1, 2, 3, 4, 5 ,6 ,7 ,8 ,9, 10])

関数はすべての範囲で定義されていないため、計算するたびに正規化されていることを確認する必要があります。離散的な場合、単純な近似は、すべてのy（x）の合計で除算することです。このようにして、異なるパラメーターを比較できます。

f,ax = plt.subplots()
ax.plot(x, f1, 'o')
ax.set_xscale("log")
ax.set_yscale("log")

def loglik(b):  
    # Power law function
    Probabilities = x**(-b)

    # Normalized
    Probabilities = Probabilities/Probabilities.sum()

    # Log Likelihoood
    Lvector = np.log(Probabilities)

    # Multiply the vector by frequencies
    Lvector = np.log(Probabilities) * freqs

    # LL is the sum
    L = Lvector.sum()

    # We want to maximize LogLikelihood or minimize (-1)*LogLikelihood
    return(-L)

s_best = minimize(loglik, [2])
print(s_best)
ax.plot(x, freqs[0]*x**-s_best.x)

その結果、前の回答と同様に、1.450408の勾配が得られます。