Examples of a few customized R functions
A function to create arrows with solid heads
This is a function to draw arrows with solid arrowheads. The tricky part here (at least for me) is getting the arrowheads to work correctly under different aspect ratios (the relative vertical and horizontal sizes of the plot). This function does that, but it does not update the arrows if the aspect ratio changes; you’ll likely have to redo the plot if you want to change its size. There is another function for drawing a variety of arrowheads (but not the lines) in the shape package.
# 15.3c Arrows ========================================================= 15.3c
# A solid arrowhead function
#
# This function draws an arrow from (x0,y0) to (x1,y1) with a solid
# arrowhead.
#
# The default arrowhead length is .25 inches.
# The default angle of the arrowhead edges is 30 degrees.
# The other parameters are standard for line and polygon formatting.
#
# The basic logic here is to use matrix rotation to translate the arrowhead
# coordinates.
#
# Note that R's trigonometric functions work with radians rather than degrees
#
myArrow = function(x0, y0, x1, y1, # Set up arrow function --------------+
L = .25, # Default arrowhead length |
angle = 30, # Default angle of arrowhead |
code = 2, # Default arrowhead at x1,y1 |
col = par("fg"), # Default color |
ljoin = par("ljoin"), # Default line joint style (0) |
lty = par("lty"), # Default line type |
lwd = par("lwd"), # Default line width |
xpd = FALSE){ # Default stay within plot area |
# Start function code |
if(code == 1){ # Reverse arrow direction |
tmp = x1; x1 = x0; x0 = tmp # Switch x values |
} # |
if(code == 1){ # |
tmp = y1; y1 = y0; y0 = tmp # Switch y values |
} # |
# |
# We need to control for the aspect ratio or for different x,y scales |
# in setting up the arrow heads. We'll do that by translating the |
# usr parameter setting from the original x,y units to units based |
# on the plot dimensions measured in inches. This will allow us to |
# adjust the angles to account for different x and y scales. Note, |
# however, that rescaling the plot after it is drawn will distort |
# the arrowheads. |
# |
X0 = (x0 - par()$usr[1])/(par()$usr[2] - par()$usr[1]) * par()$fin[1] # |
Y0 = (y0 - par()$usr[3])/(par()$usr[4] - par()$usr[3]) * par()$fin[2] # |
X1 = (x1 - par()$usr[1])/(par()$usr[2] - par()$usr[1]) * par()$fin[1] # |
Y1 = (y1 - par()$usr[3])/(par()$usr[4] - par()$usr[3]) * par()$fin[2] # |
# |
oldusr = par("usr") # Save original usr settings |
par(usr = c(0, par("fin")[1], # Set up new usr settings based |
0, par("fin")[2])) # on plot dimensions in inches |
# |
t = angle * pi/180 # Convert angle degrees to radians |
slope = (Y1 - Y0)/(X1 - X0) # Calculate slope of line |
S = atan(slope) # Slope angle in radians |
# |
M = ifelse(X1 < X0, -1, 1) # Set a marker for X1 & X0 |
# Set length of vector XA |
XA = sqrt((X1 - X0)^2 + (Y1 - Y0)^2) # |
# |
# Get arrowhead vertices from rotated vectors |
XC = X0 + M * ((XA - L) * cos(S) + L * tan(t) * sin(S)) # |
YC = Y0 + M * ((XA - L) * sin(S) - L * tan(t) * cos(S)) # |
XB = X0 + M * ((XA - L) * cos(S) - L * tan(t) * sin(S)) # |
YB = Y0 + M * ((XA - L) * sin(S) + L * tan(t) * cos(S)) # |
# | |
# Draw arrow line stopping at beginning of the arrowhead |
lines(x = c(X0, X1 - M * L * cos(S)), # |
y = c(Y0, Y1 - M * L * sin(S)), # |
lty = lty, lwd = lwd, # Apply line format options |
col = col, xpd = xpd, # |
ljoin = ljoin) # |
polygon(x = c(X1, XB, XC), # Draw arrow head |
y = c(Y1, YB, YC), # at vertices |
col = col, # Apply format options |
border = col, # |
xpd = xpd) # |
par(usr = oldusr) # Reset to original usr settings |
} # End of myArrow function ------------+
A function to draw ovals
R has a function to draw circles using the symbols() function with the circles=radius option (See chapter 15). Ovals, however, require an add-on package. You can find nice functions to do this in the shape package or the ellipse package. But, if you were a glutton for trying these things out on your own, here is a function to draw an ellipse, which you can see in action here, here, and here.
# A function to draw ellipses (This exists in various
# packages (e.g. shape and ellipse) but not in the base graphics. So, we'll
# do it as a useful exercise. This works on a (0,1) coordinate system. xcen
# and ycen are the coordinates for the center of the oval. xlen and ylen are
# the length of the x and y radii. ewidth is the width of the line. ecolor
# is the color of the line.
oval = function(xcen, ycen, # Oval function - center coords ------+
xlen, ylen, # Length of x and y radii |
ewidth = 1, ecolor = "black"){ # Line width and color |
t = seq(0, 2 * pi, length = 2000) # Set up theta for degrees around oval|
x = xcen + xlen * cos(t) # x values for ellipse |
y = ycen + ylen * sin(t) # y values for ellipse |
# |
lines(x, y, # Plot x and y values |
usr = c(0, 1, 0, 1), # Use 0,1 coordinates |
type = "l", # Use solid line |
lwd = ewidth, # Line width from function call |
col = ecolor) # Color set by function call |
}
A function to remove commas from numbers
This is a function to take commas out of numbers that have been imported with formatting commas. These commas are great for helping human beings read large numbers more accurately, but they only cause grief with R, which upon encountering them, turns everything into character or factor values.
nocommas = function(v1){ # Set up a function to strip commas
v1=as.character(v1) # Change input from factor to character
v1.temp1 = gsub(",", "", v1) # Replace commas with nothing
v1.temp2 = gsub("\\$", "", v1.temp1) # Also get rid of dollar signs
# $ is a special character so we need
# to backslash it. But backslash is
# a special character as well so it
# gets backslashed too.
return(as.numeric(v1.temp2)) # Turn factors to numeric output
} # Close the function
A function to plot a grid of colors with labels
This function facilitates printing out the 657 named colors used in R graphics. You can see the resulting output here.
# ==============================================================================
# Display All Built-in Color Names and Colors
#
# This script sets up a 10x10 grid to display 100 built in colors at a time. It
# uses a custom function to set out all of the colors in 7 plots.
#
# Kurt Taylor Gaubatz
# February, 2014
#
# ==============================================================================
#
# Function for plotting a grid of colors with names. The only argument required
# is the starting number of the colors to display. There are 657 R colors, so
# we'll need to generate 7 plots to display them all. The colors listed in the
# colors() function are in alphabetical order, so we'll demonstrate a regular
# expression grep() search to move the 200 gray/grey shades to the end.
#
# We pull out the grays with a somewhat complex regular expression. This is
# necessary because there are some colors like "bluegray" that we want to leave
# in. So, here is the regular expression search: grep("\\<gr[ae]y[[:digit:]]"
# First we run that with a preceding minus sign to remove the grays. Then we
# concatenate those observation numbers onto the end of our new colors vector.
# "grep" is the search function. In regular expressions, "<" means the beginning
# of a word. But this is a normal character so we have to make it special with
# a backslash. We have to make that backslash special with another backslash.
# Crazy, but true. Then we are looking for the letters "gr" at the beginning of
# a word. "[ae]" tells the search that the next letter can be either a or e,
# since R uses both spellings. Then there is a normal "y" to finish the word
# "gray" or "grey". Finally, we use the special indicator [:digits:] to look
# for any digit at the end of the word "grey" or "gray". Voila! a vector to
# identify all of the gray/grey colors.
ColorDisplay = function(col1=1){
colors=c(colors()[-grep("\\<gr[ae]y[[:digit:]]",colors())],
colors()[grep("\\<gr[ae]y[[:digit:]]",colors())])
x.left = trunc((0:100)%%10) # x values for left side of rectangles
y.bottom = trunc((99:0)/10) # Y values for bottom of rectangles
plot.new() # Start a new plot
par(usr=c(0,10,0,10), # Set x and y coordinates to 0-10
mai=c(0,0,0,0), # Set plot margin to 0 all around
omi=c(.1,.1,.1,.1)) # Add a little white space all around
rect(xleft=x.left, # Set left side of color rectangles
xright=x.left+1, # Set right side of color rectangles
ybottom=y.bottom, # Set bottom of color rectangles
ytop=y.bottom+.5, # Set top of color rectangles
border="white", # Set rectangle border color
col=colors[col1:(col1+99)]) # Get 100 colors starting w/col1 value
text( # Add color names
x=x.left+.5, # Set x value at middle of rectangles
y=y.bottom+.75, # Set y values between rectangles
cex=.7, # Set font size
label=colors[col1:(col1+99)]) # 100 color labels starting w/col1 value
} # End function
ColorDisplay(1) # A grid with colors 1-100
ColorDisplay(101) # A grid with colors 101-200
ColorDisplay(201) # A grid with colors 201-300
ColorDisplay(301) # A grid with colors 301-400
ColorDisplay(401) # A grid with colors 401-500
ColorDisplay(501) # A grid with colors 501-600
ColorDisplay(601) # A grid with colors 601-700