#   Sampling from a distribution

cor.draw <- function(panel) {
   panel$rho <- min(panel$rho,  1)
   panel$rho <- max(panel$rho, -1)
   with(panel, {
      x <- matrix(rnorm(2 * as.numeric(n)), ncol = 2)
      if (abs(rho) < 1) {
        A <- chol(diag(sd) %*% matrix(c(1, rho, rho, 1), ncol = 2) %*% diag(sd))        
        x <- x %*% A
        }
      else if (rho >0) x[,2] <-  (x[,1] - mn[1] + mn[2]) * sd[2] / sd[1]
      else             x[,2] <- -(x[,1] - mn[1] + mn[2]) * sd[2] / sd[1]
      plot(mn[1] + x[,1], mn[2] + x[,2], 
              xlab = "x", xlim = mn[1] + c(-4, 4) * sd[1],
              ylab = "y", ylim = mn[2] + c(-4, 4) * sd[2])
      correlation.contours(panel)
      title(paste("Rho =", format(round(rho, 2), nsmal = 2), "  n =", as.character(n)))
      })
   panel
   }
   
correlation.contours <- function(object) {
   with(object, {
      if (contours.showing) {
         if (abs(rho) < 1) {
            ngrid  <- 30
            x1grid <- seq(mn[1] - 3 * sd[1], mn[1] + 3 * sd[1], length = ngrid)
            x2grid <- seq(mn[2] - 3 * sd[2], mn[2] + 3 * sd[2], length = ngrid)
            xgrid  <- cbind(rep(x1grid - mn[1], ngrid), 
                         rep(x2grid - mn[2], rep(ngrid, ngrid)))
            covinv <- 
                solve(diag(sd) %*% matrix(c(1, rho, rho, 1), ncol = 2) %*% diag(sd))
            dnorm2 <- function(x, covinv) exp(-0.5 * t(x) %*% covinv %*% x)
            dgrid  <- matrix(apply(xgrid, 1, dnorm2, covinv), ncol = ngrid)
            contour(x1grid, x2grid, dgrid, 
                            col = "blue", drawlabels = FALSE, add = TRUE)
            }
         }
      })
   object
   }
  
cor.redraw <- function(panel) {
   rp.tkrreplot(panel, plot)
   panel
   }

cor.panel <- rp.control("Correlation", contours.showing = FALSE,
                n = 30, mn = c(0, 0), sd = c(3, 3), rho = 0,
                sample.sizes = c("30", "100", "200"))
rp.tkrplot(cor.panel, plot, cor.draw, pos = "right")
rp.radiogroup(cor.panel, n, c(30, 100, 200),
          title = "Sample size", action = cor.redraw, pos = "top")
rp.button(cor.panel,
          title = "Sample", action = cor.redraw, pos = "top")
rp.slider(cor.panel, rho, -1, 1, 
          title = "rho", action = cor.redraw, pos = "top")
rp.checkbox(cor.panel, contours.showing, 
          title = "Population", action = cor.redraw, pos = "top")