https://github.com/cran/RandomFields
Raw File
Tip revision: af7aa2881d9fd941be5411589f41ac2ed9d24e57 authored by Martin Schlather on 11 March 2011, 00:00:00 UTC
version 2.0.45
Tip revision: af7aa28
modelling.R
Kriging <- function(krige.method, x, y=NULL, z=NULL, T=NULL,
                    grid, gridtriple=FALSE,
                    model, param, given, data, trend=NULL,            
                    pch=".", return.variance=FALSE,
                    allowdistanceZero = FALSE, cholesky=FALSE) {
  ## currently only univariate Kriging possible
 
  ##  MINV <<- NULL
  SOLVE <- if (cholesky) {
    function(M, v) {
      ##    Print("cholesky!")
      if (missing(v)) chol2inv(chol(M)) else chol2inv(chol(M)) %*% v
    }
  } else solve
  
  silent = TRUE
  nuggetrange <- 1e-15 + 2 * RFparameters()$nugget.tol
  krige.methodlist <- c("S", "O", "U", "I")
  krige.method.nr <- pmatch(krige.method, krige.methodlist)
 
  given <- as.matrix(given)
  ngiven <- as.integer(nrow(given)) ## number of given points
  xdim <- as.integer(ncol(given))
  
  if (is.na(krige.method.nr))
    stop(paste("kriging method not identifiable from the list.",
               "Possible values are", paste(krige.methodlist,
                                            collapse = ",")))

  x <- CheckXT(x = x, y = y, z = z, T = T, grid = grid,
               gridtriple = gridtriple)
  y <- z <- NULL
  time.used <- (!is.null(x$T))
  if (x$spacedim + x$Time != xdim)
    stop("dimensions of the kriged points and the given points do not match")
  pm <- PrepareModel(model=model, param=param, trend=trend)
  vdim <- .Call("CheckModelIntern", pm$model, xdim, xdim,
                TRUE,  ## stationary !
                PACKAGE="RandomFields")

  data <- as.double(data)
  repet <- length(data) / (vdim *  ngiven)
  if (repet != as.integer(repet)) {
    Print(length(data), vdim, ngiven)
    stop("number of data not a multiple of the number of locations")
  }
  storage.mode(repet) <- "integer"
 
  dim(data) <- c(ngiven, vdim, repet)
  tgiven <- t(given)
  storage.mode(tgiven) <- "double"
 

  pos <- integer(ngiven)
  ## lexicographical ordering of vectors --- necessary to check
  ## whether any location is given twice, but with different value of
  ## the data
  .C("Ordering", tgiven, as.integer(ngiven), xdim,
     pos, PACKAGE = "RandomFields", DUP = FALSE)
  pos <- pos + 1

  
  ## are locations given twice with different data values?
  check <- tgiven[ , pos, drop = FALSE]
  if (any(dup <- c(FALSE, colSums(abs(check[, -1, drop = FALSE] -
                                      check[, -ngiven, drop = FALSE])) == 0))) {

  #  Print("dup")
    
    if (allowdistanceZero) {
      tgiven[1, dup] <- check[1, dup] + rnorm(n=sum(dup), 0, nuggetrange)
      data <- data[pos, , , drop = FALSE]
    } else {
      data <- data[pos, , , drop = FALSE] # pos is recysled if vdim > 1
      if (any(data[dup, , ] != data[c(dup[-1], FALSE), , ]))
        stop("duplicated conditioning points with different data values")
      tgiven <- tgiven[, !dup, drop = FALSE]
      data <- data[!dup, , drop = FALSE]
      ngiven <- as.integer(ncol(given)) ## may some point had been deleted
      stop("duplicated values not allowed")
    }
  }

  notna <- as.vector(apply(is.finite(data), 1:2, all))
#  Print(notna)
  data <- data[notna]
  dim(data) <- c(length(data) / vdim / repet, vdim, repet)

  
 # Print(length(data), dim(data))
  
  x$x <- as.matrix(x$x)
  if (grid) {
    zz <- as.matrix(cbind(x$x, x$T))
    xlist <- mapply(seq, zz[1,], zz[2,], zz[3,], SIMPLIFY=FALSE)
    dimension <- sapply(xlist, length)
    ## 'x' will be used in apply within kriging
    x <- as.matrix(do.call(expand.grid, xlist))
  }
  else if (time.used)
    x <- cbind(matrix(rep(t(x$x),times=length(seq(x$T[1],x$T[2],x$T[3]))),
                      ncol=ncol(x$x), byrow=TRUE),
               rep(seq(x$T[1],x$T[2],x$T[3]), each=nrow(x$x)))
  else x <- x$x

  nx <- nrow(x)
  storage.mode(x) = "double"
  dimgiven <- as.integer(dim(tgiven))
  ngvdim <- ngiven * vdim
  covmatrix <- double(ngvdim^2)

#  Print( ngiven , vdim, dimgiven, ngvdim)

#  Print(matrix(vd, nr=3))

  
  ## works also for variograms and returns -(gamma(x_i-x_j))_{ij}
  .C("CovMatrixIntern", tgiven, as.integer(FALSE), ngiven, covmatrix,
       PACKAGE="RandomFields", DUP = FALSE)
  dim(covmatrix) <- c(ngvdim, ngvdim)
  covmatrix <- covmatrix[notna, notna]


 #  Print(dim(covmatrix), covmatrix[1:10, 1:10], notna, ngvdim, ngiven, vdim)
 
 
  if(class(trend)=="formula")  {
    fo <- as.list(trend)[[length(as.list(trend))]]
    functions <- dummy <- functionargs <- NULL
    argnames <-c("x","y","z",paste("X",1:(xdim-time.used),sep=""),"T")
    searchargs <- lapply(argnames, function(x) grep(x, as.character(fo)))
    argsfound <- sapply(searchargs, function(x) length(x)>0)
    functionargs <- argnames[argsfound]
    functionargs <- paste(functionargs, collapse=",")
    while (as.list(fo)[[1]]=="+") {
      dummy <- as.list(fo)
      fo <- dummy[[2]]
      functions <- c(eval(parse(text=paste("2function(",functionargs,") ",
                                  as.character(dummy)[3],sep=""))), functions)
    }
    if (is.null(dummy))
      functions <-
        as.list(c(eval(parse(text=paste("function(", functionargs,") ",
                               as.character(as.list(trend))[3],sep=""))),
                  functions))
    else
      functions <-
        as.list(c(eval(parse(text=paste("function(",functionargs,") ",
                               as.character(dummy)[2],sep=""))), functions))
    trend <- functions
  }
  if(class(trend)=="list")  {
    nfct <- length(trend)
    functiontexts <- as.list(rep("", times = nfct))
    for (j in 1:nfct) {
      variablenames <- variables <- NULL
      if (any(!is.na(match(c("x","y","z"), names(formals(trend[[j]]))))))
        variablenames <-c(c("x","y","z")[1:(xdim - time.used)], if(time.used) "T")
      else variablenames <- c(paste("X",1:(xdim - time.used),sep=""),
                              if(time.used) "T")
      for(i in 1:ncol(x)) {
        variables <-
          cbind(variables, paste(variablenames[i],"=points[,",i,"]",sep=""))
      }
      argmatch <- match(variablenames, names(formals(trend[[j]])))
      args <- paste(variables[!is.na(argmatch)], collapse=",")
      functiontexts[[j]] <- paste("trend[[",j,"]](", args,")", sep="")
      ## functiontexts is a list with entries like
      ## "trend[[1]](x=points[,1],y=points[,2])"
    }
  }
  if(class(trend) == "numeric")  {
    if (as.integer(trend) != trend || trend < 0)
      stop("Trend should be a nonnegative integer.")
    Powers <- as.matrix(do.call("expand.grid", rep(list(0:trend), times=xdim)))
    Powers <- matrix(Powers[rowSums(Powers)<=trend, ], ncol = xdim)
    nfct <- nrow(Powers)
  }
  
  evaltrendfunction <- function(text, trend, functionnumber, points)  {
    points <- as.matrix(points)
    eval(parse(text=text[[functionnumber]]))
  }
  
  res <- double(nx * repet * vdim)
  switch(krige.method.nr, {
    ## simple kriging
    stopifnot(is.null(pm$trend))
    if (is.numeric(trend) && length(trend) == vdim) {
      mean <- trend
    } else {
      stopifnot(is.null(trend))
      mean <- rep(0, vdim)
    }
    mean <- as.double(rep(mean, each = ngiven))
    
    if (return.variance) {
      if (vdim > 1) stop("multivariate version not programmed yet.")
      if (!(is.numeric(try(invcov <- SOLVE(covmatrix), silent = silent)))) {
        stop("Covmatrix is singular")
      }
      
      sigma2 <- double(nx)
      .C("simpleKriging2", tgiven, x, as.double(data - mean), as.double(invcov),
         nx, ngiven, xdim, repet, mean, res, sigma2,
         PACKAGE = "RandomFields", DUP = FALSE)
    } else {
      dim(data) <- c(ngiven * vdim, repet)
      
      if (!(is.numeric(try(invcov <- SOLVE(covmatrix, data - mean),
                             silent = silent)))) {
          Print(covmatrix, pm ,mean, sum(data), dim(data), mean,
                dim(covmatrix), eigen(covmatrix)$values)
          stop("Covmatrix is singular.")
        
      } 
      
   #   Print(data, covmatrix, covmatrix, invcov, notna)
      
      if (!all(notna)) {        
        dummy <- invcov
        invcov <- numeric(ngiven)
        invcov[notna] <- dummy
        rm(dummy)
      }
      
##      MINV <<- invcov
      
      .C("simpleKriging", tgiven, x, as.double(invcov), as.integer(notna),
         nx, ngiven, xdim, repet, mean, res,
         PACKAGE = "RandomFields", DUP = FALSE)
    }
  }, {
    ## ordinary kriging
    stopifnot(is.null(pm$trend) || is.null(trend))
    covmatrix <- rbind(cbind(covmatrix, 1), c(rep(1, ngiven), 0))
    if (vdim > 1) stop("multivariate version not programmed yet.")
    dim(data) <- c(ngiven * vdim, repet)
    if (return.variance) {
      if (!(is.numeric(try(invcov <- SOLVE(covmatrix), silent = silent)))) {
                                        #       Print(covmatrix)
        stop("Covmatrix is singular!")
      }
      sigma2 <- double(nx)
      .C("ordinaryKriging2", tgiven, x, as.double(data), as.double(invcov),
         nx, ngiven, xdim, repet, res, sigma2,
         PACKAGE = "RandomFields", DUP = FALSE)
    }  else  {
#      Print(dim(covmatrix), dim(data), dim(as.matrix(data)),
#              dim( rbind(as.matrix(data), 0) ))
     if (!(is.numeric(try(invcov <- SOLVE(covmatrix, rbind(data, 0)),
                           silent = silent)))) {
        ##       Print(covmatrix)
         stop("Covmatrix is singular .") #
      }
      if (FALSE)
        if (RFparameters()$Print > 3) {
          Print(list("ordinaryKriging", tgiven,
                     x, as.double(invcov), nx,
                     ngiven, xdim, repet,
                     res, PACKAGE = "RandomFields", DUP = FALSE))
          Print("eigen(cov)", covmatrix, covmatrix, eigen(covmatrix),
                RFparameters()$Practical)
        }
      .C("ordinaryKriging", tgiven, x,  as.double(invcov), nx, ngiven, xdim,
         repet, res,
         PACKAGE = "RandomFields", DUP = FALSE)
    }
  }, {
    ## universal kriging
    if (vdim > 1) stop("multivariate version not programmed yet.")
    if(is.na(pmatch(class(trend), c("numeric", "list"))))
      stop(paste("Trend method not identifiable from the list.",
                 "Possible values are numeric, list, formula."))
    if (return.variance) {
      if (!(is.numeric(try(invcov <- SOLVE(covmatrix), silent = silent))))
        stop("covmatrix is singular!")
      sigma2 <- double(nx)
      if (class(trend) == "numeric")   {
        .C("universalKriging4", tgiven, x,
           as.double(data), as.double(invcov), nx, ngiven, xdim, repet, res,
           sigma2,  as.double(t(Powers)), as.integer(nfct),
           PACKAGE = "RandomFields", DUP = FALSE)
      } else {
        Fmatrix <- matrix(double(ngiven*nfct), nrow = ngiven)
        for (j in 1:nfct)
          Fmatrix[,j] <- evaltrendfunction(functiontexts, trend, j, given)
        f_expr <- quote(evaltrendfunction(functiontexts, trend, j,
                                          x[i,,drop=FALSE]))
        i <- integer(1) ##in- and output variable
        j <- integer(1) ##in- and output variable
        .C("universalKriging2", tgiven, x,
           as.double(data), as.double(invcov), nx, ngiven, xdim, repet, res,
           sigma2, as.double(t(Fmatrix)), as.integer(nfct), i, j, f_expr,
           new.env(), PACKAGE = "RandomFields", DUP = FALSE)
      }
    }
    else  {
     dim(data) <- c(ngiven * vdim, repet)
     data_null <- rbind(data, matrix(0.0, nrow=nfct, ncol=repet))
      Fmatrix <- matrix(ncol=nfct, nrow=ngiven)
      if (class(trend) == "numeric")   {
        for(j in 1:nfct)
          Fmatrix[,j] <- apply(as.matrix(tgiven^Powers[j,]), 2, prod)
        KMat <- rbind(cbind(covmatrix,Fmatrix), 
                      cbind(t(Fmatrix), matrix(0.0 ,nrow=nfct, ncol=nfct)))
        if (!(is.numeric(try(invcov <- SOLVE(KMat, data_null, silent=silent)))))
          stop("covmatrix is singular..")
        .C("universalKriging3", tgiven, x,
           as.double(invcov), nx, ngiven, xdim,
           repet, res, as.double(t(Powers)), 
           as.integer(nfct), PACKAGE = "RandomFields", DUP = FALSE)
      }
      else  {
        Fmatrix <- matrix(double(ngiven*nfct), nrow = ngiven)
        for (j in 1:nfct)
          Fmatrix[,j] <- evaltrendfunction(functiontexts, trend, j, given)
        KMat <- rbind(cbind(covmatrix,Fmatrix),
                      cbind(t(Fmatrix), matrix(0.0, nrow=nfct, ncol=nfct))) 
        if (!(is.numeric(try(invcov <- SOLVE(KMat, data_null, silent=silent)))))
          stop("covmatrix is singular...")
        f_expr <- quote(evaltrendfunction(functiontexts, trend, j,
                                          x[i,,drop=FALSE]))
        i <- integer(1)	##in- and output variable
        j <- integer(1) ##in- and output variable
        .C("universalKriging", tgiven, x, as.double(invcov), nx, ngiven, xdim,
           repet, res, as.double(t(Fmatrix)), as.integer(nfct), i, j, f_expr,
           new.env(), PACKAGE = "RandomFields", DUP = FALSE)
      }
    }
  }, {
    ## intrinsic kriging, notation see p. 169, Chiles
   
    if (vdim > 1) stop("multivariate version not programmed yet.")
    if (!(is.numeric(trend)))
      stop("trend should be a number/integer (order k of the intrinsic IRF(k) model)")
    if (return.variance)  {
      ## Inverting CovMatrix and initializing sigma 2
      if (!(is.matrix(try(invcov <- SOLVE(covmatrix), silent = silent))))
        stop("covmatrix is singular .")
      sigma2 <- double(nx)
      inv_expr <- quote(SOLVE(Q))
      ##now: Kriging
      .C("intrinsicKriging2", tgiven, x, as.double(data), as.double(invcov),
         nx, ngiven, xdim, repet, res, sigma2,
         as.double(t(Powers)), as.integer(nfct), inv_expr, new.env(),
         PACKAGE = "RandomFields", DUP = FALSE)
    }
    else  {
      ##Initializing Fmatrix
      Fmatrix <- matrix(double(ngiven*nfct), nrow=ngiven)
      for(j in 1:nfct)
        Fmatrix[ ,j] <- apply(tgiven^Powers[j,], 2, prod)
      KMat <- rbind(cbind(covmatrix,Fmatrix),
                    cbind(t(Fmatrix), matrix(0.0, ncol=nfct, nrow=nfct)))
      dim(data) <- c(ngiven * vdim, repet)
      data_null <- rbind(data, matrix(0.0, ncol=repet, nrow=nfct))
      if (!(is.numeric(try(invcov <- SOLVE(KMat, data_null, silent=silent)))))
        stop("covmatrix is singular !")
      .C("intrinsicKriging", tgiven, x, as.double(invcov), nx, ngiven, xdim,
         repet, res, as.double(t(Powers)), as.integer(nfct),
         PACKAGE = "RandomFields", DUP = FALSE)
    }
  })

  if (grid) {
    dim(res) <- c(dimension, if (vdim>1) vdim, if (repet>1) repet)
  } else {
    if (vdim > 1 || repet > 1)
      dim(res) <- c(nx, if (vdim>1) vdim, if (repet>1) repet)   
  }
  
  if (pch != "") cat("\n")

  return(if (return.variance)
         list(estim = res,
              var = if (grid) array(sigma2, dim = dimension) else sigma2
              )
         else res)
}


CondSimu <- function(krige.method, x, y=NULL, z=NULL, T=NULL,
                     grid, gridtriple=FALSE,
                     model, param, method=NULL,
                     given, data, trend=NULL,
                     n=1, register=0, 
                     err.model=NULL, err.param=NULL, err.method=NULL,
                     err.register=1, 
                     tol=1E-5, pch=".",
                     paired=FALSE,
                     na.rm=FALSE
                     ) {
  op.list <- c("+","*")  
  stopifnot(is.character(krige.method))
  if (is.character(method) && (!is.na(pmatch(method, c("S","O")))))
    stop("Sorry. The parameters of the function `CondSimu' as been redefined. Use `krige.method' instead of `method'. See help(CondSimu) for details")

  x  <- CheckXT(x, y, z, T, grid, gridtriple)
  total <- x$total
  y <- z <- NULL   
  pm <- PrepareModel(model, param, trend, method=method)
  givendim <- ncol(as.matrix(given))
 # Print(givendim, given, x$spacedim, x$Time) 
  if (givendim != x$spacedim + x$Time)
      stop("dimension of coordinates does not match dimension of given data")
 
  ##  krige.mean <- 0 ## pm$mean + err$mean ??
  krige <- pm$model
  krige.trend <- pm$trend
  if (!is.null(krige.trend) && length(krige.trend)!=1 &&!is.numeric(krige.trend)){
    stop("not programmed yet")
  }

  vdim <- .Call("CheckModelIntern", krige, givendim, givendim, TRUE,
                PACKAGE="RandomFields")
  if (vdim > 1) stop("multivariate version not programmed yet")
  

  if (!is.null(err.model)) {
    err <- PrepareModel(err.model, err.param, method=err.method)$model

    if (xor(is.null(pm$method), is.null(err$method)))
      stop("the simulation method must be defined for the data model and the error model or for none of them")

    if (!is.null(err$trend)) stop("trend for the error term not allowed yet")

    krige <-
      if (err[[1]]=="+") {
        if (krige[[1]]=="+") c(krige, err[-1]) else c(err, list(krige))
      } else {
        if (krige[[1]]=="+") c(krige, list(err)) else list("+", err, krige)
      }

 #   Print("CheckModelIntern", krige, givendim, givendim, TRUE,
#                  PACKAGE="RandomFields", err, err.param)
    
    ## just check whether model common model is ok
    vdim <- .Call("CheckModelIntern", krige, givendim, givendim, TRUE,
                  PACKAGE="RandomFields")
    
  }

 # Print(krige)

  simu.grid <- grid
  given <- as.matrix(given)
  if (nrow(given)!=length(data)) {
    cat("dimension of 'given' does not match 'data'")
    return(NA)
  }
  if (na.rm && any(data.idx <- is.na(data))) {
    data <- data[data.idx]
    given <- given[data.idx, , drop=FALSE]
  }
  
  txt <- "kriging in space time dimensions>3 where not all the point ly on a grid is not possible yet"
  ## if 4 dimensional then the last coordinates should ly on a grid

  ## now check whether and if so, which of the given points belong to the
  ## points where conditional simulation takes place
  if (grid) {
    zz <-  cbind(x$x, x$T)
    ind <- 1 + (t(given) - zz[1, ]) / zz[3, ]
    index <-  round(ind)
    endpoints <- 1 + floor((zz[2, ] - zz[1, ]) / zz[3, ])
    outside.grid <- apply((abs(ind-index)>tol) | (index<1) |
                          (index>endpoints), 2, any)   
    if (any(outside.grid)) {
      ## at least some data points are not on the grid
      ## simulate as if there is no grid
      simu.grid <- FALSE
      ll <- NULL ##  otherwise check will give a warning
      l <- ncol(zz)
      if (l>3) stop(txt)
      if (l==1) xx <- matrix(seq(x$x[1], x$x[2], x$x[3]), nrow=1)
      else  eval(parse(text=paste("xx <-  t(as.matrix(expand.grid(",
                         paste("seq(zz[1,", 1:l,
                               "],zz[2,", 1:l,
                               "],zz[3,", 1:l, "])", collapse=","),
                         ")))")))
      eval(parse(text=paste("ll <- c(",
                   paste("length(seq(zz[1,", 1:l, "],zz[2,", 1:l, "],zz[3,", 1:l,
                         "]))",
                         collapse=","),
                   ")")))

      new.index <- rep(0,ncol(index))
      ## data points that are on the grid, must be registered,
      ## so that they can be used as conditioning points of the grid
      if (!all(outside.grid)) {
        new.index[!outside.grid] <- 1 +
          colSums((index[, !outside.grid, drop=FALSE]-1) *
                  cumprod(c(1, ll[-length(ll)])))
      }
      index <- new.index
      new.index <- NULL
    } else {
      ## data points are all lying on the grid     
      z <- GaussRF(x=x$x, T=x$T,  grid=TRUE, model=model, param=param,
                   method=method, n=n, register=register,
                   gridtriple=TRUE, paired=paired)
      ## for all the other cases of simulation see, below
      index <- t(index)
    }
  } else {
    xx <- t(as.matrix(x$x)) ## not a grid
    
    if (!is.null(x$T)) {
      if (ncol(xx) > 2) stop(txt)
      T <- seq(x$T[1], x$T[2], x$T[3])
      ## multiple the xx structure by length of T,
      ## then add first component of T to first part ... last component of T
      ## to last part
      xx <- rbind(matrix(xx, nrow=nrow(xx), ncol=ncol(xx) * length(T)),
                  as.vector(t(matrix(T, nrow=length(T),ncol(xx)))))
    }
    
    ## the next step can be pretty time consuming!!!
    ## to.do: programme it in C
    ##
    ## identification of the points that are given twice, as points to
    ## be simulated and as data points (up to a tolerance distance !)
    ## this is important in case of nugget effect, since otherwise
    ## the user will be surprised not to get the value of the data at
    ## that point
    one2ncol.xx <- 1:ncol(xx)
    index <- apply(as.matrix(given), 1, function(z){
      i <- one2ncol.xx[colSums(abs(xx - z)) < tol]
      if (length(i)==0) return(0)
      if (length(i)==1) return(i)
      return(NA)
    })
  }  
  
  if (!simu.grid) {
    ## otherwise the simulation has already been performed (see above)
    tol <- tol * nrow(xx)
    if (any(is.na(index)))
      stop("identification of the given data points is not unique - `tol' too large?")
    if (any(notfound <- (index==0))) {
      index[notfound] <- (ncol(xx) + 1) : (ncol(xx) + sum(notfound))
    }
    xx <- rbind(t(xx), given[notfound, , drop=FALSE])

    ## hier fehler
    z <- GaussRF(x=xx, grid=FALSE, model=model, param=param,
                 method=method, n=n, register=register, paired=paired)
    xx <- NULL
  }
  if (is.null(z)) stop("random field simulation failed")
  
  if (n==1) {
    ## z values at the `given' locations
    zgiven <- z[index]
    z <- as.vector(z[1:total]) # as.vector is necessary !! Otherwise
    ##                          is not recognized as a vector
    
  } else {
    ## this is a bit more complicated since index is either a vector or
    ## a matrix of dimension dim(z)-1
    zgiven <- matrix(apply(z, length(dim(z)), function(m) m[index]), ncol=n)
    z <- as.vector(apply(z, length(dim(z)), function(m) m[1:total]))
  }

  if (!is.null(err.model)) {
     error <- GaussRF(given, grid=FALSE, model=err.model, param=err.param,
                      method=err.method, n=n, register=err.register,
                      paired=paired)
     if (is.null(error)) stop("error field simulation failed")
     zgiven <- zgiven + as.vector(error)
     error <- NULL
   }

  if (FALSE)  Print(krige.method=krige.method,
              x=x$x, grid=grid,
              model=krige,
              given=given,data=as.vector(data)-zgiven,
              gridtriple=TRUE, pch=pch)

  # zgiven is matrix
  if (FALSE)
    Print(z, krige.method=krige.method,
          x=x$x, grid=grid,
          model=krige,
          given=given,data=as.vector(data)-zgiven,
          gridtriple=TRUE, pch=pch,
          z, is.vector(z), length(z),                    
          Kriging(krige.method=krige.method,
              x=x$x, grid=grid,
              model=krige,
              given=given,data=as.vector(data)-zgiven,
              gridtriple=TRUE, pch=pch))


 # Print(krige, x$x, grid, given, as.vector(data)-zgiven);
  
  z +  Kriging(krige.method=krige.method,
              x=x$x, grid=grid,
              model=krige,
              given=given,data=as.vector(data)-zgiven,
              gridtriple=TRUE, pch=pch)
}
  
back to top