Running 'pl-test.R' [185s]
Running the tests in 'tests/pl-test.R' failed.
Complete output:
  > 
  > require(plgraphics) ##, lib="/u/stahel/R/regdevelop/pkg/plgraphics.Rcheck")
  Loading required package: plgraphics
  > ## require(plgraphics, lib="/u/stahel/R/regdevelop/pkg/plgraphics.Rcheck")
  > 
  > if(!dev.interactive(orNone=TRUE)) pdf("pl-test.pdf")
  > 
  > plyx(Sepal.Width~Sepal.Length, data=iris)
  > plyx(iris[,c("Sepal.Width","Sepal.Length")]) ##!!! farben
  > plyx(iris$Sepal.Width~iris$Sepal.Length)
  > plyx(~Sepal.Length, ~Sepal.Width, data=iris)
  > ff <- function() plyx(~Sepal.Length, ~Sepal.Width, data=iris)
  > ff()
  > 
  > ## ploptions
  > ploptions("linewidth")
        solid        dash         dot     dashDot    dashLong dashLongDot 
         1.00        1.30        1.70        1.30        1.20        1.15 
  > t.plo <- ploptions(linewidth=1.5)
  > ploptions("linewidth")
  [1] 1.5
  > t.plo$linewidth
  [1] 1.5
  > pl.envir$ploptions$linewidth
        solid        dash         dot     dashDot    dashLong dashLongDot 
         1.00        1.30        1.70        1.30        1.20        1.15 
  > default.ploptions$linewidth
        solid        dash         dot     dashDot    dashLong dashLongDot 
         1.00        1.30        1.70        1.30        1.20        1.15 
  > t.plo <- ploptions(default="linewidth")
  > ploptions("linewidth")
        solid        dash         dot     dashDot    dashLong dashLongDot 
         1.00        1.30        1.70        1.30        1.20        1.15 
  > 
  > t.plo <- ploptions(col="magenta", smooth.col="darkgreen", assign=F)
  > attr(t.plo, "old")
  $col
   [1]  1  2  3  4  5  6  7  8  9 10 11 12
  
  $smooth.col
  [1] "blue"
  
  > ploptions("col")
   [1]  1  2  3  4  5  6  7  8  9 10 11 12
  > t.plo$col
  [1] "magenta"
  > 
  > par(mar=c(2,2,1,2))
  > ploptions(mar=rep(4,4), setpar=TRUE)
  > par("mar")
  [1] 2 2 1 2
  > attr(pl.envir$ploptions, "oldpar")
  NULL
  > t.plo <- ploptions(default="mar", setpar=TRUE)
  > ## stopifnot(all(par("mar")==default.ploptions$mar))
  > 
  > par(attr(pl.envir$ploptions, "oldmarginpar"))
  named list()
  > par("mar")
  [1] 2 2 1 2
  > 
  > ## margins
  > plmframes(2,1)
  > ploptions(default="all", setpar=TRUE)
  > par(mar=c(2,2,5,2))
  > plyx(Sepal.Width~Sepal.Length, data=iris) ## margins according to ploptions
  > par("mar") ## paramteres have been recovered
  [1] 2 2 5 2
  > mtext("wrong place for text",3,1, col="red")  ## margins not appropriate for active plot
  > points(8,4.5, pch="X", col="red") ## with xpd=F, the point is not shown
  > points(8,4.5, pch="X", col="red", xpd=TRUE) ##  the point is not shown
  > plpoints(8,4.5, pch="O", col="blue", pch.cex=5)
  Warning message:
  In (function (x = NULL, y = NULL, condvar = NULL, data = NULL, subset = NULL,  :
    :pl.control: argument(s) containing 'cex' are probably misspecified. I replace 'cex' by 'csize'
  > par("mar")
  [1] 2 2 5 2
  > t.plo <- plmarginpar() ## get margin parameters from pl.envir 
  >   ## generated by the last pl graphics call
  > par("mar")
  [1] 3.20 2.96 2.60 1.66
  > mtext("here is the right place",3,1, col="blue")
  > t.usr <- par("usr")
  > points(t.usr[1],t.usr[4], pch="O", col="magenta", cex=4)
  > 
  > par(t.plo)  ## restores old 'margin parameters' 
  > par("mar")
  [1] 2 2 5 2
  > 
  > plyx(Sepal.Width~Sepal.Length, data=iris, keeppar=TRUE)
  > par("mar")
  [1] 3.20 2.96 2.60 1.66
  > mtext("this goes to the right place, too",3,1)
  > 
  > par(mar=c(2,2,5,2))
  > plot(1:10)
  > plpoints(8,8, col="red", csize=2) ## surprise, it works
  > ## ------------
  > plyx(Sepal.Width~Sepal.Length, data=iris,
  +      margin.csize=c(1.3,0.7), margin.line=c(2,1.2), csize=0.8) 
  > ## -----------------------------------------------------
  > 
  > plyx(Sepal.Width ~ Sepal.Length, data=iris)
  > ## again, each step separately
  > t.dt <- pl.envir$pldata
  > pl.envir$grid <- TRUE
  > plframe(t.dt$Sepal.Length, t.dt$Sepal.Width)
  > plframe(Sepal.Width~Sepal.Length, data=iris)
  Warning messages:
  1: In axis(side, at = lat, labels = rep("", length(lat)), col = col,  :
    "data" is not a graphical parameter
  2: In mtext(llab, side, line = lmgp[2], at = llabat, col = col, cex = lticksize *  :
    "data" is not a graphical parameter
  3: In axis(side, at = lat, labels = rep("", length(lat)), col = col,  :
    "data" is not a graphical parameter
  4: In mtext(llab, side, line = lmgp[2], at = llabat, col = col, cex = lticksize *  :
    "data" is not a graphical parameter
  > plframe()
  > plsmooth(t.dt$Sepal.Length, t.dt$Sepal.Width)
  > plsmooth(smooth.col="red",smooth.lty=1)
  > t.plab <- plmark(t.dt$Sepal.Length, t.dt$Sepal.Width, markextremes=0.03,
  +                  plargs=pl.envir)
  > plpoints(t.dt$Sepal.Length, t.dt$Sepal.Width, plargs=pl.envir, plab=t.plab) 
  > plpoints(col="blue", cex=2) ## gets the coordinates from pl.envir
  Warning message:
  In (function (x = NULL, y = NULL, condvar = NULL, data = NULL, subset = NULL,  :
    :pl.control: argument(s) containing 'cex' are probably misspecified. I replace 'cex' by 'csize'
  > plpoints(Sepal.Width ~ Sepal.Length, data=iris, pch="+", cex=2, col="green") 
  Warning message:
  In (function (x = NULL, y = NULL, condvar = NULL, data = NULL, subset = NULL,  :
    :pl.control: argument(s) containing 'cex' are probably misspecified. I replace 'cex' by 'csize'
  > 
  > ## ---------------------------------------------------------
  > plmframes(2,2)
  > plyx(Sepal.Width~Sepal.Length, data=iris, ploptions=t.plo)
  > plyx(Sepal.Width~Sepal.Length, data=iris, 
  +      psize=Petal.Length^3, pcol=Species, pch=Species, cex=1.5)
  Warning message:
  In pl.control(x = Sepal.Width ~ Sepal.Length, data = iris, psize = Petal.Length^3,  :
    :pl.control: argument(s) containing 'cex' are probably misspecified. I replace 'cex' by 'csize'
  > plyx(Sepal.Width~Sepal.Length, data=iris, smooth=2, smooth.group=Species)
  > plyx(Sepal.Width~Sepal.Length, data=iris, smooth=TRUE, group=Species)
  > plmframes()
  > plyx(jitter(Sepal.Width) ~ jitter(Sepal.Length), data=iris, axp=7, plab=T)
  > plmframes(2,3, mar=c(NA, 0.5), oma=c(2,2,2,2)+2)
  > plyx(Petal.Length+Petal.Width~Sepal.Length+Sepal.Width, group=Species,
  +      data=iris, mf=FALSE)
  > plmframes(2,2)
  > plyx(Petal.Length ~ Sepal.Length+Sepal.Width, data=iris, smooth=TRUE,
  +      smooth.group=iris$Species, refline=lm, refline.lwd=2)
  > plyx(Sepal.Width~Sepal.Length, data=iris[1:50,], smooth=F, markextremes=0.1)
  > plyx(Sepal.Width~Sepal.Length, data=iris,
  +      refline=function(x,y) { mtext("anything goes",3,-1); c(9,-1)})
  > attr(iris$Sepal.Length, "ticksat") <- 
  +   structure(seq(4, 8, 0.5), small=seq(4,8,0.1))
  > iris$"(pcol)" <- as.numeric(iris$Species)
  > plyx(Sepal.Width~Sepal.Length, data=iris)
  > 
  > t.plargs <- pl.control(~Species+Petal.Length, ~Sepal.Width+Sepal.Length,
  +                        data=iris, smooth.group=Species, group=Species)
  > t.plargs$ploptions$group.col <- c("magenta","orange","cyan")
  > plpanel(iris$Petal.Length, iris$Petal.Width, plargs=t.plargs, frame=TRUE)
  > 
  > t.plo <- ploptions(col="blue")
  > plyx(Sepal.Width~Sepal.Length, data=iris, ploptions=t.plo)
  > plyx(Sepal.Width~Sepal.Length, data=iris)
  > 
  > ploptions(gridlines.col="lightblue")
  > t.plo <- ploptions(list=list(smooth.lty=4, smooth.lwd=5), assign=FALSE)
  > plyx(Sepal.Width~Sepal.Length, data=iris, ploptions=t.plo, gridlines=TRUE)
  > 
  > plyx(y=EuStockMarkets[1:40,], type="b") ## ??? 2 blaue linien
  > plyx(structure(1:40, varlabel="time"), EuStockMarkets[1:40,], type="b")
  > 
  > ff <- function(formula, data, smooth=T, pcol=1)
  +   plyx(formula, data=data, smooth=smooth, pcol=pcol)
  > ff(Sepal.Width~Sepal.Length, data=iris, pcol=I("gray"), smooth=T)
  > 
  > ## plmatrix
  > plmatrix(iris, pch=as.numeric(Species))
  > plmatrix(~Sepal.Length+Sepal.Width, ~Petal.Length+Petal.Width, data=iris,
  +          smooth=TRUE, pch=as.numeric(iris[,"Species"]))
  > plmatrix(~Sepal.Length+Sepal.Width, ~Petal.Length+Petal.Width, data=iris,
  +          panel=points)
  > 
  > plmatrix(Petal.Width+Petal.Length~Sepal.Width+Sepal.Length+Species, data=iris, 
  +      margin.csize=c(1.3,0.9), margin.line=c(2,1.2), csize=1.2) 
  > 
  > ## plmboxes
  > plmboxes(Sepal.Width~Species, data=iris, labelsvert=1, main="iris")
  > plmboxes(Sepal.Length~Species, data=iris,
  +   widthfac=c(med=2), colors=c(med="red"), horizontal=TRUE)
  > 
  > ## attributes of variables
  > data(d.blast)
  > dd <- genvarattributes(d.blast)
  > str(attributes(dd$tremor))
  List of 10
   $ varname       : chr "tremor"
   $ nvalues       : int 174
   $ innerrange    : num [1:2] 0.62 20.36
   $ innerrange.ext: num 0.1
   $ nouter        : int [1:2] 0 8
   $ plrange       : num [1:2] -0.367 22.329
   $ plcoord       : num [1:388] 2.93 1.76 0.62 0.62 4.04 2.63 1.55 2.21 4.43 NA ...
   $ ticksat       : num [1:5] 0 5 10 15 20
   $ ticklabelsat  : num [1:5] 0 5 10 15 20
   $ varlabel      : chr "tremor"
  > ddd <- setvarattributes(dd, list( tremor=list(ticksat=seq(0,24,2),
  +   ticklabelsat = seq(0,24,10)) ) )
  > str(attr(ddd$tremor, "ticklabels"))
   num [1:3] 0 10 20
  > 
  > plyx(tremor~distance, data=ddd, subset=location=="loc3")
  > 
  > dd <- d.blast[d.blast$location=="loc6",]
  > ## outliers and type="l" or "b"
  > dd$distance[2:5] <- c(150, 130, 110, 125)
  > dd$tremor[c(2,4)] <- 6
  > plyx(tremor~distance, data=dd, innerrange.factor=2, type="b")
  > ## ------------------------------------------------------------
  > ## gendate
  > rr <- gendate(year=2010, month=c("Jan","Apr"), day=c(3,30),
  +             hour=25, min=c(0,70), sec=c(0,300))
  > stopifnot(all(
  +   format(rr) == c("(10-01-04 01:00:00)", "(10-05-01 02:15:00)")
  +   ))
  > td <- data.frame(datum=as.Date(c("2010-05-20","1968-05-01")),
  +                  tag=c(1.5, 3), min=c(30,70))
  > rr <- gendate(date=datum, day=tag, hour=6, data=td, min=min)
  > stopifnot(all(
  +   format(rr) == c("(10-05-20 06:30:00)", "(68-05-01 07:10:00)")
  +   ))
  > gendate(day=tag, hour=4, data=td, min=min) 
  [1] (00-01-01 04:30:00) (00-01-03 05:10:00)
  > gendate(day=tag, data=td, min=min, sec=8) 
  [1] (00-01-01 12:30:08) (00-01-03 01:10:08)
  > ## -----------------------------------------------
  > plscale
  function (x, plscale = "log10", ticksat = NULL, logscale = NULL, 
      valuesonly = FALSE, ploptions = NULL) 
  {
      if (is.character(plscale)) {
          if (plscale == "") 
              return(x)
          lscname <- plscale
          if (lscname %in% c("log", "log10") && min(x[is.finite(x)]) <= 
              0) 
              lscname <- "logst"
          lscfunc <- get(lscname)
      }
      else {
          if (!is.function(lscfunc)) 
              stop("!plscale! unsuitable argument 'plscale'")
          lscname <- as.character(substitute(plscale))
          if (length(lscname) != 1) 
              stop("!plscale! unsuitable argument 'plscale'")
          if (lscname %in% pl.envir$pl.scaleFunctions) {
              plscale <- lscname
              lscfunc <- get(lscname)
          }
          else {
              lscfunc <- plscale
              plscale <- lscname
              attr(plscale, "function") <- lscfunc
          }
      }
      lx <- i.def(attr(x, "numvalues", exact = TRUE), c(x))
      lvlim <- attr(x, "vlim", exact = TRUE)
      lplrg <- attr(x, "plrange", exact = TRUE)
      if (lscname == "logst") {
          lxt <- logst(lx, threshold = attr(lscname, "threshold", 
              exact = TRUE))
          if (length(lvlim)) 
              lvlimsc <- logst(lvlim, threshold = attr(lxt, "threshold", 
                  exact = TRUE))
          attr(lscname, "threshold") <- attr(lxt, "threshold", 
              exact = TRUE)
      }
      else {
          lxt <- lscfunc(lx)
          lvlimsc <- if (length(lvlim)) 
              lscfunc(lvlim)
      }
      lvlimsc <- i.def(attr(x, "vlimsc", exact = TRUE), lvlimsc)
      if (length(ticksat)) 
          ticksat <- lscfunc(ticksat)
      if (valuesonly) 
          return(lxt)
      attr(lxt, "innerrange") <- attr(x, "innerrange")
      lxtv <- i.genvattrcont(structure(lxt, vlim = lvlimsc, ticksat = ticksat), 
          ploptions = ploptions)
      lrg <- replaceNA(lvlimsc, i.def(attr(lxtv, "innerrange"), 
          attr(lxtv, "plrange")))
      ltks <- plticks(range = lrg, plscale = lscname, transformed = TRUE, 
          nouter = attr(lxtv, "nouter", exact = TRUE), ploptions = ploptions)
      structure(x, plvalues = lxt, ticksat = ltks$ticksat, ticklabelsat = ltks$ticklabelsat, 
          ticklabels = ltks$ticklabels, plscale = plscale, plrange = lplrg, 
          vlim = lvlim, vlimscaled = lvlimsc)
  }
  <bytecode: 0x0000020b8b505190>
  <environment: namespace:plgraphics>
  > prettyscale
  function (x, transformed = FALSE, plscale = "log10", inverse = NULL, 
      range = NULL, range.transformed = NULL, n = NULL, logscale = NULL) 
  {
      lf.format <- function(x) sapply(as.list(x), format)
      lf.cens <- function(x, rg) if (u.isnull(rg)) 
          x
      else pmax(pmin(x, rg[2]), rg[1])
      if (is.character(plscale)) {
          lscname <- plscale
          if (length(lscname) > 1) 
              stop("!plscale! unsuitable argument 'plscale'")
          lscfunc <- if (lscname == "userfunction") 
              attr(plscale, "function", exact = TRUE)
          else try(get(lscname))
          if (inherits(lscfunc, "try-error")) 
              stop("!plscale! could not find function", lscname)
      }
      else {
          if (!is.function(plscale)) 
              stop("!plscale! unsuitable argument 'plscale'")
          lscname <- as.character(substitute(plscale))[1]
          lscfunc <- plscale
      }
      ln <- i.getploption("tickintervals")
      ln1 <- ln[1] + 1
      ln2 <- if (length(ln) >= 2) 
          ln[2]
      else 3
      if (lscname %in% c("log", "log10", "logst") & u.isnull(logscale)) {
          lx <- if (transformed) 
              x
          else lscfunc(pmax(x, 0))
          lrg <- range(lx, finite = TRUE)
          if (lscname == "log") 
              lrg <- lrg/log(10)
          if (lrg[2] - lrg[1] > 1) {
              ltatlab <- axTicks(1, usr = lrg, axp = c(10^floor(lrg), 
                  max(3 - floor((2.5 * diff(lrg) + 1)/ln1), 1)), 
                  nintLog = ln1, log = TRUE)
              ltatlab <- clipat(ltatlab, 10^lrg)
              ltat <- log10(ltatlab)
              if (lscname == "log") 
                  ltat <- ltat * log(10)
              return(structure(ltat, ticklabels = lf.format(ltatlab)))
          }
      }
      if (lscname == "log") 
          inverse <- exp
      if (lscname %in% c("log10", "logst")) 
          inverse <- function(x) 10^x
      if (lscname %in% c("log", "log10", "logst")) 
          range <- c(0, Inf)
      if (lscname == "sqrt") {
          inverse <- function(x) x^2
          range <- range.transformed <- c(0, Inf)
      }
      if (lscname == "qnorm") {
          inverse <- pnorm
          range.transformed <- c(0, 1)
      }
      range <- i.def(range, attr(lscfunc, "range", exact = TRUE))
      range.transformed <- i.def(range.transformed, attr(lscfunc, 
          "range.transformed", exact = TRUE))
      if (u.isnull(inverse)) {
          inverse <- attr(lscfunc, "inverse", exact = TRUE)
          if (u.isnull(inverse)) 
              stop("!prettyscale! Inverse transformation function missing")
      }
      if (is.character(inverse)) 
          inverse <- get(inverse)
      lx <- if (transformed) 
          x
      else lscfunc(lf.cens(x, range))
      lrg <- range(lx, finite = TRUE)
      ld <- diff(lrg)/(ln1 - 1)
      lk <- c(-2, 0:(ln1 - 1), ln1 + 1)
      lk <- lk + 0.01 * (lk - mean(lk))/ln1
      ltr <- lf.cens(lrg[1] + ld * lk, range.transformed)
      lat <- rep(NA, ln1)
      lrw <- inverse(ltr)
      for (li in 1:ln1) {
          lrwx <- lrw[li + c(0, 2)]
          lpr <- pretty(lrwx + diff(lrwx) * c(-1, 1) * 0.5, n = ln2)
          if (length(range)) 
              lpr <- lf.cens(lpr, range)
          lat[li] <- lpr[which.min(abs(lscfunc(lpr) - ltr[li + 
              1]))]
      }
      lat <- lf.cens(unique(lat), range)
      rr <- lscfunc(lat)
      structure(rr, ticklabels = lf.format(lat))
  }
  <bytecode: 0x0000020b8b517318>
  <environment: namespace:plgraphics>
  > rr <- plscale(c(0.01,1,2,5,10), "log")
  > ## inverse function
  > aa <- c(0.1,10,50,100)
  > stopifnot(all( abs(attr(asinp, "inverse")(asinp(aa)) - aa)<1e-13) )
  > ## =========================================
  > #require(regr)
  > ## attach("../div/pl-data.rda")
  > showd(dd)
  dim:  50 8 
      no       date     datetime device charge distance tremor location
  195  1 1980-07-19 19.07. 11:47      3  0.952      108   0.62     loc6
  196  2 1980-07-20 20.07. 11:19      3  1.522      150   6.00     loc6
  197  3 1980-07-24 24.07. 09:58      3  3.570      130   1.22     loc6
  ...                                                                  
  209 15 1980-08-20 20.08. 11:13      3  4.848      100   1.79     loc6
  220 26 1980-09-13 13.09. 09:02      3  5.824       94   3.38     loc6
  232 38 1980-10-03 03.10. 12:57      3  5.355       93   3.08     loc6
  244 50 1980-10-18 18.10. 15:46      3  5.493       NA     NA     loc6
  > data(d.blast)
  > rr <-  lm(logst(tremor)~location*log10(distance)+log10(charge), data=d.blast)
  > rr <- r.blast <-
  +   lm(logst(tremor)~location+log10(distance)+log10(charge), data=d.blast)
  > plregr(rr,mf=c(3,3))
  > plregr(rr, addcomp=TRUE)
  > plregr(rr, xvar=FALSE, plotselect=c(yfit=TRUE, resfit=FALSE))
  > plregr(rr, transformed=TRUE, reflinesband=TRUE, sequence=TRUE)
  > 
  > plresx(rr, transformed=TRUE, regr.addcomp=TRUE)
  > plyx(d.blast$charge, naresid(structure(rr$na.action, class="exclude"), rr$resid))
  > 
  > dd <- d.blast[as.numeric(d.blast$location)<=3,]
  > dd[1,"distance"] <- 200
  > rr <- lm(log10(tremor)~log10(distance)+log10(charge)+location, data=dd)
  > plres2x(~ log10(distance) + log10(charge), reg=rr, transformed=F,
  +         pcol=location) ## ???
  > 
  > ## utilities
  > showd(dd)
  dim:  219 8 
      no       date     datetime device charge distance tremor location
  98   1 1980-07-19 19.07. 11:47      2  0.952      200   1.76     loc1
  292  1 1980-07-19 19.07. 11:47      4  0.952      123   0.62     loc3
  99   2 1980-07-20 20.07. 11:19      2  1.522       69   2.63     loc1
  ...                                                                  
  126 29 1980-09-18 18.09. 18:23      2  5.408       34  10.79     loc1
  144 47 1980-10-15 15.10. 18:17      2  4.368       38  10.79     loc1
  162 65 1980-11-07 07.11. 16:43      2  3.725       72   5.18     loc1
  388 93 1980-02-06 06.02. 08:56      4  3.952       77   3.95     loc3
  > sumNA(dd)
        no     date datetime   device   charge distance   tremor location 
         0        0        0        0        0        1       13        0 
  > tit(dd) <- "blasting"
  > plmatrix(dd, main="test plmatrix")
  > ## --------------------------------------
  > plcond(Sepal.Width~Sepal.Length, data=iris, condvar=~Petal.Length+Petal.Width)
  > ## --------------------------------------
  > ## functions generating elements
  > t.fc <- fitcomp(rr,se=TRUE)
  > t.fc$comp[1:10,]
        distance     charge    location
  1   0.37882844 -0.4980042 -0.10032728
  2   0.31089781 -0.4499260  0.03478467
  3   0.24978622 -0.4094672  0.00000000
  4   0.19424869 -0.3745400          NA
  5   0.14335283 -0.3438121          NA
  6   0.09638225 -0.3163813          NA
  7   0.05277461 -0.2916081          NA
  8   0.01208036 -0.2690226          NA
  9  -0.02606552 -0.2482697          NA
  10 -0.06196349 -0.2290742          NA
  > t.fct <- fitcomp(rr, se=TRUE, transformed=TRUE)
  > 
  > rr <- lm(log10(tremor)~location+log10(distance)+log10(charge), data=d.blast)
  > r.smooth <- gensmooth( fitted(rr), residuals(rr))
  > showd(r.smooth$y)
  dim:  362 1 
       transposed column
              292          195          293          ...           92
  V1 -0.069612613 -0.067016675 -0.054112436               0.041459327
               97          360           49
  V1  0.016602540 -0.007189267  0.022723296
  > plot(fitted(rr), resid(rr), main="Tukey-Anscombe Plot")
  > abline(h=0)
  > lines(r.smooth$x,r.smooth$y, col="red")
  > ## grouped data
  > t.plargs <- list(pldata=data.frame(d.blast$location), names="(smoothGroup)")
  > ## residuals against regressor, without  plresx:
  > t.res <- naresid(structure(r.blast$na.action, class="exclude"), residuals(r.blast))
  > r.smx <- gensmooth( d.blast$dist, t.res, plargs=t.plargs)
  > plot(d.blast$dist, t.res, main="Residuals against Regressor")
  > abline(h=0)
  > plsmoothline(r.smx, d.blast$dist, t.res, plargs=t.plargs)
  > 
  > ## --------------------------------------------------------
  > ## multivariate regression
  > data(d.fossileSamples)
  > rr <-
  +   lm(cbind(sAngle,lLength,rWidth)~SST+Salinity+lChlorophyll+Region,
  +                 data=d.fossileSamples)
  > plregr(rr)
  Warning messages:
  1: In mean.default(sumNA(ldata)) :
    argument is not numeric or logical: returning NA
  2: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  3: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  4: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  > data(d.fossileSamples)
  > r.foss <-
  +   lm(cbind(sAngle,lLength,rWidth)~SST+Salinity+lChlorophyll+Region+N,
  +   data=d.fossileSamples)
  > plregr(r.foss, plotselect=c(resfit=3, resmatrix=1, qqmult=1))
  Warning messages:
  1: In mean.default(sumNA(ldata)) :
    argument is not numeric or logical: returning NA
  2: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  3: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  4: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  5: In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  > 
  > ## ================================================
  > ## glm
  > data(d.babysurvival)
  > t.d <- d.babysurvival
  > t.d$Age[2] <- NA
  > rr <- glm(Survival~Weight+Age+Apgar1,data=t.d,family=binomial)
  > plregr(rr, xvar=~Weight, cex.plab=0.7, ylim=c(-5,5))
  plregr: plot of residuals on  Weight  not shown because it is equivalent to 'resfit'
  Warning message:
  In pl.control(x = "Weight", cex.plab = 0.7, ylim = c(-5, 5), y = list( :
    :pl.control: argument(s) containing 'cex' are probably misspecified. I replace 'cex' by 'csize'
  > plregr(rr, xvar= ~Age+Apgar1)
  > plregr(rr, condquant=FALSE)
  > 
  > ## polr
  > if(requireNamespace("MASS")) {
  + data(housing, package="MASS")
  + rr <- MASS::polr(Sat ~ Infl + Type + Cont, weights = Freq, data = housing)
  + t.res <- residuals.regrpolr(rr)
  + showd(attr(t.res, "condquant"))
  + plregr(rr)
  + plregr(rr, factor.show="jitter")
  + }
  dim:  72 10 
           median       lowq        uppq     random     limlow      limup
  1   -1.45505606 -2.2585755 -0.92550776 -1.5597151       -Inf -0.4961353
  2    0.08920666 -0.1991835  0.38137909  0.4873775 -0.4961353  0.6907083
  3    1.60748728  1.0964447  2.39612212  1.2714710  0.6907083        Inf
  ...                                                                    
  20   0.42562122  0.1450257  0.72388587  0.9152559 -0.1299488  1.0568949
  38  -0.24126244 -0.5363735  0.04368262 -0.7253806 -0.8564195  0.3304241
  55  -1.45053431 -2.2545272 -0.92038712 -1.0260676       -Inf -0.4902329
  72   1.18895013  0.6182914  2.02383158  3.2594377  0.1326200        Inf
           prob index          fit y
  1   0.3784493     1  0.000000000 1
  2   0.2876752     2  0.000000000 2
  3   0.3338755     3  0.000000000 3
  ...                               
  20  0.2745383    20 -0.366186566 2
  38  0.2837746    38  0.360284150 2
  55  0.3798387    55 -0.005902416 1
  72  0.4668935    72  0.558088306 3
  
  Re-fitting to get Hessian
  
  ..plregr: all leverage elements equal, no leverage plot
  
  Re-fitting to get Hessian
  
  ..plregr: all leverage elements equal, no leverage plot
  > 
  > ## survreg
  > if(requireNamespace("survival")) {
  + data(cancer, package="survival")
  + cancer$gender <- factor(c("m","f")[cancer$sex])
  + r.sr <- survival::survreg(
  +   survival::Surv(time, status) ~ age + gender + ph.karno, data=cancer) 
  + plregr(r.sr, group=gender, pcol=gender, xvar=~age)
  + r.cox <- survival::coxph(
  +   survival::Surv(time, status) ~ age + gender + ph.karno, data=cancer) 
  + plregr(r.cox, group=gender, pcol=gender, xvar=~age)
  + }
  plregr: plot of residuals on  age  not shown because it is equivalent to 'resfit'
  plregr: plot of residuals on  age  not shown because it is equivalent to 'resfit'
  Warning message:
  In plcoord(lrfy, range = lyir, ploptions = ploptions) :
    :plcoord: inadequate range. Not used
  > 
  > proc.time()
     user  system elapsed 
    18.76    1.12   19.90