I'm using plotrix in R to draw NBA court features for plotting basketball shots. I'm having trouble getting the arc of the 3pt line exactly the way I want it. Using draw.arc and draw.circle allows the top of the arc to float. The top of the arc should always be at 29ft. draw.ellipse seems to solve this problem. However, when I segment the ellipse it leaves a "cross line" through the middle of the court depiction that I'd like to remove. However, I must segment the ellipse or it will extend past where it needs to. Any ideas?
Code used:
setwd("~")
library("plotrix", lib.loc="~/R/win-library/3.1")
library("RColorBrewer", lib.loc="~/R/win-library/3.1")
korver <- read.csv("Korver_XY_Test.csv", header = TRUE)
x <- (korver$x)
y <- (korver$y)
plot(x,y, cex=.7, col=brewer.pal(3, "Greens"))
#Draw 3pt Line
segments(3,0,3,14.19777, lwd=3)
segments(47,0,47,14.19777, lwd=3)
draw.ellipse(x=25, y=5.25, deg=TRUE, angle=0, arc.only= TRUE, segment=rbind(c(22,0),c(158,360)), a=23.75, b=23.75, border=1, nv=200, lwd=3)
#Draw Half Court Line
segments(0,47,50,47, lwd=4)
#Draw Court Boundaries
abline(v=0, lwd=5)
abline(v=50, lwd=5)
abline(h=94, lwd=5)
abline(h=0, lwd =5)
#draw lane
segments(17,0,17,19, lwd=3)
segments(33,0,33,19, lwd=3)
segments(19,0,19,19, lwd=3)
segments(31,0,31,19, lwd=3)
segments(17,19,33,19, lwd=3)
draw.circle(25,19,6,100,lwd=3)
#draw hoop
draw.circle(25,5.25, 0.75, 200, lwd=2)
#draw backboard
segments(22,4,28,4, lwd=4)
Related
I'm unable to get the polygon to align with the curve. I'll put the code here:
critvalmax <- qt(0.975,df=4)
critvalmin <- qt(0.025,df=4)
xvals <- seq(-5, 5, length=100)
fx.samp.t <- dt(xvals, df=4)
plot(xvals, dnorm(xvals), col="white")
lines(xvals, fx.samp.t, lty=1, lwd=2)
abline(v= critvalmin, lty=2)
abline(v= critvalmax, lty=2)
abline(h=0, lty=3)
polygon(cbind(c(critvalmin, xvals[xvals>=critvalmin & xvals<=critvalmax], critvalmax, critvalmax), c(0, dt(critvalmin, df=4), fx.samp.t[xvals>=critvalmin & xvals<=critvalmax], 0)), density=10, lty=3)
The result is that the polygon is drawn a bit to the right and I can't find a solution by myself. Also, the left bottom corner doesn't seem to fill properly.
I removed some variables in your polygon like the second critvalmax and dt(critvalmin, df=4) and cbind. The dt(critvalmin, df=4) seems to have slightly moved your polygon by 0.02558082 to right. You can use the following code:
critvalmax <- qt(0.975,df=4)
critvalmin <- qt(0.025,df=4)
xvals <- seq(-5, 5, length=100)
fx.samp.t <- dt(xvals, df=4)
plot(xvals, dnorm(xvals), col="white")
lines(xvals, fx.samp.t, lty=1, lwd=2)
abline(v= critvalmin, lty=2)
abline(v= critvalmax, lty=2)
abline(h=0, lty=3)
polygon(c(critvalmin, xvals[xvals>=critvalmin & xvals<=critvalmax], critvalmax), c(0, fx.samp.t[xvals>=critvalmin & xvals<=critvalmax], 0), density=10, lty=3)
Created on 2022-08-31 with reprex v2.0.2
polygon only needs your x and y:
vectors containing the coordinates of the vertices of the polygon.
And the density:
the density of shading lines, in lines per inch. The default value of
NULL means that no shading lines are drawn. A zero value of density
means no shading nor filling whereas negative values and NA suppress
shading (and so allow color filling).
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.
I am having some serious problems with layout() and it is driving me crazy when adding one figure with multiple layers.
I only seem to have a problem when adding a layer on one of the figures within the jpeg I am trying to create.
The layout is to have a 1) simple line plot on top for a time series of fish catch data and on the bottom 2) have a larger image of a map of oceanographic data layers.
I am making a series of maps using image.plot() plus contour(... add=T) and arrows my.symbols(... add=T) from library TeachingDemos.
Data is sliced from large netCDF files.
The image and contours are dissolved oxygen depth and the red arrows are surface current.
Below is my R code, data is looped through variable 'n':
jpeg(paste(interpdate[n],"DailyDOLayerCenAm.jpg", sep=""), width=1150, height=1000, res=100)
layout(matrix(c(1,2),nrow=2), heights=c(1,3))
#first plot on the top, fish catch data by time, moving each day
par(mar=c(1,4,.3,.5))
plot(Date[15:n],sail$X7.day.Average[15:n], xlim=c(Date[15],Date[350]),
xlab='',ylab='Raises/Trip',ylim=c(0,50), type='l', xaxt='n', lwd=2.5)
axis(1, Date, format(Date, "%b %d"), cex.axis = 1)
abline(18.4,0, lty=2)
points(Date[n],sail$X7.day.Average[n], pch=21, col='black', bg='red',
cex=3)
#second plot, Ocean data
par(mar=c(3,3.7,.5,1))
# layer 1 plot the main layer, interpolated grid O2 minimum depth
image.plot( as.surface( expandgrid, ww),xlim=c(xmin,xmax),
ylim=c(ymin,ymax), ylab="Latitude", xlab="Longitude",main="",
col=pal(256), legend.lab="Depth of O2 Minimum Layer (m)",
zlim=c(20,zlimit), cex=1.5)
#layer 2 add the contours
contour(as.surface( expandgrid, ww),xlim=c(xmin,xmax), ylim=c(ymin,ymax),
col='white', lwd=2, nlevels=10, labcex=1, add=T)
#layer 3 add current arrows
my.symbols(lonx,laty,ms.arrows, angle=theta, r=intensity, length=.06,
add=T,xlim=c(xmin,xmax), ylim=c(ymin,ymax), lwd=2, col="red",
fg="black")
#layer 4add the map of land/countries
plot(newmap, col="GREY", add=T)
#add a point of home port in Guatemala
points(-90.81, 13.93, pch=21, col='black', bg='yellow', cex=3.5)
dev.off()
When I plot just my ocean data, it plots fine:
https://fbcdn-sphotos-f-a.akamaihd.net/hphotos-ak-xap1/t31.0-8/10861076_10101738319375937_3436888929444896713_o.jpg
plot it within layout() I get this mess, The contour lines are fine within the x-space, but squished in y space, as are the arrows and map overlay:
https://scontent-b.xx.fbcdn.net/hphotos-xfp1/t31.0-8/10923795_10101738319625437_7583695382864373718_o.jpg
I fixed this by not using imageplot() but by using image() and adding the color legend described by Aurélien Madouasse:
https://aurelienmadouasse.wordpress.com/author/aurelienmadouasse/
I looped the images from a large arrays of oceanographic data and created a series of plots in a function.
My code (sans data) is here, from within a loop:
jpeg(paste(interpdate[n],"DailyDOLayerCenAm.jpg", sep=""), width=1150,
height=1000, res=100)
layout(matrix(c(1,2),nrow=2), heights=c(1,3))
#first plot on the top, fish catch data by time, moving each day
par(mar=c(1,4,.3,.5))
plot(Date[15:n],sail$X7.day.Average[15:n], xlim=c(Date[15],Date[350]),
xlab='',ylab='Raises/Trip',ylim=c(0,50), type='l', xaxt='n', lwd=2.5)
axis(1, Date, format(Date, "%b %d"), cex.axis = 1)
abline(18.4,0, lty=2)
points(Date[n],sail$X7.day.Average[n], pch=21, col='black', bg='red', cex=3)
#second plot, Ocean data
#plot the main layer, dissolved oxygen minimum depth
#plot the main layer, dissolved oxygen minimum depth
image( as.surface( expandgrid, ww),xlim=c(xmin,xmax),
ylim=c(ymin,ymax),ylab="Latitude", xlab="Longitude",main="", col=pal(256),
zlim=c(20,zlimit), cex=1.5)
#add the contours
contour(as.surface( expandgrid, ww),xlim=c(xmin,xmax), ylim=c(ymin,ymax),
col='white', lwd=2,levels=seq(0,zlimit,10), labcex=1, add=T)
#add sea surface current arrows
my.symbols(lonx,laty,ms.arrows, angle=theta, r=intensity, length=.06,
add=T, xlim=c(xmin,xmax), ylim=c(ymin,ymax), lwd=2, col="red", fg="white")
#add the map of land/countries
plot(newmap, col="GREY", add=T)
#add a point of home port in Guatemala
points(-90.81, 13.93, pch=21, col='black', bg='yellow', cex=3.5)
colr <- pal(256) # colors from 'blues'
legend.col(col = colr, lev = ww) # legend from Aurélien Madouasse:
mtext("Depth of O2 Minimum Layer (m)", 4, line=2.5, font=2)
dev.off()
To see a plot of my new images which I am making into a movie, see this link:
https://fbcdn-sphotos-a-a.akamaihd.net/hphotos-ak-xpa1/t31.0-8/10856647_10101738461765587_2760202217270038911_o.jpg
I am having trouble with getting a simple plot to return a dotted line (lty=2). This is a very elementary problem, but I can't seem to find the solution. I would greatly appreciate if someone could help me with this. My code is below:
par(family="serif", yaxs="i", xaxs="i")
#Empty plot with axes labeled
plot(dataset1[,6]~dataset2[,5], ann=FALSE, cex.axis=1.5, xaxs="i", yaxs="i", lty=1, type="n")
title(xlab="X axis title (%)", ylab="Y axis title", cex.lab=1.5)
axis(side=1, at=c(0,10,20, 30,40,50,60,70,80,90,100), cex.axis=1.5)
#Add curves
lines(dataset1[,6]~dataset2[,5], lty=1)
lines(dataset1[,6]~dataset2[,5], lty=2)
##### PROBLEM IS HERE WITH LTY=2 ####
The graph gets returned as 2 solid curves (rather than 1 solid and 1 dashed) and I can't figure out where the problem lies. Can someone shed some light on this?
Thanks so much.
Perhaps you could provide your data. Here is an example of a plot with lines of various types.
plot(1:10, type='b',lty=2)
lines(1:2, lty=1)
lines(2:4, lty=2)
lines(3:6, lty=3)
lines(4:7, lty=4)
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)