Commit 56aaff91 authored by Christopher Lawrence's avatar Christopher Lawrence Committed by Andreas Tille

Import Debian changes 1.03.10-1

r-cran-pscl (1.03.10-1) unstable; urgency=low

  * New upstream release.
parents c5a187ee 0e0ba8b2
Package: pscl Package: pscl
Version: 1.03.6.1 Version: 1.03.10
Date: 2010-08-25 Date: 2011-03-27
Title: Political Science Computational Laboratory, Stanford University Title: Political Science Computational Laboratory, Stanford University
Author: Simon Jackman, with contributions from Alex Tahk, Achim Author: Simon Jackman, with contributions from Alex Tahk, Achim
Zeileis, Christina Maimone and Jim Fearon Zeileis, Christina Maimone and Jim Fearon
Maintainer: Simon Jackman <jackman@stanford.edu> Maintainer: Simon Jackman <jackman@stanford.edu>
Depends: R (>= 2.11.0), MASS, stats, mvtnorm, coda, gam Depends: R (>= 2.10.0), MASS, stats, mvtnorm, coda, gam, vcd
Suggests: MCMCpack, car, lmtest, sandwich, zoo Suggests: MCMCpack, car, lmtest, sandwich, zoo
Enhances: stats, MASS Enhances: stats, MASS
Imports: lattice
Description: Bayesian analysis of item-response theory (IRT) models, Description: Bayesian analysis of item-response theory (IRT) models,
roll call analysis; computing highest density regions; maximum roll call analysis; computing highest density regions; maximum
likelihood estimation of zero-inflated and hurdle models for likelihood estimation of zero-inflated and hurdle models for
...@@ -18,6 +19,6 @@ LazyLoad: true ...@@ -18,6 +19,6 @@ LazyLoad: true
LazyData: true LazyData: true
License: GPL-2 License: GPL-2
URL: http://pscl.stanford.edu/ URL: http://pscl.stanford.edu/
Packaged: 2011-03-28 23:03:05 UTC; jackman
Repository: CRAN Repository: CRAN
Date/Publication: 2011-03-21 14:58:50 Date/Publication: 2011-03-31 15:18:56
Packaged: 2011-03-21 12:57:49 UTC; ripley
1.03.10 * pythag deprecated in Rmath.h, use system hypot instead (3/13/2011)
* warnings about memory etc only come on with verbose=TRUE (req by Stephen Jessee)
1.03.9 * ideal: small change in partyLoyalty (thanks to Chris Hanretty)
* ideal: reformat output of ideal to be 3-d arrays
* ideal: change default prior precision for item parameters to .04 (used to be .01)
* added UKHouseOfCommons data; Example 6.9 in BASS
1.03.8 * added an optional "at" argument to predprob() methods for
count data so that the counts at which the probabilities
are evaluated can be specified
1.03.7 * small bug in constrain.item (reported by Paul Johnson)
* change normalization option in ideal to generate posterior means with mean 0, sd 1
* do normalization over all dimensions
* typos in documentation for pseudo-R2 (thanks to Henrik Pärn)
1.03.6 * made gam dependency explicit 1.03.6 * made gam dependency explicit
* change linear.hypothesis to linearHypothesis * change linear.hypothesis to linearHypothesis
...@@ -11,7 +28,6 @@ ...@@ -11,7 +28,6 @@
* added nj07 * added nj07
* added vote92 * added vote92
1.03.3 * improved offset handling in hurdle()/zeroinfl(): offsets in zero 1.03.3 * improved offset handling in hurdle()/zeroinfl(): offsets in zero
model are now allowed and can be different from count model. model are now allowed and can be different from count model.
See ?hurdle/?zeroinfl for details. See ?hurdle/?zeroinfl for details.
......
...@@ -572,7 +572,7 @@ model.matrix.hurdle <- function(object, model = c("count", "zero"), ...) { ...@@ -572,7 +572,7 @@ model.matrix.hurdle <- function(object, model = c("count", "zero"), ...) {
} }
predict.hurdle <- function(object, newdata, type = c("response", "prob", "count", "zero"), predict.hurdle <- function(object, newdata, type = c("response", "prob", "count", "zero"),
na.action = na.pass, ...) na.action = na.pass, at = NULL, ...)
{ {
type <- match.arg(type) type <- match.arg(type)
...@@ -629,7 +629,7 @@ predict.hurdle <- function(object, newdata, type = c("response", "prob", "count" ...@@ -629,7 +629,7 @@ predict.hurdle <- function(object, newdata, type = c("response", "prob", "count"
else if(!is.null(object$model)) y <- model.response(object$model) else if(!is.null(object$model)) y <- model.response(object$model)
else stop("predicted probabilities cannot be computed for fits with y = FALSE and model = FALSE") else stop("predicted probabilities cannot be computed for fits with y = FALSE and model = FALSE")
yUnique <- min(y):max(y) yUnique <- if(is.null(at)) 0:max(y) else at
nUnique <- length(yUnique) nUnique <- length(yUnique)
rval <- matrix(NA, nrow = length(mu), ncol = nUnique) rval <- matrix(NA, nrow = length(mu), ncol = nUnique)
dimnames(rval) <- list(rownames(X), yUnique) dimnames(rval) <- list(rownames(X), yUnique)
......
...@@ -124,7 +124,7 @@ ideal <- function(object, ...@@ -124,7 +124,7 @@ ideal <- function(object,
## check to see how much information will need to be stored ## check to see how much information will need to be stored
numrec <- (maxiter-burnin)/thin+1 numrec <- (maxiter-burnin)/thin+1
if (interactive() & if (interactive() & verbose &
((store.item)&&((n+m)*d*numrec>2000000)) ((store.item)&&((n+m)*d*numrec>2000000))
|| ||
((!store.item)&&((n*d*numrec)>2000000)) ((!store.item)&&((n*d*numrec)>2000000))
...@@ -138,7 +138,7 @@ ideal <- function(object, ...@@ -138,7 +138,7 @@ ideal <- function(object,
stop("User terminated execution of ideal.") stop("User terminated execution of ideal.")
} }
if (interactive() & numrec>1000) { if (interactive() & verbose & numrec>1000) {
ans <- readline(paste("You are attempting to save ",numrec," iterations. This\n", ans <- readline(paste("You are attempting to save ",numrec," iterations. This\n",
"could result in a very large object and cause memory problems.\n", "could result in a very large object and cause memory problems.\n",
"Do you want to continue with the current call to ideal? (y/n): ", "Do you want to continue with the current call to ideal? (y/n): ",
...@@ -222,8 +222,8 @@ ideal <- function(object, ...@@ -222,8 +222,8 @@ ideal <- function(object,
else{ else{
if(verbose) if(verbose)
cat("no prior precisions supplied for item parameters,\n", cat("no prior precisions supplied for item parameters,\n",
"setting to default of .01\n") "setting to default of .04\n")
bpv <- matrix(.01,m,d+1) bpv <- matrix(.04,m,d+1)
} }
if (((nrow(xp) != n)||(ncol(xp) != d)) || ((nrow(xpv)!=n)||(ncol(xpv)!=d))) { if (((nrow(xp) != n)||(ncol(xp) != d)) || ((nrow(xpv)!=n)||(ncol(xpv)!=d))) {
...@@ -256,14 +256,14 @@ ideal <- function(object, ...@@ -256,14 +256,14 @@ ideal <- function(object,
} }
if(is.null(bpv)){ if(is.null(bpv)){
if(verbose) if(verbose)
cat("setting prior precisions for item parameters to all 0.01\n") cat("setting prior precisions for item parameters to all 0.04\n")
bpv <- matrix(0.01,m,d+1) bpv <- matrix(0.04,m,d+1)
} }
xp <- as.vector(t(xp)) xp <- as.vector(xp)
xpv <- as.vector(t(xpv)) xpv <- as.vector(xpv)
bp <- as.vector(t(bp)) bp <- as.vector(bp)
bpv <- as.vector(t(bpv)) bpv <- as.vector(bpv)
################################################################ ################################################################
## check for start values - create if not supplied ## check for start values - create if not supplied
...@@ -334,15 +334,25 @@ ideal <- function(object, ...@@ -334,15 +334,25 @@ ideal <- function(object,
## report to user ## report to user
if(verbose){ if(verbose){
cat("using the following start values for ideal points (summary follows):\n") if(n<501){
print(summary(xstart)) cat("using the following start values for ideal points:\n")
print(xstart)
cat("using the following start values for item parameters (summary follows):\n") } else {
print(summary(bstart)) cat("using the following start values for ideal points (summary follows):\n")
print(summary(xstart))
}
if(m<501){
cat("using the following start values for item parameters:\n")
print(bstart)
} else {
cat("using the following start values for item parameters (summary follows):\n")
print(summary(bstart))
}
} }
xstart <- as.vector(t(xstart)) xstart <- as.vector(xstart)
bstart <- as.vector(t(bstart)) bstart <- as.vector(bstart)
options(warn=0) options(warn=0)
...@@ -351,7 +361,7 @@ ideal <- function(object, ...@@ -351,7 +361,7 @@ ideal <- function(object,
############################################################## ##############################################################
yToC <- ifelse(is.na(v), 9, v) yToC <- ifelse(is.na(v), 9, v)
yToC <- as.vector(t(yToC)) yToC <- as.vector(yToC)
cat("\nStarting MCMC Iterations...\n") cat("\nStarting MCMC Iterations...\n")
## ############################################ ## ############################################
...@@ -420,58 +430,51 @@ ideal <- function(object, ...@@ -420,58 +430,51 @@ ideal <- function(object,
cat("\n") cat("\n")
## parse returns from C job ## parse returns from C
xbar <- NULL
betabar <- NULL
if (!usefile) { if (!usefile) {
x <- output$xoutput
x <- matrix(x,nrow=numrec,byrow=T)
itervec <- seq(burnin,maxiter,by=thin) itervec <- seq(burnin,maxiter,by=thin)
x <- cbind(itervec,x) keep <- itervec > burnin
rownames(x) <- x[,1]
colnames(x) <- gencolnames(legis.names,d) ## ideal points
print(output$xoutput[1:(n*d)])
x <- array(output$xoutput,
c(n,d,numrec))
## reshape to iteration first format
x <- aperm(x,c(3,1,2))
dimnames(x) <- list(itervec,
legis.names,
paste("D",1:d,sep=""))
if(verbose)
cat("...computing posterior means for ideal points...")
xbar <- getMean(keep,x)
if(verbose)
cat("done\n")
###############################################################
## item parameters
if (store.item) { if (store.item) {
b <- output$boutput b <- array(output$boutput,c(d+1,m,numrec)) ## parameters by votes by iters
b <- matrix(b,nrow=numrec,byrow=T) dimnames(b) <- list(c(paste("Discrimination D",1:d,sep=""),
b <- cbind(itervec,b) "Difficulty"),
rownames(b) <- b[,1] vote.names,
colnames(b) <- gencolnames(vote.names,d,beta=T) itervec)
} ## reshape to iteration first format
else { b <- aperm(b,c(3,2,1)) ## iters by votes by parameters
if(verbose)
cat("...computing posterior means for item parameters...")
betabar <- getMean(keep,b)
if(verbose)
cat("done\n")
} else {
b <- NULL b <- NULL
} }
} } else { ## output went to a file
else { ## output went to a file
b <- x <- NULL b <- x <- NULL
} }
## compute some summary stats now, since we almost always use them
xbar <- betabar <- NULL
if(!is.null(x)){
if(verbose)
cat("MCMC sampling done, computing posterior means for ideal points...\n")
keep <- x[,1] > burnin
xbar <- apply(x[keep,-1],2,mean)
xbar <- matrix(xbar,n,d,byrow=TRUE)
mnames <- NULL
if(d>1){
for(j in 1:d)
mnames <- c(mnames,paste("Dimension",j))
}
dimnames(xbar) <- list(legis.names,mnames)
if(verbose)
cat("done\n")
}
if(store.item & !is.null(b)){
if(verbose)
cat("and for bill parameters...")
keep <- b[,1] > burnin
betabar <- apply(b[keep,-1],2,mean)
betabar <- matrix(betabar,m,d+1,byrow=TRUE)
if(verbose)
cat("done\n")
}
## wrap up for return to user ## wrap up for return to user
out <- list(n=n,m=m,d=d, out <- list(n=n,m=m,d=d,
codes=codes, codes=codes,
...@@ -484,41 +487,17 @@ ideal <- function(object, ...@@ -484,41 +487,17 @@ ideal <- function(object,
class(out) <- c("ideal") class(out) <- c("ideal")
## and, finally, if the user wanted meanzero ## and, finally, if the user wanted meanzero
if(normalize) if(normalize){
if(verbose)
cat("...normalizing output (post-processing)...")
out <- postProcess(out, out <- postProcess(out,
constraints="normalize") constraints="normalize")
if(verbose)
cat("done\n")
}
return(out) return(out)
} }
gencolnames <- function(name, d, beta=FALSE) {
if(d>1){ ## more than one dimension?
dname <- NULL
for(i in 1:d){
dname <- c(dname,paste(name,"d",i,sep=""))
}
if(beta)
dname <- c(dname,paste(name,"Difficulty",sep=""))
dname <- matrix(dname,ncol=length(name),byrow=TRUE)
dname <- as.vector(dname)
dname <- c("Iteration",dname)
}
else {
if(beta){
if(beta)
dname <- c(name,paste(name,"Intercept",sep=""))
dname <- matrix(dname,ncol=length(name),byrow=T)
dname <- as.vector(dname)
dname <- c("Iteration",dname)
}
else {
dname <- c("Iteration",name)
}
}
dname
}
x.startvalues <- function(x,d,scale=TRUE,constraint=NULL,verbose=FALSE){ x.startvalues <- function(x,d,scale=TRUE,constraint=NULL,verbose=FALSE){
if(verbose) if(verbose)
cat("will use eigen-decomposition method to get start values for ideal points...") cat("will use eigen-decomposition method to get start values for ideal points...")
...@@ -546,7 +525,7 @@ x.startvalues <- function(x,d,scale=TRUE,constraint=NULL,verbose=FALSE){ ...@@ -546,7 +525,7 @@ x.startvalues <- function(x,d,scale=TRUE,constraint=NULL,verbose=FALSE){
} }
if(verbose) if(verbose)
cat("done\n") cat("done\n")
v return(v)
} }
probit <- function(y,x){ probit <- function(y,x){
......
...@@ -3,9 +3,10 @@ ...@@ -3,9 +3,10 @@
## check validity of a burnin number ## check validity of a burnin number
## return logical of valid iters ## return logical of valid iters
checkBurnIn <- function(object, burnin) { checkBurnIn <- function(object, burnin) {
if (as.numeric(burnin)>=max(object$x[,1])) theIters <- as.numeric(dimnames(object$x)[[1]])
stop("start must be less than the number of iterations") if (as.numeric(burnin)>max(theIters))
return (object$x[,1] > burnin) stop("burnin greater than number of iterations")
return (theIters > burnin)
} }
checkD <- function(x,d) { checkD <- function(x,d) {
...@@ -18,28 +19,11 @@ checkCI <- function(conf.int) { ...@@ -18,28 +19,11 @@ checkCI <- function(conf.int) {
stop("conf.int must be between 0 and 1") stop("conf.int must be between 0 and 1")
} }
getDimX <- function(x,d,columns=TRUE) { getMean <- function(keep,x){
checkD(x,d) xbar <- apply(x[keep,,,drop=FALSE],
px <- NULL c(2,3),
if(columns) { mean)
px <- (x$x[,seq(from=d+1,to=ncol(x$x),by=x$d)]) dimnames(xbar) <- list(dimnames(x)[[2]],
colnames(px) <- x$legis.names dimnames(x)[[3]])
} else { return(xbar)
px <- (x$x[seq(from=d,to=nrow(x$x),by=x$d),])
rownames(px) <- x$legis.names
}
px
}
getDim <- function(x,d,dims,names,columns=TRUE) {
px <- NULL
if(columns) {
px <-(x[,seq(from=d,to=ncol(x),by=dims)])
colnames(px) <- names
}
else {
px <- (x[seq(from=d,to=nrow(x),by=dims),])
rownames(px) <- names
}
px
} }
...@@ -43,11 +43,15 @@ plot1d <- function(x, ...@@ -43,11 +43,15 @@ plot1d <- function(x,
checkCI(conf.int) ## check that confidence interval is ok checkCI(conf.int) ## check that confidence interval is ok
q <- c((1-conf.int)/2, 1-((1-conf.int)/2)) ## quantiles from CI q <- c((1-conf.int)/2, 1-((1-conf.int)/2)) ## quantiles from CI
xd <- getDimX(x,d) ## indicators for dimension xm <- x$xbar ## xbar
xm <- apply(xd[keep,],2,mean,na.rm=T) ## xbar
indx <- order(xm) ## sort index indx <- order(xm) ## sort index
exispar <- par(no.readonly=T) exispar <- par(no.readonly=T)
xq <- t(apply(xd[keep,],2,quantile,probs=q)) ## get CIs
myHPD <- function(x,prob){
tmp <- coda::as.mcmc(x)
return(coda::HPDinterval(tmp,prob))
}
xq <- t(apply(x$x[keep,,1],2,myHPD,prob=conf.int)) ## get HPDs
## names etc ## names etc
cat(paste("Looking up legislator names and party affiliations\n")) cat(paste("Looking up legislator names and party affiliations\n"))
...@@ -60,13 +64,13 @@ plot1d <- function(x, ...@@ -60,13 +64,13 @@ plot1d <- function(x,
rm(tmpObject) rm(tmpObject)
textLoc <- 1.05*min(xq) ## where to put x labels textLoc <- 1.05*min(xq) ## where to put x labels
if(showAllNames) if(showAllNames){
par(mar=c(3,longName*.55,4,2)+0.1, par(mar=c(3,longName*.55,4,2)+0.1,
oma=rep(0,4)) oma=rep(0,4))
else } else {
par(mar=c(3,longName*.75,4,2)+0.1, par(mar=c(3,longName*.75,4,2)+0.1,
oma=rep(0,4)) oma=rep(0,4))
}
## title string info ## title string info
mainString <- paste("Ideal Points: ", mainString <- paste("Ideal Points: ",
"Posterior Means and ", "Posterior Means and ",
...@@ -80,7 +84,8 @@ plot1d <- function(x, ...@@ -80,7 +84,8 @@ plot1d <- function(x,
x=1.02*range(xq), x=1.02*range(xq),
xaxs="i", xaxs="i",
xlab="",ylab="", xlab="",ylab="",
axes=F, type="n", axes=FALSE,
type="n",
...) ...)
mtext(mainString,side=3,line=3) mtext(mainString,side=3,line=3)
...@@ -107,7 +112,7 @@ plot1d <- function(x, ...@@ -107,7 +112,7 @@ plot1d <- function(x,
lines(y=c(i,i),x=xq[indx[i],],lwd=2) lines(y=c(i,i),x=xq[indx[i],],lwd=2)
if (is.null(party)){ if (is.null(party)){
points(y=i,x=xm[indx[i]],col="red",pch=19) points(y=i,x=xm[indx[i]],col="red",pch=19,xpd=NULL)
} }
else{ else{
tbl <- table(party, exclude=NULL) tbl <- table(party, exclude=NULL)
...@@ -116,7 +121,7 @@ plot1d <- function(x, ...@@ -116,7 +121,7 @@ plot1d <- function(x,
grp <- match(party[indx[i]],names(tbl)) grp <- match(party[indx[i]],names(tbl))
points(y=i, points(y=i,
x=pt, x=pt,
pch=19,col=cl[grp]) pch=19,col=cl[grp],xpd=NULL)
} }
} }
##par(ps=8) ##par(ps=8)
...@@ -167,16 +172,13 @@ plot2d <- function(x, ...@@ -167,16 +172,13 @@ plot2d <- function(x,
if(d1==d2) if(d1==d2)
stop("can't do 2 dimensional summaries of the same dimension\n") stop("can't do 2 dimensional summaries of the same dimension\n")
xd1 <- getDimX(x,d1)
xd2 <- getDimX(x,d2)
if(is.null(burnin)){ ## use x bar in ideal object if(is.null(burnin)){ ## use x bar in ideal object
xm1 <- x$xbar[,d1] xm1 <- x$xbar[,d1]
xm2 <- x$xbar[,d2] xm2 <- x$xbar[,d2]
} }
else{ else{
xm1 <- apply(xd1[keep,],2,mean) ## posterior means xm1 <- apply(x$x[keep,,d1],2,mean) ## posterior means
xm2 <- apply(xd2[keep,],2,mean) xm2 <- apply(x$x[keep,,d2],2,mean)
} }
if(oCP){ if(oCP){
...@@ -186,10 +188,11 @@ plot2d <- function(x, ...@@ -186,10 +188,11 @@ plot2d <- function(x,
alphaBar <- x$betabar[,(x$d+1)] alphaBar <- x$betabar[,(x$d+1)]
} }
else{ else{
betaBar <- apply(x$beta[keep,-1],2,mean) bKeep <- x$beta[keep,,,drop=FALSE]
b1Bar <- betaBar[seq(from=d1,by=x$d+1,length=x$m)] betaBar <- apply(bKeep,c(2,3),mean)
b2Bar <- betaBar[seq(from=d2,by=x$d+1,length=x$m)] b1Bar <- betaBar[,d1]
alphaBar <- betaBar[seq(from=x$d+1,by=x$d+1,length=x$m)] b2Bar <- betaBar[,d2]
alphaBar <- betaBar[,x$d]
} }
} }
...@@ -204,6 +207,7 @@ plot2d <- function(x, ...@@ -204,6 +207,7 @@ plot2d <- function(x,
type="p", type="p",
xlab=paste("Dimension ",as.character(d1),sep=""), xlab=paste("Dimension ",as.character(d1),sep=""),
ylab=paste("Dimension ",as.character(d2),sep=""), ylab=paste("Dimension ",as.character(d2),sep=""),
xpd=NULL,
...) ...)
if(oCP){ if(oCP){
for(j in 1:x$m) for(j in 1:x$m)
...@@ -212,8 +216,9 @@ plot2d <- function(x, ...@@ -212,8 +216,9 @@ plot2d <- function(x,
col=gray(.45)) col=gray(.45))
} }
} }
else{ else{ ## we have party info
plot(x=xm1,y=xm2, plot(x=xm1,
y=xm2,
main=mainString, main=mainString,
type="n", type="n",
xlab=paste("Dimension ",as.character(d1),sep=""), xlab=paste("Dimension ",as.character(d1),sep=""),
...@@ -232,7 +237,8 @@ plot2d <- function(x, ...@@ -232,7 +237,8 @@ plot2d <- function(x,
thisParty <- party==names(tbl)[i] thisParty <- party==names(tbl)[i]
points(y=xm2[thisParty], points(y=xm2[thisParty],
x=xm1[thisParty], x=xm1[thisParty],
pch=16,col=cl[i]) pch=16,col=cl[i],
xpd=NULL)
} }
} }
...@@ -315,7 +321,7 @@ tracex <- function(object, ...@@ -315,7 +321,7 @@ tracex <- function(object,
keep <- checkBurnIn(object,eval(object$call$burnin,envir=.GlobalEnv)) keep <- checkBurnIn(object,eval(object$call$burnin,envir=.GlobalEnv))
else else
keep <- checkBurnIn(object,burnin) keep <- checkBurnIn(object,burnin)
start <- object$x[keep,1][1] start <- as.numeric(dimnames(object$x)[[1]])[keep][1]
## ####################################################### ## #######################################################
## one-dimensional stuff ## one-dimensional stuff
...@@ -341,8 +347,8 @@ tracex <- function(object, ...@@ -341,8 +347,8 @@ tracex <- function(object,
for (i in 1:nLegis){ for (i in 1:nLegis){
meat <- object$x[keep,p[[i]]+d-1] meat <- object$x[keep,p[[i]],1]
iter <- object$x[keep,1] iter <- as.numeric(dimnames(object$x)[[1]])[keep]
par(mar=c(4, 4, 4, 2) + 0.1) par(mar=c(4, 4, 4, 2) + 0.1)
mainText <- plotName[i] mainText <- plotName[i]
...@@ -411,8 +417,8 @@ tracex <- function(object, ...@@ -411,8 +417,8 @@ tracex <- function(object,
col <- rainbow(nLegis) ## colors col <- rainbow(nLegis) ## colors
meat <- list() ## container for iters to plot meat <- list() ## container for iters to plot
for(i in 1:nLegis){ for(i in 1:nLegis){
xTraces <- object$x[keep,p[[i]][1]] xTraces <- object$x[keep,p[[i]],d[1]]
yTraces <- object$x[keep,p[[i]][2]] yTraces <- object$x[keep,p[[i]],d[2]]
meat[[i]] <- list(x=xTraces, meat[[i]] <- list(x=xTraces,
y=yTraces, y=yTraces,
col=col[i]) col=col[i])
...@@ -434,8 +440,11 @@ tracex <- function(object, ...@@ -434,8 +440,11 @@ tracex <- function(object,
axis(1,las=1) axis(1,las=1)
axis(2,las=1) axis(2,las=1)
lineFunc <- function(obj){ lineFunc <- function(obj){
points(obj$x[1],obj$y[1],pch=16,col=obj$col)
lines(obj$x,obj$y,col=obj$col) lines(obj$x,obj$y,col=obj$col)
points(obj$x[1],obj$y[1],pch=1,col="black",cex=2)
npoints <- length(obj$x)
points(obj$x[npoints],obj$y[npoints],
pch=16,col="black",cex=2)
} }
lapply(meat,lineFunc) lapply(meat,lineFunc)
......
...@@ -4,26 +4,39 @@ postProcess <- function(object, ...@@ -4,26 +4,39 @@ postProcess <- function(object,
debug=FALSE){ debug=FALSE){
if(class(object)!="ideal") if(class(object)!="ideal")
stop("postProcess only defined for objects of class ideal") stop("postProcess only defined for objects of class ideal")
## process constraints