As the sketch map above, you can imagine the upper one is a plot of parameter space, for example, the mean and variance for normal distribution, and the lower one is the corresponding density plot. Any hints for doing this? Thank you~
UPDATE: As an enhancement, can I build a interactive version for this? Say, whenever I mouse-over a point, R shows the corresponding plot beneath.
Here is an interactive version, you can click on a point and then corresponding density plot appears. Mainly used ?identify
and as @Tyler suggested ?zoomInPlot
.
Some more details on how it works: rxlim
and rylim
defined at the very beginning is the size of rectangle which surrounds the selected point, so one might want to change the factor /20
. Possibility of multiple clicks is nontrivial: identify()
detects clicks only in the "recent" plot, i.e.
par(mfrow = c(1,2)) plot(1:10) # 1 plot(1:10) # 2 identifyPch(1:10)
detects clicks only in the plot #2 (here identifyPch()
is from ?identify
). For this issue par(mfg=c(1, 1))
was used:
mfg
A numerical vector of the form c(i, j) where i and j indicate which figure in an array of figures is to be drawn next (if setting) or is being drawn (if enquiring). The array must already have been set by mfcol or mfrow.
zoom <- function (x, y, xlim, ylim, xd, yd) { rxlim <- x + c(-1, 1) * (diff(range(xd))/20) rylim <- y + c(-1, 1) * (diff(range(yd))/20) par(mfrow = c(1, 2)) plot(xd, yd, xlab = "mean", ylab = "sd") xext <- yext <- rxext <- ryext <- 0 if (par("xaxs") == "r") { xext <- diff(xlim) * 0.04 rxext <- diff(rxlim) * 0.04 } if (par("yaxs") == "r") { yext <- diff(ylim) * 0.04 ryext <- diff(rylim) * 0.04 } rect(rxlim[1] - rxext, rylim[1] - ryext, rxlim[2] + rxext, rylim[2] + ryext) xylim <- par("usr") xypin <- par("pin") rxi0 <- xypin[1] * (xylim[2] - (rxlim[1] - rxext))/diff(xylim[1:2]) rxi1 <- xypin[1] * (xylim[2] - (rxlim[2] + rxext))/diff(xylim[1:2]) y01i <- xypin[2] * (xylim[4] - (rylim[2] + ryext))/diff(xylim[3:4]) y02i <- xypin[2] * ((rylim[1] - ryext) - xylim[3])/diff(xylim[3:4]) mu <- x curve(dnorm(x, mean = mu, sd = y), from = -4 * y + mu, to = 4 * y + mu, xlab = paste("mean:", round(mu, 2), ", sd: ", round(y, 2)), ylab = "") xypin <- par("pin") par(xpd = NA) xylim <- par("usr") xymai <- par("mai") x0 <- xylim[1] - diff(xylim[1:2]) * (xymai[2] + xymai[4] + rxi0)/xypin[1] x1 <- xylim[1] - diff(xylim[1:2]) * (xymai[2] + xymai[4] + rxi1)/xypin[1] y01 <- xylim[4] - diff(xylim[3:4]) * y01i/xypin[2] y02 <- xylim[3] + diff(xylim[3:4]) * y02i/xypin[2] par(xpd = TRUE) xend <- xylim[1] - diff(xylim[1:2]) * xymai[2]/(2 * xypin[1]) xprop0 <- (xylim[1] - xend)/(xylim[1] - x0) xprop1 <- (xylim[2] - xend)/(xylim[2] - x1) par(xpd = NA) segments(c(x0, x0, x1, x1), c(y01, y02, y01, y02), c(xend, xend, xend, xend), c(xylim[4] - (xylim[4] - y01) * xprop0, xylim[3] + (y02 - xylim[3]) * xprop0, xylim[4] - (xylim[4] - y01) * xprop1, xylim[3] + (y02 - xylim[3]) * xprop1)) par(mfg = c(1, 1)) plot(xd, yd, xlab = "mean", ylab = "sd") } ident <- function(x, y, ...) { ans <- identify(x, y, n = 1, plot = FALSE, ...) if(length(ans)) { zoom(x[ans], y[ans], range(x), range(y), x, y) points(x[ans], y[ans], pch = 19) ident(x, y) } } x <- rnorm(10) y <- rnorm(10, mean = 5) par(mfrow = c(1, 2)) plot(x, y, xlab = "mean", ylab = "sd") ident(x, y)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With