linksrm {PtProcess} | R Documentation |
Creates a point process model object with class "linksrm"
.
linksrm(data, gif, marks, params, gmap, mmap, TT)
data |
a data.frame containing the history of the process, denoted below as Ht. It should contain all variables that are required to evaluate the gif function and the mark distribution, though can contain others too. No history is represented as NULL . |
gif |
ground intensity function. At this stage, this can only be linksrm_gif or modifications of that function; see “Details” below. |
marks |
mark distribution. See topic marks for further details. |
params |
numeric vector of all model parameters. |
gmap |
expression , maps the model parameters (params ) into the parameter sub-space of the ground intensity function; see “Details” below. |
mmap |
expression , maps the model parameters (params ) into the parameter sub-space of the mark distribution; see “Details” below. |
TT |
vector of length 2, being the time interval over which the integral of the ground intensity function is to be evaluated. |
The linked stress release model has a slightly peculiar structure which makes it difficult to fit into the mpp
class. While the region should be thought of as a mark, it is completely defined by the function linksrm_gif
, and hence from the programming perspective the region
mark is really tied in with the gif
function. Hence at the moment, the linked stress release model is treated as a special case. There may be other models that could be grouped into this class.
p <- c(-1.5, -1.5, 0.01, 0.03, 2, -0.5, 0.2, 1, 1*log(10), 3) TT <- c(0, 1000) rexptrunc_mark <- function(ti, data, params){ x <- rexp(n=1, params[1]) x[x > params[2]] <- params[2] names(x) <- "magnitude" return(x) } x <- linksrm(data=NULL, gif=linksrm_gif, mark=list(NULL, rexptrunc_mark), params=p, gmap=expression(params[1:8]), mmap=expression(params[9:10]), TT=TT) x <- simulate(x, seed=5) print(logLik(x)) # estimate parameters temp_map <- function(y, p){ # map only gif parameters into model object y$params[1:8] <- p return(y) } # replace linksrm_gif with linksrm1_gif (faster) if (exists('St1')) rm(St1) if (exists('St2')) rm(St2) x$gif <- linksrm1_gif weight <- c(0.1, 0.1, 0.005, 0.005, 0.1, 0.1, 0.1, 0.1) z <- nlm(neglogLik, p[1:8], object=x, pmap=temp_map, hessian=TRUE, gradtol=1e-08, steptol=1e-10, print.level=2, iterlim=500, typsize=weight) param.names <- c("a1", "a2", "b1", "b2", "c11", "c12", "c21", "c22") param.est <- cbind(p[1:8], z$estimate, sqrt(diag(solve(z$hessian)))) dimnames(param.est) <- list(param.names, c("Actual", "Estimate", "StdErr")) print(param.est) # place parameter estimates into model object x <- temp_map(x, z$estimate) # plot ground intensity function par.default <- par(mfrow=c(2,1), mar=c(4.1, 4.1, 0.5, 1)) x$gif <- linksrm_gif plot(x, 1, xlab="") plot(x, 2) par(par.default) # plot "residuals" for each region tau <- residuals(x) par(mfrow=c(2,1)) plot(tau[[1]], ylab="Transformed Time", xlab="Event Number", main="Region 1") abline(a=0, b=1, lty=2, col="red") plot(tau[[2]], ylab="Transformed Time", xlab="Event Number", main="Region 2") abline(a=0, b=1, lty=2, col="red") par(mfrow=c(1,1))