##### 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