Binary files /tmp/tmpb_8od6qh/KCbyRv5B39/car-3.1-0/build/vignette.rds and /tmp/tmpb_8od6qh/6Cfeu3JHAi/car-3.1-1/build/vignette.rds differ diff -Nru car-3.1-0/debian/changelog car-3.1-1/debian/changelog --- car-3.1-0/debian/changelog 2022-06-15 12:03:06.000000000 +0000 +++ car-3.1-1/debian/changelog 2022-10-20 00:07:17.000000000 +0000 @@ -1,3 +1,11 @@ +car (3.1-1-1) unstable; urgency=medium + + * New upstream release + + * debian/control: Set Build-Depends: to current R version + + -- Dirk Eddelbuettel Wed, 19 Oct 2022 19:07:17 -0500 + car (3.1-0-1) unstable; urgency=medium * New upstream release diff -Nru car-3.1-0/debian/control car-3.1-1/debian/control --- car-3.1-0/debian/control 2022-06-15 12:02:40.000000000 +0000 +++ car-3.1-1/debian/control 2022-10-20 00:06:59.000000000 +0000 @@ -2,7 +2,7 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.2.0), dh-r, r-cran-abind, r-cran-mass, r-cran-nnet, r-cran-mgcv, r-cran-pbkrtest (>= 0.4-4), r-cran-quantreg, r-cran-maptools, r-cran-rio, r-cran-lme4, r-cran-nlme, r-cran-cardata +Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.2.1), dh-r, r-cran-abind, r-cran-mass, r-cran-nnet, r-cran-mgcv, r-cran-pbkrtest (>= 0.4-4), r-cran-quantreg, r-cran-maptools, r-cran-rio, r-cran-lme4, r-cran-nlme, r-cran-cardata Standards-Version: 4.6.1 Vcs-Browser: https://salsa.debian.org/edd/r-cran-car Vcs-Git: https://salsa.debian.org/edd/r-cran-car.git diff -Nru car-3.1-0/DESCRIPTION car-3.1-1/DESCRIPTION --- car-3.1-0/DESCRIPTION 2022-06-15 10:20:02.000000000 +0000 +++ car-3.1-1/DESCRIPTION 2022-10-19 22:15:05.000000000 +0000 @@ -1,6 +1,6 @@ Package: car -Version: 3.1-0 -Date: 2022-06-07 +Version: 3.1-1 +Date: 2022-10-18 Title: Companion to Applied Regression Authors@R: c(person("John", "Fox", role = c("aut", "cre"), email = "jfox@mcmaster.ca"), person("Sanford", "Weisberg", role = "aut", email = "sandy@umn.edu"), @@ -23,6 +23,7 @@ person("Henric", "Nilsson", role = "ctb"), person("Derek", "Ogle", role = "ctb"), person("Brian", "Ripley", role = "ctb"), + person("Tom", "Short", role="ctb"), person("William", "Venables", role = "ctb"), person("Steve", "Walker", role="ctb"), person("David", "Winsemius", role="ctb"), @@ -30,11 +31,11 @@ person("R-Core", role="ctb")) Depends: R (>= 3.5.0), carData (>= 3.0-0) Imports: abind, MASS, mgcv, nnet, pbkrtest (>= 0.4-4), quantreg, - grDevices, utils, stats, graphics, maptools, lme4 (>= - 1.1-27.1), nlme + grDevices, utils, stats, graphics, lme4 (>= 1.1-27.1), nlme, + scales Suggests: alr4, boot, coxme, effects, knitr, leaps, lmtest, Matrix, - MatrixModels, rgl (>= 0.93.960), rio, sandwich, SparseM, - survival, survey + MatrixModels, mvtnorm, rgl (>= 0.93.960), rio, sandwich, + SparseM, survival, survey ByteCompile: yes LazyLoad: yes Description: @@ -45,6 +46,8 @@ https://CRAN.R-project.org/package=car, https://socialsciences.mcmaster.ca/jfox/Books/Companion/index.html VignetteBuilder: knitr +NeedsCompilation: no +Packaged: 2022-10-18 19:06:59 UTC; johnfox Author: John Fox [aut, cre], Sanford Weisberg [aut], Brad Price [aut], @@ -66,6 +69,7 @@ Henric Nilsson [ctb], Derek Ogle [ctb], Brian Ripley [ctb], + Tom Short [ctb], William Venables [ctb], Steve Walker [ctb], David Winsemius [ctb], @@ -73,9 +77,4 @@ R-Core [ctb] Maintainer: John Fox Repository: CRAN -Repository/R-Forge/Project: car -Repository/R-Forge/Revision: 712 -Repository/R-Forge/DateTimeStamp: 2022-06-07 21:31:00 -Date/Publication: 2022-06-15 10:20:02 UTC -NeedsCompilation: no -Packaged: 2022-06-07 21:51:23 UTC; rforge +Date/Publication: 2022-10-19 22:15:05 UTC Binary files /tmp/tmpb_8od6qh/KCbyRv5B39/car-3.1-0/inst/doc/embedding.pdf and /tmp/tmpb_8od6qh/6Cfeu3JHAi/car-3.1-1/inst/doc/embedding.pdf differ diff -Nru car-3.1-0/man/avPlots.Rd car-3.1-1/man/avPlots.Rd --- car-3.1-0/man/avPlots.Rd 2022-05-30 15:29:13.000000000 +0000 +++ car-3.1-1/man/avPlots.Rd 2022-08-30 15:26:47.000000000 +0000 @@ -155,7 +155,7 @@ avPlots(m1, ~ womwage, marginal.scale=TRUE, ellipse=list(levels=0.5)) # 3D AV plot, requires the rgl package -if (require("rgl")){ +if (interactive() && require("rgl")){ avPlot3d(lm(prestige ~ income + education + type, data=Duncan), "income", "education") } diff -Nru car-3.1-0/man/crPlots.Rd car-3.1-1/man/crPlots.Rd --- car-3.1-0/man/crPlots.Rd 2022-05-24 17:01:51.000000000 +0000 +++ car-3.1-1/man/crPlots.Rd 2022-08-30 15:26:11.000000000 +0000 @@ -44,7 +44,10 @@ smoother = c("loess", "mgcv", "none"), df.mgcv = NULL, loess.args = NULL, sphere.size = 1, radius = 1, threshold = 0.01, speed = 1, fov = 60, ellipsoid = FALSE, level = 0.5, ellipsoid.alpha = 0.1, - id = FALSE, ...) + id = FALSE, + mouseMode=c(none="none", left="polar", right="zoom", middle="fov", + wheel="pull"), + ...) } \arguments{ @@ -112,7 +115,7 @@ axis.col, surface.col, surface.alpha, point.col, text.col, grid.col, fogtype, fill, sphere.size, radius, threshold, speed, fov, - ellipsoid, level, ellipsoid.alpha}{see \code{\link{scatter3d}.}} + ellipsoid, level, ellipsoid.alpha, mouseMode}{see \code{\link{scatter3d}.}} } \details{ @@ -157,7 +160,7 @@ data=Womenlf, family=binomial), smooth=list(span=0.75)) # 3D C+R plot, requires the rgl, effects, and mgcv packages -if (require(rgl) && require(effects) && require(mgcv)){ +if (interactive() && require(rgl) && require(effects) && require(mgcv)){ crPlot3d(lm(prestige ~ income*education + women, data=Prestige), "income", "education") } diff -Nru car-3.1-0/man/Ellipses.Rd car-3.1-1/man/Ellipses.Rd --- car-3.1-0/man/Ellipses.Rd 2020-06-25 19:04:47.000000000 +0000 +++ car-3.1-1/man/Ellipses.Rd 2022-09-23 17:38:55.000000000 +0000 @@ -5,6 +5,10 @@ \alias{confidenceEllipse.default} \alias{confidenceEllipse.lm} \alias{confidenceEllipse.glm} +\alias{confidenceEllipse.mlm} +\alias{confidenceEllipses} +\alias{confidenceEllipses.default} +\alias{confidenceEllipses.mlm} \title{Ellipses, Data Ellipses, and Confidence Ellipses} \description{ @@ -29,14 +33,24 @@ \method{confidenceEllipse}{lm}(model, which.coef, vcov.=vcov, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, - col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...) + col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, + grid=TRUE, ...) \method{confidenceEllipse}{glm}(model, chisq, ...) +\method{confidenceEllipse}{mlm}(model, xlab, ylab, which.coef=1:2, ...) + \method{confidenceEllipse}{default}(model, which.coef, vcov.=vcov, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, - col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...) + col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, + grid=TRUE, ...) + +confidenceEllipses(model, ...) + +\method{confidenceEllipses}{default}(model, coefnames, main, grid=TRUE, ...) + +\method{confidenceEllipses}{mlm}(model, coefnames, main, ...) } \arguments{ @@ -110,18 +124,22 @@ which identifies the 2 points with the largest Mahalanobis distances from the center of the data.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} + \item{coefnames}{character vector of coefficient names to use to label the diagonal of the pairwise confidence ellipse matrix plotted by \code{confidenceEllipses}; defaults to the names of the coefficients in the model.} + \item{main}{title for matrix of pairwise confidence ellipses.} } \details{ The ellipse is computed by suitably transforming a unit circle. \code{dataEllipse} superimposes the normal-probability contours over a scatterplot of the data. + + \code{confidenceEllipses} plots a matrix of all pairwise confidence ellipses; each panel of the matrix is created by \code{confidenceEllipse}. } \value{ These functions are mainly used for their side effect of producing plots. For greater flexibility (e.g., adding plot annotations), however, \code{ellipse} returns invisibly the (x, y) coordinates of the calculated ellipse. \code{dataEllipse} and \code{confidenceEllipse} return invisibly the coordinates of one or more ellipses, in the latter instance a list named by - \code{levels}. + \code{levels}; \code{confidenceEllipses} invisibly returns \code{NULL}. } \references{ @@ -146,12 +164,17 @@ dataEllipse(Duncan$income, Duncan$education, levels=0.1*1:9, ellipse.label=0.1*1:9, lty=2, fill=TRUE, fill.alpha=0.1) -confidenceEllipse(lm(prestige~income+education, data=Duncan), Scheffe=TRUE) +confidenceEllipse(lm(prestige ~ income + education, data=Duncan), Scheffe=TRUE) -confidenceEllipse(lm(prestige~income+education, data=Duncan), vcov.=hccm) +confidenceEllipse(lm(prestige ~ income + education, data=Duncan), vcov.=hccm) -confidenceEllipse(lm(prestige~income+education, data=Duncan), +confidenceEllipse(lm(prestige ~ income + education, data=Duncan), L=c("income + education", "income - education")) + +confidenceEllipses(lm(prestige ~ income + education + type, data=Duncan), + fill=TRUE) +cov2cor(vcov(lm(prestige ~ income + education + type, + data=Duncan))) # correlations among coefficients wts <- rep(1, nrow(Duncan)) wts[c(6, 16)] <- 0 # delete Minister, Conductor diff -Nru car-3.1-0/man/hccm.Rd car-3.1-1/man/hccm.Rd --- car-3.1-0/man/hccm.Rd 2021-04-30 20:48:48.000000000 +0000 +++ car-3.1-1/man/hccm.Rd 2022-10-18 15:08:38.000000000 +0000 @@ -48,12 +48,19 @@ The function \code{hccm.default} simply catches non-\code{lm} objects. - See Freedman (2006) and Fox and Weisberg(2019, Sec. 5.1.2) for discussion of the use of these methods in generalized linear models or models with nonconstant variance. + See Freedman (2006) and Fox and Weisberg (2019, Sec. 5.1.2) for discussion of the use of these methods in generalized linear models or models with nonconstant variance. + + The heteroscedasticity-corrected covariance matrix will be singular if one or more observations have hatvalues (leverages) equal to 1, and hence is not a consistent estimate of the population covariance matrix. This will occur most often in outlier testing: if there are m suspected outliers then m dummy variables are added to the regression model corresponding to the m cases (See Section 2.2.2 of Cook and Weisberg (1982)). The function returns an error if the heteroscedasticity-corrected covariance matrix is singular. } \value{ The heteroscedasticity-corrected covariance matrix for the model. } + \references{ + Cook, R. D. and Weisberg, S. (1982). + Residuals and Influence in Regression, Chapman and Hall, + \url{https://hdl.handle.net/11299/37076}. + Cribari-Neto, F. (2004) Asymptotic inference under heteroskedasticity of unknown form. \emph{Computational Statistics and Data Analysis} \bold{45}, 215--233. @@ -80,16 +87,16 @@ \author{John Fox \email{jfox@mcmaster.ca}} \examples{ -options(digits=4) -mod<-lm(interlocks~assets+nation, data=Ornstein) -vcov(mod) +mod <- lm(interlocks ~ assets + nation, data=Ornstein) +print(vcov(mod), digits=4) ## (Intercept) assets nationOTH nationUK nationUS ## (Intercept) 1.079e+00 -1.588e-05 -1.037e+00 -1.057e+00 -1.032e+00 ## assets -1.588e-05 1.642e-09 1.155e-05 1.362e-05 1.109e-05 ## nationOTH -1.037e+00 1.155e-05 7.019e+00 1.021e+00 1.003e+00 ## nationUK -1.057e+00 1.362e-05 1.021e+00 7.405e+00 1.017e+00 ## nationUS -1.032e+00 1.109e-05 1.003e+00 1.017e+00 2.128e+00 -hccm(mod) + +print(hccm(mod), digits=4) ## (Intercept) assets nationOTH nationUK nationUS ## (Intercept) 1.664e+00 -3.957e-05 -1.569e+00 -1.611e+00 -1.572e+00 ## assets -3.957e-05 6.752e-09 2.275e-05 3.051e-05 2.231e-05 diff -Nru car-3.1-0/man/influencePlot.Rd car-3.1-1/man/influencePlot.Rd --- car-3.1-0/man/influencePlot.Rd 2022-03-05 17:41:24.000000000 +0000 +++ car-3.1-1/man/influencePlot.Rd 2022-09-23 16:20:18.000000000 +0000 @@ -16,7 +16,8 @@ influencePlot(model, ...) \method{influencePlot}{lm}(model, scale=10, - xlab="Hat-Values", ylab="Studentized Residuals", id=TRUE, ...) + xlab="Hat-Values", ylab="Studentized Residuals", id=TRUE, + fill=TRUE, fill.col=carPalette()[2], fill.alpha=0.5, ...) \method{influencePlot}{lmerMod}(model, ...) } @@ -31,6 +32,9 @@ \code{id=FALSE}; the default, \code{id=TRUE} is equivalent to \code{id=list(method="noteworthy", n=2, cex=1, col=carPalette()[1], location="lr")}. The default \code{method="noteworthy"} is used only in this function and indicates setting labels for points with large Studentized residuals, hat-values or Cook's distances. Set \code{id=list(method="identify")} for interactive point identification.} + \item{fill}{if \code{TRUE} (the default) fill the circles, with the opacity of the filled color proportional to Cook's D, using the \code{\link[scales]{alpha}} function in the \pkg{scales} package to compute the opacity of the fill.} + \item{fill.col}{color to use for the filled points, taken by default from the second element of the \code{\link{carPalette}} color palette.} + \item{fill.alpha}{the maximum alpha (opacity) of the points.} \item{\dots}{arguments to pass to the \code{plot} and \code{points} functions.} } @@ -51,10 +55,10 @@ } \author{John Fox \email{jfox@mcmaster.ca}, minor changes by S. Weisberg -\email{sandy@umn.edu}} +\email{sandy@umn.edu} and a contribution from Michael Friendly} -\seealso{\code{\link{cooks.distance}}, \code{\link{rstudent}}, +\seealso{\code{\link{cooks.distance}}, \code{\link{rstudent}}, \code{\link[scales]{alpha}}, \code{\link{carPalette}}, \code{\link{hatvalues}}, \code{\link{showLabels}}} \examples{ diff -Nru car-3.1-0/man/pointLabel.Rd car-3.1-1/man/pointLabel.Rd --- car-3.1-0/man/pointLabel.Rd 1970-01-01 00:00:00.000000000 +0000 +++ car-3.1-1/man/pointLabel.Rd 2022-10-04 22:29:17.000000000 +0000 @@ -0,0 +1,106 @@ +\name{pointLabel} +\alias{pointLabel} +\title{ Label placement for points to avoid overlaps } +\description{ + Use optimization routines to find good locations for point labels + without overlaps. +} +\usage{ +pointLabel(x, y = NULL, labels = seq(along = x), cex = 1, + method = c("SANN", "GA"), + allowSmallOverlap = FALSE, + trace = FALSE, + doPlot = TRUE, + ...) +} +\arguments{ + \item{x, y}{ as with \code{plot.default}, these provide the x and y coordinates for + the point labels. Any reasonable way of defining the coordinates is + acceptable. See the function \code{xy.coords} for details. } + \item{labels}{ as with \code{text}, a character vector or expression specifying the text to be + written. An attempt is made to coerce other language objects + (names and calls) to expressions, and vectors and other + classed objects to character vectors by \code{as.character}. } + \item{cex}{ numeric character expansion factor as with \code{text}. } + \item{method}{ the optimization method, either \dQuote{SANN} for simulated + annealing (the default) or \dQuote{GA} for a genetic algorithm. } + \item{allowSmallOverlap}{ logical; if \code{TRUE}, labels are allowed + a small overlap. The overlap allowed is 2\% of the diagonal + distance of the plot area.} + \item{trace}{ logical; if \code{TRUE}, status updates are given as the optimization algorithms + progress.} + \item{doPlot}{ logical; if \code{TRUE}, the labels are plotted on the + existing graph with \code{text}.} + \item{\ldots}{ arguments passed along to \code{text} to specify + labeling parameters such as \code{col}. } + +} +\details{ + + Eight positions are candidates for label placement, either + horizontally, vertically, or diagonally offset from the points. The + default position for labels is the top right diagonal relative to the + point (considered the preferred label position). + + With the default settings, simulating annealing solves faster than the + genetic algorithm. It is an open question as to which settles into a + global optimum the best (both algorithms have parameters that may be + tweaked). + + The label positioning problem is NP-hard (nondeterministic + polynomial-time hard). Placement becomes difficult and slows + considerably with large numbers of points. This function places all + labels, whether overlaps occur or not. Some placement algorithms + remove labels that overlap. + + Note that only \code{cex} is used to calculate string width and + height (using \code{strwidth} and \code{strheight}), so passing a + different font may corrupt the label dimensions. You could get around + this by adjusting the font parameters with \code{par} prior to running + this function. + +} +\value{ + An \code{xy} list giving the \code{x} and \code{y} positions of the + label as would be placed by \code{text(xy, labels)}. +} + +\section{Note}{This function was moved from the \pkg{maptools} package in anticipation of the retirement of that package, and with the permission of the function author.} + +\references{ + +\url{https://en.wikipedia.org/wiki/Automatic_label_placement} + +\url{https://i11www.iti.uni-karlsruhe.de/map-labeling/bibliography/} + +\url{http://www.eecs.harvard.edu/~shieber/Projects/Carto/carto.html} + +\url{http://www.szoraster.com/Cartography/PracticalExperience.htm} + +The genetic algorithm code was adapted from the python code at + +\url{https://meta.wikimedia.org/wiki/Map_generator}. + +The simulated annealing code follows the algorithm and guidelines in: + +Jon Christensen, Joe Marks, and Stuart Shieber. Placing text labels on +maps and diagrams. In Paul Heckbert, editor, Graphics Gems IV, pages +497-504. Academic Press, Boston, MA, 1994. +\url{http://www.eecs.harvard.edu/~shieber/Biblio/Papers/jc.label.pdf} + +} +\author{ Tom Short, EPRI, \email{tshort@epri.com} } +\seealso{ \code{\link{text}}, \code{\link[plotrix]{thigmophobe.labels}} + in package \pkg{plotrix} } +\examples{ +n <- 50 +x <- rnorm(n)*10 +y <- rnorm(n)*10 +plot(x, y, col = "red", pch = 20) +pointLabel(x, y, as.character(round(x,5)), offset = 0, cex = .7) + +plot(x, y, col = "red", pch = 20) +pointLabel(x, y, expression(over(alpha, beta[123])), offset = 0, cex = .8) + +} +\keyword{aplot} diff -Nru car-3.1-0/man/scatter3d.Rd car-3.1-1/man/scatter3d.Rd --- car-3.1-0/man/scatter3d.Rd 2022-05-30 15:29:13.000000000 +0000 +++ car-3.1-1/man/scatter3d.Rd 2022-08-30 01:05:41.000000000 +0000 @@ -41,7 +41,11 @@ sphere.size=1, radius=1, threshold=0.01, speed=1, fov=60, fit="linear", groups=NULL, parallel=TRUE, ellipsoid=FALSE, level=0.5, ellipsoid.alpha=0.1, id=FALSE, - model.summary=FALSE, ...) + model.summary=FALSE, + reg.function, reg.function.col=surface.col[length(surface.col)], + mouseMode=c(none="none", left="polar", right="zoom", middle="fov", + wheel="pull"), + ...) Identify3d(x, y, z, axis.scales=TRUE, groups = NULL, labels = 1:length(x), col = c("blue", "green", "orange", "magenta", "cyan", "red", "yellow", "gray"), @@ -135,6 +139,9 @@ least as many colours as groups; if there are no groups, the first colour is used. Normally, the colours would correspond to the \code{surface.col} argument to \code{scatter3d}.} \item{offset}{vertical displacement for point labels (to avoid overplotting the points).} + \item{reg.function}{an arithmetic expression that is a function of \code{x} and \code{z} (respectively, the horizontal and out-of-screen explanatory variables), representing an arbitrary regression function to plot.} + \item{reg.function.col}{color to use for the surface produced by \code{reg.function}; defaults to the \emph{last} color in \code{surface.col}.} + \item{mouseMode}{defines what the mouse buttons, etc., do; passed to \code{\link[rgl]{par3d}} in the \pkg{rgl} package; the default in \code{scatter3d} is the same as in the \pkg{rgl} package, except for the left mouse button.} \item{\dots}{arguments to be passed down.} } @@ -187,6 +194,27 @@ Sys.sleep(5) scatter3d(prestige ~ income + education | type, radius=(1 + women)^(1/3), data=Prestige) +Sys.sleep(5) +if (require(mvtnorm)){ + local({ + set.seed(123) + Sigma <- matrix(c( + 1, 0.5, + 0.5, 1), + 2, 2 + ) + X <- rmvnorm(200, sigma=Sigma) + D <- data.frame( + x1 = X[, 1], + x2 = X[, 2] + ) + D$y <- with(D, 10 + 1*x1 + 2*x2 + 3*x1*x2 + rnorm(200, sd=3)) + # plot true regression function + scatter3d(y ~ x1 + x2, D, + reg.function=10 + 1*x + 2*z + 3*x*z, + surface=FALSE, revolutions=2) + }) +} } \dontrun{ # requires user interaction to identify points # drag right mouse button to identify points, click right button in open area to exit diff -Nru car-3.1-0/MD5 car-3.1-1/MD5 --- car-3.1-0/MD5 2022-06-15 10:20:02.000000000 +0000 +++ car-3.1-1/MD5 2022-10-19 22:15:05.000000000 +0000 @@ -1,11 +1,11 @@ -ff560da752813540deba7ac1dd409c83 *DESCRIPTION -3c9c109375d59172c9747630da7e3f7f *NAMESPACE -eeeae94d67d46b715c9ac5eab71fcf9f *NEWS -cd0ef2d0d6c97c1e65c0b8bc74b3e67d *R/Anova.R +4de43bc0e9c3d451047844db99ae4492 *DESCRIPTION +ab79e532a13c66fda227a7e88d86b2cc *NAMESPACE +1d34236aa24dfa06a171060a3b61e831 *NEWS +33fc2a976152118c303875d20dc97dc7 *R/Anova.R 3effd70a639a7336269f94a285d12807 *R/Boot.R -7a59048f55c9b7c24cd211c2add306f2 *R/Boxplot.R +923a00fbf64c35abc42805ed43f4e974 *R/Boxplot.R 0de785cf1492be1ff844173d644aeb6e *R/Contrasts.R -5bf18f5700fe1ceeea10e0936d3841d8 *R/Ellipse.R +ab0c55fcdd19b532a277d4047819e8a1 *R/Ellipse.R 92b5f034161893d40061302f560713cc *R/Export.R a674772c26eea0a05dccbed64614f47d *R/Import.R 89b92c8d474a07961b936add617df9d8 *R/Predict.R @@ -26,16 +26,16 @@ 46a7d8f865abcfc4b78145e87d40ea25 *R/carWeb.R 3ed6b97ba60b4749edf08d428b022c71 *R/ceresPlots.R 320f846a1788e0b8ce19294a3d7238c1 *R/compareCoefs.R -0ed174c23962f95308de874fbae527c2 *R/crPlot3d.R +2b6a9163fa192866fd2caa71b841228e *R/crPlot3d.R 7550dc327b2fd42741f8b021599a6670 *R/crPlots.R 76ceb735f9775bcbaa0c218cf5fe0c31 *R/deltaMethod.R 5d4c4d78b963e1f598648246498f0d49 *R/densityPlot.R cb88c6ed6b7df0507502578ba8faa887 *R/dfbetaPlots.R a89ec78a4487110c5315c4d204517067 *R/durbinWatsonTest.R -c39759ef9430aae545772da4c84fa8f0 *R/hccm.R +1120fe3ce8db9681a01f1b771e11681d *R/hccm.R de1c06572c573c84d37a9e77b14b5ff2 *R/infIndexPlot.R b2e49aeed279384dce3552ca8e73d7ea *R/influence-mixed-models.R -5a2306470b02be96861f14675669168e *R/influencePlot.R +7754412cdc643bba6abb4618201c809d *R/influencePlot.R 8c40677332f61a2d70c95a9f96ec0253 *R/invResPlot.R 3cba0d8358049f1ecb54e7486ca8a889 *R/invTranPlot.R 07425429472a206c91e9a5f04553387a *R/leveneTest.R @@ -48,17 +48,18 @@ 89aaca3deb4c124a7a7c51d9f9d8aa40 *R/outlierTest.R 1eb88def199cf5837f3faf812e5f7c67 *R/panel.car.R 79be4f89175ad19509ca87916ed57f33 *R/poTest.R +0a0a2d24d0539896e998ab3d285940ec *R/pointLabel.R 07056f3e557e63ee95681a6ea643b081 *R/powerTransform.R edd2795ac4e2c188985a05adc0013e55 *R/powerTransformlmer.R 5cff5736345ed39803538314884e98cf *R/qqPlot.R 2b83ebb69b3fce0f752c4a6f80b5f23c *R/recode.R 2ffa28985dcab22f222c5687fed744a6 *R/regLine.R 754f41a48da5b5bcf5f5557acc34f2de *R/residualPlots.R -a6fcd2c38b55530d3ff05218583cbf57 *R/scatter3d.R +ac62f851567d6dfebd9a8e8b779bc6e7 *R/scatter3d.R c7a3bb289e877e0449b84aa6b779c40f *R/scatterplot.R 57e68c519e455f66477253f6cf64f955 *R/scatterplotMatrix.R 2a39ba86fd900c0cc33a89f079f3bf91 *R/scatterplotSmoothers.R -1b4288cb9189cf0e579e325db82ca724 *R/showLabels.R +894b365dae4b641dbb9c59c4b2ce6019 *R/showLabels.R 11bf042736b3cabd46ce713d09c147fa *R/sigmaHat.R 9314e03ceb0ce81847849890c19abe41 *R/some.R 4b09095391198869bcf7719fb008926d *R/spreadLevelPlot.R @@ -69,17 +70,17 @@ 510fb482d599708b15d24f2389fc5f10 *R/vif.R 317b9f576ec59708c8945d1f8126c5fa *R/wcrossprod.R d90296231464288e04124e8f1d864302 *R/which.names.R -3d6121a48a66265705550955e77d8064 *build/vignette.rds +f44f9d17f3bb733d89bbf63f82127643 *build/vignette.rds e2082206594825292948475ea3960d0a *inst/CITATION 7621f84dece1418b1687ca3516d1bdf8 *inst/doc/embedding.R 984ec51291df672146d63264a1d3b428 *inst/doc/embedding.Rnw -25397e9c80dd7ab25d605eedb8f658d6 *inst/doc/embedding.pdf +7c849a22b546ec2c434128b19f4bb99a *inst/doc/embedding.pdf b6b5c8008a809152b9308aba25757693 *inst/misc/car-hex.pdf 37c2d8ee74207a549851e70344a4821e *man/Anova.Rd 379318432c40f0f6ae63bfa5d4827146 *man/Boot.Rd ff51ddead5705eea6a0c341f7ba6cd31 *man/Boxplot.Rd c0b45af98a0fc46375bd67cab5c16907 *man/Contrasts.Rd -0ed5a58e2e5f17fe1e40e33f0be67477 *man/Ellipses.Rd +d26a77be7036de46c616ceb78303ca1f *man/Ellipses.Rd 499e738440e3964bcb4dcc8012139d29 *man/Export.Rd e13214ced0c4ae81af6ae8fa31088330 *man/Import.Rd 21f5d9493f5a75444a2fc29d426d4d94 *man/Predict.Rd @@ -87,7 +88,7 @@ f33ca470464b7ba360338070e8dc3118 *man/ScatterplotSmoothers.Rd c8f84af19b4ed745941e52ffea675fe8 *man/Tapply.Rd 93f423f8e2b58b240a1ac1ca2450ec64 *man/TransformationAxes.Rd -7e4a6bda1552032b27718764df310f5e *man/avPlots.Rd +6a2fb4b96960ab40ecf5cf46b07ea4b9 *man/avPlots.Rd c3b71b5d466f5cd348081e55f0d37aa4 *man/bcPower.Rd 8dc42cb9e3555b4401599c59757d56ea *man/boxCox.Rd 584517c6bf28306d59bb0aa2ec77f3dc *man/boxCoxVariable.Rd @@ -101,16 +102,16 @@ bb02287c5d1a1a0e15d00750cf75ade8 *man/carWeb.Rd a130c7d676ee3954d1dead941398265d *man/ceresPlots.Rd 58fa779b32a45ef1170c8262a0f4439f *man/compareCoefs.Rd -314d0b1d339c6246d5d60338d8a0eb6c *man/crPlots.Rd +b61ed466a568592d71fcbc43114ea5e5 *man/crPlots.Rd 3b920194dd649f7b4801ad0845ec20c1 *man/deltaMethod.Rd a96436d9a0ec006374d431e9aa294b52 *man/densityPlot.Rd 3e5c68e5f118aa2a0abae358afd1bca5 *man/dfbetaPlots.Rd 90958fada247ed72d05247db2a5f7a24 *man/durbinWatsonTest.Rd -a3a445ef8d7dad21614c06b08f81f7f4 *man/hccm.Rd +47fd0867ef19239e81e9fb3aaa7a4328 *man/hccm.Rd 37ea5af56353b7db504b4327b347daf3 *man/hist.boot.Rd 9c03608405b5c26070c02c4cc1842a96 *man/infIndexPlot.Rd bf8ee5ab1199f6fbb1de71e7b0e979c2 *man/influence-mixed-models.Rd -13c059b68a624a0b544caad20ed005b8 *man/influencePlot.Rd +851d732bc183c797f9e7c8f4951fc424 *man/influencePlot.Rd eca15590f3162495bef3432ffb08e631 *man/invResPlot.Rd 3f76990cbc8e9035c1cefd424cd1598a *man/invTranPlot.Rd 0b5bf989bf429ac840eeda6941b3eb30 *man/leveneTest.Rd @@ -123,12 +124,13 @@ 01526b54b43c5dd59afea0d28271dbb4 *man/outlierTest.Rd 6454d18a770e6b5f3c4883f8f0a9892a *man/panel.car.Rd 60fcdc949824d17eed24fc17d14f51d5 *man/poTest.Rd +3106b01f7243c5577967cb085b0f7518 *man/pointLabel.Rd c6eee7952bc60c84165353880dedb140 *man/powerTransform.Rd e280dd002ab6d30f3d899bc352cdddcd *man/qqPlot.Rd c44b1f80b6da4dc7a0405adbc9b95447 *man/recode.Rd 4a473fa630d2c75e4f2e84af1a6a7083 *man/regLine.Rd 72ce0e0d91029df6d790a4e6ea9fb0c8 *man/residualPlots.Rd -deec71eb9ad9c36e24d31666b7431837 *man/scatter3d.Rd +5461820747f444633ce8c18faaa1466c *man/scatter3d.Rd ced81e87472eec1626d7f4bfb95c3157 *man/scatterplot.Rd e178488836197c6142558fc7b1e47801 *man/scatterplotMatrix.Rd 39bd10269ecfd9b30c3f84a66b259e60 *man/showLabels.Rd diff -Nru car-3.1-0/NAMESPACE car-3.1-1/NAMESPACE --- car-3.1-0/NAMESPACE 2022-06-07 20:40:42.000000000 +0000 +++ car-3.1-1/NAMESPACE 2022-10-04 22:40:45.000000000 +0000 @@ -1,4 +1,4 @@ -# last modified 2022-06-07 by J. Fox +# last modified 2022-10-04 by J. Fox # additions for car >= 3.0-0, started 2016-12-27 @@ -6,6 +6,7 @@ export(Confint, S, carPalette, poTest, brief) export(avPlot3d, crPlot3d) export(strings2factors) +export(pointLabel) S3method(Confint, lm) S3method(Confint, glm) S3method(Confint, multinom) @@ -74,12 +75,14 @@ "AIC", "BIC", "expand.model.frame") importFrom("utils", "download.file", "capture.output", "askYesNo", "browseURL", "globalVariables", "getFromNamespace") +importFrom("grDevices", "as.graphicsAnnot", "xy.coords") +importFrom("stats", "runif") # from earlier versions car package importFrom(graphics, abline, arrows, axis, box, boxplot, contour, hist, identify, layout, legend, lines, locator, mtext, pairs, par, plot, points, polygon, - rug, segments, strheight, strwidth, text) + rug, segments, strheight, strwidth, text, title) importFrom(grDevices, boxplot.stats, col2rgb, gray, palette, rgb) importFrom(stats, D, IQR, alias, anova, as.formula, binomial, bw.nrd0, coef, coefficients, complete.cases, confint, contrasts, "contrasts<-", cooks.distance, cor, @@ -104,6 +107,7 @@ carHexsticker, carWeb, confidenceEllipse, + confidenceEllipses, contr.Helmert, contr.Sum, contr.Treatment, @@ -218,6 +222,9 @@ S3method(confidenceEllipse, default) S3method(confidenceEllipse, glm) S3method(confidenceEllipse, lm) +S3method(confidenceEllipse, mlm) +S3method(confidenceEllipses, default) +S3method(confidenceEllipses, mlm) S3method(print, spreadLevelPlot) S3method(qqPlot, default) S3method(qqPlot, glm) diff -Nru car-3.1-0/NEWS car-3.1-1/NEWS --- car-3.1-0/NEWS 2022-06-07 21:31:00.000000000 +0000 +++ car-3.1-1/NEWS 2022-10-18 15:12:06.000000000 +0000 @@ -1,10 +1,26 @@ +Changes to Version 3.1-1 + + o Fixed bug in hccm(): when some cases are fit exactly all versions of the hccm estimate are singular and inconsistent. A error message is now returned. + + o Fixed bug in Anova.survreg() for Wald tests (reported by Megan Taylor Jones), which failed with a spurious "missing residual df" error. + + o Made Anova.lm() more robust when there are aliased coefficients (following report of cryptic output by Taiwo Fagbohungbe). + + o Added reg.function, reg.function.col, and mouseMode arguments to scatter3d(), and mouseMode to crPlot3d(). + + o Added fill and associated arguments to influencePlot() (initial implementation of Michael Friendly). + + o Added confidenceEllipses() function to create matrix of all pairwise confidence ellipses for a regression model (suggestion of Michael Friendly). + + o Moved the pointLabel() function from the maptools package in anticipation of the retirement of that package, and with the permission of the function author, Tom Short. + Changes to Version 3.1-0 o New 3D added-variable and component+residual plots, avPlot3d() and crPlot3d(). o More flexible recode()/Recode(). - o Added Anova.svycoxph() to prevent seledtion of test.statistic="LR". + o Added Anova.svycoxph() to prevent selection of test.statistic="LR". o New take on vif.lm(). diff -Nru car-3.1-0/R/Anova.R car-3.1-1/R/Anova.R --- car-3.1-0/R/Anova.R 2022-06-07 20:51:23.000000000 +0000 +++ car-3.1-1/R/Anova.R 2022-08-20 17:02:07.000000000 +0000 @@ -71,6 +71,9 @@ # 2022-01-17,18: handle singularities better in Anova.mlm() (suggestion of Marius Barth) # 2922-04-24: introduce new error.df argument for linearHypothesis.default(). JF # 2022-06-07: Added Anova.svycoxph(). JF +# 2022-07-22: Fix bug in Anova.survreg() for Wald tests (reported by Megan Taylor Jones). JF +# 2022-07-22: Make Anova.lm() more robust when there are aliased coefficients (following report by Taiwo Fagbohungbe). JF +# 2022-07-27: Tweaked the last fix so the tolerance for deciding rank is the same for the lm model and the temporary glm model. SW #------------------------------------------------------------------------------- @@ -98,17 +101,25 @@ } lm2glm <- function(mod){ - class(mod) <- c("glm", "lm") - wts <- mod$weights - mod$prior.weights <- if (is.null(wts)) rep(1, length(mod$residuals)) else wts - mod$y <- model.response(model.frame(mod)) - mod$linear.predictors <- mod$fitted.values - mod$control <- list(epsilon=1e-8, maxit=25, trace=FALSE) - mod$family <- gaussian() - mod$deviance <- sum(residuals(mod)^2, na.rm=TRUE) - mod + # class(mod) <- c("glm", "lm") + # wts <- mod$weights + # mod$prior.weights <- if (is.null(wts)) rep(1, length(mod$residuals)) else wts + # mod$y <- model.response(model.frame(mod)) + # mod$linear.predictors <- mod$fitted.values + # mod$control <- list(epsilon=1e-8, maxit=25, trace=FALSE) + # mod$family <- gaussian() + # mod$deviance <- sum(residuals(mod)^2, na.rm=TRUE) + # mod + Data <- getModelData(mod) + wts <- weights(mod) + Data$..wts.. <- if (is.null(wts)) rep(1, nrow(Data)) else wts + form <- formula(mod) + eps <- 1000 * (if(is.null(mod$call$tol)) 1e-7 else mod$call$tol) + glm(form, weights=..wts.., data=Data, control=list(epsilon=eps)) } +globalVariables("..wts..") + Anova <- function(mod, ...){ UseMethod("Anova", mod) } @@ -1403,16 +1414,20 @@ switch(type, II=switch(test.statistic, LR=Anova.II.LR.survreg(mod), - Wald=Anova.II.Wald.survreg(mod)), + # Wald=Anova.II.Wald.survreg(mod) + Wald=Anova.Wald.survreg(mod, type="2")), III=switch(test.statistic, LR=Anova.III.LR.survreg(mod), - Wald=Anova.III.Wald.survreg(mod)), + # Wald=Anova.III.Wald.survreg(mod) + Wald=Anova.Wald.survreg(mod, type="3")), "2"=switch(test.statistic, LR=Anova.II.LR.survreg(mod), - Wald=Anova.II.Wald.survreg(mod)), + # Wald=Anova.II.Wald.survreg(mod) + Wald=Anova.Wald.survreg(mod, type="2")), "3"=switch(test.statistic, LR=Anova.III.LR.survreg(mod), - Wald=Anova.III.Wald.survreg(mod))) + # Wald=Anova.III.Wald.survreg(mod) + Wald=Anova.Wald.survreg(mod, type="3"))) } Anova.II.LR.survreg <- function(mod, ...){ @@ -1513,18 +1528,29 @@ result } -Anova.II.Wald.survreg <- function(mod){ - V <- vcov(mod, complete=FALSE) - b <- coef(mod) - if (length(b) != nrow(V)){ - # p <- which(rownames(V) == "Log(scale)") - p <- which(grepl("^Log\\(scale", rownames(V))) - if (length(p) > 0) V <- V[-p, -p] - } - Anova.II.default(mod, V, test="Chisq") -} +# Anova.II.Wald.survreg <- function(mod){ +# V <- vcov(mod, complete=FALSE) +# b <- coef(mod) +# if (length(b) != nrow(V)){ +# # p <- which(rownames(V) == "Log(scale)") +# p <- which(grepl("^Log\\(scale", rownames(V))) +# if (length(p) > 0) V <- V[-p, -p] +# } +# Anova.II.default(mod, V, test="Chisq") +# } +# +# Anova.III.Wald.survreg <- function(mod){ +# V <- vcov(mod, complete=FALSE) +# b <- coef(mod) +# if (length(b) != nrow(V)){ +# # p <- which(rownames(V) == "Log(scale)") +# p <- which(grepl("^Log\\(scale", rownames(V))) +# if (length(p) > 0) V <- V[-p, -p] +# } +# Anova.III.default(mod, V, test="Chisq") +# } -Anova.III.Wald.survreg <- function(mod){ +Anova.Wald.survreg <- function(mod, type){ V <- vcov(mod, complete=FALSE) b <- coef(mod) if (length(b) != nrow(V)){ @@ -1532,7 +1558,7 @@ p <- which(grepl("^Log\\(scale", rownames(V))) if (length(p) > 0) V <- V[-p, -p] } - Anova.III.default(mod, V, test="Chisq") + Anova.default(mod, V, test.statistic="Chisq", type=type) } # Default Anova() method: requires methods for vcov() (if vcov. argument not specified) and coef(). diff -Nru car-3.1-0/R/Boxplot.R car-3.1-1/R/Boxplot.R --- car-3.1-0/R/Boxplot.R 2018-01-24 00:41:34.000000000 +0000 +++ car-3.1-1/R/Boxplot.R 2022-10-04 22:30:35.000000000 +0000 @@ -6,6 +6,7 @@ # 2016-10-01: tweaked data.frame and list methods. J. Fox # 2017-01-11: consolidate id argument # 2017-10-03: add col and cex to id argument +# 2022-10-04: pointLabel() is now in the car package. Boxplot <- function(y, ...){ arg.list <- list(...) @@ -69,7 +70,7 @@ labs <- c(labs.low, labs.high) at <- if(!is.null(pars$at)) pars$at else 1 if (id.location == "lr") text(at, c(y.low, y.high), labs, pos = 2, xpd=TRUE, cex=id.cex, col=id.col) - else maptools::pointLabel(c(at, at), c(y.low, y.high, y.low, y.high), + else pointLabel(c(at, at), c(y.low, y.high, y.low, y.high), c(paste0(" ", labs, " "), rep(" ", length(labs))), xpd=TRUE, col=id.col, cex=id.cex) return(if (length(labs) == 0) invisible(NULL) else labs) @@ -128,7 +129,7 @@ at <- if(!is.null(pars$at)) pars$at[group] else group labs <- c(labs.low, labs.high) if (id.location == "lr") text(at, c(y.low, y.high), labs, pos = pos, xpd=TRUE, col=id.col, cex=id.cex) - else maptools::pointLabel(c(at, at), c(y.low, y.high, y.low, y.high), + else pointLabel(c(at, at), c(y.low, y.high, y.low, y.high), c(paste0(" ", labs, " "), rep(" ", length(labs))), xpd=TRUE, col=id.col, cex=id.cex) identified <- c(identified, c(labs.low, labs.high)) diff -Nru car-3.1-0/R/crPlot3d.R car-3.1-1/R/crPlot3d.R --- car-3.1-0/R/crPlot3d.R 2022-05-28 02:06:36.000000000 +0000 +++ car-3.1-1/R/crPlot3d.R 2022-08-30 15:17:44.000000000 +0000 @@ -37,6 +37,8 @@ level = 0.5, ellipsoid.alpha = 0.1, id = FALSE, + mouseMode=c(none="none", left="polar", right="zoom", middle="fov", + wheel="pull"), ...) { smoother <- match.arg(smoother) @@ -45,6 +47,8 @@ if (!requireNamespace("mgcv") && smoother == "mgcv") stop("mgcv package missing") if (!requireNamespace("effects")) stop("effects package missing") + rgl::par3d(mouseMode=mouseMode) + loess.args <- applyDefaults( loess.args, defaults = list( diff -Nru car-3.1-0/R/Ellipse.R car-3.1-1/R/Ellipse.R --- car-3.1-0/R/Ellipse.R 2020-12-16 17:18:50.000000000 +0000 +++ car-3.1-1/R/Ellipse.R 2022-09-24 00:53:39.000000000 +0000 @@ -24,6 +24,7 @@ # 2015-09-04: throw error if there are too few colors for groups (fixing bug reported by Ottorino Pantani). J. Fox # 2016-02-16: replace cov.trob() call with MASS::cov.trob(). J. Fox # 2017-11-30: substitute carPalette() for palette(). J. Fox +# 2022-09-22: add grid argument. J. Fox ellipse <- function(center, shape, radius, log="", center.pch=19, center.cex=1.5, segments=51, draw=TRUE, add=draw, xlab="", ylab="", col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, @@ -221,10 +222,9 @@ UseMethod("confidenceEllipse") } - confidenceEllipse.lm <- function(model, which.coef, vcov.=vcov, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, - col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...){ + col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, grid=TRUE, ...){ if (missing(dfn)) dfn <- if (Scheffe) sum(df.terms(model)) else 2 dfd <- df.residual(model) vcov. <- getVcov(vcov., model) @@ -256,7 +256,7 @@ add.plot <- !level==max(levels) | add result[[i]] <- ellipse(coef, shape, radius, add=add.plot, xlab=xlab, ylab=ylab, center.pch=center.pch, center.cex=center.cex, segments=segments, - col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...) + col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, grid=grid, ...) } invisible(if (length(levels) == 1) result[[1]] else result) } @@ -264,7 +264,7 @@ confidenceEllipse.default <- function(model, which.coef, vcov.=vcov, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, - col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...){ + col=carPalette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, grid=TRUE, ...){ vcov. <- getVcov(vcov., model) #if (is.function(vcov.)) vcov. <- vcov.(model) if (missing(L)){ @@ -297,7 +297,7 @@ add.plot <- !level==max(levels) | add result[[i]] <- ellipse(coef, shape, radius, add=add.plot, xlab=xlab, ylab=ylab, center.pch=center.pch, center.cex=center.cex, segments=segments, - col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...) + col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, grid=grid, ...) } invisible(if (length(levels) == 1) result[[1]] else result) } @@ -325,3 +325,109 @@ ylab <- names(coef)[2] list(coef=coef, shape=shape, xlab=xlab, ylab=ylab) } + +confidenceEllipses <- function(model, ...) { + UseMethod("confidenceEllipses") +} + +confidenceEllipses.default <- function(model, coefnames, main, grid=TRUE, ...) { + if (missing(main)) + main <- paste("Pairwise Confidence Ellipses for", + deparse(substitute(model))) + b <- coef(model) + p <- length(b) + if (missing(coefnames)) + coefnames <- paste0(names(b), "\ncoefficient") + save <- + par( + mfrow = c(p, p), + mar = c(2, 2, 0, 0) + 0.1, + oma = c(0, 0, 2, 0) + 0.2 + ) + on.exit(par(save)) + ylab <- coefnames[1] + for (i in 1:p) { + for (j in 1:p) { + if (j == 1) { + yaxis <- TRUE + } else { + yaxis <- FALSE + } + if (i == p) { + xaxis <- TRUE + } else { + xaxis <- FALSE + } + if (i == j) { + if (i == 1) { + confidenceEllipse( + model, + c(2, 1), + xaxt = "n", + yaxt = "n", + center.pch = "", + col = "white", + grid = FALSE + ) + axis(2) + } else if (j == p) { + confidenceEllipse( + model, + c(p, 2), + xaxt = "n", + yaxt = "n", + center.pch = "", + col = "white", + grid = FALSE + ) + axis(1) + } + else { + confidenceEllipse( + model, + c(1, 2), + xaxt = "n", + yaxt = "n", + center.pch = "", + col = "white", + grid = FALSE + ) + } + usr <- par("usr") + text(mean(usr[1:2]), mean(usr[3:4]), coefnames[i]) + } + else{ + confidenceEllipse(model, c(j, i), # xlab = xlab, ylab = ylab, + xaxt = "n", yaxt = "n", grid=grid, ...) + if (j == 1) + axis(2) + if (i == p) + axis(1) + } + } + } + title(main = main, + outer = TRUE, + line = 1) + invisible(NULL) +} + +confidenceEllipse.mlm <- function(model, xlab, ylab, which.coef=1:2, ...){ + if (missing(xlab) || missing(ylab)){ + coefnames <- rownames(vcov(model)) + if (missing(xlab)) xlab <- coefnames[which.coef[1]] + if (missing(ylab)) ylab <- coefnames[which.coef[2]] + } + NextMethod(xlab=xlab, ylab=ylab) +} + +confidenceEllipses.mlm <- function(model, coefnames, main, ...) { + if (missing(coefnames)) { + coefnames <- rownames(vcov(model)) + coefnames <- paste0(coefnames, "\ncoefficient") + } + if (missing(main)) + main <- paste("Pairwise Confidence Ellipses for", + deparse(substitute(model))) + NextMethod(coefnames = coefnames, main = main) +} diff -Nru car-3.1-0/R/hccm.R car-3.1-1/R/hccm.R --- car-3.1-0/R/hccm.R 2021-08-01 12:15:05.000000000 +0000 +++ car-3.1-1/R/hccm.R 2022-10-13 00:17:16.000000000 +0000 @@ -6,6 +6,8 @@ # (reported by Justin Yap). J. Fox # 2021-07-29: Report error when any hatvalue = 1 for all but hc0 and hc1 # (following report of problem reported by Peng Ding) J. Fox +# 2022-10-11: Modified error reports for hatvalue = 1, and add for +# hc0 and hc1. S. Weisberg #------------------------------------------------------------------------------- # Heteroscedasticity-corrected standard errors (Huber/White adjustment) (J. Fox) @@ -42,22 +44,19 @@ hc2 = 1 - h, hc3 = (1 - h)^2, hc4 = (1 - h)^pmin(4, n * h/p)) V <- V %*% t(X) %*% apply(X, 2, "*", (e^2)/factor) %*% V bad <- h > 1 - sqrt(.Machine$double.eps) - if ((n.bad <- sum(bad)) > 0 && !(type %in% c("hc0", "hc1"))) { + if ((n.bad <- sum(bad)) > 0 ) { nms <- names(e) bads <- if (n.bad <= 10) { paste(nms[bad], collapse=", ") } else { paste0(paste(nms[bad[1:10]], collapse=", "), ", ...") - } - if (any(is.nan(V))){ - stop("cannot proceed because of ", n.bad, if (n.bad == 1) " case " else " cases ", - "with hatvalue = 1:\n ", bads) - } else { - warning("adjusted coefficient covariances may be unstable because of ", n.bad, - if (n.bad == 1) " case " else " cases ", - "with hatvalue near 1:\n ", bads) - } - } + }} +# error checking. hc2, hc3, hc4 may have nan's if n.bad > 1 + if (n.bad > 0 & any(is.nan(V))) + stop("hccm estimator is singular because of ", n.bad, if (n.bad == 1) " case " else " cases ", "with hatvalue = 1:\n ", bads) +# for hc0, hc1 there are no nans, but V may be singular + if (qr(V)$rank < p) + stop("hccm estimator is singular because of ", n.bad, if (n.bad == 1) " case " else " cases ", "with hatvalue = 1:\n ", bads) V } diff -Nru car-3.1-0/R/influencePlot.R car-3.1-1/R/influencePlot.R --- car-3.1-0/R/influencePlot.R 2019-01-02 17:16:09.000000000 +0000 +++ car-3.1-1/R/influencePlot.R 2022-09-24 15:16:21.000000000 +0000 @@ -1,3 +1,5 @@ +# influencePlot.R + # changed point marking, 25 November 2009 by S. Weisberg # deleted the cutoff for Cook's D, and the coloring of the circles # inserted default labeling of the id.n largest Cook D. @@ -11,16 +13,32 @@ # 2017-02-12: consolidated id argument. J. Fox # 2017-11-30: substitute carPalette() for palette(). J. Fox # 2019-01-02: added lmerMod method. J. Fox +# 2022-09-21: Fill the bubble points by default. M. Friendly & J. Fox # moved from Rcmdr 5 December 2006 +colscale <- function(x, y, colors, min, max){ + n <- length(colors) + polygon(x=c(x[1], x[2], x[2], x[1]), y=c(y[1], y[1], y[2], y[2]), xpd=TRUE) + xincrement <- (x[2] - x[1])/n + for (i in 1:n){ + xx <- c(x[1] + (i - 1)*xincrement, x[1] + i*xincrement) + polygon(x=c(xx[1], xx[2], xx[2], xx[1]), y=c(y[1], y[1], y[2], y[2]), + border=NA, col=colors[i], xpd=TRUE) + } + text(x[1], mean(y), labels=min, pos=2, xpd=TRUE) + text(x[2], mean(y), labels=max, pos=4, xpd=TRUE) +} + influencePlot <- function(model, ...){ UseMethod("influencePlot") } influencePlot.lm <- function(model, scale=10, xlab="Hat-Values", ylab="Studentized Residuals", - id=TRUE, ...){ + id=TRUE, + fill=TRUE, fill.col=carPalette()[2], fill.alpha=0.5, + ...){ id <- applyDefaults(id, defaults=list(method="noteworthy", n=2, cex=1, col=carPalette()[1], location="lr"), type="id") if (isFALSE(id)){ id.n <- 0 @@ -44,10 +62,21 @@ scale <- scale/max(cook, na.rm=TRUE) p <- length(coef(model)) n <- sum(!is.na(rstud)) - plot(hatval, rstud, xlab=xlab, ylab=ylab, type='n', ...) + plot(hatval, rstud, xlab=xlab, ylab=ylab, type="n", ...) abline(v=c(2, 3)*p/n, lty=2) abline(h=c(-2, 0, 2), lty=2) - points(hatval, rstud, cex=scale*cook, ...) + points(hatval, rstud, cex=scale*cook, ...) + if (fill) { + cols <- scales::alpha(fill.col, alpha=fill.alpha*(cook^2/max(cook)^2)) + points(hatval, rstud, cex=scale*cook, col=cols, pch=16) + usr <- par("usr") + left <- usr[1] + 0.2*(usr[2] - usr[1]) + right <- usr[1] + 0.8*(usr[2] - usr[1]) + bot <- usr[4] + strheight("a") + top <- bot + 2*strheight("A") + colors <- scales::alpha(fill.col, alpha=seq(0, 1, length=100)) + colscale(c(left, right), c(bot, top), colors, "Cook's D: 0", signif(max(cook)^2, 3)) + } if(id.method == "noteworthy"){ which.rstud <- order(abs(rstud), decreasing=TRUE)[1:id.n] which.cook <- order(cook, decreasing=TRUE)[1:id.n] diff -Nru car-3.1-0/R/pointLabel.R car-3.1-1/R/pointLabel.R --- car-3.1-0/R/pointLabel.R 1970-01-01 00:00:00.000000000 +0000 +++ car-3.1-1/R/pointLabel.R 2022-10-04 19:34:08.000000000 +0000 @@ -0,0 +1,218 @@ +pointLabel <- function(x, y = NULL, labels = seq(along = x), cex = 1, + method = c("SANN", "GA"), + allowSmallOverlap = FALSE, + trace = FALSE, + doPlot = TRUE, + ...) +{ + if (!missing(y) && (is.character(y) || is.expression(y))) { + labels <- y + y <- NULL + } + labels <- as.graphicsAnnot(labels) + boundary <- par()$usr + xyAspect <- par()$pin[1] / par()$pin[2] # width / height + # scale to a unit area from 0 to 1 + toUnityCoords <- function(xy) { + list(x = (xy$x - boundary[1]) / (boundary[2] - boundary[1]) * xyAspect, + y = (xy$y - boundary[3]) / (boundary[4] - boundary[3]) / xyAspect) + } + toUserCoords <- function(xy) { + list(x = boundary[1] + xy$x / xyAspect * (boundary[2] - boundary[1]), + y = boundary[3] + xy$y * xyAspect * (boundary[4] - boundary[3])) + } + z <- xy.coords(x, y, recycle = TRUE) + z <- toUnityCoords(z) + x <- z$x + y <- z$y + if (length(labels) < length(x)) + labels <- rep(labels, length(x)) + method <- match.arg(method) + + if (allowSmallOverlap) + nudgeFactor <- 0.02 + n_labels <- length(x) + # There are eight possible alignment codes, corresponding to the + # corners and side mid-points of the rectangle + # Codes are 1:8 + # Code 7 (top right) is the most preferred + width <- (strwidth(labels, units = "figure", cex = cex) + 0.015) * xyAspect + height <- (strheight(labels, units = "figure", cex = cex) + 0.015) / xyAspect + + gen_offset <- function(code) + c(-1, -1, -1, 0, 0, 1, 1, 1)[code] * (width/2) + + 1i * c(-1, 0, 1, -1, 1, -1, 0, 1)[code] * (height/2) + + + # Finds intersection area of two rectangles + rect_intersect <- function(xy1, offset1, xy2, offset2) { + w <- pmin(Re(xy1+offset1/2), Re(xy2+offset2/2)) - pmax(Re(xy1-offset1/2), Re(xy2-offset2/2)) + h <- pmin(Im(xy1+offset1/2), Im(xy2+offset2/2)) - pmax(Im(xy1-offset1/2), Im(xy2-offset2/2)) + w[w <= 0] <- 0 + h[h <= 0] <- 0 + w*h + } + + nudge <- function(offset) { + # Nudge the labels slightly if they overlap: + doesIntersect <- rect_intersect(xy[rectidx1] + offset[rectidx1], rectv[rectidx1], + xy[rectidx2] + offset[rectidx2], rectv[rectidx2]) > 0 + + pyth <- abs(xy[rectidx1] + offset[rectidx1] - xy[rectidx2] - offset[rectidx2]) / nudgeFactor + eps <- 1.0e-10 + + for (i in which(doesIntersect & pyth > eps)) { + idx1 <- rectidx1[i] + idx2 <- rectidx2[i] + vect <- (xy[idx1] + offset[idx1] - xy[idx2] - offset[idx2]) / pyth[idx1] + offset[idx1] <- offset[idx1] + vect + offset[idx2] <- offset[idx2] - vect + } + offset + } + + objective <- function(gene) { + offset <- gen_offset(gene) + + # Allow for "bending" the labels a bit + if (allowSmallOverlap) offset <- nudge(offset) + + if (!is.null(rectidx1)) + area <- sum(rect_intersect(xy[rectidx1] + offset[rectidx1], rectv[rectidx1], + xy[rectidx2] + offset[rectidx2], rectv[rectidx2])) + else + area <- 0 + + # Penalize labels which go outside the image area + # Count points outside of the image + n_outside <- sum(Re(xy + offset - rectv/2) < 0 | Re(xy + offset + rectv/2) > xyAspect | + Im(xy + offset - rectv/2) < 0 | Im(xy + offset + rectv/2) > 1/xyAspect) + res <- 1000 * area + n_outside + #cat(n_outside,"\n") + res + } + + # Make a list of label rectangles in their reference positions, + # centered over the map feature; the real labels are displaced + # from these positions so as not to overlap + # Note that some labels can be bigger than others + xy <- x + 1i * y + rectv <- width + 1i * height + + rectidx1 <- rectidx2 <- array(0, (length(x)^2 - length(x)) / 2) + k <- 0 + for (i in 1:length(x)) + for (j in seq(len=(i-1))) { + k <- k + 1 + rectidx1[k] <- i + rectidx2[k] <- j + } + canIntersect <- rect_intersect(xy[rectidx1], 2 * rectv[rectidx1], + xy[rectidx2], 2 * rectv[rectidx2]) > 0 + rectidx1 <- rectidx1[canIntersect] + rectidx2 <- rectidx2[canIntersect] + if (trace) cat("possible intersects =", length(rectidx1), "\n") + + if (trace) cat("portion covered =", sum(rect_intersect(xy, rectv,xy,rectv)),"\n") + + GA <- function() { + # Make some starting genes + n_startgenes <- 1000 # size of starting gene pool + n_bestgenes <- 30 # genes selected for cross-breeding + prob <- 0.2 + + # Mutation function: O(n^2) time + mutate <- function(gene) { + offset <- gen_offset(gene) + # Directed mutation where two rectangles intersect + doesIntersect <- rect_intersect(xy[rectidx1] + offset[rectidx1], rectv[rectidx1], + xy[rectidx2] + offset[rectidx2], rectv[rectidx2]) > 0 + + for (i in which(doesIntersect)) { + gene[rectidx1[i]] <- sample(1:8, 1) + } + # And a bit of random mutation, too + for (i in seq(along=gene)) + if (runif(1) <= prob) + gene[i] <- sample(1:8, 1) + gene + } + + # Crossbreed two genes, then mutate at "hot spots" where intersections remain + crossbreed <- function(g1, g2) + ifelse(sample(c(0,1), length(g1), replace = TRUE) > .5, g1, g2) + + + genes <- matrix(sample(1:8, n_labels * n_startgenes, replace = TRUE), n_startgenes, n_labels) + + for (i in 1:10) { + scores <- array(0., NROW(genes)) + for (j in 1:NROW(genes)) + scores[j] <- objective(genes[j,]) + rankings <- order(scores) + genes <- genes[rankings,] + bestgenes <- genes[1:n_bestgenes,] + bestscore <- scores[rankings][1] + if (bestscore == 0) { + if (trace) cat("overlap area =", bestscore, "\n") + break + } + # At each stage, we breed the best genes with one another + genes <- matrix(0, n_bestgenes^2, n_labels) + for (j in 1:n_bestgenes) + for (k in 1:n_bestgenes) + genes[n_bestgenes*(j-1) + k,] <- mutate(crossbreed(bestgenes[j,], bestgenes[k,])) + + genes <- rbind(bestgenes, genes) + if (trace) cat("overlap area =", bestscore, "\n") + } + nx <- Re(xy + gen_offset(bestgenes[1,])) + ny <- Im(xy + gen_offset(bestgenes[1,])) + list(x = nx, y = ny) + } + SANN <- function() { + # Make some starting "genes" + #gene <- sample(1:8, n_labels, repl = TRUE) + gene <- rep(8, n_labels) + score <- objective(gene) + bestgene <- gene + bestscore <- score + T <- 2.5 + for (i in 1:50) { + k <- 1 + for (j in 1:50) { + newgene <- gene + newgene[sample(1:n_labels, 1)] <- sample(1:8,1) + newscore <- objective(newgene) + if (newscore <= score || runif(1) < exp((score - newscore) / T)) { + # keep the new set if it has the same or better score or + # if it's worse randomly based on the annealing criteria + k <- k + 1 + score <- newscore + gene <- newgene + } + if (score <= bestscore) { + bestscore <- score + bestgene <- gene + } + if (bestscore == 0 || k == 10) break + } + if (bestscore == 0) break + if (trace) cat("overlap area =", bestscore, "\n") + T <- 0.9 * T + } + + if (trace) cat("overlap area =", bestscore, "\n") + nx <- Re(xy + gen_offset(bestgene)) + ny <- Im(xy + gen_offset(bestgene)) + list(x = nx, y = ny) + } + if (method == "SANN") + xy <- SANN() + else + xy <- GA() + xy <- toUserCoords(xy) + if (doPlot) + text(xy, labels, cex = cex, ...) + invisible(xy) +} diff -Nru car-3.1-0/R/scatter3d.R car-3.1-1/R/scatter3d.R --- car-3.1-0/R/scatter3d.R 2022-05-30 15:29:13.000000000 +0000 +++ car-3.1-1/R/scatter3d.R 2022-08-30 01:08:55.000000000 +0000 @@ -17,6 +17,8 @@ # 2017-06-27: introduced id argument replacing several arguments. J. Fox # 2017-11-30: use carPalette(), avoid red and green. J. Fox # 2022-05-30: add "robust" as a fit option. +# 2022-08-20: introduce reg.function and reg.function.col arguments. J. Fox +# 2022-08-29: introduce mouseMode argument. J. Fox scatter3d <- function(x, ...){ if (!requireNamespace("rgl")) stop("rgl package missing") @@ -74,10 +76,13 @@ # id.method=c("mahal", "xz", "y", "xyz", "identify", "none"), # id.n=if (id.method == "identify") Inf else 0, # labels=as.character(seq(along=x)), offset = ((100/length(x))^(1/3)) * 0.02, - id=FALSE, model.summary=FALSE, ...){ + id=FALSE, model.summary=FALSE, + reg.function, reg.function.col=surface.col[length(surface.col)], + mouseMode=c(none="none", left="polar", right="zoom", middle="fov", wheel="pull"), ...){ if (!requireNamespace("rgl")) stop("rgl package missing") if (!requireNamespace("mgcv")) stop("mgcv package missing") if (!requireNamespace("MASS")) stop("MASS package missing") + rgl::par3d(mouseMode=mouseMode) id <- applyDefaults(id, defaults=list(method="mahal", n=2, labels=as.character(seq(along=x)), offset = ((100/length(x))^(1/3))*0.02), type="id") if (isFALSE(id)){ @@ -243,10 +248,12 @@ col=surface.col[j]) } } - } + } + + vals <- seq(0, 1, length.out=grid.lines) + dat <- expand.grid(x=vals, z=vals) + if (surface){ - vals <- seq(0, 1, length.out=grid.lines) - dat <- expand.grid(x=vals, z=vals) for (i in 1:length(fit)){ f <- match.arg(fit[i], c("linear", "quadratic", "smooth", "additive", "robust")) if (is.null(groups)){ @@ -365,6 +372,23 @@ } } else levs <- levels(groups) + + # plot an arbitrary regression function + if (!missing(reg.function)){ + x <- seq(minx, maxx, length.out=grid.lines) + z <- seq(minz, maxz, length.out=grid.lines) + D <- expand.grid(x=x, z=z) + x <- D$x + z <- D$z + ys <- eval(substitute(reg.function)) + ys <- (ys - miny)/(maxy - miny) + ys <- matrix(ys, grid.lines, grid.lines) + + if (fill) rgl::rgl.surface(vals, vals, ys, color=reg.function.col, alpha=surface.alpha, lit=FALSE) + if(grid) rgl::rgl.surface(vals, vals, ys, color=if (fill) grid.col + else reg.function.col, alpha=surface.alpha, lit=FALSE, front="lines", back="lines") + } + if (id.method == "identify"){ Identify3d(xg, yg, zg, axis.scales=axis.scales, groups=ggroups, labels=glabels, col=surface.col, offset=offset) diff -Nru car-3.1-0/R/showLabels.R car-3.1-1/R/showLabels.R --- car-3.1-0/R/showLabels.R 2018-05-29 17:30:11.000000000 +0000 +++ car-3.1-1/R/showLabels.R 2022-10-04 22:30:54.000000000 +0000 @@ -13,7 +13,7 @@ # 2017-01-10 special handling for method="none". # 2017-02-13 fixed showLabels1() when location="avoid" # 2017-03-25: don't supply names if indexes are the same as labels. J. Fox - +# 2022-10-04: pointLabel() is now in the car package. showLabels <- function(x, y, labels=NULL, method="identify", n = length(x), cex=1, col=carPalette()[1], @@ -131,7 +131,7 @@ text(x[i], y[i], labels[i], cex = id.cex, xpd = TRUE, col = id.col, pos = labpos[i], offset = 0.25)} } - else maptools::pointLabel(c(x[ind], x[ind]), c(y[ind], y[ind]), + else pointLabel(c(x[ind], x[ind]), c(y[ind], y[ind]), c(paste0(" ", labels[ind], " "), rep(" ", length(ind))), cex=id.cex, xpd=TRUE, col=id.col) if (any(as.character(ind) != labels[ind])) names(ind) <- labels[ind]