.packageName <- "spatialkernel"
## time=(tic_interval, show_delay, from, to)
## fades: 0--no fading, n--n steps of fading
animation<-function(xyt, poly=NULL, win=NULL, time=NULL,
                    fades=0)
{ 
    if(is.null(poly)) {
        xyrng<-apply(xyt[,1:2], 2, range, na.rm=T)
        poly<-cbind(xyrng[c(1,2,2,1),1], xyrng[c(1,1,2,2),2])
    }
    if(is.null(win)){
        polyrng<-apply(poly, 2, range, na.rm=T)
        win<-c(polyrng[1,1:2], polyrng[2,1]-polyrng[1,1], 
               polyrng[2,2]-polyrng[1,2])
    }
    if(is.null(time)){
        trng<-range(xyt[,3], na.rm=T)
        time<-c((trng[2]-trng[1])/10, 1, trng[1], trng[2])
    }
    .C("animation", as.double(xyt), as.integer(dim(xyt)[1]),
       as.double(poly), as.integer(dim(poly)[1]),
       as.double(win), as.double(time), as.integer(fades),
       PACKAGE="spatialkernel")
}
## area of a polygon
## "." in name string may be confused with class method???
areapoly <- function(poly) {
    npoly <- nrow(poly)
    asign <- 1
    ans <- .C("area_poly", as.double(poly), as.integer(npoly),
              area=as.double(0), PACKAGE="spatialkernel")$area
    if(ans < 0) {
        asign <- -1
        ans <- -ans
    }
    invisible(list(area=ans, sign=asign, poly=poly))
}
cvloglk <- function(pts, marks, t = NULL, h)
{
  if(is.null(t)) {
    ans <- cvlogl(pts, marks, h)
  }	else ans <- cvloglp(pts, marks, t, h)
  ans$hcv <- h[which.max(ans$cv)]
  ans
}

## pts[n*2], y[n].
## h[] can be unequally separated values
cvlogl <- function(pts, marks, h)
{
    ##if(exists(".adaptpara", env=.GlobalEnv)) {
    ##    .adaptpara <- get(".adaptpara", env=.GlobalEnv) ##, env=.GlobalEnv)
    ##} else .adaptpara <- get(".adaptpara", env = getNamespace("spatialkernel"))
	adapt <- chkernel()
    n <- length(marks)
    nh <- length(h)
    types <- unique(marks)
    mtypes <- 1:length(types) - 1 ## y must from 0 to m-1
    names(mtypes) <- types
    y <- mtypes[marks]
    c <- NULL
    for(i in 1:nh) c <- cbind(c, rep(1, n))
    ans<-.C("lcn", as.double(pts), as.integer(y), as.integer(n), as.double(h), 
        as.integer(nh), as.integer(adapt$kernel), as.double(c),
        lc=double(nh), PACKAGE="spatialkernel")$lc
    invisible(list(cv=ans, pts=pts, marks=marks, h=h))
}

## pooled cvlogl
cvloglp <- function(pts, marks, t, h)
{
    tt <- sort(unique(t))
    ntt <- length(tt)
    lcp <- rep(0, length(h))
    for(i in 1:ntt) {
        ndx <- which(t==tt[i])
        lcp <- lcp+cvlogl(pts[ndx,], marks[ndx], h)$cv
    }
    invisible(list(cv=lcp, pts=pts, marks=marks, t=t, h=h))
}
##
filled.contour.poly <- function (x = seq(min(poly[,1]), max(poly[,1]), len = nrow(z)),
               y = seq(min(poly[,2]), max(poly[,2]), len = ncol(z)), 
               z, poly, xlim = range(x, finite = TRUE), ylim = range(y, finite = TRUE), 
               zlim = range(z, finite = TRUE), 
               levels = pretty(zlim, nlevels), nlevels = 10,
               color.palette = risk.colors, 
               col = color.palette(length(levels) - 1),
               llevels = levels, labels = NULL, labcex = 0.6,
               drawlabel = TRUE, method = "flattest",
               vfont = c("sans serif", "plain"),
               lcol = par("fg"), lty = par("lty"), lwd = par("lwd"),        
               plot.title, plot.axes, key.title, key.axes, asp = NA, 
               xaxs = "i", yaxs = "i", las = 1, axes = TRUE, ...) 
{
    if(!missing(poly)){
        if (missing(z)) {
            if (!missing(x)) {
                if (is.list(x)) {
                    z <- x$z
                    y <- x$y
                    x <- x$x
                } else {
                    z <- x
                    x <- seq(min(poly[,1]), max(poly[,1]), len = nrow(z))
                }
            } else stop("no `z' matrix specified")
        } else if (is.list(x)) {
            y <- x$y
            x <- x$x
        }
    } else { ## missing poly
        if (missing(z)) {
            if (!missing(x)&&!missing(y)) {
                poly <- y
                if (is.list(x)) {
                    z <- x$z
                    y <- x$y
                    x <- x$x
                } else {
                    z <- x
                    x <- seq(min(poly[,1]), max(poly[,1]), len = nrow(z))
                    y <- seq(min(poly[,2]), max(poly[,2]), len = ncol(z))
                }
            } else stop("no `z' and `poly' matrices specified")
        } else if (is.list(x)) {
            poly <- y
            y <- x$y
            x <- x$x
        }          
    }
    if (any(diff(x) <= 0) || any(diff(y) <= 0)) 
        stop("increasing x and y values expected")
    mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
    on.exit(par(par.orig))
    w <- (3 + mar.orig[2]) * par("csi") * 2.54
    layout(matrix(c(2, 1), nc = 2), widths = c(1, lcm(w)))
    par(las = las)
    mar <- mar.orig
    mar[4] <- mar[2]
    mar[2] <- 1
    par(mar = mar)
    plot.new()
    plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", 
                yaxs = "i")
    rect(0, levels[-length(levels)], 1, levels[-1], col = col)
    if (missing(key.axes)) {
        if (axes) 
            axis(4)
    }
    else key.axes
    box()
    if (!missing(key.title)) 
        key.title
    mar <- mar.orig
    mar[4] <- 1
    par(mar = mar)
    plot.new()
    plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
    if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1) 
        stop("no proper `z' matrix specified")
    if (!is.double(z)) 
        storage.mode(z) <- "double"
    .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), 
                            col = col))
    if (missing(plot.axes)) {
        if (axes) {
            title(main = "", xlab = "", ylab = "")
            axis(1)
            axis(2)
        }
    }
    else plot.axes
    contour(x, y, z, nlevels, levels, labels,
            xlim, ylim, zlim,
            labcex, drawlabel, method,
            vfont, axes = FALSE, frame.plot = FALSE,
            lcol,  lty, lwd, add=T)
    polygon(poly)
    box()
    if (missing(plot.title)) 
        title(...)
    else plot.title
    invisible()
}
## see notes at lambdahat()
## return NA at points outside polygon
kernelhat <- function(dpts, h, poly, win=apply(poly, 2, range),
                      delta=1, edge=TRUE)
{
    adapt <- chkerenl()
    x <- seq(win[1,1]+delta/2, win[2,1], by=delta)
    y <- seq(win[1,2]+delta/2, win[2,2], by=delta)
    nx <- length(x)
    ny <- length(y)
    xygrids <- as.matrix(expand.grid(x=x, y=y))
    ndx <- which(pnpoly(poly, xygrids) > 0)
    ## 0 outside, 1 boundary, 2 inside, -1 error
    pts <- xygrids[ndx,]
    npts <- nrow(pts)
    ndpts <- nrow(dpts)
    res <- rep(NA, nx*ny)
    if(edge)
        c <- adaptpoly(pts, h, poly)$c
    else
        c <- rep(1, npts)
    ans <- .C("hat_lambda_c", as.double(pts), as.integer(npts),
              as.double(dpts), as.integer(ndpts), as.double(h),
              as.integer(adapt$kernel), as.double(c), lam=double(npts),
              PACKAGE="spatialkernel")$lam
    res[ndx] <- ans
    invisible(list(lambda=matrix(res, nrow=nx, ncol=ny), x=x, y=y,
                   dpts=dpts, h=h, poly=poly, win=win, delta=1, edge=edge))
}
"kinhat" <-
function (pts, lambda, poly, s)
{
    ptsx <- pts[, 1]
    ptsy <- pts[, 2]
    npt <- length(ptsx)
    ns <- length(s)
    s <- sort(s)
    np <- length(poly[, 1])
    polyx <- c(poly[, 1], poly[1, 1])
    polyy <- c(poly[, 2], poly[1, 2])
    hkhat <- rep(0, times = ns)
    klist <- .Fortran("dokinhat", as.double(ptsx), as.double(ptsy),
        as.integer(npt), as.double(lambda), as.double(polyx), as.double(polyy),
        as.integer(np), as.double(s), as.integer(ns), as.double(hkhat), 
        PACKAGE="spatialkernel")
    res <- list(k = as.numeric(klist[[10]]), s = s)
}
## kernel density estimation of \hat\lambda
## should be divided by |A| so that N(A) follows a Poisson with mean lambda*|A|
## See Peter (2003), pp47 homogeneous Poisson process definition
lambdahat<-function(pts, h, gpts=NULL, poly=NULL, edge=TRUE)
{
  adapt <- chkernel()
  npts <- nrow(pts)
  if(is.null(gpts)) { ##Baddeley's modified version
	if(edge) c <- adaptpoly(pts, h, poly)$c else c <- rep(1, npts)
    ans <- .C("hat_lambda_b", as.double(pts), as.integer(npts),
            as.double(h), as.integer(adapt$kernel), as.double(c),
            lam=double(npts), PACKAGE="spatialkernel")$lam
  } else {
    ngpts <- nrow(gpts)
    if(edge) c <- adaptpoly(gpts, h, poly)$c else c <- rep(1, ngpts)
    ans <- .C("hat_lambda_c", as.double(gpts), as.integer(ngpts),
            as.double(pts), as.integer(npts), as.double(h),
            as.integer(adapt$kernel), as.double(c), lam=double(ngpts),
            PACKAGE="spatialkernel")$lam
  }
  invisible(list(lambda=ans, pts=pts, gpts=gpts, poly=poly, h=h, edge=edge))
}

adaptpoly<-function(pts, h, poly) 
{
    c1 <- 10; eps <- 0.0001; mcalls <- 10000
    adapt <- chkernel()
	if(adapt$kernel==1) c2 <- 20 else c2 <- 1
    rng <- c(range(poly[,1]), range(poly[,2]))
    if(is.null(nrow(pts))) npts <- 1 else npts <- nrow(pts)
    ans<-.C("adaptpoly", as.double(poly), as.integer(nrow(poly)), as.double(pts),
            as.integer(npts), as.double(h), as.integer(adapt$kernel),
            as.double(c1), as.double(c2), as.double(rng),
            as.double(eps), err=double(npts), as.integer(mcalls),
            ncalls=integer(npts), ier=integer(6), c=double(npts),
			PACKAGE="spatialkernel")
    invisible(list(c=ans$c, err=ans$err, ncalls=ans$ncalls, ier=ans$ier,
        pts=pts, h=h, poly=poly))
}
##Monte Carlo test of change of pattern over time (marks)
mcpat.test <- function(pts, marks, t, h, ntest=100, proc=TRUE)
{
    p2k <- function(p, r) { ## find k, sum_{j=1}^{k-1} p_j < r <= sum_{j=1}^k
        k <- 1
        pa <- p[1]
        while(r>pa) {
            k <- k+1
            pa <- pa+p[k]
        }
        k
    }
    
    tpfun <- function(p){
        sum(apply(p, 3, function(x) sum((x-apply(p, c(1,2), mean))^2)))
    }
        
    n <- length(marks)
    mtypes <- sort(unique(marks))
    m <- length(mtypes)
    tt <- sort(unique(t))
    ntt <- length(tt)
    ps <- array(NA, dim=c(n, m, ntt), dimnames = list(NULL, mtypes, NULL)) 
    tp <- NULL
    nh <- length(h)
    if(nh > 1) {
      lcp1 <- cvloglp(pts, marks, t, h)$cv
      hopt <- h[which.max(lcp1)]
    } else hopt <- h
    for(i in 1:ntest){
        if(proc) cat("\rProcessing No.", i, "out of", ntest)
        if(i==1) {
            y1 <- marks
        } else {
            runifn <- runif(n, min=0, max=1)
            for(j in 1:n) {
                y1[j] <- mtypes[p2k(p0[j,], runifn[j])]
            }
        }
        for(j in 1:ntt) {
            ndx <- which(t==tt[j])
            ps[,,j] <- phat(pts, pts[ndx,], y1[ndx], hopt)$p[, mtypes]
        }
        if(i==1) {
            p0 <- apply(ps, 1:2, mean) ## mean of p_j(x, t) over t
        }
        tp <- c(tp, tpfun(ps))
    }
    pv <- (ntest+1-rank(tp)[1])/ntest
    ##pv1 <- (ntest-rank(tp[2:ntest])[1])/(ntest-1)
    invisible(list(pvalue=pv, pts=pts, marks=marks, t=t, h=h, ntest=ntest))
}
##spatial variation in the risk surface between different types
##return pointwise tolerance limits (PTLs) for plotting
mcseg.test <- function(pts, marks, h, stpts=NULL, ntest=100, proc=TRUE)
{
    adapt <- chkernel()
    ynames <- unique(marks)
    m <- length(ynames)
    ynames0 <- 1:m - 1
    names(ynames0) <- ynames
    y1 <- ynames0[as.character(marks)]
    nh <- length(h)
    stat<-rep(0, ntest)
    n <- length(y1)
    if(!is.null(stpts)) {
        nstpts <- nrow(stpts)
        tct <- matrix(NA, nrow=nstpts*m, ncol=ntest) ## m types????
    }
    c <- matrix(1, nrow=n, ncol=nh)
    alpha <- table(y1)/n
    for(i in 1:ntest){
        if(proc) cat("\rProcessing No.", i, "out of", ntest) 
        if(i==1) y2 <- y1 else y2 <- y1[sample(1:n)]
        if(nh > 1) {
            lcc <- .C("lcn", as.double(pts), as.integer(y2), as.integer(n),
                  as.double(h), as.integer(nh), as.integer(adapt$kernel),
                  as.double(c), lc=double(nh),
                  PACKAGE="spatialkernel")$lc
            ##ophndx <- which(lcc==max(lcc, na.rm=TRUE))
            ##oph <- h[ophndx[1]]
            oph <- h[which.max(lcc)]
        } else oph <- h
        p <- .C("hatpn", as.double(pts), as.integer(n), as.double(pts),
                as.integer(y2), as.integer(n), as.double(oph),
                as.integer(adapt$kernel),
                as.double(c), as.integer(m), p=double(n*m),
                PACKAGE="spatialkernel")$p
        p <- matrix(p, ncol=m)
        stat[i] <- sum(apply(p, 1, function(x) sum((x-alpha)^2)))
        if(!is.null(stpts)) {
            p <- .C("hatpn", as.double(stpts), as.integer(nstpts), as.double(pts),
                    as.integer(y2), as.integer(n), as.double(oph),
                    as.integer(adapt$kernel),
                    as.double(c), as.integer(m), p=double(nstpts*m),
                    PACKAGE="spatialkernel")$p
            tct[,i] <- (p-rep(alpha, each=nstpts))
        }
    }
    pv <- (ntest+1-rank(stat)[1])/ntest
    if(!is.null(stpts)) {
        pvtc <- apply(tct, 1, function(x) (ntest+1-rank(x)[1])/ntest)
        pvtc <- matrix(pvtc, ncol=m, dimnames = list(NULL, ynames))
        invisible(list(pvalue=pv, stpvalue=pvtc, pts=pts, marks=marks,
                       h=h, stpts=stpts, ntest=ntest))
    } else {
        invisible(list(pvalue=pv, pts=pts, marks=marks, h=h,
                       ntest=ntest))
    }
}
##"shift" factor to shift away from the rect legend default=1
metre <- function(xl, yb, xr, yt, lab, cols = risk.colors(length(lab) - 1),
                  shift = 0, cex = 1)
{
    n <- length(lab)-1
    dx <- xr-xl
    dy <- yt-yb
    dxy <- max(dx, dy)/n ##increasing step
    drift <- min(xr-xl, yt-yb)*shift
    if(dx>dy) {
        rect(xl+(1:n-1)*dxy, yb, xl+(1:n)*dxy, yt, col=cols)
        text(xl+(0:n)*dxy, yb-drift, lab, cex=cex, pos=1)
    } else {
        rect(xl, yb+(1:n-1)*dxy, xr, yb+(1:n)*dxy, col=cols)
        text(xr+drift, yb+(0:n)*dxy, lab, cex=cex, pos=4)
    }
	return()
}
package.version <- function(all.available=FALSE, lib.loc=NULL)
{
    ##if(is.null(pkg))
    pkg <- .packages(all.available, lib.loc)
    if(is.null(lib.loc)) libpath <- .Library
    pkgs <- NULL
    vers <- NULL
    for(i in pkg) {
        verline <- NULL
        dnm <- paste(libpath, "/", i, sep="")
        flnm <- paste(dnm, "/DESCRIPTION", sep="")
        if(!file.exists(dnm)) {
            cat("\n", i, "not exists.")
            next
        } else if(!file.exists(flnm)) {
            cat("\nDESCRIPTION for", i, "not found.")
            next
        }
        chlines <- readLines(con=flnm, n=-1, ok=TRUE)
        for(j in chlines) 
            verline <- paste(verline, grep("version:", j, ignore.case=T, value=T))
        version <- gsub("Version: ", "", verline, ignore.case=TRUE)
        version <- gsub(" ", "", version)
        cat("\nVersion of", i, ":", version)
        pkgs <- c(pkgs, i)
        vers <- c(vers, version)
    }
    cat("\n")
    invisible(list(package=pkgs, version=vers))
}
## {y}={0,1,2,..,m-1} converted inside
## calculate phat at point pts
phat<-function(gpts, pts, marks, h)
{
    adapt <- chkernel()
    ngpts <- length(gpts)/2 ## NO. of points
    n <- length(marks)
    ynames <- names(table(marks))
    m <- length(ynames)
    ynames0 <- 1:m -1 
    names(ynames0) <- ynames
    yy <- ynames0[as.character(marks)]
    c <- rep(1, ngpts)
    ans<-.C("hatpn", as.double(gpts), as.integer(ngpts), as.double(pts),
            as.integer(yy), as.integer(n), as.double(h), 
            as.integer(adapt$kernel),
            as.double(c), as.integer(m), p=double(ngpts*m),
            PACKAGE="spatialkernel")$p
    ans <- matrix(ans, ncol=m, dimnames=list(NULL, ynames))
    invisible(list(p=ans, pts=pts, gpts=gpts, marks=marks, h=h))
}
## -1 outside; 0 on boundary; 1 inside
## number of poly points more than 3000--error
## return values change to -1-error, 0-outside, 1-boundary, 2-inside
pinpoly<-function(poly, pts)
{
    if(nrow(poly)>3000) {
        cat("\nBoundary polygon vertices number exceeds 3000.\n")
        return(-1)
    }
    if(is.matrix(pts)){
        ans<-.Fortran("psnpoly", as.double(pts[,1]), as.double(pts[,2]),
                      as.integer(nrow(pts)), as.double(poly[,1]), as.double(poly[,2]),
		      as.integer(nrow(poly)), 
                      inout=integer(nrow(pts)), PACKAGE="spatialkernel")$inout
    }else{
        ans<-.Fortran("pnpoly", as.double(pts[1]), as.double(pts[2]),
                      as.double(poly[,1]), as.double(poly[,2]), as.integer(nrow(poly)), 
                      inout=as.integer(0), PACKAGE="spatialkernel")$inout
    }
    ans + 1
}
risk.colors <- function(n)
{
    j <- n%/%4
    c(rgb(0.86*(1:j)/j, 0, 0), 
      rainbow(n-2*j, start=1/20,end=1/7),
      hsv(h = 1/6,s = seq(from = 1 - 1/(2 * j), to = 1/(2 * j), length = j), v = 1))[n:1]
}

## 1--gaussian; 2--quadratic(Epanechnikov); 3--quartic; 
.adaptpara <- list(kernel = 1, PACKAGE="spatialkerenl")
kernames <- c("gaussian", "epanechnikov", "quartic")
ker4names <- c(kernames, "quadratic") ## equal to "ep"

## check .adaptpara in .GlobalEnv for existence and validation 
chkernel <- function()
{ 
  if(exists(".adaptpara", env=.GlobalEnv)) {
    chk <- FALSE
    adapt <- get(".adaptpara", env=.GlobalEnv)
	if(is.list(adapt)) {
	  if(adapt$PACKAGE != "spatialkerenl") chk = TRUE
	} else chk = TRUE
	if(chk) {
	  stop("\n.adaptpara is reserved for spatialkernel internal usage.\n") 
    }
  } else {
    adapt <- get(".adaptpara", env = getNamespace("spatialkernel"))
  }
  adapt
}
	  
setkernel <- function(kernel=NULL)
{
  adapt <- chkernel()
  if(is.null(kernel)) {
    kf <- kernames[adapt$kernel]
  } else {
    kernel <- tolower(kernel)
    kernel <- match.arg(kernel, ker4names)
    adapt$kernel = switch(kernel,
	  gaussian = 1,
	  quadratic = 2,
	  epanechnikov = 2,
	  quartic = 3)
    assign(".adaptpara", adapt, env=.GlobalEnv)
    kf <- kernel
  }
  kf
}
##use data within a polygon 
##select bandwidth, calculate phat, and do MC test 
##opt=1,2,3 to do task one, two or three
spseg <- function(pts, marks, h, opt=2, ntest=100, poly=NULL, 
  delta=min(apply(apply(pts, 2, range), 2, diff))/100, proc=TRUE)
{
    if(!(opt %in% 1:3)) stop("\nargument opt must be one of 1, 2, or 3.\n")
    ans <- list(pts=pts, marks=marks, h=h, opt=opt)
    ## opt==1
    if(length(h) > 1) {
      if(proc) cat("\nCalculating cross-validated likelihood function\n")
      cv <- cvlogl(pts, marks, h)$cv
      hopt <- h[which.max(cv)]
      ans <- c(list(cv=cv, hcv=hopt), ans)
    } else {
      hopt <- h ## for opt=2, phat
    }
    if(opt >= 2) { ##phat and mcseg.test
      if(!is.null(poly)) ans$poly <- poly
      ## opt==2
      if(proc) cat("\nCalculating type-specific probabilities\n")
      mtypes <- unique(marks)
      m <- length(mtypes)
      if(is.null(poly)) {
        xyrng <- apply(pts, 2, range)
      } else xyrng <- apply(poly, 2, range)
      gridxy <- list(gridx=seq(xyrng[1,1]+delta/2, xyrng[2,1]-delta/2, by=delta),
        gridy=seq(xyrng[1,2]+delta/2, xyrng[2,2]-delta/2, by=delta))
      gridpts <- as.matrix(expand.grid(gridxy))
      ngrid <- nrow(gridpts)
      if(is.null(poly)) gridndx <- rep(TRUE, 1:ngrid) else 
        gridndx <- which(pinpoly(poly, gridpts)>0)
      p <- matrix(NA, ncol=m, nrow=ngrid)
      tmp <- phat(gridpts[gridndx,], pts, marks, hopt)$p
      p[gridndx,] <- tmp; colnames(p) <- colnames(tmp)
      ans <- c(gridxy, list(p=p), ans)
      if(opt==3) {
        ## opt==3
        if(proc) cat("\nMonte Carlo testing\n")
        stp <- matrix(NA, ncol=m, nrow=ngrid)
        mc <- mcseg.test(pts, marks, h, stpts=gridpts[gridndx,], 
          ntest=ntest, proc=proc)[c("pvalue", "stpvalue")]
        stp[gridndx,] <- mc$stpvalue; colnames(stp) <- colnames(mc$stpvalue)
        ans <- c(list(pvalue=mc$pvalue, stpvalue=stp, ntest=ntest), ans)
      }
    }
    if(proc) cat("\n")
    ans
}

plotcv <- function(obj, ...) plot(obj$h, obj$cv, type="l", ...)

plotphat <- function(obj, types=unique(obj$marks), sup=TRUE, col=risk.colors(10), 
    breaks=seq(0,1,length=length(col)+1), ...) 
{
    if(obj$opt<=1) stop("\nRun phatmctest() with argument opt=2 or 3.\n")
    sapply(types, function(x) match.arg(x, unique(obj$marks)))
    m <- length(types)
    for(j in 1:m) {
        if(is.null(obj$poly)) {
            plot(obj$pts[1,], xlab="", ylab="", xlim=range(pts[,1]), ylim=range(pts[,2]),
                 asp=1, main=types[j], type="n")
        } else {
            plot(obj$pts[1,], xlab="", ylab="", xlim=range(obj$poly[,1]), 
                 ylim=range(obj$poly[,2]), asp=1, main=types[j], type="n")
        }
        image(obj$gridx, obj$gridy, matrix(obj$p[,types[j]], ncol=length(obj$gridy)), 
              zlim=0:1, add=TRUE, col=col, breaks=breaks) 
        if(!is.null(obj$poly)) {
            polygon(obj$poly)
            if(sup) {
                ndx <- which(obj$marks == types[j]) ##not gridpts, pts!!!
                points(obj$pts[ndx,], ...)
            }
        }
        if(m>1 && j<m && interactive()) readline("\nPress Enter to plot next one ...")
    }
}

plotmc <- function(obj, types=unique(obj$marks), quan=c(0.05, 0.95), sup=FALSE, 
    col=risk.colors(10), breaks=seq(0,1,length=length(col)+1), ...) 
{
    if(obj$opt<=2) stop("\nRun phatmctest() with argument opt=3 first.\n")
    sapply(types, function(x) match.arg(x, unique(obj$marks)))
    m <- length(types)
    for(j in 1:m) {
        if(is.null(obj$poly)) {
            plot(obj$pts[1,], xlab="", ylab="", xlim=range(pts[,1]), ylim=range(pts[,2]),
                 asp=1, main=types[j], type="n")
        } else {
            plot(obj$pts[1,], xlab="", ylab="", xlim=range(obj$poly[,1]), 
                 ylim=range(obj$poly[,2]), asp=1, main=types[j], type="n")
        }
        image(obj$gridx, obj$gridy, matrix(obj$p[,types[j]], ncol=length(obj$gridy)), 
              zlim=0:1, add=TRUE, col=col, breaks=breaks)
        if(!is.null(quan)) {
            contour(obj$gridx, obj$gridy,
                    matrix(obj$stpvalue[,types[j]], ncol=length(obj$gridy)),
                    levels=quan, add=TRUE, ...)
        } 
        if(!is.null(obj$poly)) {
            polygon(obj$poly)
            if(sup) {
                ndx <- which(obj$marks == types[j]) ##not gridpts, pts!!!
                points(obj$pts[ndx,], ...)
            }
        }
        if(m>1 && j<m && interactive()) readline("\nPress Enter to plot next one ...")
    }
}
## {y}={0,1,2,..,m-1} converted inside
## calculate var(phat) at point pts

##return NAs at points outside polygon???
varphat<-function(pts, dpts, y, p, h)
{
    npts <- length(pts)/2
    n <- length(y)
    ynames <- names(table(y))
    m <- length(ynames)
    ynames0 <- c(0:(m-1))
    names(ynames0) <- ynames
    yy <- ynames0[as.character(y)]
    c <- rep(1, npts)
    wrksp <- rep(0, n)
    ans<-.C("varphat", as.double(pts), as.integer(npts), as.double(dpts),
            as.integer(yy), as.double(p), as.integer(n), as.double(h), as.integer(1),
            as.double(c), as.integer(m), as.double(wrksp), varp=double(npts*m),
	    PACKAGE="spatialkermel")$varp
    ans <- matrix(ans, ncol=m, dimnames=list(NULL, ynames))
    invisible(list(pvar=ans, pts=pts, dpts=dpts, y=y, h=h))
}
.noGenerics <- TRUE

.onLoad <- function(libname, pkgname) 
{
    chkernel()
    library.dynam("spatialkernel", pkgname, libname)
}

.onAttach <- function(libname, pkgname)
{
    desfile <-  file.path(libname, pkgname, "DESCRIPTION",
                          fsep = .Platform$file.sep)
    verline <- readLines(desfile, n=2, ok=TRUE)[[2]]
    version <- gsub("Version: ", "", verline, ignore.case=TRUE)
    cat("\nThis is", pkgname, version, "\n\n")
}

.onUnload <- function(libpath)
    library.dynam.unload("spatialkernel", libpath)
