R symbol background for custom symbols - r

I have an R plot where I use the values as symbols. The points also have error bars:
The problem is, obviously, that the error bars (I use arrows for that) cross through the numbers and that just looks ugly and makes them hard to read.
This is my code, any ideas?
x = c(45.58333, 89.83333, 114.03333,138.65000,161.50000,185.15000,191.50000)
y_mean = c(3.350000,6.450000,7.200000,7.033333,8.400000,7.083333,6.750000)
y_sd = c(0.1802776,0.1732051,0.2500000,0.2020726,0.3500000,0.2020726,0.1000000)
values = data.frame(x, y_mean, y_sd)
plot(values$x, values$y_mean, type="n")
arrows(values$x, values$y_mean - values$y_sd,
values$x, values$y_mean + values$y_sd,
length=0.05, angle=90,
code=3, col="red")
lines(values$x, values$y_mean, type="b",
pch=" ",
col="red", bg="white")
text(values$x, values$y_mean, label=round(values$y_mean), col="red")
EDIT:
I executed the exact code shown above as asked:

I would play with the horizontal justification and add small points to keep track of the original position
points(values$x, values$y_mean, pch=19, col="red", cex=0.5)
text(values$x, values$y_mean, label=round(values$y_mean), col="red", adj = -0.2)

One idea is to white out the plot content where the text will be drawn, before drawing the text. This can be done with rect(). Although you risk whiting out the error bars entirely with this approach.
We can use strwidth() and strheight() to get the appropriate sizes for the whiteout rectangles.
x <- c(45.58333, 89.83333, 114.03333,138.65000,161.50000,185.15000,191.50000);
y_mean <- c(3.350000,6.450000,7.200000,7.033333,8.400000,7.083333,6.750000);
y_sd <- c(0.1802776,0.1732051,0.2500000,0.2020726,0.3500000,0.2020726,0.1000000);
xlim <- range(x);
ylim <- c(min(y_mean-y_sd),max(y_mean+y_sd));
plot(NA,xlim=xlim,ylim=ylim,xlab='x',ylab='y');
arrows(x,y_mean-y_sd,x,y_mean+y_sd,length=0.05,angle=90,code=3,col='red');
lines(x,y_mean,type='b',pch=' ',col='red',bg='white');
ls <- as.character(round(y_mean));
ex <- 0.4; ## whiteout expansion factor
lsw <- strwidth(ls); w <- lsw/2*(1+ex);
lsh <- strheight(ls); h <- lsh/2*(1+ex);
rect(x-w,y_mean-h,x+w,y_mean+h,col='white',border=NA);
text(x,y_mean,ls,col='red');

Just apply these changes:
plot(values$x, values$y_mean, type="n",
xlim = c(min(values$x), max(values$x) + 20),
ylim = c(min(values$y_mean)-1, max(values$y_mean)+1))
text(values$x, values$y_mean, label=round(values$y_mean), col="blue", pos = 3)

Related

How can I plot a population growth rate function in R?

I'm trying to reproduce the plot of the image using this code in R:
N = 1:100
r = 1
K = 1
r1 = list(r*N*(1 - (N/K)))
plot(N, r1[[1]])
but negative values ​​appear on the graph. What am I doing wrong or how can I graph the image?
Thanks in advance
You could use the curve function, which is designed for drawing function curves. In this way, you avoid the detour of generating values in advance.
For the basic curve you just need to code your varying variable N as x:
curve(expr=r*x*(1 - (x/K)), from=1, to=100)
To completely reproduce the plot, we open the R graphics toolbox a little further.
op <- par(mar=c(4, 8, 2, 5)) ## set margins
curve(r*x*(1 - (x/K)), 1, 100,
xlab="", ylab="", xaxt="n", yaxt="n",
axes=FALSE, xaxs="i", yaxs="i",
ylim=c(-8e3, 3e3), lwd=2)
axis(2, labels=FALSE, lwd.ticks=0)
abline(h=-5e3)
text(max(N), -5e3*1.05, "N", font=8, xpd=TRUE)
mtext("r", 2, .5, at=0, las=1, font=8)
mtext("Growth rate", 2, .5, at=2e3, las=1, font=6, cex=1.5)
## for the "K" tick and label in the plot, we need to solve the equation
## to get the intersect with our abitrary x axis at -5e3
f <- function(x, y) r*x*(1 - (x/K)) - y
x.val <- uniroot(f, y=-5e3, lower=0, upper=1000)$root
## and insert the solution as x.value
axis(1, x.val, labels=FALSE, pos=-5e3)
text(x.val, -5e3*1.1, "K", font=8, xpd=TRUE)
par(op) ## reset margins
Result
If you have a look at r1, you'll see that the data are plotted correctly. The values begin at zero and decrease.
If you simply wanted to shift the data for a quick visualization, you can add a scale factor:
#add a scale factor - all values positive
r2<-r1[[1]]+10000
plot(N, r2)
or
#add a scale factor - span y = 0
r3<-r1[[1]]+5000
plot(N, r3)
Add annotation to the plot:
abline(h=0, col="black") #add line at zero
text(65, -600, "K", cex=1.5, col="black") #add text

how to plot matlab style log-log plot using R plot

ENV
R version 3.3.1
MAC OSX 10.9.4
I would like to plot a style like figure below, which is plotted by matlab.
There is full grid on the plot with customized axis range (e.g. $10^0~10^{-4}$) and axis label (e.g. 10^0 10^1 10^-2 10^-3 10^-4 10^-5). There are ten ticks between 10^0 and 10^1 and also other labels. Similar for y axis.
Expected:
I tried:
initial.dir<-getwd()
setwd("/Rworks/bin")
sink("r.o")
pk <- read.table("2017.file)
rownames(pk)<-c("k","pk")
d.f <- data.frame(t(pk))
png(file="m.png")
plot(
d.f$k,
d.f$pk,
type = "n",
log = "xy",
xlim = c( 10^0, 10^2),
ylim = c( 0.00001, 1),
)
lines( d.f$k, d.f$pk, col = "green4", lty = "dotted")
points( d.f$k, d.f$pk, bg = "limegreen", pch = 21 )
box()
dev.off
sink()
setwd(initial.dir)
I got:
The axis and axis label and the ticks and grid is not what I want. Can anyone can give an advices? Thanks.
Worst case scenario, you can just draw the axes and background lines yourself.
plot(
x=c(1,2), y=c(0.6,0.2),
pch=21, bg="red",
log = "xy",
xlim = c( 10^0, 10^2),
ylim = c( 0.00001, 1),
xaxt="n", yaxt="n",
xlab="", ylab="",
yaxs="i"
)
lines(x=c(1,2), y=c(0.6,0.2))
axis(1, at=10^(0:2),
labels=expression(10^0, 10^1, 10^2))
axis(2, at=10^(-5:0), las=1,
labels=expression(10^-5, 10^-4, 10^-3, 10^-2, 10^-1, 10^0))
abline(h=outer((1:10),(10^(-5:-1))), col="#00000033", lty=2)
abline(v=outer((1:10),(10^(0:1))), col="#00000033", lty=2)
Here's an example - it's not exactly what you want (e.g. you could play around with theme options such as panel.grid.minor to get dotted grid lines), but it's most of the way there.
Exponential-format axis tick labels, from here:
fancy_scientific <- function(l) {
# turn in to character string in scientific notation
l <- format(l, scientific = TRUE)
# quote the part before the exponent to keep all the digits
l <- gsub("^(.*)e", "'\\1'e", l)
# turn the 'e+' into plotmath format
l <- gsub("e", "%*%10^", l)
# return this as an expression
parse(text=l)
}
Manual ticks from #G5W's answer: might be possible to write a function to do this automatically, or one might exist somewhere.
yticks = outer((1:10),(10^(-5:-1)))
xticks = outer((1:10),(10^(0:1)))
Draw the plot (with #G5W's sample mini-data)
library(ggplot2)
ggplot(data.frame(x=1:2,y=c(0.6,0.2)),
aes(x,y))+
geom_point(colour="red")+
scale_x_log10(limits=c(1,100),labels=fancy_scientific,
minor_breaks=xticks)+
scale_y_log10(limits=c(1e-5,1),labels=fancy_scientific,
minor_breaks=yticks)+
theme_bw()

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).

r xyplot "steps" centered on data points

the type argument to xyplot() can take "s" for "steps." From help(plot):
The two step types differ in their x-y preference: Going from
(x1,y1) to (x2,y2) with x1 < x2, 'type = "s"' moves first
horizontal, then vertical, whereas 'type = "S"' moves the other
way around.
i.e. if you use type="s", the horizontal part of the step has its left end attached to the data point, while type="S" has its right end attached to the data point.
library(lattice)
set.seed(12345)
num.points <- 10
my.df <- data.frame(x=sort(sample(1:100, num.points)),
y=sample(1:40, num.points, replace=TRUE))
xyplot(y~x, data=my.df, type=c("p","s"), col="blue", main='type="s"')
xyplot(y~x, data=my.df, type=c("p","S"), col="red", main='type="S"')
How could one achieve a "step" plot, where the vertical motion happens between data points points, i.e. at x1 + (x2-x1)/2, so that the horizontal part of the step is centered on the data point?
Edited to include some example code. better late than never I suppose.
I am using excellent #nico answer to give its lattice version. Even I am ok with #Dwin because the question don't supply a reproducible example, but customizing lattice panel is sometimes challenging.
The idea is to use panel.segments which is the equivalent of segments of base graphics.
library(lattice)
xyplot(y~x,
panel =function(...){
ll <- list(...)
x <- ll$x
y <- ll$y
x.start <- x - (c(0, diff(x)/2))
x.end <- x + (c(diff(x)/2, 0))
panel.segments(x.start, y, x.end, y, col="orange", lwd=2)
panel.segments(x.end[-length(x.end)], y[1:(length(y)-1)],
x.end[-length(x.end)], y[-1], col="orange", lwd=2)
## this is optional just to compare with type s
panel.xyplot(...,type='s')
## and type S
panel.xyplot(...,type='S')
})
This is a base graphics solution, as I am not too much of an expert in lattice.
Essentially you can use segments to draw first the horizontal, then the vertical steps, passing the shifted coordinates as a vector.
Here is an example:
set.seed(12345)
# Generate some data
num.points <- 10
x <- sort(sample(1:100, num.points))
y <- sample(1:40, num.points, replace=T)
# Plot the data with style = "s" and "S"
par(mfrow=c(1,3))
plot(x, y, "s", col="red", lwd=2, las=1,
main="Style: 's'", xlim=c(0, 100))
points(x, y, pch=19, col="red", cex=0.8)
plot(x, y, "S", col="blue", lwd=2, las=1,
main="Style: 'S'", xlim=c(0, 100))
points(x, y, pch=19, col="blue", cex=0.8)
# Now plot our points
plot(x, y, pch=19, col="orange", cex=0.8, las=1,
main="Centered steps", xlim=c(0, 100))
# Calculate the starting and ending points of the
# horizontal segments, by shifting the x coordinates
# by half the difference with the next point
# Note we leave the first and last point as starting and
# ending points
x.start <- x - (c(0, diff(x)/2))
x.end <- x + (c(diff(x)/2, 0))
# Now draw the horizontal segments
segments(x.start, y, x.end, y, col="orange", lwd=2)
# and the vertical ones (no need to draw the last one)
segments(x.end[-length(x.end)], y[1:(length(y)-1)],
x.end[-length(x.end)], y[-1], col="orange", lwd=2)
Here is the result:

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