.packageName <- "gstat"
"bpy.colors" <-
function (n = 100, cutoff.tails = 0.1)
{
    n <- as.integer(n[1])
    if (n <= 0)
        return(character(0))

	if (cutoff.tails >= 1 || cutoff.tails < 0)
		stop("cutoff.tails should be in [0, 1]")
	i = seq(0.5 * cutoff.tails, 1 - 0.5 * cutoff.tails, length = n)
    r = ifelse(i < .25, 0, ifelse(i < .57, i / .32 - .78125, 1))
    g = ifelse(i < .42, 0, ifelse(i < .92, 2 * i - .84, 1))
    b = ifelse(i < .25, 4 * i, ifelse(i < .42, 1,
        ifelse(i < .92, -2 * i + 1.84, i / .08 - 11.5)))
    rgb(r, g, b)
}
"bubble" <-
function (data, xcol = 1, ycol = 2, zcol = 3, fill = TRUE, maxsize = 3, 
    do.sqrt = TRUE, pch, col = c(2, 3), key.entries = quantile(data[,zcol]),
	main = ifelse(is.numeric(zcol), names(data)[zcol], zcol),
    identify = FALSE, labels = row.names(data), ...) 
{
    x = data[, xcol]
    y = data[, ycol]
    z = data[, zcol]
    d = data.frame(x = x, y = y)
    if (missing(pch)) 
        pch = ifelse(fill, 16, 1)
    z.col = ifelse(z < 0, col[1], col[2])
    q = key.entries
    q.pch = rep(pch, length(q))
    q.text = as.character(round(q, 3))
    q.col = ifelse(q < 0, col[1], col[2])
    az = abs(z)
    q = abs(q)
    if (do.sqrt) {
		az = sqrt(az)
		q = sqrt(q)
    }
    cex = maxsize * az/max(az)
    q.cex = maxsize * q/max(az)

    if (identify) {
		plot(data[, xcol], data[, ycol], asp = 1, cex = cex, main = main, ...)
		return(identify(data[, xcol], data[, ycol], labels))
	} 
    key = list(space = "right", points = list(pch = q.pch, col = q.col, 
    	cex = q.cex), text = list(q.text))
	xyplot(y ~ x, d, col = z.col, cex = cex, pch = pch, asp = mapasp(d), 
        key = key, main = main, ...)
}
"fit.lmc" <-
function (v, g, model, fit.ranges = FALSE, fit.lmc = !fit.ranges, 
    correct.diagonal = 1.0, ...) 
{
    posdef = function(X) {
        q = eigen(X)
        d = q$values
        d[d < 0] = 0
        q$vectors %*% diag(d) %*% t(q$vectors)
    }
    if (!inherits(v, "gstatVariogram"))
        stop("v should be of class variogram")
    if (!inherits(g, "gstat"))
        stop("g should be of class gstat")
    if (!missing(model)) {
        if (!inherits(model, "variogramModel"))
            stop("model should be of class variogramModel")
    }
    n = names(g$data)
    for (i in 1:length(n)) {
        for (j in i:length(n)) {
            name = ifelse(i == j, n[i], cross.name(n[i], n[j]))
            x = v[v$id == name, ]
            if (nrow(x) == 0) 
                stop(paste("gstatVariogram", name, "not present"))
            m = g$model[[name]]
            if (!missing(model)) 
                m = model
            g$model[[name]] = fit.variogram(x, m, fit.ranges = fit.ranges, 
                ...)
        }
    }
    if (fit.lmc) {
        m = g$model[[n[1]]]
        for (k in 1:nrow(m)) {
            psill = matrix(NA, nrow = length(n), ncol = length(n))
            for (i in 1:length(n)) {
                for (j in i:length(n)) {
                  name = ifelse(i == j, n[i], cross.name(n[i], n[j]))
                  psill[i, j] = psill[j, i] = g$model[[name]][k, 
                    "psill"]
                }
            }
            psill = posdef(psill)
			diag(psill) = diag(psill) * correct.diagonal 
            for (i in 1:length(n)) {
                for (j in i:length(n)) {
                  name = ifelse(i == j, n[i], cross.name(n[i], n[j]))
                  g$model[[name]][k, "psill"] = psill[i, j]
                }
            }
        }
    }
    g
}
"fit.variogram" <-
function (object, model, fit.sills = TRUE, fit.ranges = TRUE, 
    fit.method = 7, print.SSE = FALSE, debug.level = 1) 
{
    if (missing(object)) 
        stop("nothing to fit to")
	if (!inherits(object, "gstatVariogram"))
		stop("object should be of class variogram")
	if (length(unique(object$id)) > 1)
		stop("to use fit.variogram, variogram object should be univariable")
    if (missing(model)) 
        stop("no model to fit")
    if (!inherits(model, "variogramModel"))
        stop("model should be of class variogramModel (use vgm)")
    if (fit.method == 5)
    	stop("use function fit.variogram.reml() to use REML")
    if (length(fit.sills) < length(model$model)) 
        fit.sills = rep(fit.sills, length(model$model))
    if (length(fit.ranges) < length(model$model)) 
        fit.ranges = rep(fit.ranges, length(model$model))
    fit.ranges = fit.ranges & (model$model != "Nug")
    .Call("gstat_init", as.integer(debug.level), PACKAGE = "gstat")
    .Call("gstat_load_ev", object$np, object$dist, object$gamma, 
		PACKAGE = "gstat")
    load.variogram.model(model)
    ret = .Call("gstat_fit_variogram", as.integer(fit.method), 
        as.integer(fit.sills), as.integer(fit.ranges), PACKAGE = "gstat")
    .Call("gstat_exit", 0, PACKAGE = "gstat")
    model$psill = ret[[1]]
    model$range = ret[[2]]
	attr(model, "singular") = as.logical(ret[[3]]);
	direct = attr(object, "direct")
	if (!is.null(direct)) {
		id = unique(object$id)
		if (direct[direct$id == id, "is.direct"] && any(model$psill < 0))
			stop("partial sill fitted to direct variogram is negative")
	}
    if (print.SSE) 
        print(paste("SSErr: ", ret[[4]]))
    model
}
"fit.variogram.reml" <-
function (formula, locations, data, model, debug.level = 1, set, degree = 0)
{
    if (missing(formula)) 
        stop("nothing to fit to")
    if (class(formula) != "formula") 
        stop("formula should be of class formula")
    if (missing(model)) 
        stop("no model to fit")
    if (!inherits(model, "variogramModel"))
        stop("model should be of class variogramModel (use vgm)")
    fit.sills = rep(TRUE, length(model$model))
    fit.ranges = rep(FALSE, length(model$model))
    .Call("gstat_init", as.integer(debug.level)
    	, PACKAGE = "gstat"
	)
    ret = gstat.formula(formula, locations, data)
    ret$y <- residuals(lm(formula, data))
    .Call("gstat_new_data", as.double(ret$y), as.double(ret$locations),
		as.double(ret$X), as.integer(1), double(0), as.integer(-1), 
		as.integer(0), as.double(-1), as.integer(1), 
		double(0), double(0), as.integer(degree)
		, PACKAGE = "gstat"
		)
    load.variogram.model(model)
    if (!missing(set))
    	gstat.load.set(set)
    ret = .Call("gstat_fit_variogram", as.integer(5), 
        as.integer(fit.sills), as.integer(fit.ranges)
	, PACKAGE = "gstat"
	)
    .Call("gstat_exit", 0, PACKAGE = "gstat")
    model$psill = ret[[1]]
    model$range = ret[[2]]
    model
}
"get.contr" <-
function (data, gstat.object, X, ids = names(gstat.object$data)) 
{
	contr.fun <- function(x, n, pr.idx, cov.idx, contr) {
		y = matrix(x[pr.idx], n, 1)
		V = matrix(x[cov.idx], n, n)
		beta = t(contr) %*% y
		Vbeta = t(contr) %*% V %*% contr
		ret = c(beta, diag(Vbeta))
		for (j in 1:nrow(Vbeta)) {
	       	if (j > 1)
       			for (k in 1:(j - 1))
        			ret = c(ret, Vbeta[j, k])
		}
		ret
	}
    lti <- function(i, j) {
        mx = max(i, j) - 1
        mn = min(i, j) - 1
        ((mx) * (mx - 1))/2 + mn + 1
    }
    n = length(ids)
    if (!is.matrix(X)) 
        X = as.matrix(X)
    if (n != nrow(X)) 
        stop("length(ids) should equal nrow(X) or length(X)")
    gstat.names = create.gstat.names(ids)
    names.pr = gstat.names[seq(1, 2 * n, 2)]
    names.cov = matrix("", n, n)
    for (i in 1:n) 
		for (j in 1:n) 
			names.cov[i, j] = ifelse(i == j, gstat.names[2 * i], 
				gstat.names[2 * n + lti(i, j)])
	pr.idx = match(names.pr, names(data))
	cov.idx = match(names.cov, names(data))
	if (any(is.na(pr.idx)) || any(is.na(cov.idx)))
		stop("colunn names in data not matched")

	res = data.frame(t(apply(data, 1, contr.fun, n = n, pr.idx = pr.idx, 
		cov.idx = cov.idx, contr = X)))

	col.names = NULL
    for (j in 1:NCOL(X))
    	col.names = c(col.names, paste("beta", j, sep = "."))
    for (j in 1:NCOL(X))
    	col.names = c(col.names, paste("var.beta", j, sep = "."))
	for (j in 1:NCOL(X)) {
		if (j > 1) {
			for (k in 1:(j - 1)) {
				col.names = c(col.names, paste("cov.beta", 
					k, j, sep = "."))
			}
		}
	}
    names(res) = col.names
    row.names(res) = row.names(data)
    return(res)
}
"cross.name" <- function(id1, id2) {
    paste(id1, id2, sep = ".")
}

try.coordinates <- function(data) {
	ret = try(cc <- coordinates(data), silent = TRUE)
	if (inherits(ret, "try-error"))
		stop("coordinates could not be derived from data; please supply them")
	else cc
}

has.coordinates <- function(data) {
	!inherits(try(coordinates(data), silent = TRUE), "try-error")
}

try.gridparameters <- function(data) {
	ret = try(grd <- gridparameters(data), silent = TRUE)
	if (!inherits(ret, "try-error"))
		grd
	else numeric(0)
}

"gstat" <-
function (g, id, formula, locations = try.coordinates(data), 
	data = NULL, model = NULL, beta, nmax = Inf, nmin = 0, maxdist = Inf, 
	dummy = FALSE, set, fill.all = FALSE, fill.cross = TRUE, 
	variance = "identity", weights = NULL, merge, degree = 0) 
{
	call = match.call()
	if (has.coordinates(locations)) { # shift arguments:
		data = locations
		locations = NULL
	}
	if (fill.all) {
	# fill all variogram models
		if (missing(g) || is.null(model))
			stop("fill.all assumes object g and model are supplied")
        g.names = names(g$data)
		for (i in 1:length(g.names)) {
           	g$model[[paste(g.names[i])]] = model
			if (fill.cross) {
				for (j in (i+1):length(g.names))
           			g$model[[cross.name(g.names[i], g.names[j])]] = model
			}
		}
        return(g)
	} 
    if (!missing(g) && inherits(g, "gstat") && !missing(id) && 
        !missing(model) && missing(formula) && missing(locations)) {
		# here, only direct or cross variogram model is defined
        g.names = names(g$data)
		if (length(id) == 2) {
           	m1 = match(id[1], g.names)
           	m2 = match(id[2], g.names)
           	if (is.na(m1)) 
               	stop("first id does not match available data")
           	if (is.na(m1)) 
               	stop("second id does not match available data")
           	nm = cross.name(g.names[min(m1, m2)], g.names[max(m1, m2)])
        } else if (length(id) == 1) {
			m1 = match(id, g.names)
        	if (is.na(m1)) 
           		stop("id does not match available data")
			nm = g.names[m1]
		} else
			stop("id should have length 1 or 2")
        g$model[[nm]] = model
        return(g)
    }
    if (!inherits(formula, "formula"))
        stop("argument formula should be of class formula")
    if (!inherits(locations, "formula") && !has.coordinates(data))
        stop("argument locations should be of class formula or data.frame")
    if (missing(beta) || is.null(beta)) 
        beta = numeric(0)
	vfn = pmatch(variance, c("identity", "mu", "mu(1-mu)", "mu^2", "mu^3"))
	if (is.na(vfn))
		stop("unknown value for variance function")
	if (vfn > 1 && length(beta) == 0)
		stop("non-identity variance function only allowed if beta is supplied")
    if (missing(g)) {
        g = list()
        g[["data"]] = list()
        g[["model"]] = list()
    }
    if (missing(id)) 
        id = paste("var", length(g$data) + 1, sep = "")
    g$data[[id]] = list(formula = formula, locations = locations, 
        data = data, has.intercept = attr(terms(formula), "intercept"),
		beta = beta, nmax = nmax, nmin = nmin, maxdist = maxdist, 
		dummy = dummy, vfn = vfn, weights = weights, degree = degree)
    g$model[[id]] = model
    if (!missing(set)) {
        if (!is.list(set)) 
            stop("argument set should be a list")
        g$set = set
    }
	if (!missing(merge))
		g$merge = merge
	g$call = call
    class(g) = c("gstat", "list")
    g
}

"[.gstat" <- function(x, ids) { 
	if (is.numeric(ids)) {
		if (min(ids) < 1 || max(ids) > length(names(x$data)))
			stop("selection index(es) out of bound")
		ids = names(x$data)[ids]
	} else if (any(is.na(match(ids, names(x$data)))))
		stop("selected ids do not match those of gstat object")
	g = list()
	g$data = x$data[ids]
	if (length(ids) > 1) {
		ids.cross = NULL
		for (i in 2:length(ids))
			for (j in 1:(i-1))
				ids.cross = c(ids.cross, cross.name(ids[j], ids[i]))
		g$model = x$model[c(ids, ids.cross)]
	} else
		g$model = x$model[ids]
	if (!is.null(x$set))
		g$set = x$set
	if (!is.null(g$merge))
		g$merge = x$merge
    class(g) = c("gstat", "list")
	g
}
"gstat.cv" <-
function (object, nfold = nrow(object$data[[1]]$data), remove.all = FALSE, 
	verbose = FALSE, all.residuals = FALSE, ...) 
{
	if (!inherits(object, "gstat")) 
		stop("first argument should be of class gstat")
	var1 = object$data[[1]]
	data = var1$data
	formula = var1$formula
	locations = var1$locations
	if (all.residuals)
		nc = length(object$data)
	else
		nc = 2 + length(attr(terms(locations), "term.labels"))
	ret = data.frame(matrix(NA, nrow(data), nc))
	if (missing(nfold)) 
		nfold = nrow(data)
	if (nfold < nrow(data)) 
		fold = sample(nfold, nrow(data), replace = TRUE)
	else fold = 1:nrow(data)

	if (all.residuals || (remove.all && length(object$data) > 1)) {
		all.data = list()
		for (v in 1:length(object$data))
			all.data[[v]] = object$data[[v]]$data
	}

	for (i in sort(unique(fold))) {
		sel = which(fold == i)
		object$data[[1]]$data = data[-sel, ]
		if (remove.all && length(object$data) > 1) {
			for (v in 2:length(object$data)) {
				varv = object$data[[v]]
				varv$data = all.data[[v]]
				atv = gstat.formula(varv$formula, varv$locations, 
				  varv$data)$locations
				at1 = gstat.formula(formula, locations, data[sel, 
				  ])$locations
				all = rbind(atv, at1)
				if (length(attr(terms(~x+y), "term.labels")) == 2) # 2-D
					zd = zerodist(all[, 1], all[, 2])
				else 
					zd = zerodist(all[, 1], all[, 2], all[, 3])
				skip = zd[, 1]
				object$data[[v]]$data = varv$data[-skip, ]
			}
		}
		x = predict.gstat(object, newdata = data[sel, ], ...)
		if (verbose) 
			print(paste("fold", i))
		if (all.residuals) {
			for (i in 1:length(object$data)) {
				var.i = object$data[[i]]
				data.i = all.data[[i]]
				formula.i = var.i$formula
				locations.i = var.i$locations
				observed = gstat.formula(formula.i, locations.i, data.i)$y[sel]
				pred.name = paste(names(object$data)[i], "pred", sep = ".")
				residual = as.numeric(observed - x[pred.name])
				ret[sel, i] = residual
			}
		} else 
			ret[sel, 1:nc] = x[, 1:nc]
	}

	if (! all.residuals) {
		names(ret) = names(x)[1:nc]
		observed = gstat.formula(formula, locations, data)$y
		pred.name = paste(names(object$data)[1], "pred", sep = ".")
		residual = observed - ret[pred.name]
		var.name = paste(names(object$data)[1], "var", sep = ".")
		zscore = residual/sqrt(ret[var.name])
		ret = data.frame(ret, observed = observed, residual = residual, 
			zscore = zscore, fold = fold)
		names(ret) = c(names(x)[1:nc], "observed", "residual", "zscore", "fold")
	} else {
		names(ret) = names(object$data)
	}
	ret
}
"gstat.debug" <-
function(level = 0)
{
	invisible(.Call("gstat_debug_level", as.integer(level), PACKAGE = "gstat"))
}
"gstat.formula" <-
function (formula, locations, data)
{
	grid = numeric(0)
    if (has.coordinates(locations)) {
        data = as.data.frame(locations)
		grid = try.gridparameters(locations)
        locations = coordinates(locations)
    } else if (has.coordinates(data)) {
        locations = coordinates(data)
		grid = try.gridparameters(data)
        data = as.data.frame(data)
    } else { # resolve locations formula from data.frame:
        if (!inherits(locations, "formula"))
            stop("locations argument should be a formula, such as ~x+y")
		m = model.frame(terms(locations), data)
        Terms = attr(m, "terms")
        attr(Terms, "intercept") = 0
        if ((yvar = attr(Terms, "response")) > 0)
            stop("no response allowed in locations formula")
		# retrieve coord columns from model frame:
        locations = model.matrix(Terms, m)
    }
	# now extract main formula from data:
    m = model.frame(terms(formula), data)
    Y = model.extract(m, response)
    if (length(Y) == 0)
        stop("no response variable present in formula")
    Terms = attr(m, "terms")
    X = model.matrix(Terms, m)
    has.intercept = attr(Terms, "intercept")

    list(y = Y, locations = as.matrix(locations), X = X, call = call,
        has.intercept = has.intercept, grid = as.double(unlist(grid)))
}
"gstat.formula.predict" <-
function (formula, locations, newdata, na.action) 
{
	if (has.coordinates(newdata)) {
		locs = coordinates(newdata)
		newdata = as.data.frame(newdata)
	} else {
		# resolve locations:
		terms.l = terms(locations)
    	attr(terms.l, "intercept") = 0
    	mf.locs = model.frame(terms.l, newdata, na.action = na.action)
    	locs = model.matrix(terms.l, mf.locs)
	}

	# resolve formula:
	terms.f = delete.response(terms(formula))
    mf.f = model.frame(terms.f, newdata, na.action = na.action)
    X = model.matrix(terms.f, mf.f)

	if (inherits(locations, "formula") && NROW(locs) != NROW(X)) { 
		# NA's were filtered in one, but not the other:
		mf.locs = model.frame(terms.l, newdata, na.action = na.pass)
    	mf.f =    model.frame(terms.f, newdata, na.action = na.pass)
		valid.pattern = !(apply(cbind(mf.f, mf.locs), 1,
			             function(x) any(is.na(x))))
		X    = model.matrix(terms.f, mf.f   [valid.pattern, , drop = FALSE])
		locs = model.matrix(terms.l, mf.locs[valid.pattern, , drop = FALSE])
		if (NROW(locs) != NROW(X))
			stop("NROW(locs) != NROW(X): this should not occur")
	}
    list(locations = as.matrix(locs), X = as.matrix(X))
}
"image.data.frame" <-
function (x, zcol = 3, xcol = 1, ycol = 2, ...)
{
    image.default(xyz2img(xyz = x, zcol = zcol, xcol = xcol, ycol = ycol),
		asp = 1,
		...)
}
"krige" <-
function (formula, locations = try.coordinates(data), data = sys.frame(sys.parent()), 
	newdata, model = NULL, beta = NULL, nmax = Inf, nmin = 0, 
	maxdist = Inf, block = numeric(0), nsim = 0, indicators = FALSE, 
	na.action = na.pass, ...)
{
	if (has.coordinates(locations)) { # shift arguments:
		if (has.coordinates(data)) # another shift:
			newdata = data
		data = locations
		locations = coordinates(data)
	}
    g = gstat(formula = formula, locations = locations, model = model,
		data = data, beta = beta, nmax = nmax, nmin = nmin, 
		maxdist = maxdist, ...)
    predict.gstat(g, newdata = newdata, block = block, nsim = nsim,
		indicators = indicators, na.action = na.action)
}
"krige.cv" <- function (formula, locations, data = sys.frame(sys.parent()), 
	model = NULL, beta = NULL, nmax = Inf, nmin = 0, maxdist = Inf, 
	nfold = nrow(data), verbose = FALSE, ...)
{
	if (has.coordinates(locations)) {
		data = locations
		locations = coordinates(data)
	}
	nc = 2 + length(attr(terms(locations), "term.labels"))
	ret = data.frame(matrix(NA, nrow(data), nc))
	if (nfold < nrow(data))
		fold = sample(nfold, nrow(data), replace = TRUE)
	else
		fold = 1:nrow(data)
	for (i in sort(unique(fold))) {
		sel = which(fold == i)
    	g = gstat(formula = formula, locations = locations, model = model, 
			data = data[-sel, ], beta = beta, nmax = nmax, nmin = nmin,
			maxdist = maxdist, ...)
    	x = predict.gstat(g, newdata = data[sel, ])
    	ret[sel, ] = x
		if (verbose)
			print(paste("fold", i))
	}
	names(ret) = names(x)
	observed = gstat.formula(formula, locations, data)$y
	residual = observed - ret["var1.pred"]
	zscore = residual / sqrt(ret["var1.var"])
	ret = data.frame(ret, observed = observed, residual = residual, 
		zscore = zscore, fold = fold)
	names(ret) = c(names(x), "observed", "residual", "zscore", "fold")
	ret
}
"load.variogram.model" <- function(model, ids = c(0, 0)) 
{
	if (missing(model))
		stop("model is missing");
	if (!inherits(model, "variogramModel"))
		stop("model should be of mode variogramModel (use function vgm)")
	anis = c(model$ang1, model$ang2, model$ang3, model$anis1, model$anis2)
	.C("Cgstat_load_variogram", 
		as.integer(ids),
		as.integer(length(model$model)),
		as.character(model$model),
		as.numeric(model$psill),
		as.numeric(model$range),
		as.numeric(model$kappa),
		as.numeric(anis)
		, PACKAGE = "gstat"
		)
}
makegrid = function(x, y, n = 10000, nsig = 2, margin = 1.05, cell.size) {
        dx = range(x)
        dy = range(y)
		if (missing(cell.size)) {
        	cell.area = margin * diff(dx) * margin * diff(dy) / n
        	cell.size = signif(sqrt(cell.area), nsig)
		} 
        midx = signif(mean(dx), nsig)
        midy = signif(mean(dy), nsig)
        nx = ceiling((midx - min(x))/cell.size) * 2 + 1
        ny = ceiling((midy - min(y))/cell.size) * 2 + 1
        minx = midx - ceiling((midx - min(x))/cell.size) * cell.size
        maxx = midx + ceiling((midx - min(x))/cell.size) * cell.size
        miny = midy - ceiling((midy - min(y))/cell.size) * cell.size
        maxy = midy + ceiling((midy - min(y))/cell.size) * cell.size
        expand.grid(x = seq(minx, maxx, length = nx),
			y = seq(miny, maxy, length = ny))
}
"map.to.lev" <-
function (data, xcol = 1, ycol = 2, zcol = c(3, 4), ns = names(data)[zcol]) 
{
    len = nrow(data)
    d = matrix(nrow = len * length(zcol), ncol = 3)
    xnames = NULL
    if (length(ns) > 1 && length(ns) != length(zcol)) 
        stop("names should have length 1 or equal to length of zcol")
    nr = 1
    for (i in zcol) {
        if (length(ns) == 1) 
            nm = rep(paste(ns, nr), len)
        else nm = rep(ns[nr], len)
        range = (1 + (nr - 1) * len):(nr * len)
        d[range, ] = cbind(data[, xcol], data[, ycol], data[, 
            i])
        xnames = c(xnames, nm)
        nr = nr + 1
    }
	nms <- factor(xnames, levels = unique(xnames))
    d = data.frame(d, nms)
    names(d) = c("x", "y", "z", "name")
    d
}
mapasp <- function(data, x = data$x, y = data$y) {
	# calculates aspect ratio for levelplot of geographic data,
	# using proportial units (compare eqscplot)
	diff(range(y))/diff(range(x))
}
"ossfim" <-
function(spacings = 1:5, block.sizes = 1:5, model, nmax = 25, debug = 0)
{
	n = floor(sqrt(nmax)) + 1
	x = 0:(n-1) + .5
	x = sort(c(-x, x))
	ret = matrix(NA, length(spacings) * length(block.sizes), 3)
	r = 1
	for (sp in spacings) {
		for (bl in block.sizes) {
			data.grid = data.frame(expand.grid(x * sp, x * sp),
				z = rep(1, length(x)^2))
			names(data.grid) = c("x", "y", "z")
			kr = krige(z~1, ~x+y, data.grid, data.frame(x=0, y=0), 
				block = c(bl, bl), model = model, nmax = nmax,
				set = list(debug = debug))
			ret[r, ] = c(sp, bl, sqrt(kr[1,"var1.var"]))
			r = r + 1
		}
	}
	ret = data.frame(ret)
	names(ret) = c("spacing", "block.size", "kriging.se")
	ret
}
"panel.pointPairs" <-
function (x, y, type = "p", pch = plot.symbol$pch, col, col.line = 
	plot.line$col, col.symbol = plot.symbol$col, lty = plot.line$lty, 
	cex = plot.symbol$cex, lwd = plot.line$lwd, pairs = pairs, 
	line.pch = line.pch, ...) 
{
    x = as.numeric(x)
    y = as.numeric(y)
    if (length(x) > 0) {
        if (!missing(col)) {
            if (missing(col.line)) 
                col.line = col
            if (missing(col.symbol)) 
                col.symbol = col
        }
        plot.symbol = trellis.par.get("plot.symbol")
        plot.line = trellis.par.get("plot.line")
        lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch)
        if (!missing(pairs)) {
			for (i in seq(along = pairs[,1])) {
				xx = c(x[pairs[i,1]], x[pairs[i,2]])
				yy = c(y[pairs[i,1]], y[pairs[i,2]])
            	llines(x = xx, y = yy, lty = lty, col = col.line, lwd = lwd)
				if (line.pch > 0)
					lpoints(mean(xx), mean(yy), pch = line.pch, col = col.line)
			}
        }
    }
}
"plot.gstatVariogram" <-
function (x, model = NULL, ylim, xlim, xlab = "distance", 
	ylab = "semivariance", multipanel = TRUE, plot.numbers = FALSE, scales, 
	ids = x$id, group.id = TRUE, skip, layout, ...) 
{
    if (missing(ylim)) {
        ylim = c(min(0, 1.04 * min(x$gamma)), 1.04 * max(x$gamma))
		ylim.set = FALSE
	} else
		ylim.set = TRUE
    if (missing(xlim)) 
        xlim = c(0, 1.04 * max(x$dist))
    labels = NULL
	shift = 0.03
	if (is.numeric(plot.numbers)) {
		shift = plot.numbers
		plot.numbers = TRUE
	} 
    if (plot.numbers == TRUE) 
       	labels = as.character(x$np)
    if (length(unique(x$dir.ver)) > 1 || any(x$dir.ver != 0))
		warning("vertical directions are not dealt with -- yet!")
    if (length(unique(x$dir.hor)) > 1 && group.id == TRUE) { 
	# directional, grouped:
        if (multipanel) {
            if (length(levels(ids)) > 1) { # multivariate directional:
				xyplot(gamma ~ dist | as.factor(dir.hor), data = x, 
					type = c("p", "l"), xlim = xlim, ylim = ylim, xlab = xlab, 
					ylab = ylab, groups = id, ...)
			} else # univariate directional, multipanel:
				xyplot(gamma ~ dist | as.factor(dir.hor), subscripts = TRUE, 
                	panel = vgm.dir.panel.xyplot, data = x, xlim = xlim, 
                	ylim = ylim, xlab = xlab, ylab = ylab, dir.hor = x$dir.hor, 
                	labels = labels, model = model, shift = shift, ...)
        } else { # univariate directional, using symbol/color to distinguish
            pch = as.integer(as.factor(x$dir.hor))
            xyplot(gamma ~ dist, data = x, type = c("p", "l"), 
                groups = pch, xlim = xlim, ylim = ylim, xlab = xlab, 
                ylab = ylab, pch = pch, ...)
        }
    } else if (length(unique(ids)) > 1) { # multivariable:
        n = floor(sqrt(2 * length(unique(ids))))
		if (missing(skip)) {
        	skip = NULL
        	for (row in n:1) 
				for (col in 1:n) 
					skip = c(skip, row < col)
		}
		if (missing(layout))
			layout = c(n,n)
        if (missing(scales)) 
            scales = list(y = list(relation = "free"))
		else
			if (scales$relation == "same")
				ylim.set = TRUE
    	if (length(unique(x$dir.hor)) > 1) { # multiv.; directional groups
			if (ylim.set) {
            	xyplot(gamma ~ dist | id, data = x, type = c("p", 
                	"l"), xlim = xlim, ylim = ylim, xlab = xlab, 
                	ylab = ylab, groups = as.factor(dir.hor), layout = layout,
                  	skip = skip, scales = scales, ...)
			} else {
            	xyplot(gamma ~ dist | id, data = x, type = c("p", 
                	"l"), xlim = xlim, xlab = xlab, 
                	ylab = ylab, groups = as.factor(dir.hor), layout = layout,
                  	skip = skip, scales = scales, ...)
			}
		} else { # non-multi-directional, multivariable
			if (ylim.set) {
        		xyplot(gamma ~ dist | id, data = x, xlim = xlim, 
            		ylim = ylim, xlab = xlab, ylab = ylab, ids = ids, 
            		panel= xvgm.panel.xyplot, labels = labels, scales = scales, 
            		layout = layout, skip = skip, prepanel = function(x, y) 
					list(ylim = c(min(0, y), max(0, y))), model = model, 
					direction = c(x$dir.hor[1], x$dir.ver[1]), shift = shift, ...)
			} else {
        		xyplot(gamma ~ dist | id, data = x, xlim = xlim, 
            		xlab = xlab, ylab = ylab, ids = ids, 
            		panel =xvgm.panel.xyplot, labels = labels, scales = scales, 
            		layout = layout, skip = skip, prepanel = function(x, 
                		y) list(ylim = c(min(0, y), max(0, y))), 
					model = model, direction = c(x$dir.hor[1], x$dir.ver[1]), 
					shift = shift, ...)
			}
		}
    } else  # non multi-directional, univariable -- mostly used of all:
		xyplot(gamma ~ dist, data = x, panel = vgm.panel.xyplot, xlim = xlim, 
			ylim = ylim, xlab = xlab, ylab = ylab, labels = labels, model = model, 
			direction = c(x$dir.hor[1], x$dir.ver[1]), shift = shift, ...)
}

"plot.variogramMap" <-
function(x, np = FALSE, skip, ...) {
	x = x$map
	if (! inherits(x, "SpatialDataFrameGrid"))
		stop("x should be of class SpatialDataFrameGrid")
	if (np)
		start = 2 
	else
		start = 1 
	idx = seq(start, length(names(x@data))-length(x@coord.names), by=2)
	n = floor(sqrt(length(idx) * 2))
    if (missing(skip)) {
        skip = NULL
        for (row in n:1)
            for (col in 1:n)
                skip = c(skip, row < col)
    }
	levelplot(values ~ dx + dy | ind, as.data.frame(stack(x, select = idx)),
		asp = mapasp(x), layout = c(n,n), skip = skip, ...)
}
"plot.pointPairs" <-
function(x, data, xcol = data$x, ycol = data$y, xlab = "x coordinate", 
	ylab = "y coordinate", col.line = 2, line.pch = 0, ...) {
	xyplot(ycol ~ xcol, aspect = mapasp(x = xcol, y = ycol), 
		panel = panel.pointPairs, xlab = xlab, ylab = ylab, pairs = x,
		col.line = col.line, line.pch = line.pch, ...)
}
"plot.variogramCloud" <-
function (x, identify = FALSE, digitize = FALSE, 
	xlim = c(0, max(x$dist)), ylim = c(0, max(x$gamma)), 
	xlab = "distance", ylab = "semivariance", keep = FALSE, ...) 
{
    if (identify || digitize) {
        plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 
            ylab = ylab, ...)
        head = floor(x$np/2^16) + 1
        tail = floor(x$np%%2^16) + 1
		if (identify) {
			print("mouse-left identifies, mouse-right stops")
        	labs = paste(head, tail, sep = ",")
        	sel = identify(x$dist, x$gamma, labs, pos = keep)
		} else {
			print("mouse-left digitizes, mouse-right closes polygon")
			poly = locator(n = 512, type = "l")
			if (!is.null(poly))
				sel = point.in.polygon(x$dist, x$gamma, poly$x, poly$y)
			else stop("digitized selection is empty")
		}
		ret = data.frame(cbind(head, tail)[sel, ])
		class(ret) = c("pointPairs", "data.frame")
        if (keep) {
			if (identify) {
				attr(x, "sel") = sel
				attr(x, "text") = labs[sel$ind]
			} else  # digitize
				attr(x, "poly") = poly
			attr(x, "ppairs") = ret
			return(x)
		} else 
        	return(ret)
	} else {
		sel = attr(x, "sel")
		lab = attr(x, "text")
		poly = attr(x, "poly")
		if (!is.null(sel) && !is.null(lab)) {
        	plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 
            	ylab = ylab, ...)
			text(x$dist[sel$ind], x$gamma[sel$ind], labels=lab, pos= sel$pos)
		} else if (!is.null(poly)) {
        	plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 
            	ylab = ylab, ...)
			lines(poly$x, poly$y)
		} else {
        	x$np = rep(1, length(x$gamma))
        	plot.gstatVariogram(x, xlim = xlim, ylim = ylim, xlab = xlab, 
        	    ylab = ylab, ...)
		}
    }
}
"point.in.polygon" <-
function(point.x, point.y, pol.x, pol.y) {
	as.logical(.Call("gstat_pip", 
		as.numeric(point.x),
		as.numeric(point.y),
		as.numeric(pol.x),
		as.numeric(pol.y)
		, PACKAGE = "gstat"
		))
}
"predict.gstat" <-
function (object, newdata, block = numeric(0), nsim = 0, indicators = FALSE,
	BLUE = FALSE, debug.level = 1, mask, na.action = na.pass, ...) 
{
	if (missing(object) || length(object$data) < 1) 
		stop("no data available")
	if (!inherits(object, "gstat"))
		stop("first argument should be of class gstat")
	if (extends(class(newdata), "SpatialDataFrame") && require(sp))
		use.sdf = TRUE
	else
		use.sdf = FALSE
	.Call("gstat_init", as.integer(debug.level), PACKAGE = "gstat")
	if (!missing(mask)) {
		cat("argument mask is deprecated:")
		stop("use a missing value pattern in newdata instead")
	}
	nvars = length(object$data)
	new.X = NULL
	for (i in 1:length(object$data)) {
		name = names(object$data)[i]
		d = object$data[[i]]
		if (d$nmax == Inf) 
			nmax = as.integer(-1)
		else nmax = as.integer(d$nmax)
		nmin = as.integer(max(0, d$nmin))
		if (d$maxdist == Inf)
			maxdist = as.numeric(-1)
		else maxdist = d$maxdist
		if (d$dummy) {
			tr = terms(d$locations)
			if (is.null(d$beta) || length(d$beta) == 0)
				stop("dummy data should have beta defined")
			if (d$degree != 0)
				stop("dummy data cannot have non-zero degree arg; use formula")
			loc.dim = length(attr(tr, "term.labels"))
			.Call("gstat_new_dummy_data", as.integer(loc.dim), 
				as.integer(d$has.intercept), as.double(d$beta), 
				nmax, nmin, maxdist, as.integer(d$vfn)
				, PACKAGE = "gstat"
				)
		} else {
			if (is.null(d$weights))
				w = numeric(0)
			else
				w = d$weights
			raw = gstat.formula(d$formula, d$locations, d$data)
			.Call("gstat_new_data", as.double(raw$y), as.double(raw$locations),
				as.double(raw$X), as.integer(raw$has.intercept),
				as.double(d$beta), nmax, nmin, maxdist, as.integer(d$vfn),
				as.numeric(w), double(0), as.integer(d$degree)
				, PACKAGE = "gstat"
			)
		}
		if (!is.null(object$model[[name]])) 
			load.variogram.model(object$model[[name]], c(i - 1, i - 1))
		raw = gstat.formula.predict(d$formula, d$locations, newdata, 
				na.action = na.action)
		if (is.null(new.X)) 
			new.X = raw$X
		else new.X = cbind(new.X, raw$X)
		if (i > 1) {
			for (j in 1:(i - 1)) {
				cross = cross.name(names(object$data)[j], name)
				if (!is.null(object$model[[cross]])) 
					load.variogram.model(object$model[[cross]], 
						c(i - 1, j - 1))
			}
		}
	}
	if (!is.null(object$set)) 
		gstat.load.set(object$set)
	if (!is.null(object$merge)) 
		gstat.load.merge(object)
	if (!is.null(dim(block))) { # i.e., block is data.frame or matrix
		block = data.matrix(block) # converts to numeric
		block.cols = ncol(block)
	} else {
		block = as.numeric(block) # make sure it's not integer
		block.cols = numeric(0)
	} 
	# handle NA's in the parts of newdata used:
	valid.pattern = NULL
	if (any(is.na(raw$locations)) || any(is.na(new.X))) {
		valid.pattern = !(apply(cbind(raw$locations, new.X), 1, 
				function(x) any(is.na(x))))
		raw$locations.all = raw$locations
		raw$locations = as.matrix(raw$locations[valid.pattern, ])
		new.X = as.matrix(new.X[valid.pattern, ])
	} 
	if (nsim) {
		if (indicators == TRUE)
			nsim = -abs(nsim)
	# random path: randomly permute row indices
		perm = sample(seq(along = new.X[, 1]))
		ret = .Call("gstat_predict", as.integer(nrow(as.matrix(new.X))),
			as.vector(raw$locations[perm, ]), as.vector(new.X[perm,]), 
		as.integer(block.cols), as.vector(block), 
		as.integer(nsim), as.integer(BLUE)
		, PACKAGE = "gstat"
		)[[1]]
		ret = data.frame(cbind(raw$locations, 
		matrix(ret[order(perm),], nrow(as.matrix(new.X)), 
		max(2, abs(nsim) * nvars))))
	}
	else {
		ret = .Call("gstat_predict", as.integer(nrow(as.matrix(new.X))),
			as.vector(raw$locations), as.vector(new.X), as.integer(block.cols), 
			as.vector(block), as.integer(nsim), as.integer(BLUE)
			, PACKAGE = "gstat"
			)[[1]]
		ret = data.frame(cbind(raw$locations, ret))
	}
	.Call("gstat_exit", NULL, PACKAGE = "gstat")
	if (!is.null(valid.pattern) && any(valid.pattern)) {
		ret.all = data.frame(matrix(NA, length(valid.pattern), ncol(ret)))
		ret.all[, 1:ncol(raw$locations.all)] = raw$locations.all
		ret.all[valid.pattern, ] = ret
		ret = ret.all
	}
	if (abs(nsim) > 0) {
		names.vars = names(object$data)
		if (length(names.vars) > 1) 
			names.vars = paste(rep(names.vars, each = abs(nsim)), 
				paste("sim", 1:abs(nsim), sep = ""), sep = ".")
		else names.vars = paste("sim", 1:abs(nsim), sep = "")
		if (abs(nsim) == 1) 
			ret = ret[, 1:(ncol(ret) - 1)]
	} else
		names.vars = create.gstat.names(names(object$data))
	names(ret) = c(dimnames(raw$locations)[[2]], names.vars)
	if (use.sdf) {
		coordinates(ret) = dimnames(raw$locations)[[2]]
		gridded(ret) = gridded(newdata)
	}
	return(ret)
}

# call with: create.gstat.names(names(object$data))
# creates the names of the output columns in case of (multivariable) prediction
create.gstat.names <- function(ids, names.sep = ".") {
	nvars = length(ids)
	names.vars = character(nvars * 2 + nvars * (nvars - 1)/2)
	pos = 1
	for (i in 1:length(ids)) {
		name = ids[i]
		names.vars[1 + (i - 1) * 2] = paste(name, "pred", sep = names.sep)
		names.vars[2 + (i - 1) * 2] = paste(name, "var", sep = names.sep)
		if (i > 1) {
			for (j in 1:(i - 1)) {
				cross = paste(ids[j], name, sep = names.sep)
				names.vars[nvars * 2 + pos] = paste("cov", cross, 
					sep = names.sep)
				pos = pos + 1
			}
		}
	}
	return(names.vars)
}
"print.gstat" <-
function (x, ...) 
{
    if (missing(x) || !inherits(x, "gstat"))
        stop("wrong call")
    data.names <- names(x$data)
    if (length(data.names)) 
        cat("data:\n")
    for (n in data.names) {
        fstr = paste(x$data[[n]]$formula[c(2, 1, 3)], collapse = "")
        lstr = paste(x$data[[n]]$locations[c(1, 2)], collapse = "")
        cat(n, ": formula =", fstr, "; locations =", lstr, ";")
        if (!is.null(x$data[[n]]$data)) {
            data.dim = dim(x$data[[n]]$data)
            cat(" data dim =", data.dim[1], "x", data.dim[2])
        }
        else {
            if (x$data[[n]]$dummy) 
                cat(" dummy data")
            else cat(" NULL data")
        }
		if (x$data[[n]]$nmax != Inf)
			cat(" nmax =", x$data[[n]]$nmax)
		if (x$data[[n]]$nmin > 0)
			cat(" nmin =", x$data[[n]]$nmin)
		if (x$data[[n]]$maxdist < Inf)
			cat(" radius =", x$data[[n]]$maxdist)
		if (x$data[[n]]$vfn > 1)
			cat(" variance function =", 
				c("identity", "mu", "mu(1-mu)", "mu^2", "mu^3")[x$data[[n]]$vfn])
		if (length(x$data[[n]]$beta) > 0)
			cat(" beta =", x$data[[n]]$beta)
		if (x$data[[n]]$degree > 0)
			cat(" degree =", x$data[[n]]$degree)
        cat("\n")
    }
    xx.names = xx = NULL
    for (n in data.names) {
        m = x$model[[n]]
        if (!is.null(m)) {
            xx = rbind(xx, m)
            if (nrow(m) == 1) 
                xx.names = c(xx.names, n)
            else xx.names = c(xx.names, paste(n, "[", 1:nrow(m), 
                "]", sep = ""))
        }
    }
    if (length(data.names) > 1) {
        for (j in 2:length(data.names)) {
            for (i in 1:(j - 1)) {
                n = cross.name(data.names[i], data.names[j])
                m = x$model[[n]]
                if (!is.null(m)) {
                  xx = rbind(xx, m)
                  if (nrow(m) == 1) 
                    xx.names = c(xx.names, n)
                  else xx.names = c(xx.names, paste(n, "[", 1:nrow(m), 
                    "]", sep = ""))
                }
            }
        }
    }
    if (!is.null(xx)) {
        cat("variograms:\n")
        row.names(xx) = xx.names
        print(xx, ...)
    }
    if (!is.null(x$set)) {
        s = gstat.set(x$set)
        for (i in 1:length(s)) cat(s[i], "\n")
    }
    invisible(x)
}
"print.gstatVariogram" <-
function(x, ...)
{
	print(data.frame(x), ...)
}
"print.variogramCloud" <-
function (x, ...) 
{
	x$left = x$np %% 2^16 + 1
	x$right = x$np %/% 2^16 + 1
	x$np = NULL
    print(data.frame(x), ...)
}
"print.variogramModel" <-
function (x, ...) 
{
    df <- data.frame(x)
	if (!any(df[, "model"] == "Mat"))
		df$kappa <- NULL
    if (!any(df[, "anis2"] != 1))  {
		df$anis2 <- NULL
		df$ang2 <- NULL
		df$ang3 <- NULL
		if (!any(df[, "anis1"] != 1))  {
			df$anis1 <- NULL
			df$ang1 <- NULL
		}
	} 
    print(df, ...)
	invisible(x)
}
"select.spatial" <-
function(x = data$x, y = data$y, data, pch = "+", n = 512) {
	plot(x, y, pch = pch, asp = 1)
	pol = locator(n = n, type = "o")
	which(point.in.polygon(x, y, pol$x, pol$y))
}
gstat.set <- function(set) {
	if(!is.list(set))
		stop("set should be a list")
	if (length(set) == 0)
		return(NULL)
	ret = NULL
	n = names(set)
	for (i in (1:length(set))) {
		val = set[[i]]
		if (is.character(val))
			val = paste("'", val, "'", sep = "")
		str = paste("set ", n[i], " = ", val, ";", sep="")
		ret = c(ret, str)
	}
	ret
}

gstat.load.set <- function(set) {
	str = gstat.set(set)
	if (!is.null(str)) {
		ret = .C("Cload_gstat_command", str, as.integer(length(str)), 
			as.integer(0), PACKAGE = "gstat")[[3]]
		if (ret != 0)
			stop(paste("error occured when parsing command:", str[ret]))
	}
	invisible()
}

gstat.load.merge <- function(obj) {
	gstat.merge <- function(obj) {
		ret = NULL
		for (i in 1:length(obj$merge)) {
			m = obj$merge[[i]]
			if (is.character(m) && length(m) == 4) {
				id = match(m[c(1,3)], names(obj$data)) - 1 # name ->> id
				if (any(is.na(id)))
					stop(paste("could not match all ids:", m[c(1,3)]))
				col = as.integer(m[c(2,4)]) - 1
				if (any(is.na(col)) || any(col < 0))
					stop("merge: parameters should be positive integers")
				str = paste("merge", id[1], "(", col[1], ") with", id[2], 
						"(", col[2], ");")
				ret = c(ret, str)
			} else stop(
				"list elements of merge should be lenght 4 character vectors")
		}
		ret
	}

	if (is.character(obj$merge) && length(obj$merge) == 2)
		obj$merge = list(c(obj$merge[1], 1, obj$merge[2], 1))
	if (is.list(obj$merge)) {
		str = gstat.merge(obj)
		ret = .C("Cload_gstat_command", str, as.integer(length(str)), 
			as.integer(0), PACKAGE = "gstat")[[3]]
		if (ret != 0)
			stop(paste("error occured when parsing command:", str[ret]))
	} else 
		stop("merge argument should be list or character vector of lenght 2")
}
"show.vgms" <-
function(min = 1e-12 * max, max = 3, n = 50, sill = 1, range = 1,
	models = as.character(vgm()[c(1:16)]), nugget = 0, kappa.range = 0.5,
	plot = TRUE) 
{

	zero.range.models = c("Nug", "Int", "Lin", "Err")
	# print(models)
	i = 0
	if (length(kappa.range) > 1) { # loop over kappa values for Matern model:
		data = matrix(NA, n * length(kappa.range), 2)
		v.level = rep("", n * length(kappa.range))
		for (kappa in kappa.range) {
			v = vgm(sill, "Mat", range, nugget = nugget, kappa = kappa)
			x = variogram.line(v, 0, 1, 0)
			data[(i*n+1), ] = as.matrix(x)
			x = variogram.line(v, max, n - 1, min)
			data[(i*n+2):((i+1)*n), ] = as.matrix(x)
			m.name = paste("vgm(", sill, ",\"Mat\",", range, sep = "")
			if (nugget > 0)
				m.name = paste(m.name, ",nugget=", nugget, sep = "")
			m.name = paste(m.name, ",kappa=", kappa, ")", sep = "")
			v.level[(i*n+1):((i+1)*n)] = rep(m.name, n)
			i =  i + 1
		}
	} else {
		data = matrix(NA, n * length(models), 2)
		v.level = rep("", n * length(models))
		for (m in models) {
			this.range = ifelse(!is.na(pmatch(m,zero.range.models)), 0, range)
			v = vgm(sill, m, this.range, nugget = nugget, kappa = kappa.range)
			x = variogram.line(v, 0, 1, 0)
			data[(i*n+1), ] = as.matrix(x)
			x = variogram.line(v, max, n - 1, min)
			data[(i*n+2):((i+1)*n), ] = as.matrix(x)
			m.name = paste("vgm(", sill, ",\"", m, "\",", this.range, sep = "")
			if (nugget > 0)
				m.name = paste(m.name, ",nugget=", nugget, sep = "")
			m.name = paste(m.name, ")", sep = "")
			v.level[(i*n+1):((i+1)*n)] = rep(m.name, n)
			i =  i + 1
		}
	}
	dframe = data.frame(semivariance = data[,2], distance = data[,1], 
		model = factor(v.level, levels = unique(v.level)))
	vgm.panel = function(x,y) {
		n = length(x)
		lpoints(x[1],y[1])
		llines(x[2:n],y[2:n])
	}
	if (!plot)
		dframe
	else
		xyplot(semivariance ~ distance | model, dframe, 
			panel = vgm.panel, as.table = TRUE)
}
"variogram.default" <-
function (object, locations, X, cutoff, width = cutoff/15.0, alpha = 0, 
    beta = 0, tol.hor = 90/length(alpha), tol.ver = 90/length(beta), 
    cressie = FALSE, dX = numeric(0), boundaries = numeric(0), 
    cloud = FALSE, trend.beta = NULL, debug.level = 1, cross = TRUE, 
	grid, map = FALSE, ...) 
{
    id1 = id2 = 0
    ret = NULL
    if (missing(cutoff)) {
		if (is.logical(map) && map == TRUE)
			stop("for variogram maps, supply at least a cutoff")
        cutoff = numeric(0)
	}
    else if (width <= 0) 
        stop("argument width should be positive")
    if (missing(width)) 
        width = numeric(0)
    if (cloud == TRUE) 
        width = 0
	if (is.logical(map) && map == TRUE) {
		# set up map:
		dx = seq(-cutoff, cutoff, by = width)
		map = data.frame(x = dx, y = dx)
		map = data.frame(lapply(map, as.double))
		require(sp)
		coordinates(map) = c("x", "y")
		gridded(map) = TRUE
	}
    .Call("gstat_init", as.integer(debug.level), PACKAGE = "gstat")
    id.names = NULL
    if (is.list(object) && is.list(locations)) {
        nvars = length(object)
        if (!is.null(names(object))) 
            id.names = names(object)
        for (i in 1:nvars) {
            if (missing(X)) 
                Xloc = rep(1, length(object[[i]]))
            else Xloc = X[[i]]
            t.beta = numeric(0)
            if (!is.null(trend.beta) && length(trend.beta) > 0) 
                t.beta = trend.beta[[i]]
            else t.beta = numeric(0)
			if (missing(grid) || !is.list(grid))
				grd = numeric(0)
			else
				grd = grid[[i]]
            .Call("gstat_new_data", as.double(object[[i]]), 
				as.double(locations[[i]]), as.double(Xloc), 
				as.integer(1), as.double(t.beta), as.integer(-1),
				as.integer(0), as.double(-1), as.integer(1), 
				double(0), grd, as.integer(0)
				, PACKAGE = "gstat"
				)
        }
    } else 
		stop("argument object and locations should be lists")

	if (is(map, "SpatialDataFrameGrid"))
		map = as.double(unlist(gridparameters(map)))

    pos = 0
    ids = NULL
	is.direct = NULL
	if (cross)
		id.range = nvars:1
	else
		id.range = 1:nvars
    for (id1 in id.range) {
        for (id2 in ifelse(cross, 1, id1):id1) {
            if (is.null(id.names)) 
                id = ifelse(id1 == id2, paste(id1), cross.name(id2, id1))
            else id = ifelse(id1 == id2, paste(id.names[id1]), 
                cross.name(id.names[id2], id.names[id1]))
            for (a in alpha) {
                for (b in beta) {
                  direction = as.numeric(c(a, b, tol.hor, tol.ver))
                  ret.call = .Call("gstat_variogram", 
				  		as.integer(c(id1 - 1, id2 - 1)), 
						as.numeric(cutoff), as.numeric(width), 
                    	as.numeric(direction), as.integer(cressie), 
                    	as.numeric(dX), as.numeric(boundaries), map
						, PACKAGE = "gstat"
						)
				  boundaries = numeric(0)
                  if (is.logical(map) && map == FALSE) {
                    np = ret.call[[1]]
                    sel = np > 0
                    n.dir = length(sel[sel])
                    if (n.dir > 0) {
                      dist = ret.call[[2]]
                      gamma = ret.call[[3]]
                      dir.a = rep(a, n.dir)
                      dir.b = rep(b, n.dir)
                      ids = c(ids, rep(id, n.dir))
					  is.direct = c(is.direct, id1 == id2)
                      df = data.frame(np = np[sel], dist = dist[sel], 
                        gamma = gamma[sel], dir.hor = dir.a, dir.ver = dir.b)
                      if (pos > 0) 
                        ret[(pos + 1):(pos + n.dir), ] = df
                      else ret = df
                      pos = pos + n.dir
                    }
				  } else {
				  	if (is.null(ret)) {
					  ret = data.frame(ret.call[[1]], ret.call[[2]],
							ret.call[[4]], ret.call[[3]])
					  names = c("dx", "dy", id, paste("np", id, sep="."))
					} else { 
					  ret = data.frame(ret, ret.call[[4]], ret.call[[3]])
					  names = c(names, id, paste("np", id, sep="."))
					}
					names(ret) = names
				  }
                }
            }
        }
    }
    .Call("gstat_exit", NULL, PACKAGE = "gstat")
	if (is.logical(map) && map == FALSE) {
    	ret$id = factor(ids, levels = unique(ids))
		attr(ret, "direct") = data.frame(id = unique(ids), is.direct = is.direct)
    	if (cloud) 
        	class(ret) = c("variogramCloud", "data.frame")
    	else 
			class(ret) = c("gstatVariogram", "data.frame")
	} else {
		require(sp)
		coordinates(ret) = c("dx", "dy")
		gridded(ret) = TRUE
		ret = list(map = ret)
		class(ret) = c("variogramMap", "list")
	}
    ret
}
"variogram.formula" <-
function (object, locations = try.coordinates(data), data, ...) 
{
	# gstat.formula takes care of the case where locations contains
	# both data and coordinates --- see there.
	## ret = gstat.formula(object, locations, data)
	## variogram(object = ret$y, locations = ret$locations, X = ret$X, ...)
	g = gstat(formula = object, locations = locations, data = data)
	variogram(g, ...)
}
"variogram.gstat" <-
function (object, ...) {
	if (!inherits(object, "gstat"))
		stop("first argument should be of class gstat")
	y = list()
	locations = list()
	X = list()
	beta = list()
	grid = list()
	for (i in 1:length(object$data)) {
		d = object$data[[i]]
		raw = gstat.formula(d$formula, d$locations, eval(d$data))
		y[[i]] = raw$y
		locations[[i]] = raw$locations
		X[[i]] = raw$X
		beta[[i]] = raw$beta
		grid[[i]] = raw$grid
		if (d$degree != 0)
			stop("degree != 0: residual variograms wrt coord trend using degree not supported")
	}
	names(y) = names(locations) = names(X) = names(object$data)
	# call variogram.default() next:
	variogram(y, locations, X, trend.beta = beta, grid = grid, ...)
}
"variogram.line" <-
function(object, maxdist, n=200, min=1.0e-6*maxdist, dir = c(1,0,0), ...)
{
	if (missing(object))
		stop("model is missing");
	if (!inherits(object, "variogramModel"))
		stop("model should be of mode variogramModel (use function vgm)")
	if (missing(maxdist))
		stop("maxdist is missing");
	if (length(dir) != 3)
		stop("dir should be numeric vector of length 3")
	pars = c(min,maxdist,n,dir)
	load.variogram.model(object, c(0,0)) # loads object into gstat 
	ret = .Call("gstat_variogram_values", as.integer(c(0,0)),
		as.numeric(pars)
		, PACKAGE = "gstat"
		)
	.Call("gstat_exit", 0, PACKAGE = "gstat");
	data.frame(dist=ret[[1]], gamma=ret[[2]])
}
"vgm" <-
function(psill = 0, model, range = 0, nugget, add.to, anis, kappa = 0.5) {
	add.to.df = function(x, y) {
		x = rbind(y, x)
		row.names(x) = 1:nrow(x)
		return(x)
	}
	n = .Call("gstat_get_n_variogram_models", 0, PACKAGE = "gstat")[[1]];
	m = .C("Cgstat_get_variogram_models", rep("",n), PACKAGE = "gstat")[[1]]
	mf = factor(m, levels = m)
	if (missing(model))
		return(mf)
	if (!any(m == model)) stop(paste("variogram model", model, "unknown\n"))
	if (missing(anis))
		anis = c(0,0,0,1,1)
	if (length(anis) == 2)
		anis = c(anis[1], 0, 0, anis[2], 1)
	else if (length(anis) != 5)
		stop("anis vector should have length 2 (2D) or 5 (3D)")
	if (model != "Nug") {
		if (model != "Lin" && model != "Err" && model != "Int")
			if (range <= 0.0) stop("range should be positive")
		else if(range < 0.0) stop("range should be non-negative")
	} else {
		if (range != 0.0) stop("Nugget should have zero range")
		if (anis[4] != 1.0 || anis[5] != 1.0)
			stop("Nugget anisotropy is nonsense")
	}
	if (!missing(nugget)) {
		ret = data.frame(model=mf[mf==model], psill=psill, range=range,
			kappa = kappa, ang1=anis[1], ang2=anis[2], ang3=anis[3], 
			anis1=anis[4], anis2=anis[5])
		n.vgm = data.frame(model=mf[mf=="Nug"], psill=nugget, range=0,
			kappa = 0.0, ang1=0.0, ang2=0.0, ang3=0.0, anis1=1.0, anis2=1.0)
		ret = add.to.df(n.vgm, ret)
	} else
		ret = data.frame(model=mf[mf==model], psill=psill, range=range,
			kappa = kappa, ang1=anis[1], ang2=anis[2], ang3=anis[3], 
			anis1=anis[4], anis2=anis[5])
	if (!missing(add.to))
		ret = add.to.df(data.frame(add.to), ret)
	class(ret) = c("variogramModel", "data.frame")
	ret
}
"get.direction.unitv" <- function(alpha, beta) {
	cb = cos(beta)
	c(cb * sin(alpha), cb * cos(alpha), sin(beta))
}

"vgm.panel.xyplot" <-
function (x, y, type = "p", pch = plot.symbol$pch, col, 
	col.line = plot.line$col, col.symbol = plot.symbol$col, lty = 
	plot.line$lty, cex = plot.symbol$cex, lwd = plot.line$lwd, 
	model = model, direction = direction, labels, shift = shift, ...) 
{
    x <- as.numeric(x)
    y <- as.numeric(y)
    if (length(x) > 0) {
        if (!missing(col)) {
            if (missing(col.line)) 
                col.line <- col
            if (missing(col.symbol)) 
                col.symbol <- col
        }
        plot.symbol <- trellis.par.get("plot.symbol")
        plot.line <- trellis.par.get("plot.line")
        lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch)
        if (!missing(model) && !is.null(model)) {
            ang.hor <- pi * (direction[1]/180)
			ang.ver <- pi * (direction[2]/180)
            dir <- get.direction.unitv(ang.hor, ang.ver)
            ret <- variogram.line(model, max(x), dir = dir)
            llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, 
                lwd = lwd)
        }
		if (!is.null(labels))
			ltext(x = x + shift * max(x), y = y, labels = labels)
    }
}

"xvgm.panel.xyplot" <-
function (x, y, subscripts, type = "p", pch = plot.symbol$pch, 
    col, col.line = plot.line$col, col.symbol = plot.symbol$col, 
    lty = plot.line$lty, cex = plot.symbol$cex, ids, lwd = plot.line$lwd, 
    model = model, direction = direction, labels, shift = shift, ...) 
{
    x <- as.numeric(x)
    y <- as.numeric(y)
    id <- as.character(ids[subscripts][1])
    if (length(x) > 0) {
        if (!missing(col)) {
            if (missing(col.line)) 
                col.line <- col
            if (missing(col.symbol)) 
                col.symbol <- col
        }
        plot.symbol <- trellis.par.get("plot.symbol")
        plot.line <- trellis.par.get("plot.line")
        lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch)
        if (!missing(model) && !is.null(model)) {
			if (inherits(model, "gstat"))
				m = model$model
			else
				m = model
			if (!is.list(m))
				stop("model argument not of class gstat or list")
			if (is.list(m) && !is.null(m[[id]])) {
                ang.hor <- pi * (direction[1]/180)
				ang.ver <- pi * (direction[2]/180)
                dir <- get.direction.unitv(ang.hor, ang.ver)
				ret <- variogram.line(m[[id]], max(x), dir = dir)
				llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, 
					lwd = lwd)
			}
        }
        if (!is.null(labels)) 
            ltext(x = x + shift * max(x), y = y, labels = labels[subscripts])
    }
}

"vgm.dir.panel.xyplot" <-
function (x, y, subscripts, type = "p", pch = plot.symbol$pch, 
    col, col.line = plot.line$col, col.symbol = plot.symbol$col, 
    lty = plot.line$lty, cex = plot.symbol$cex, lwd = plot.line$lwd, 
    model = model, dir.hor = dir.hor, labels, shift = shift, ...) 
{
    x <- as.numeric(x)
    y <- as.numeric(y)
    if (length(x) > 0) {
        if (!missing(col)) {
            if (missing(col.line)) 
                col.line <- col
            if (missing(col.symbol)) 
                col.symbol <- col
        }
        plot.symbol <- trellis.par.get("plot.symbol")
        plot.line <- trellis.par.get("plot.line")
        lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch)
        if (!missing(model) && !is.null(model)) {
            dir <- c(1, 0, 0)
            if (!missing(dir.hor)) {
                ang.hor <- pi * (dir.hor[subscripts][1]/180.0)
                dir <- get.direction.unitv(ang.hor, 0)
            }
            ret <- variogram.line(model, max = max(x), dir = dir)
            llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, 
                lwd = lwd)
        }
		if(!is.null(labels))
			ltext(x + shift * max(x), y, labels = labels[subscripts])
    }
}
"xyz2img" <-
function (xyz, zcol = 3, xcol = 1, ycol = 2) 
{
    if (ncol(xyz) < 3) 
        stop("xyz object should have at least three columns")
    z = xyz[, zcol]
    x = xyz[, xcol]
    y = xyz[, ycol]
    xx = sort(unique(x))
    yy = sort(unique(y))
    nx = length(xx)
    ny = length(yy)
    nmax = max(nx, ny)
    difx = diff(xx)
    if (diff(range(unique(difx))) > 1e-15) 
        stop("x intervals are not constant")
    dify = diff(yy)
    if (diff(range(unique(dify))) > 1e-15) 
        stop("y intervals are not constant")
    dx = difx[1]
    dy = dify[1]
    ratio = (nx * dx)/(ny * dy)
    xmin = min(xx)
    xmax = max(xx)
    xrange = xmax - xmin
    ymin = min(yy)
    ymax = max(yy)
    yrange = ymax - ymin
    zz = matrix(NA, nrow = nx, ncol = ny)
    xx = seq(xmin, xmax, dx)
    yy = seq(ymin, ymax, dy)
    row = round((x - xmin)/dx) + 1
    col = round((y - ymin)/dy) + 1
    for (i in 1:length(x)) zz[row[i], col[i]] = z[i]
    list(x = xx, y = yy, z = zz)
}
"zerodist" <- function(x, y, z, zero = 0.0) {
	zero = zero*zero # work with squares
	# calculates matrix with pairwise distances for 
	# coordinate vectors x and y:
	D <- outer(x, x, "-")^2 
	diag(D) <- 1
	if (!any(D <= zero))
		return(numeric(0))
	if (!missing(y))
		D <- D + outer(y, y, "-")^2
	diag(D) <- 1
	if (!any(D <= zero))
		return(numeric(0))
	if (!missing(z))
		D <- D + outer(z, z, "-")^2
	diag(D) <- 1
	n <- length(x)
	index <- 1:(n*n)
	z <- index[as.vector(D) <= zero]
    ret <- cbind(((z - 1) %/% n) + 1, ifelse(z %% n == 0, n, z %% n))
	if (zero > 0) {
		ret = cbind(ret, sqrt(as.vector(D)[z]))
    	ret = matrix(ret[ret[, 1] < ret[, 2], ], ncol = 3)
		colnames(ret) = c("left", "right", "dist")
	} else {
    	ret = matrix(ret[ret[, 1] < ret[, 2], ], ncol = 2)
		colnames(ret) = c("left", "right")
	}
	ret
}
### NAMESPACE VERSION:
.onLoad <-
function(lib, pkg) {
	# remove the require() call for 2.0.0:
	require(lattice)

	.Call("gstat_init", as.integer(1), PACKAGE = "gstat")
}

### pre-NAMESPACE VERSION:
## ".First.lib" <-
## function(lib, pkg) {
## 	require(lattice)
## 	library.dynam("gstat", pkg, lib)
## 	.Call("gstat_init", as.integer(1), PACKAGE = "gstat")
## }
 
 
variogram <- function(object, ...) UseMethod("variogram")
