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.
Related
I would like to create a polar/radar style graph in R that only shows a partial arc instead of a full circle.
I have looked at both the Plotrix and Pracma packages, but I've only been able to create a full circle polar chart like what I'm displaying here (created this is Pracma)
What I would like to do is create a 1/4 circle arc in the 0 to 270 degrees range of a polar arc chart and then plot data points that would radiate from the center towards the outer edges to indicate relative popularity. Data would indicate increasingly lower popularity/adoption rates as it approached the outer ring.
We create a polar plot layout from scratch in base graphics:
## Fake data
set.seed(493)
dat = data.frame(theta=runif(20, 3*pi/2, 2*pi), r=sample(1:10, 20, replace=TRUE))
# Calculate x and y values from r and theta
dat$x = dat$r * cos(dat$theta)
dat$y = dat$r * sin(dat$theta)
## 1:1 aspect ratio for plot
par(pty="s")
## Create plot layout
plot(NA,NA,
xlim=c(0, ceiling(max(c(dat$x,dat$y)))),
ylim=c(-ceiling(max(c(dat$x,dat$y))),0),
frame.plot=FALSE,
xaxt="n", yaxt="n", xlab="", ylab="")
## Add axes
axis(3, pos=0, at=seq(0,10,1))
axis(2, pos=0, at=seq(-10,0,1), las=1, labels=c(10:0))
## Add grid lines
angle = seq(0, -pi/2, length.out=100)
invisible(lapply(1:10, function(r) {
lines(r*cos(angle), r*sin(angle), lwd=0.5, col="grey40", lty="12")
}))
## Add data
invisible(lapply(1:nrow(dat), function(i) {
lines(c(0,dat$x[i]), c(0,dat$y[i]), col="blue")
}))
Original Answer
Using ggplot2:
library(ggplot2)
set.seed(493)
dat = data.frame(x=runif(20, 3*pi/2, 2*pi), value=sample(1:10, 20, replace=TRUE))
ggplot(dat, aes(x=x, xend=x, y=0, yend=value)) +
geom_segment(x=3*pi/2, xend=2*pi, y=0, yend=0 ,color="red") +
geom_segment(color="blue") +
scale_y_continuous(limits=c(-2,10), breaks=seq(0,10,2)) +
scale_x_continuous(limits=c(0,2*pi), breaks=seq(0, 2*pi, length.out=13)[-13],
labels=seq(0,360,length.out=13)[-13]) +
coord_polar(start=-pi/2, direction=-1)
I would like to add a curved line to fit the dark bars of this supply cost curve (like the red line that appears in image). The height of the dark bars represent the range in uncertainty in their costs (costrange). I am using fully transparent values (costtrans) to stack the bars above a certain level
This is my code:
costtrans<-c(10,10,20,28,30,37,50,50,55,66,67,70)
costrange<-c(15,30,50,21,50,20,30,40,45,29,30,20)
cost3<-table(costtrans,costrange)
cost3<-c(10,15,10,30,20,50,28,21,30,50,37,20,50,30,50,40,55,45,66,29,67,30,70,20)
costmat <- matrix(data=cost3,ncol=12,byrow=FALSE)
Dark <- rgb(99/255,99/255,99/250,1)
Transparent<-rgb(99/255,99/255,99/250,0)
production<-c(31.6,40.9,3.7,3.7,1,0.3,1.105,0.5,2.3,0.7,0.926,0.9)
par(xaxs='i',yaxs='i')
par(mar=c(4, 6, 4, 4))
barplot(costmat,production, space=0, main="Supply Curve", col=c(Transparent, Dark), border=NA, xlab="Quantity", xlim=c(0,100),ylim=c(0, 110), ylab="Supply Cost", las=1, bty="l", cex.lab=1.25,axes=FALSE)
axis(1, at=seq(0,100, by=5), las=1, cex.axis=1.25)
axis(2, at=seq(0,110, by=10), las=1, cex.axis=1.25)
Image to describe what I am looking for:
I guess it really depends how you want to calculate the line...
One first option would be:
# Save the barplot coordinates into a variable
bp <- barplot(costmat,production, space=0, main="Supply Curve",
col=c(Transparent, Dark), border=NA, xlab="Quantity",
xlim=c(0,100), ylim=c(0, 110), ylab="Supply Cost", las=1,
bty="l", cex.lab=1.25,axes=FALSE)
axis(1, at=seq(0,100, by=5), las=1, cex.axis=1.25)
axis(2, at=seq(0,110, by=10), las=1, cex.axis=1.25)
# Find the mean y value for each box
mean.cost <- (costmat[1,]+colSums(costmat))/2
# Add a line through the points
lines(bp, mean.cost, col="red", lwd=2)
Which gives
Now, you could do some smoother line, using some sort of regression
For instance, using a LOESS regression.
# Perform a LOESS regression
# To allow for extrapolation, you may want to add
# control = loess.control(surface = "direct")
model <- loess(mean.cost~bp, span=1)
# Predict values in the 0:100 range.
# Note that, unless you allow extrapolation (see above)
# by default only values in the range of the original data
# will be predicted.
pr <- predict(model, newdata=data.frame(bp=0:100))
lines(0:100, pr, col="red", lwd=2)
I borrowed this code from statmethods[dot]net. The result is a coloured area under a normal distribution.
mean=100; sd=15
lb=80; ub=120
x <- seq(-4,4,length=100)*sd + mean
hx <- dnorm(x,mean,sd)
plot(x, hx, type="n", xlab="IQ Values", ylab="Density",
main="Normal Distribution", axes=FALSE)
i <- x >= lb & x <= ub
lines(x, hx)
polygon(c(lb,x[i],ub), c(0,hx[i],0), col="red")
area <- pnorm(ub, mean, sd) - pnorm(lb, mean, sd)
result <- paste("P(",lb,"< IQ <",ub,") =",
signif(area, digits=3))
mtext(result,2)
I was wondering if it is possible to select an image as the colour of the red polygon?
Many thanks!
Working with your code, I basically suggest plotting an image (I used a random image below) using the png package (based on advice from In R, how to plot with a png as background?) and then plot your lines over that.
mean=100; sd=15
lb=80; ub=120
x <- seq(-4,4,length=100)*sd + mean
hx <- dnorm(x,mean,sd)
# load package and an image
library(png)
ima <- readPNG("Red_Hot_Sun.PNG")
# plot an empty plot with your labels, etc.
plot(1,xlim=c(min(x),max(x)), type="n", xlab="IQ Values", ylab="Density",
main="Normal Distribution", axes=FALSE)
# put in the image
lim <- par()
rasterImage(ima, lim$usr[1], lim$usr[3], lim$usr[2], lim$usr[4])
# add your plot
par(new=TRUE)
plot(x, hx, xlim=c(min(x),max(x)), type="l", xlab="", ylab="", axes=FALSE)
i <- x >= lb & x <= ub
lines(x, hx)
# add a polygon to cover the background above plot
polygon(c(x,180,180,20,20), c(hx,0,1,1,0), col="white")
# add polygons to cover the areas under the plot you don't want visible
polygon(c(-20,-20,x[x<=lb],lb), c(-10,min(hx),hx[x<=lb],-10), col="white")
polygon(c(ub,x[x>=ub],200,200), c(-1,hx[x>=ub],min(hx),-1), col="white")
# add your extra text
area <- pnorm(ub, mean, sd) - pnorm(lb, mean, sd)
result <- paste("P(",lb,"< IQ <",ub,") =",
signif(area, digits=3))
mtext(result,2)
Gives you:
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:
I would like to make a plot with 4 axes in R so that it looks similar to this plot:
I've looked at the Quick-R website for advice and modified one of their examples (called A Silly Axis Example):
# specify the data
x <- c(1:5); y <- x/2;
w <- c(2:4)
z <- c(1:5)
# create extra margin room on the right for an axis
par(mar=c(5, 4, 4, 8) + 0.1)
# plot x vs. y
plot(x, y,type="b", pch=21, col="red",
yaxt="n", lty=3, xlab="", ylab="")
# add x vs. 1/x
lines(x, z, type="b", pch=22, col="blue", lty=2)
# draw an axis on the left
axis(2, at=x,labels=x, col.axis="red", las=2)
# draw an axis on the right, with smaller text and ticks
axis(4, at=w,labels=round(w,digits=2),
col.axis="blue", las=2, cex.axis=0.7, tck=-.01)
# draw an axis on the top
axis(3, at=z,labels=round(z,digits=2),
col.axis="blue", las=2, cex.axis=0.7, tck=-.01)
# add a title for the right axis
mtext("L", side=3, line=3, cex.lab=1,las=2, col="blue")
# add a title for the right axis
mtext("OSR", side=4, line=3, cex.lab=1,las=2, col="red")
# add a main title and bottom and left axis labels
title("", xlab="GSI", ylab="FSI")
This code produces the following plot:
I'm having difficulty figuring out how different axes can have different scales. For example, I want the top axis L, to go from 5 - 13, but if I set z <-c(5:13) it will not set the axis to these values. However, I can overwrite what the labels are:
axis(3, at=z,labels=round(c(9:13),digits=2), col.axis="blue",
las=2, cex.axis=0.7, tck=-.01)
but then if I want to plot a point with these four parameters, the point will not show up in the correct place. How should I do this?
One (perhaps cumbersome) option would be to write conversion functions that transform values between your two scales. Assuming you know the data ranges for both the top and bottom axes ahead of time, you could write a function like this:
convertScaleToBottom <- function(x,botRange,topRange){
temp <- (x - topRange[1]) / (topRange[2] - topRange[1])
return(botRange[1] + (temp * (botRange[2] - botRange[1])))
}
that takes a set of values, x, in the top axis scale and converts them to the bottom axis scale. Then you can plot the converted values and retain the originals as the labels:
z1 <- 5:13
z1Adj <- convertScaleToBottom(z1,range(x),range(z1))
# draw an axis on the top
axis(3, at=z1Adj,labels=round(z1,digits=2),
col.axis="blue", las=2, cex.axis=0.7, tck=-.01)
This method is easily modified to reverse the order of the top axis:
convertScaleToBottomRev <- function(x,botRange,topRange){
temp <- (x - topRange[1]) / (topRange[2] - topRange[1])
return(botRange[2] - (temp * (botRange[2] - botRange[1])))
}