Come calcolare il coefficiente di legge di Zipf da una serie di frequenze massime?

Ho diverse frequenze di interrogazione e ho bisogno di stimare il coefficiente della legge di Zipf. Queste sono le frequenze migliori:

26486
12053
5052
3033
2536
2391
1444
1220
1152
1039

Aggiornamento Ho aggiornato il codice con lo stimatore della massima probabilità secondo il suggerimento di @whuber. Ridurre al minimo la somma dei quadrati delle differenze tra le probabilità teoriche dei registri e le frequenze dei registri, anche se fornisce una risposta, sarebbe una procedura statistica se si potesse dimostrare che si tratta di un qualche tipo di stimatore M. Purtroppo non sono riuscito a pensare a nessuno che potesse dare gli stessi risultati.

Ecco il mio tentativo. Calcolo i logaritmi delle frequenze e provo ad adattarli ai logaritmi delle probabilità teoriche fornite da questa formula . Il risultato finale sembra ragionevole. Ecco il mio codice 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

La migliore misura quadratica quindi è .$s=1.47$

La massima verosimiglianza in R può essere eseguita con la mlefunzione (dal stats4pacchetto), che calcola utile errori standard (se viene fornita la funzione di verosimiglianza massima negativa corretta):

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 

Ecco il grafico dell'adattamento nella scala log-log (sempre come suggerito da @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)

La linea rossa indica la somma dei quadrati, la linea verde indica la massima probabilità.

Ci sono diversi problemi davanti a noi in qualsiasi problema di stima:

1. Stimare il parametro

2. Valutare la qualità di tale stima.

3. Esplora i dati.

4. Valuta la vestibilità.

Per coloro che userebbero metodi statistici per la comprensione e la comunicazione, il primo non dovrebbe mai essere fatto senza gli altri.

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

$i$$1$$n$

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

Quindi la probabilità di log per i dati è

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

Data la natura della legge di Zipf, il modo giusto per rappresentare graficamente questo adattamento è su un diagramma log-log , dove l'adattamento sarà lineare (per definizione):

Per valutare la bontà di adattamento ed esplorare i dati, esaminare i residui (dati / adattamento, assi dei log-log):

$\chi^2 = 656.476$

Poiché i residui appaiono casuali, in alcune applicazioni potremmo accontentarci di accettare la Legge di Zipf (e la nostra stima del parametro) come una descrizione accettabile sebbene approssimativa delle frequenze . Questa analisi mostra, tuttavia, che sarebbe un errore supporre che questa stima abbia un valore esplicativo o predittivo per il set di dati esaminato qui.

$s$

Uno dei linguaggi di programmazione probabilistica come PyMC3 rende questa stima relativamente semplice. Altre lingue includono Stan, che ha grandi funzionalità e community di supporto.

Ecco la mia implementazione Python del modello adattato ai dati degli OP (anche su 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$

Per fornire alcune diagnostiche di base sul campionamento, possiamo vedere che il campionamento "si mescolava bene" poiché non vediamo alcuna struttura nella traccia:

Per eseguire il codice, è necessario installare Python con i pacchetti Theano e PyMC3 installati.

Grazie a @ w-huber per la sua ottima risposta e commenti!

Ecco il mio tentativo di adattare i dati, valutare ed esplorare i risultati usando 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

Nel nostro caso, l'ipotesi nulla di Chi square è che i dati siano distribuiti secondo la legge di zipf, quindi valori p più alti supportano l'affermazione che i dati sono distribuiti in base ad essi. Si noti che anche valori p molto grandi non sono una prova, ma solo un indicatore.

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

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

Ancora una volta, UWSE fornisce solo una stima coerente, senza intervalli di confidenza e possiamo vedere un certo compromesso in termini di precisione. La soluzione di mpiktas sopra è anche un'applicazione dell'UWSE, sebbene sia necessaria la programmazione. Per una spiegazione completa dello stimatore, consultare: https://paradsp.wordpress.com/ - fino in fondo.

La mia soluzione cerca di essere complementare alle risposte fornite da mpiktas e whuber facendo un'implementazione in Python. Le nostre frequenze e gamme x sono:

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

Poiché la nostra funzione non è definita in tutte le gamme, dobbiamo verificare che ci stiamo normalizzando ogni volta che la calcoliamo. Nel caso discreto, una semplice approssimazione è dividere per la somma di tutti y (x). In questo modo possiamo confrontare diversi parametri.

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)

Il risultato ci dà una pendenza di 1.450408 come nelle risposte precedenti.