[R] srt --- slope text with function?

[ivo welch]

Dear R Wizards:  To bore everyone to death, below is an improved and
hopefully final version of my native.slope() function.  (Thanks, Jim.)
 In case you are not asleep yet reading yet another post of mine, may
I ask the experts some programming questions?

  [I just saw yesterday's threat---I think it would be very, very, very nice if
  R would remember from what files with what linenumbers code came from.
  thus ignore below questions that mention this feature.  ALAS, I understand
  that this cannot be done generally.  But could not function definitions at
  least have a component that remembers this?]

* Is there a way that I can print an R functional backtrace?  Instead
of passing my subroutine name to my function "assert()" below, it
would be nice if I could just print the whole call tree [preferably
with file names+line numbers] when I want my program to gracefully
bonk out.  (PS: I think that this is also what R should print when any
user program bonks out, not just the stop message.)  Actually, I just
learned about traceback(), which functions nicely AFTER the program
stops, not before.  But it gives no traceback earlier---and it does
not give filename+lineno.

* is there a way to print all my user defined functions?  I have an
init file, in which I am defining all sorts of useful utility
functions, and I would like to print what I have defined (for memory)
upon a read of this init file?  that is, something that has
functionality like
   note.all.local.definitions.now.in.vector( all.local.functions )
   a <- function() { }
   b <- function() { }
   cat( all.local.functions ); # should print 'a' and 'b'.

* is there a string variable that gives me the name of the current
function I am in?

* SUGGESTION: can we please offer the "?:" operator ala C in addition
to ifelse()?  This would make R code prettier.  Similarly, perl has a
nice construct, which would be lovely, but which may not jive with the
R syntax:
    condition  or die("the condition", condition, "has failed");
    condition  and cat("my condition", condition, "is met");
I believe "or" and "and" are not defined, so this may be possible...

* has it now become possible to embed sample data sets in R code?  (I
asked this a while back, but there were nly kludges, no standard
"pretty" solutions.)

* SUGGESTION: The ?"function" docs would be terrific if they had a
small example at the end that showed how to return multiple arguments,
and then pick them up.  I believe this is best done through lists, but
I am not sure.

I find myself programming more and more in R, so I am beginning to see
it as my standard language, rather than as a statistical program.

Regards,

/iaw


################################################################
#### native.slope computes a suitable srt from a function around
#### a point on a function.  This is useful until text() gets
#### an srt parameter that is relative to the coordinate system.
####   (Ideally, R would be able to slope along a function.)
################################################################

native.slope <- function( x, y, where.i, debug =0) {

  assert <- function( condition, routine, ... ) {
    if (condition) return(NULL);
    cat(paste(routine,...));
    stop("THIS IS A FATAL ERROR!\n");
  }

  subname= "native.slope";  # until I discover how to print a complete
backtrace, this is it.

  assert( length(x) == length(y), subname,
	 "Sorry, but x and y must have equal dimensions, not ", length(x), "
and ", length(y), "\n");

  ## try to take a symmetric field around the point to be described
  l0= ifelse( where.i<=1, 1, where.i-1);
  l1= ifelse( where.i>=length(y), length(y), where.i+1);

  assert( !is.na(x[l0]), subname, "Sorry, but x[",l0,"] is NaN");
  assert( !is.na(x[l1]), subname, "Sorry, but x[",l1,"] is NaN");
  assert( !is.na(y[l0]), subname, "Sorry, but y[",l0,"] is NaN");
  assert( !is.na(y[l0]), subname, "Sorry, but y[",l1,"] is NaN");

  assert( y[l1] != y[l0], subname, "Sorry, but you cannot draw a slope
on a point");

  ## native slope in a 1:1 coordinate system
  d= ( (y[l0]-y[l1])/(x[l0]-x[l1]) );
  if (is.na(d)) return(0); # we do not know how to handle an undefined
spot at a function!

  ## now adjust by the axis scale and size of plot area
  .usr <- par('usr')  # dimensions of user units
  .plt <- par('plt') # percent of figure area that plot region is
  d.m <- (.usr[4] - .usr[3]) / (.usr[2] - .usr[1]) * (.plt[2] -
.plt[1]) / (.plt[4] - .plt[3])
  assert( !is.na(d.m), subname, "Internal Error: I do not have
sensible axis dimensions (", d.m, ")\n");

  ## now handle the drawing system
  .fin = par('fin');
  asp.ratio = .fin[1]/.fin[2];
  assert( !is.na(asp.ratio), subname, "Internal Error: I do not have a
reasonable drawing aspect ratio");

  net.slope= d/asp.ratio/d.m;
  slope = atan(net.slope)/pi*180.0;

  if (debug) {
    cat("\t", subname, "debug: d=", d, " (",y[where.i-1],y[where.i+1],
x[where.i-1], x[where.i+1],")\n",
	"\t\td.m=",d.m, " (", .usr, ",", .plt, ")\n",
	"\t\tasp.ratio=", .fin, "\n\t\t==> slope=", net.slope, "=", slope, "deg\n");
    points( x[where.i], y[where.i], pch=19 );
  }

  return( slope = slope );
}