Question

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.

Answer 1

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)