Use custom font for points in R - r

I am trying to make a scatter plot in R using these points:
(as far as I can trace, W. Cleveland suggested using these for sparse and dense, respectively, scatter plots -- I now call them "Cleveland points".)
The bottom row should be straightforward, and the top row could be achieved by doing some smart overplotting (i.e. plotting two symbols on top of each other). But this will not suffice when plotting the legend.
As a solution I was therefore imagining getting a font that contains these 10 symbols and instruct R to use this font when plotting the points + legend.
(And now it occurs to me, that I might just use text with the custom font to plot the points. But this does not solve the legend issue.)
I have also considered using ggplot2, but this would perhaps easiest be implemented via a scale?
Question: Any suggestions on how to use these symbols (preferable the top row), that can also be used in the legend?

Here is one approach using base graphics and the my.symbols function from the TeachingDemos package:
library(TeachingDemos)
ms.Cleveland <- function(num.pt = 1, cex=2, ...) {
funs <- list(
open = function(cex, ...)
points(0,0, pch=1, lwd=2, cex=cex, ...),
filled = function(cex, ...)
points(0,0, pch=16, cex=cex, ...),
half = function(cex, ...)
points(0,0, pch=1, lwd=5, cex=cex, ...),
vert = function(cex, ...) {
points(0,0, pch=1, lwd=2, cex=cex, ...)
points(0,0, pch='|', lwd=2, cex=cex/2, ...)
},
dot = function(....) {
points(0,0, pch=1, lwd=2, cex=cex, ...)
points(0,0, pch=16, cex=cex/3, ...)
}
)
funs[[num.pt]](cex, ...)
}
### create size variable for mtcars
sz <- findInterval( mtcars$wt, quantile( mtcars$wt, c(0.2, 0.4, 0.6, 0.8) ) ) + 1
with(mtcars, my.symbols(wt, mpg, ms.Cleveland, num.pt=sz, add=FALSE,
symb.plots=TRUE))
tmp <- legend('topright', pch=1, col=NA, pt.cex=2,
legend=c('Small', 'SMed', 'Medium', 'LMed', 'Large'))
my.symbols( (tmp$rect$left + tmp$text$x)/2, tmp$text$y, ms.Cleveland, num.pt=1:5,
symb.plots=TRUE)
The ms.Cleveland function plots the points according to a number (1 to 5) or name and uses overplotting for the last 2 points (may want to tweak the functions a bit).
Then the legend is drawn using the regular legend function, but with col=NA there is place for the symbols, but they are not drawn. Then my.symbols is used again to place the symbols within the legend at the point halfway between the left edge of the box and the start of the text.

Related

Plot multiple sparkles by overlapping each other

I use following code to make a plot with the first set of my values (here it is the number of crimes).
This is what I do have now:
Here is the code I use to plot it:
library(lattice)
library(latticeExtra)
library(grid)
library(reshape)
library(RCurl)
dd <- read.csv(text = getURL("https://gist.githubusercontent.com/GeekOnAcid/da022affd36310c96cd4/raw/9c2ac2b033979fcf14a8d9b2e3e390a4bcc6f0e3/us_nr_of_crimes_1960_2014.csv"))
d <- melt(dd, id="Year")
names(d)[1] <- "time"
pdf("sparklines_lattice_multiple_ten.pdf", height=10, width=8)
xyplot(value~time | variable, d, xlab="", ylab="", strip=F, lwd=0.7, col=1, type="l",
layout=c(1,length(unique(d$variable))), between = list(y = 1),
scales=list(y=list(at=NULL, relation="free"), x=list(fontfamily="serif")),
par.settings = list(axis.line = list(col = "transparent"),
layout.widths=list(right.padding=20, left.padding=-5)),
panel = function(x, y, ...) {
panel.xyplot(x, y, ...)
pushViewport(viewport(xscale=current.viewport()$xscale-5,
yscale=current.viewport()$yscale, clip="off"))
panel.text(x=tail(x,n=1), y=tail(y,n=1), labels=levels(d$variable)[panel.number()],
fontfamily="serif", pos=4)
popViewport()
panel.text(x=x[which.max(y)], y=max(y), labels=round(max(y),0), cex=0.8,
fontfamily="serif",adj=c(0.5,2.5))
panel.text(x=x[which.min(y)], y=min(y), labels=round(min(y),0), cex=0.8,
fontfamily="serif",adj=c(0.5,-1.5))
panel.text(x=tail(x,n=1), y=tail(y,n=1), labels=round(tail(y,n=1),0), cex=0.8,
fontfamily="serif", pos=4)
panel.points(x[which.max(y)], max(y), pch=16, cex=1)
panel.points(x[which.min(y)], min(y), pch=16, cex=1, col="red")})
dev.off()
What I need: to add an extra dimension (i.e., extra line) to each sparkline with the number of suspects per each type of crime (e.g., Vehicle.Theft, Larceny.Theft, etc.). In other words, I also want to add extra line to each sparkline to compare the dynamics of (1) the number of crimes and (2) the number of suspect for each type of crime.
To be clear: I want to set up two lines for each sparkline.
Just before you answer my question please be aware of:
par(new=TRUE) doesn't work: Warning message: In par(new = TRUE) : calling par(new=TRUE) with no plot. It just creates two separated pages in a PDF file with two different sparklines. I need the opposite result: two sparklines on the same PDF page.
Thank you very much for your efforts to help me (if you do so).

Dynamic background in plot() based on x-axis values?

I'm looking to implement EXACTLY this, but using plot() instead of ggplot2. There is even a reply on the blog by someone saying they did this with plot, but the link to their code is dead. I'm literally trying to do the exact same thing. I've downloaded data from FRED using quantmod's getSymbols(), and I have that data in a df, which I'm plotting with plot(). The x-axis are dates, and I want to change the background color based on a specific set of dates. Any ideas or hints how I can do this with plot?
Thank you!
Based on this question: R: change background color of plot for specific area only (based on x-values)
## plotting area with no axes
plot(unrate.df, type = "n")
lim <- par("usr")
## adding one rectangle
for (i in 1:nrow(recessions.trim)) {
rect(recessions.trim[i, 1], lim[3],
recessions.trim[i, 2], lim[4], border = "pink", col = "pink")
}
## adding the data
lines(unrate.df)
box()
You can use this:
plot(unrate.df, type="n")
makeRectangles(recessions.trim, col="pink", alpha=0.5)
lines(unrate.df)
grid()
where the function makeRectangles is defined as:
makeRectangles = function(x, col, alpha=1, border=NA, ...) {
col = col2rgb(col=col, alpha=FALSE)
col = rgb(red=col[1], green=col[2], blue=col[3],
alpha=floor(255*alpha) , maxColorValue=255)
rect(x[,1], par("usr")[3], x[,2], par("usr")[4], col=col, border=border, ...)
return(invisible())
}

How to add multiple straight lines in a multi plot.zoo

I have multiple time series data plots and I need an horizontal line in each plot but with different horizontal values (es. 1st plot: h=50, 2nd plot: h=48...).
I tried abline(h=50... and I get the horizontal line in each plot.
I tried abline(h=c(50,48... and I get multilple horizontal lines in each plot.
I can't figure out how to get the plot.zoo index in order to plot h=50 in the 1st plot, h=48 in the 2nd plot and so on.
library(xts)
data(sample_matrix)
x <- as.xts(sample_matrix)
# plot with single line
my.panel <- function(x, ...) {
lines(x, ...)
abline(h=50, col = "red", lty="solid", lwd=1.5 )
}
plot.zoo(x, main="title",
plot.type="multiple", type="o", lwd=1.5, col="blue",
panel=my.panel)
# plot multiple lines in all plots
my.panel <- function(x, ...) {
lines(x, ...)
abline(h=c(50,50,48,50), col = "red", lty="solid", lwd=1.5 )}
plot.zoo(x, main="title",
plot.type="multiple", type="o", lwd=1.5, col="blue",
panel=my.panel)
To customize single panels in a multipanel plot is not thoroughly described in the actual ?plot.zoo text. In the 'Details' section you find:
"In the case of a custom panel the panel can reference parent.frame$panel.number in order to determine which frame the panel is being called from. See examples.". And there are quite a few examples. Using them as template, I found that this could be a way to call separate panels, and draw a separate hline in each.
Update. Thanks to #G. Grothendieck for an edit that made the code much cleaner!
# create values for hline, one for each panel
hlines <- c(50, 50, 48, 50)
# panel function that loops over panels
my.panel <- function(x, ...) {
lines(x, ...)
panel.number <- parent.frame()$panel.number
abline(h = hlines[panel.number], col = "red", lty = "solid", lwd = 1.5)
}
plot.zoo(x, main = "title", type = "o", lwd = 1.5, col = "blue", panel = my.panel)

how to create a plot with customized points in R?

I know I can create a plot with line and dots using the type = "o" argument in the plot command. I would like some more control over this -- I want to be able to draw the "o" as full dots, with black border and fill-in color of my choice, of customized size and of a different color than the line. Same for the line, I want to make it thicker, and of my choice of color. How would I go on about doing that?
What I found until now is just a plain
plot(y, type= "o")
which is too poor for my needs.
I am not interested in using ggplot, but instead use the internal plot library of R.
Any help appreciated.
All the information you need should be present in ?plot and ?points, as suggested by #BenBolker. In particular, you want to be using pch=21, and specifying background colour with the bg argument, size with cex, and line width with lwd.
If you want the line to be a different thickness to the point borders, you need to plot the line first, and then overlay the points.
For example:
y <- sample(10)
plot(y, lwd=6, type='l')
points(y, bg='tomato2', pch=21, cex=3, lwd=3) # tomato2 is a personal fave
You could also provide a vector of lwd, cex and col to the points call:
plot(y, lwd=6, type='l')
points(y, bg=rainbow(10), pch=21, cex=seq(1, by=0.2, length.out=10),
lwd=seq(2, by=1, length.out=10))
You could use layering (I don't work in base too much any more as a social researcher I love the facet_grid of ggplot, so there may be a better way) as in:
x <- sort(rnorm(25))
y <- sort(rnorm(25))
z <- as.factor(sample(LETTERS[1:5], 25, r=TRUE))
plot(x, y, pch = 19, cex = 1.3)
par(new = TRUE)
plot(x, y, pch = 19, cex = 1, col = z)
Which gives you:

Get plot() bounding box values

I'm generating numerous plots with xlim and ylim values that I'm calculating on a per-plot basis. I want to put my legend outside the plot area (just above the box around the actual plot), but I can't figure out how to get the maximum y-value of the box around my plot area.
Is there a method for even doing this? I can move the legend where I want it by manually changing the legend() x and y values, but this takes a LONG time for the amount of graphs I'm creating.
Thanks!
-JM
Here's a basic example illustrating what I think you're looking for using one of the code examples from ?legend.
#Construct some data and start the plot
x <- 0:64/64
y <- sin(3*pi*x)
plot(x, y, type="l", col="blue")
points(x, y, pch=21, bg="white")
#Grab the plotting region dimensions
rng <- par("usr")
#Call your legend with plot = FALSE to get its dimensions
lg <- legend(rng[1],rng[2], "sin(c x)", pch=21,
pt.bg="white", lty=1, col = "blue",plot = FALSE)
#Once you have the dimensions in lg, use them to adjust
# the legend position
#Note the use of xpd = NA to allow plotting outside plotting region
legend(rng[1],rng[4] + lg$rect$h, "sin(c x)", pch=21,
pt.bg="white", lty=1, col = "blue",plot = TRUE, xpd = NA)
The command par('usr') will return the coordinates of the bounding box, but you can also use the grconvertX and grconvertY functions. A simple example:
plot(1:10)
par(xpd=NA)
legend(par('usr')[1], par('usr')[4], yjust=0, legend='anything', pch=1)
legend( grconvertX(1, from='npc'), grconvertY(1, from='npc'), yjust=0,
xjust=1, legend='something', lty=1)
The oma, omd, and omi arguments of par() control boundaries and margins of plots - they can be queried using par()$omd (etc). and set (if needed) using par(oma=c()) (where the vector can have up to 4 values - see ?par)

Resources