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
A few points:
set.seed
to make the run reproduciblebeta <-
line in the question is equivalent to beta <- params
nloglik_bi_hawkes
function is not really needed since you can pass likelihoodHawkes
directly to optim
. Fixed parameters to it can be passed to optim
and it will forward them.method = "BFGS"
instead.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