swh:1:snp:33a53053e50f7abe7d281cc0c803be827debf4a3
Raw File
Tip revision: 298da2447c47ae82148ed053286b951c796a4294 authored by Edzer J. Pebesma on 12 March 2007, 14:19:41 UTC
version 0.9-36
Tip revision: 298da24
plot.variogramCloud.R
# $Id: plot.variogramCloud.q,v 1.5 2006-12-12 12:38:19 edzer Exp $

"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)
			ret = data.frame(cbind(head, tail)[sel, ])
		} 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 == 1, ])
		}
		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, ...)
		}
    }
}
back to top