##### Using simulated data in all examples
  ##### Example 1
  set.seed(1234)
  n <- 300
  x1 <- rexp(n)
  x2 <- runif(n, 0, 5)
  x <- cbind(x1,x2)
  b <- function(p){matrix(cbind(1, qnorm(p), slp(p, 2)), nrow=4, byrow=TRUE)}
  theta <- matrix(0, nrow=3, ncol=4); theta[, 1] <- 1; theta[1,2] <- 1; theta[2:3,3] <- 2
  qy <- function(p, theta, b, x){rowSums(x * t(theta %*% b(p)))}
  y <- qy(runif(n), theta, b, cbind(1, x))
  s <- matrix(1, nrow=3, ncol=4); s[1,3:4] <- 0; s[2:3, 2] <- 0
  obj <- piqr(y ~ x1 + x2, formula.p = ~ I(qnorm(p)) + slp(p, 2), s=s, nlambda=50)
  best <- gof.piqr(obj, method="AIC", plot=FALSE)
  best2 <- gof.piqr(obj, method="BIC", plot=FALSE)
  summary(obj, best$posMinLambda)
  summary(obj, best2$posMinLambda)
  if (FALSE) {
  ##### other examples
  set.seed(1234)
  n <- 1000
  q <- 5
  k <- 3
  X <- matrix(abs(rnorm(n*q)), n, q)
  rownames(X) <- 1:n
  colnames(X) <- paste0("X", 1:q)
  theta <- matrix(c(3, 1.5, 1, 1,
                    2, 1, 1, 1,
                    0, 0, 0, 0,
                    0, 0, 0, 0,
                    1.5, 1, 1, 1,
                    0, 0, 0, 0),
                  ncol=(k+1), byrow=TRUE)
  rownames(theta) <- c("(intercept)", paste0("X", 1:q))
  colnames(theta) <- c("(intercept)", "slp(p,1)", "slp(p,2)", "slp(p,3)")
  B <- function(p, k){matrix(cbind(1, slp(p, k)), nrow=(k+1), byrow=TRUE)}
  Q <- function(p, theta, B, k, X){rowSums(X * t(theta %*% B(p, k)))}
  pp <- runif(n)
  y <- Q(p=pp, theta=theta, B=B, k=k, X=cbind(1, X))
  m1 <- piqr(y ~ X, formula.p = ~ slp(p, k))
  best1 <- gof.piqr(m1, method="AIC", plot=FALSE)
  best2 <- gof.piqr(m1, method="BIC", plot=FALSE)
  summary(m1, best1$posMinLambda)
  summary(m1, best2$posMinLambda)
  par(mfrow = c(1,3)); plot(m1, xvar="lambda");
                       plot(m1, xvar="objective"); plot(m1, xvar="grad")
  set.seed(1234)
  n <- 1000
  q <- 6
  k <- 4
  # x <- runif(n)
  X <- matrix(abs(rnorm(n*q)), n, q)
  rownames(X) <- 1:n
  colnames(X) <- paste0("X", 1:q)
  theta <- matrix(c(1, 2, 0, 0, 0,
                    2, 0, 1, 0, 0,
                    0, 0, 0, 0, 0,
                    1, 0, 0, 1, -1.2,
                    0, 0, 0, 0, 0,
                    1.5, 0, .5, 0, 0,
                    0, 0, 0, 0, 0),
                  ncol=(k+1), byrow=TRUE)
  rownames(theta) <- c("(intercept)", paste0("X", 1:q))
  colnames(theta) <- c("(intercept)", "qnorm(p)", "p", "log(p)", "log(1-p)")
  B <- function(p, k){matrix(cbind(1, qnorm(p), p, log(p), log(1-p)), nrow=(k+1), byrow=TRUE)}
  Q <- function(p, theta, B, k, X){rowSums(X * t(theta %*% B(p, k)))}
  pp <- runif(n)
  y <- Q(p=pp, theta=theta, B=B, k=k, X=cbind(1, X))
  s <- matrix(1, q+1, k+1); s[2:(q+1), 2] <- 0; s[1, 3:(k+1)] <- 0; s[2:3, 4:5] <- 0
  s[4:5, 3] <- 0; s[6:7, 4:5] <- 0
  m2 <- piqr(y ~ X, formula.p = ~ qnorm(p) + p + I(log(p)) + I(log(1-p)), s=s)
  best1 <- gof.piqr(m2, method="AIC", plot=FALSE)
  best2 <- gof.piqr(m2, method="BIC", plot=FALSE)
  summary(m2, best1$posMinLambda)
  summary(m2, best2$posMinLambda)
  par(mfrow = c(1,3)); plot(m2, xvar="lambda");
                       plot(m2, xvar="objective"); plot(m2, xvar="grad")
  }
  # see the documentation for 'summary.piqr', and 'plot.piqr'
Run the code above in your browser using DataLab