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

From: ivo welch <ivowel_at_gmail.com>
Date: Mon 06 Feb 2006 - 08:28:50 EST

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?]

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 );
}



R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html Received on Mon Feb 06 08:38:00 2006

This archive was generated by hypermail 2.1.8 : Fri 03 Mar 2006 - 03:42:24 EST