Related
Background
I am plotting the following image:
Using this code:
par(mfrow = c(2, 2),
mar = c(2, 2, 2, 2))
plot(1, col = "red", pch = 15)
plot(1, col = "blue", pch = 15)
plot(1, col = "orange", pch = 15)
plot(1, col = "purple", pch = 15)
I'd like to add an external postscript file using grImport (sample data included):
library(grImport)
#PostScriptTrace("drawing.ps")
#pic <- readPicture("drawing.ps.xml")
# generated with dput()
pic <- new("Picture",
paths = list(path = new("PictureFill", rule = "nonzero",
x = c(move = 0, line = 1315.47, line = 1315.47, line = 0,
line = 0),
y = c(move = 1080, line = 1080, line = 7.37891,
line = 7.37891, line = 1080),
rgb = "#D0D1E6", lty = numeric(0),
lwd = 10, lineend = 1, linejoin = 1, linemitre = 10)),
summary = new("PictureSummary",
numPaths = 1, xscale = c(xmin = 0, xmax = 1315.47),
yscale = c(ymin = 7.37891, ymax = 1080)))
grid.picture(pic)
This just puts the ps image filling the entire plotting device:
Question
I would like the violet square to plot exactly on top of one of the plotting regions (let's say top left).
How do I extract the coordinates of the first plot() in the reference frame of the entire device?
Once I have those, how to correctly use the coordinates in grid.picture()?
I am trying to graph a few different gamma distribution functions in R with the standard R commands--no packages.
As you can see here, the y-axis is being redone for each function I graph. Is there a way that I can have all 7 of my functions go along the same y-axis? Here is my code
par(mfrow=c(1,1))
x <- seq(0, 1, length = 10000)
fun1 <- function(x) dgamma(x, 1, 2)
fun2 <- function(x) dgamma(x, 2, 2)
fun3 <- function(x) dgamma(x, 3, 2)
fun4 <- function(x) dgamma(x, 5, 1)
fun5 <- function(x) dgamma(x, 9, .5)
fun6 <- function(x) dgamma(x, 7.5, 1)
fun7 <- function(x) dgamma(x, .5, 1)
plot(fun1, 0, 20, col = "red")
par(new = TRUE)
plot(fun2, 0, 20, col = "orange")
par(new = TRUE)
plot(fun3, 0, 20, col = "yellow")
par(new = TRUE)
plot(fun4, 0, 20, col = "green")
par(new = TRUE)
plot(fun5, 0, 20, col = "black")
par(new = TRUE)
plot(fun6, 0, 20, col = "blue")
par(new = TRUE)
plot(fun7, 0, 20, col = "purple")
Rather than using S3 dispatch to call plot.function(), I would prefer to directly call curve(), and use the add parameter rather than par(new = TRUE) to add lines to the existing plot; then we get just one set of axis and tick labels for the y axis:
curve(fun1, 0, 20, col = "red")
curve(fun2, 0, 20, col = "orange", add = TRUE)
curve(fun3, 0, 20, col = "yellow", add = TRUE)
curve(fun4, 0, 20, col = "green", add = TRUE)
curve(fun5, 0, 20, col = "black", add = TRUE)
curve(fun6, 0, 20, col = "blue", add = TRUE)
curve(fun7, 0, 20, col = "purple", add = TRUE)
As you can see, this is quite different than the plot you initially had, which is because it was re-drawing the axes each time instead of sticking to one set of axis limits.
This code gets the data needed to make two different lines. I was wondering if there was a way to see if two lines intersected easily.
# generate data
red <- matrix(runif(n = 4, min = 0, max = 1), nrow = 2)# gets the 4 points for the first line
blue <- matrix(runif(n = 4, min = 0, max = 1), nrow = 2)# gets the 4 points for second line
# make a plot
plot(red, col = "red", pch = 16, cex = 2,
asp = 1, xlim = c(0,1), ylim = c(0,1),
xlab = "", ylab = "")##plots both points red
abline(v = c(0,1), col = "grey", lty = 2)
abline(h = c(0,1), col = "grey", lty = 2)
segments(red[1,1], red[1,2], red[2,1], red[2,2], lwd = 2, col = "red")#Makes the line segment
points(blue, col = "blue", pch = 16, cex = 2,
asp = 1, xlim = c(0,1), ylim = c(0,1))# does same thing for blue line
segments(blue[1,1], blue[1,2], blue[2,1], blue[2,2], lwd = 2, col = "blue")
##makes all of the plots and can see if the plot intersects.`
Here's a practical answer using simple algebra wrapped up in a function.
The process is to find the slope and y intercept of both lines, and solve simultaneous equations to find the intersection. If both line segments have the same gradient the answer is undefined so return NA.
Return the x, y co-ordinates of the intersection if it is within the x range of one of the line segments, otherwise return NA
check_intersect <- function(mat1, mat2)
{
dy1 <- mat1[,2][which.max(mat1[,1])] - mat1[,2][which.min(mat1[,1])]
dy2 <- mat2[,2][which.max(mat2[,1])] - mat2[,2][which.min(mat2[,1])]
dx1 <- max(mat1[,1]) - min(mat1[,1])
dx2 <- max(mat2[,1]) - min(mat2[,1])
m1 <- dy1/dx1
m2 <- dy2/dx2
if(m1 == m2) return(NA)
c1 <- mat1[1, 2] - m1 * mat1[1, 1]
c2 <- mat2[1, 2] - m2 * mat2[1, 1]
x <- (c2 - c1)/(m1 - m2)
y <- m1 * x + c1
if(x > min(mat1[,1]) & x < max(mat1[,1]))
return(c(x, y))
else
return(NA)
}
Now test this with a reprex:
set.seed(123)
red <- matrix(runif(n = 4, min = 0, max = 1), nrow = 2)# gets the 4 points for the first line
blue <- matrix(runif(n = 4, min = 0, max = 1), nrow = 2)# gets the 4 points for second line
# make a plot
plot(red, col = "red", pch = 16, cex = 2,
asp = 1, xlim = c(0,1), ylim = c(0,1),
xlab = "", ylab = "")##plots both points red
abline(v = c(0,1), col = "grey", lty = 2)
abline(h = c(0,1), col = "grey", lty = 2)
segments(red[1,1], red[1,2], red[2,1], red[2,2], lwd = 2, col = "red")#Makes the line segment
points(blue, col = "blue", pch = 16, cex = 2,
asp = 1, xlim = c(0,1), ylim = c(0,1))# does same thing for blue line
segments(blue[1,1], blue[1,2], blue[2,1], blue[2,2], lwd = 2, col = "blue")
p <- check_intersect(red, blue)
points(p[1], p[2], cex = 2)
p
#> [1] 0.5719010 0.6781469
Created on 2020-03-24 by the reprex package (v0.3.0)
I am creating a plot where I plot the variable on the X-axis against that on the Y-axis, and I am adding histograms of the variables as well. I have added a trend-line to the plot using abline().
The problem is that it does not appear to respect the xlim = c(0, 20) in the plot region as it extends beyond the limits of the x-axis. I tried playing around with the xpd option, but to no avail. Next I tried fiddling with the different par()options, but found nothing that could help with this issue.
What I want is for the trend-line to be the exact length of the x-axis. Any help is much appreciated. In this particular case the trend-line is almost flat, but the slope will change when I do the same for other variables.
MWE -- NOTE: I am only providing 15 data points to illustrate the issue so the graph will differ from the image provided.
df.data <- data.frame(id = 1:15,
ll = c(-9.53026, -6.50640,-6.50640, -7.68535, -11.80899, -8.42790,
-6.50640, -6.50640, -7.92405, -6.50640, -8.95522, -9.99228,
-10.02286, -8.95969, -6.07313),
aspm = c(4.582104, 0.490244, 0.737765, 0.256699, 1.575931, 1.062693,
1.006984, 0.590355, 1.014370, 0.924855, 0.735989, 0.831025,
1.197886, 1.143220, 0.928068))
str.col.light.blue <- c(rgb(r = 110/255, g = 155/255, b = 225/255))
str.col.dark.blue <- c(rgb(r = 50/255, g = 100/255, b = 185/255))
layout(matrix(c(2, 4, 1, 3), 2, 2, byrow = TRUE), widths = c(5, 2), heights = c(2, 5))
layout.show(4)
par(omi = c(0.1, 0.1, 0.1, 0.1))
par(mar = c(2, 2, 0, 0))
par(mai = c(1, 1, 0, 0))
plot(df.data[, "ll"] ~ df.data[, "aspm"], col = str.col.light.blue,
xlim = c(0, 20), ylim = c(-15, -5), axes = FALSE,
xlab = "X1", ylab = "X2",
cex.lab = 1.25)
abline(a = -8.156670, b = -0.000879, lty = 5, col = "black", lwd = 2, xpd = FALSE)
axis(1, at = seq(0, 20, by = 5), labels = seq(0, 20, by = 5), cex.axis = 1)
axis(2, at = seq(-15, -5, by = 3), labels = seq(-15, -5, by = 3), cex.axis = 1, las = 1)
rect(0, -15, 20, log(1/3)*8, density = 10, angle = 45, lwd = 0.5, col = "gray")
par(mar = c(0, 2, 0, 0))
par(mai = c(0, 1, 0.25, 0))
x.hist <- hist(df.data[, "aspm"], plot = FALSE, breaks = 20)
barplot(x.hist$density, axes = FALSE, horiz = FALSE, space = 0, col = str.col.dark.blue)
par(mar = c(2, 0, 0, 0))
par(mai = c(1, 0, 0, 0.25))
y.hist <- hist(df.data[, "ll"], plot = FALSE, breaks = 20)
barplot(y.hist$density, axes = FALSE, horiz = TRUE, space = 0, col = str.col.dark.blue)
In order to avoid working out the start and end points of the segments, you can program a helper function to do it for you.
linear <- function(x, a, b) a + b*x
Then, I've used your code with the following changes. abline was replaced by segments, with all the graphics parameters you had used in your original call.
x0 <- 0
y0 <- linear(x0, a = -8.156670, b = -0.000879)
x1 <- 20
y1 <- linear(x1, a = -8.156670, b = -0.000879)
segments(x0, y0, x1, y1, lty = 5, col = "black", lwd = 2, xpd = FALSE)
This call to segment was placed where ablinewas.
In the final graph, I see a well behaved segment.
I'm trying to put multiple background legends on an rgl plot (in my real-world example, one for lines and one for points), and I would like them to be in different corners of the screen. It seems that the default behavior of rgl is to replace an older legend when a new one is called. The following code, modified from the rgl legend3d example, illustrates this:
library(rgl)
x <- rnorm(100)
y <- rnorm(100)
z <- rnorm(100)
open3d()
par3d(windowRect = c(100, 100, 612, 612))
plot3d(x, y, z)
legend3d(x = 0, y = 0, xjust = 0, yjust = 0, legend = c("2D", "3D"), pch = c(1, 16))
legend3d(x = 1, y = 0, xjust = 1, yjust = 0, legend = c("2D", "3D"), pch = c(1, 16))
What can I do to work around this behavior and get multiple 2D graphics to appear?
legend3d() makes a background using legend() after plot(). So it can't make multiple legends. It would be better to use bgplot3d().
open3d()
par3d(windowRect = c(100, 100, 612, 612))
plot3d(x, y, z)
bgplot3d({
par(mar = c(0, 0, 0, 0))
plot(0, 0, type = "n", xlim = 0:1, ylim = 0:1, xaxs = "i",
yaxs = "i", axes = FALSE, bty = "n")
legend(x = 0, y = 0, xjust = 0, yjust = 0, legend = c("2D", "3D"), pch = c(1, 16))
legend(x = 1, y = 0, xjust = 1, yjust = 0, legend = c("2D", "3D"), pch = c(1, 16))
})