Wie berechnet man den Zipf-Gesetzeskoeffizienten aus einer Reihe von Spitzenfrequenzen?

Ich habe mehrere Abfragehäufigkeiten und muss den Koeffizienten des Zipf-Gesetzes schätzen. Dies sind die Spitzenfrequenzen:

26486
12053
5052
3033
2536
2391
1444
1220
1152
1039

Aktualisieren Ich habe den Code mit dem Maximum Likelihood Estimator gemäß dem @ whuber-Vorschlag aktualisiert. Das Minimieren der Differenzquadratsumme zwischen logarithmischen Wahrscheinlichkeiten und logarithmischen Häufigkeiten wäre ein statistisches Verfahren, wenn gezeigt werden könnte, dass es sich um eine Art M-Schätzer handelt. Leider fiel mir keiner ein, der die gleichen Ergebnisse liefern könnte.

Hier ist mein Versuch. Ich berechne Logarithmen der Frequenzen und versuche, sie an Logarithmen der theoretischen Wahrscheinlichkeiten anzupassen, die durch diese Formel gegeben sind . Das Endergebnis erscheint vernünftig. Hier ist mein Code in 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

Die beste quadratische Anpassung ist dann .$s=1.47$

Die maximale Wahrscheinlichkeit in R kann mit der mleFunktion (aus stats4Paket) ausgeführt werden, die Standardfehler hilfreich berechnet (wenn die korrekte negative maximale Wahrscheinlichkeitsfunktion angegeben wird):

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 

Hier ist das Diagramm der Anpassung in der Log-Log-Skala (erneut als @whuber vorgeschlagen):

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)

Die rote Linie ist die Summe der Quadrate, die grüne Linie ist die maximale Wahrscheinlichkeit.

Bei jedem Schätzungsproblem liegen uns mehrere Probleme vor :

1. Schätzen Sie den Parameter.

2. Bewerten Sie die Qualität dieser Schätzung.

3. Erforschen Sie die Daten.

4. Bewerten Sie die Passform.

Für diejenigen, die statistische Methoden zum Verständnis und zur Kommunikation verwenden würden, sollte die erste Methode niemals ohne die anderen durchgeführt werden.

$i=1,2,\ldots,n$$i^{-s}$$s$$s\gt 0$

$i$$1$$n$

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

Somit ist die Log-Wahrscheinlichkeit für die Daten

$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]$

In Anbetracht der Natur des Zipf-Gesetzes ist der richtige Weg, diese Anpassung grafisch darzustellen, ein Log-Log-Diagramm , in dem die Anpassung (per Definition) linear ist:

Um die Anpassungsgüte zu bewerten und die Daten zu untersuchen, sehen Sie sich die Residuen an (Daten / Anpassung, Log-Log-Achsen erneut):

$\chi^2 = 656.476$

Da die Residuen zufällig erscheinen, akzeptieren wir in einigen Anwendungen möglicherweise das Zipf-Gesetz (und unsere Schätzung des Parameters) als akzeptable, wenn auch grobe Beschreibung der Frequenzen . Diese Analyse zeigt jedoch, dass es ein Fehler wäre anzunehmen, dass diese Schätzung einen erklärenden oder vorhersagenden Wert für den hier untersuchten Datensatz hat.

$s$

Eine der probabilistischen Programmiersprachen wie PyMC3 macht diese Schätzung relativ einfach. Andere Sprachen sind Stan, der großartige Features und eine unterstützende Community hat.

Hier ist meine Python-Implementierung des auf die OP-Daten angepassten Modells (auch auf Github ):

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$

Um eine grundlegende Stichprobendiagnose zu ermöglichen, können wir feststellen, dass sich die Stichprobe "gut vermischt" hat, da in der Kurve keine Struktur zu sehen ist:

Um den Code auszuführen, muss Python mit Theano- und PyMC3-Paketen installiert sein.

Vielen Dank an @ w-huber für seine großartige Antwort und seine Kommentare!

Hier ist mein Versuch, die Daten anzupassen, die Ergebnisse mit VGAM auszuwerten und zu untersuchen:

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

In unserem Fall lautet die Nullhypothese von Chi square, dass die Daten gemäß dem zipf-Gesetz verteilt werden. Daher stützen größere p-Werte die Behauptung, dass die Daten gemäß diesem Gesetz verteilt werden. Beachten Sie, dass selbst sehr große p-Werte kein Beweis sind, sondern nur ein Indikator.

$x = 1$$\hat{w_{x=1}}$

$\hat{w_{x=1}} = 0.4695599775$

Auch hier liefert die UWSE nur eine konsistente Schätzung - keine Konfidenzintervalle, und wir können einen gewissen Kompromiss bei der Genauigkeit feststellen. Die oben genannte Lösung von mpiktas ist auch eine Anwendung von UWSE - obwohl Programmierung erforderlich ist. Eine vollständige Erklärung des Schätzers finden Sie unter: https://paradsp.wordpress.com/ - ganz unten.

Meine Lösung soll zu den Antworten von mpiktas und whuber, die eine Implementierung in Python durchführen, komplementär sein. Unsere Frequenzen und Bereiche x sind:

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])

Da unsere Funktion nicht in allen Bereichen definiert ist, müssen wir bei jeder Berechnung überprüfen, ob wir uns normalisieren. Im diskreten Fall besteht eine einfache Annäherung darin, durch die Summe aller y (x) zu dividieren. Auf diese Weise können wir verschiedene Parameter vergleichen.

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)

Das Ergebnis ergibt eine Steigung von 1.450408 wie in den vorherigen Antworten.