R-alpha: Re: greedy wishing 'cdfplot' : plot.step(.) + deparse(substitute(..))

Martin Maechler (maechler@stat.math.ethz.ch)
Wed, 22 Jan 97 08:51:18 +0100


Date: Wed, 22 Jan 97 08:51:18 +0100
Message-Id: <9701220751.AA02041@>
From: Martin Maechler <maechler@stat.math.ethz.ch>
To: pd@kubism.ku.dk
In-Reply-To: <x2680rc5mv.fsf@bush.kubism.ku.dk> (message from Peter Dalgaard
Subject: R-alpha: Re: greedy wishing 'cdfplot' :  plot.step(.) + deparse(substitute(..))

Here is one of our 'goodies' that I wrote a while ago for S-plus.
It is a general  'step function' plotter.

It runs ok in R
	(I see some rounding 'problem' at the ends(Example w/ 'cad = F'),
	 and an 
>>  R 'incompatibility' / 'bug': 
>> 	The  xlab =  deparse(substitute(..))
>>  gives not what I expected (and what S gives)..

Could the persons who find out please  post (or e-mail me) the result?

#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1997-01-22 08:43 MET by <sfs@florence>.
# Source directory was `/users/home2/staff/sfs/S/MISC_S'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode       name
# ------ ---------- ------------------------------------------
#   3096 -rw-r--r-- plot.step.S
#   2034 -rw-r--r-- plot.step.d
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
  if test "$gettext_dir" = FAILED && test -f $dir/gettext \
     && ($dir/gettext --version >/dev/null 2>&1)
  then
    set `$dir/gettext --version 2>&1`
    if test "$3" = GNU
    then
      gettext_dir=$dir
    fi
  fi
  if test "$locale_dir" = FAILED && test -f $dir/shar \
     && ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
  then
    locale_dir=`$dir/shar --print-text-domain-dir`
  fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
  echo=echo
else
  TEXTDOMAINDIR=$locale_dir
  export TEXTDOMAINDIR
  TEXTDOMAIN=sharutils
  export TEXTDOMAIN
  echo="$gettext_dir/gettext -s"
fi
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
  shar_touch=touch
else
  shar_touch=:
  echo
  $echo 'WARNING: not restoring timestamps.  Consider getting and'
  $echo "installing GNU \`touch', distributed in GNU File Utilities..."
  echo
fi
rm -f 1231235999 $$.touch
#
if mkdir _sh19128; then
  $echo 'x -' 'creating lock directory'
else
  $echo 'failed to create lock directory'
  exit 1
fi
# ============= plot.step.S ==============
if test -f 'plot.step.S' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'plot.step.S' '(file already exists)'
else
  $echo 'x -' extracting 'plot.step.S' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'plot.step.S' &&
plot.step <- function(ti, y, 
X		      cad.lag = T,
X		      verticals = !cad.lag,
X		      left.points = cad.lag,
X		      right.points = F,
X		      end.points = F,
X		      
X		      add = FALSE,
X
X		      xlab = deparse(substitute(ti)), 
X		      ylab = deparse(substitute(y)), 
X		      main = NULL,	
X		      ...)	
{
X  ## Purpose: plot step-function  f(x)= sum{ y[i] * 1_[ t[i-1], t[i] ] (x) }
X  ## -------------------------------------------------------------------------
X  ## Arguments: for missing 'y', do empirical CDF; ==> ON-LINE Help "?plot.step"
X  ## -------------------------------------------------------------------------
X  ## Author: Martin Maechler, 1990, U.Washington, Seattle; improved -- Dec.1993
X  ##
X  ## CALLS:  function  give.xy.list
X  ##
X  ## EXAMPLE: ##-- Plot empirical cdf  Fn(x)  for a small n:
X  ## 	      xx_ runif(20); plot.step(xx); plot.step( xx, cad.lag = F )
X  ##	      plot.step( runif(20), add=T, cad.lag=F)
X  if(missing(y)) {
X    if(is.vector(ti) && is.numeric(ti)) {   # -- Do empirical CDF --
X      nt <- length(ti)
X      ti <- sort(ti)
X      dt <- (ti[nt] - ti[1])/20
X      ti <- c(ti[1] - dt, ti, ti[nt] + dt)
X      n <- nt + 1
X      y <- (0:nt)/nt
X    } else {
X      y <- give.xy.list(ti)	   #-- returns list(x=.., y=..)  {or stop()s !}
X      ti <- c(y$x[1], y$x)
X      y <- y$y
X      n <- length(y)
X    }
X  } else {
X    n <- length(y)
X    if(length(ti) != (n + 1))  stop("length(ti) MUST == length(y) + 1")
X  }
X  if(length(ti) != (n + 1) || length(y) != n)
X    stop("NEVER CALLED! --length(ti) MUST == length(y) + 1")
X  if(missing(main))  main <- deparse(sys.call())
X
X  n1 <- n+1
X  ##-- horizontal segments:
X  if (add) segments(ti[-n1], y, ti[-1], y, ...)
X  else {
X    plot(ti, c(y[1],y), type= 'n', xlab= xlab, ylab= ylab, main= main, ...)
X    segments(ti[-n1], y, ti[-1], y)
X  }
X  if(left.points)  points(ti[-n1],y)
X  if(right.points) points(ti[-1],y)
X  if(! end.points) points(ti[c(1,n1)], y[c(1,n)], col = 0) #-- col=0 : erase
X  if(verticals) {
X    if (add) segments(ti[2:n], y[-n], ti[2:n], y[-1], ...)
X    else     segments(ti[2:n], y[-n], ti[2:n], y[-1])
X  }
X  invisible(list(t = ti, y = y))
}
X
give.xy.list <- function(x, y)
{
X  ## Purpose: Return  list(x = . , y = . [, ... ] ) for many cases
X  ## -------------------------------------------------------------------------
X  ## Arguments: x: x-y data structure  or x-vector
X  ##  (optional y: y-vector  [in most simple case])
X  ## -------------------------------------------------------------------------
X  ## Author: Martin Maechler, 1990
X  if(is.list(x)) {
X    if(any(is.na(match(c("x", "y"), names(x))))) {
X      if(length(x) == 2)
X	list(x = x[[1]], y = x[[2]])
X      else stop("arg. is not an xy.list")
X    }
X    x
X  } 
X  else if(is.complex(x))		list(x = Re(x),   y = Im(x))
X  else if(is.matrix(x)) {
X    if(ncol(x) == 2)			list(x = x[, 1],  y = x[, 2])
X    else stop("matrix 'x' must have 2 columns (x, y)")
X  }
X  else if(is.ts(x))			list(x = time(x), y = x)
X  else if(length(x) == 0) stop("zero length x data")
X  else if(length(y) == 0) stop("zero length y data")
X  else					list(x = x, y = y)
}
SHAR_EOF
  $shar_touch -am 0122084097 'plot.step.S' &&
  chmod 0644 'plot.step.S' ||
  $echo 'restore of' 'plot.step.S' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'plot.step.S:' 'MD5 check failed'
71fba81bd2fd885f8d6e8993b6c50f0f  plot.step.S
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'plot.step.S'`"
    test 3096 -eq "$shar_count" ||
    $echo 'plot.step.S:' 'original size' '3096,' 'current size' "$shar_count!"
  fi
fi
# ============= plot.step.d ==============
if test -f 'plot.step.d' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'plot.step.d' '(file already exists)'
else
  $echo 'x -' extracting 'plot.step.d' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'plot.step.d' &&
X.BG
X.FN plot.step
X.TL
plot a step function  f(x)= sum{ y[i] * 1_[ t[i-1], t[i] ) (x) }
X.DN
Plots a step function, i.e., a piecewise constant function of one variable.
With one argument, plots "THE" empirical cumulative distribution function.
X.CS
plot.step(ti, y, 
X          cad.lag = T, 
X          verticals = !cad.lag, 
X          left.points= cad.lag, right.points= F, end.points= F,
X	  add = FALSE,
X          xlab=deparse(substitute(ti)), ylab=deparse(substitute(y)),
X          main=NULL, ...)
X.RA
X.AG ti
Numeric Vector = X[1:N] or  t[0:n]
X.OA
X.AG y
Numeric Vector y[1:n]; if omitted take y = k/N  for empirical CDF
X.AG cad.lag
Logical: Draw 'cad.lag', i.e., "continue a droite, limite a gauche". Default = T
X.AG verticals
Logical: Draw vertical lines?  Default= ! cad.lag
X.AG left.points
Logical: Draw left points?     Default= cad.lag
X.AG right.points
Logical: Draw right points?    Default= FALSE
X.AG end.points
Logical: Draw 2 end points?    Default= FALSE
X.AG add
Logical: Add to existing plot?    Default= FALSE
X.PP
Any arguments to `plot(..)'; the following three have a different default:
X.AG xlab
Label of x-axis
X.AG ylab
Label of y-axis
X.AG main
Main Title; Default = 'call'; if you do not want a title, use 'main=""'.
X.AG ...
Any valid argument to plot(..), e.g.,  main = "This is the Main Title", lty=3.
X.RT
[INVISIBLY:]  List with components `t' and `y'.
X.SE
Calls plot(..), points(..),  segments(..) appropriately
and plots on current graphics device.
X.sp 0
NOTE:
X.SH AUTHOR
Martin Maechler, Seminar for Statistics, ETH Zurich, Switzerland
X.sp 0
maechler@stat.math.ethz.ch
X.SA
plot, segments, approx(..., method = "constant")
X.EX
##-- Draw an Empirical CDF  (and see the default title ..)
plot.step(rnorm(15))
X
plot.step(runif(25), cad.lag=F)
plot.step(runif(25), cad.lag=F, add=T, lty = 2)
X
ui _ sort(runif(20))
plot.step(ui, ni _cumsum(rpois(19, lambda=1.5) - 1.5), cad.lag = F)
plot.step(ui, ni, verticals = T, right.points = T)
X.KW empirical distribution function
X.KW nonparametric
X.KW hplot
X.KW step function
X.WR
SHAR_EOF
  $shar_touch -am 1221150893 'plot.step.d' &&
  chmod 0644 'plot.step.d' ||
  $echo 'restore of' 'plot.step.d' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'plot.step.d:' 'MD5 check failed'
78e05df613e348b35003f90080445f37  plot.step.d
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'plot.step.d'`"
    test 2034 -eq "$shar_count" ||
    $echo 'plot.step.d:' 'original size' '2034,' 'current size' "$shar_count!"
  fi
fi
rm -fr _sh19128
exit 0
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- For info or help, send "info" or "help",
To [un]subscribe, send "[un]subscribe"
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-