How can I plot a population growth rate function in R? - 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

Related

R: getting axis labels on parallel coordinates plot

I am having difficulty trying to get labels on my parcoord() plot. If I do :
library(MASS)
data1<-cbind.data.frame("A"=rbind(6,9,10))
data2<-cbind.data.frame("B"=rbind(3,19,1))
parcoord(cbind(data1,data2), col=1, lty=1)
axis(2, at=c(6,9,10), labels=c("this","should","bealabel"))
I do not get labels the left hand side of the plot. How do I fix this?
Because y-axis has been rescaled to [0,1]. Simply try axis(2) to see what the default axis is. Therefore, when you do at = c(6, 9, 10), that is beyond the range hence not displayed. Here is a solution:
y <- c(6, 9, 10)
pos <- (y - min(y)) / diff(range(y)) ## rescaling
parcoord(cbind(data1,data2), col=1, lty=1)
axis(2, at=pos, labels=c("this","should","bealabel"))

R symbol background for custom symbols

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)

How can I have the full range in the x- and y-axis labels in a plot?

I have two variables, x and y
x = runif(8, 0, runif(1, 1, 5))
y = x^2
that I want to plot. Note that the range of x (and hence y=x^2) is not always the same.
So, the command
plot(x, y, pch=19, col='red')
produces
However, I don't want the borders around the graph, so I use the bty='n' parameter for plot:
plot(x, y, pch=19, col='red', bty='n')
which produces
This is a bit unfortunate, imho, since I'd like the y-axis to go all the way up to 4 and the x-axis all the way to 2.
So, I ue the xaxp and yaxp parameters in the plot command:
plot(x, y, pch=19, col='red', bty='n',
xaxp=c(
floor (min(x)),
ceiling(max(x)),
5
),
yaxp=c(
floor (min(y)),
ceiling(max(y)),
5
)
)
which produces
This is a bit better, but it still doesn't show the full range. Also, I thought it nice that the default axis labaling uses steps that were like 1,2,3,4 or 0.5,1,1.5,2, not just some arbitrary fractions.
I guess R has some parameter or mechanism to plot the full range in the axis in a "humanly" fashion (0.5,1,1.5 ...) but I didn't find it. So, what could I try?
Try:
plot(x, y, pch=19, col='red', bty='n', xlim=c(min(x),max(x)),
ylim=c(min(y),max(y)), axes=FALSE)
axis(1, at=seq(floor(min(x)), ceiling(max(x)), 0.5))
axis(2, at=seq(floor(min(y)), ceiling(max(y)), 0.5))
Or if you'd prefer to hard-code those axis ranges:
axis(1, at=seq(0, 2, 0.5))
axis(2, at=seq(0, 4, 0.5))
Is that what you were after?

Bid Rent Curves - Plotting Circles of Projected Radii from Another Dimension

The goal is to reproduce this Bid-Rent graph in R:
The challenge is to draw the projected circles. So far I got:
The 2D part is created by the R code below with the traditional graphic system in base R:
#Distance
X <- seq(0,7,1)
#Bid Rent Curves: Commercial, Industrial, Residential
com <- -5*X + 10
ind <- -2*X + 7
res <- -0.75*X + 4
graph <- plot(X, com, type="l", col="green", ylim=c(0,10), xlab="", ylab="", axes=FALSE)
lines(X, ind, col="red")
lines(X, res, col="blue")
abline(v=0, h=0)
segments(1,0, 1,5, lty=2)
segments(2.5,0, 2.5,2, lty=2)
title(main="Bid Rent Curves", sub="Alonso Model",
xlab="Distance from CBD", ylab="Rent per m2")
text(2.5,7.5, "Commercial", col="green")
text(3.5,4, "Industrial", col="red")
text(5.5,2, "Residential", col="blue")
(Detail: Why the curves do not respect the ylim = 0 ?)
How make the projection and draw the semi-circles?
It is not exactly a 3D plot. I have looked into plot3D and rgl. I am not sure which packages or strategy to use from here.
I'm taking you at your word that you want circles, so you need to push the plot area into the upper right corner:
outHalfCirc <- function(r,colr) {opar=par(xpd=TRUE, new=TRUE) #plot ouside plot area
polygon(x=seq(r,-r,by=-0.1),
y= -sqrt(r^2 - seq(r,-r,by=-0.1)^2) , # solve r^2 = x^2 +y^2 for y
xlim =c(0,7 ), ylim=c(0,10), col=colr, # need xlim and ylim to match base plot ranges
yaxs="i", yaxt="n", xaxs="i") # yaxis off; x and y axes meet at origin
par(opar)}
Then push plot up and to the right: This will draw a colored half-circles (largest first so they overlap) below the y=0 line.
png() # send to image file; not needed for testing
opar <- par(mar=c(15, 15, 2,2) ) # default units are in widths of text-"line".
# the margins start at lower, then clockwise
# run your code
outHalfCirc(5.5, "blue")
outHalfCirc(2.5, "red")
outHalfCirc(1, "green")
dev.off() # complete image production
par(opar) # different than the 'opar' inside the function
Voila! Although not really circles because the aspect ratio is not 1. That can be fixed (or you could set the xlim and ylim to be equal.

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:

Resources