rparameterslog-likelihood

parameter optimisation in Hawkes Point Process in R


I have a data set with 1,000 of people some of which know each other and others do not. I am trying to predict using a hawkes point process which individuals (or nodes) will adopt a behaviour. The issue is I am attempting to optimise the parameters. I am assuming the edge list of who knows who is the alpha input into Hawkes, that lambda is a constant background value for all nodes and its the decay function beta I am trying to calculate.

I have this as an example, which runs but not certain this is the correct way to calculate this parameter?


library(hawkes)


#Multivariate Hawkes process - with 10 nodes
lambda0<-c(rep(0.2,10)) # set to constant to assume background intensity is equal for all nodes
alpha<-matrix(c(0.05,0.05,0,0.05,0,0.05,0.05,0,0,0.05, # matrix of who knows who 0.05 indicating a link 0 no link
                0.05,0.05,0,0,0,0,0,0,0,0,
                0,0,0.05,0,0,0,0,0,0,0,
                0.05,0,0,0.05,0,0,0,0,0,0,
                0,0,0,0,0.05,0,0,0,0,0,
                0.05,0,0,0,0,0.05,0,0,0,0,
                0.05,0,0,0,0,0,0.05,0,0,0,
                0,0,0,0,0,0,0,0.05,0,0,
                0,0,0,0,0,0,0,0,0.05,0,
                0.05,0,0,0,0,0,0,0,0,0.05
                ),byrow=TRUE,nrow=10) 
beta<-c(rep(0.7,10)) # set the initial values of beta to be able to generate some random history of events
history<-simulateHawkes(lambda0,alpha,beta,3600) # within 1 hour random generation of events for the 10 nodes


nloglik_bi_hawkes <- function(params, history){
beta <- c(params[1], params[2],params[3], params[4],params[5], params[6],params[7], params[8],params[9], params[10]) # in my real data I may have 1,000 of nodes so may need to optimise beta for more than 10.
return(likelihoodHawkes(lambda0, alpha, beta, history))
}



params_hawkes <- optim(c(rep(1,10)), nloglik_bi_hawkes, history = history) # to store the values of beta


Solution

  • A few points:

    Thus we have

    library(hawkes)
    set.seed(123)
    
    lambda0 <- rep(0.2,10)
    alpha<-matrix(c(0.05,0.05,0,0.05,0,0.05,0.05,0,0,0.05, 
                    0.05,0.05,0,0,0,0,0,0,0,0,
                    0,0,0.05,0,0,0,0,0,0,0,
                    0.05,0,0,0.05,0,0,0,0,0,0,
                    0,0,0,0,0.05,0,0,0,0,0,
                    0.05,0,0,0,0,0.05,0,0,0,0,
                    0.05,0,0,0,0,0,0.05,0,0,0,
                    0,0,0,0,0,0,0,0.05,0,0,
                    0,0,0,0,0,0,0,0,0.05,0,
                    0.05,0,0,0,0,0,0,0,0,0.05
                    ),byrow=TRUE,nrow=10) 
    beta <- rep(0.7,10)
    history <- simulateHawkes(lambda0, alpha, beta, 3600)
    
    fm <- optim(rep(1, 10), likelihoodHawkes, method = "BFGS",
      lambda0 = lambda0, alpha = alpha, history = history)
    fm
    

    giving:

    $par
     [1] 0.2656976 0.1371221 0.6215783 0.1425127 0.4481591 0.1409979 0.1428707
     [8] 0.7836967 0.6930492 0.1490555
    
    $value
    [1] 15793.9
    
    $counts
    function gradient 
         105       26 
    
    $convergence
    [1] 0
    
    $message
    NULL