Adding a plane to a scatterplot3d - r

I have an equation of a line
y=sqrt(c+x^2)
and I want to add a plane to a 3d scatterplot, such that my plane is perpendicular to the x y plane and the line given above is the intersection line of the two planes.
How do I do this? I don't quite understand how plane3d works. I've read http://svitsrv25.epfl.ch/R-doc/library/scatterplot3d/html/scatterplot3d.html
But still don't get it.

This might be what you are looking for:
library(scatterplot3d)
# y=sqrt(a+x^2) with x in (-0.5,0.5), z in (0,1) and a=0
a <- 0
x <- rep(seq(-0.5, 0.5, length = 200), each = 200)
y <- sqrt(a + x^2)
z <- rep(seq(0, 1, length = 200), 200)
scatterplot3d(x, y, z, highlight.3d = TRUE, pch = 20)
Edit: That would be helpful to see how did you add these other points, but let us take the second example from ?scatterplot3d
temp <- seq(-pi, 0, length = 50)
x2 <- c(rep(1, 50) %*% t(cos(temp)))
y2 <- c(cos(temp) %*% t(sin(temp)))
z2 <- c(sin(temp) %*% t(sin(temp)))
Now combining x with x2 and doing the same with others we get:
scatterplot3d(c(x,x2), c(y,y2), c(z,z2), highlight.3d = TRUE, pch = 20)

In addition to the previous answer, once you construct a 3-D scatterplot, you can add a plane to it by creating a model and parsing it using a function nested within your scatterplot3d() container. It should look something like this:
plot3d <- scatterplot3d(x, y, z, ... )
model <- lm(y ~ sqrt(c + x^2) + z)
plot3d$plane3d(model)
It's a very weird syntax to have a function within a container like that, but it works, giving you something like this (the dotted-line plane is visible near the center of the cube):
If you would like to create one or multiple planes manually, I would use Uwe's method that I re-posted here:
spd <- scatterplot3d(1:10, 1:10, 1:10)
# xy
spd$plane3d(0.3549896,0,0,lty="dotted")
# yz
x0 <- 5
xyz1 <- spd$xyz.convert(rep(x0, 6), rep(0, 6), seq(0, 10, by=2))
xyz2 <- spd$xyz.convert(rep(x0, 6), rep(10, 6), seq(0, 10, by=2))
segments(xyz1$x, xyz1$y, xyz2$x, xyz2$y, lty="dotted")
xyz1 <- spd$xyz.convert(rep(x0, 6), seq(0, 10, by=2), rep(0, 6))
xyz2 <- spd$xyz.convert(rep(x0, 6), seq(0, 10, by=2), rep(10, 6))
segments(xyz1$x, xyz1$y, xyz2$x, xyz2$y, lty="dotted")
# zx
y0 <- 6
xyz1 <- spd$xyz.convert(rep(0, 6), rep(y0, 6), seq(0, 10, by=2))
xyz2 <- spd$xyz.convert(rep(10, 6), rep(y0, 6), seq(0, 10, by=2))
segments(xyz1$x, xyz1$y, xyz2$x, xyz2$y, lty="dotted")
xyz1 <- spd$xyz.convert(seq(0, 10, by=2), rep(y0, 6), rep(0, 6))
xyz2 <- spd$xyz.convert(seq(0, 10, by=2), rep(y0, 6), rep(10, 6))
segments(xyz1$x, xyz1$y, xyz2$x, xyz2$y, lty="dotted")
This produces planes through manual specification:

Related

Plot+points animation works in graphics device but only saves as single GIF image, not video

Using the "animate" package to create plot videos. I need to be able to create an initial plot and then add multiple series with a delay in between. As an example, the following code works great in the R graphics device:
library(animate)
x <- rnorm(20, 5, 2)
rand <- rnorm(20, 2, 3)
y <- x + rand
df <- data.frame(a = rnorm(20, 6, 2), b = rnorm(20, 3, 2), c = rnorm(20, 10, 3))
co <- c("red", "blue", "orange")
oopt = ani.options(interval = 2)
plot(y, x, col="green")
points(y, x, type='l', col="green", lwd=3)
ani.pause()
interval = ani.options('interval')
for (i in 1:3){
newy <- df[,i]
points (x, newy, col=co[i])
ani.pause()
}
However, this same code when placed within saveGIF will save only a static image instead of a video:
x <- rnorm(20, 5, 2)
rand <- rnorm(20, 2, 3)
y <- x + rand
df <- data.frame(a = rnorm(20, 6, 2), b = rnorm(20, 3, 2), c = rnorm(20, 10, 3))
co <- c("red", "blue", "orange")
oopt = ani.options(interval = 2)
saveGIF({
plot(y, x, col="green")
points(y, x, type='l', col="green", lwd=3)
ani.pause()
interval = ani.options('interval')
for (i in 1:3){
newy <- df[,i]
points (x, newy, col=co[i])
ani.pause()
}
},movie = "savegiftest.gif")
Tried sending additional parameters to image magick with no success so far (I noted in the animate documentation that perhaps the issue is that ani.pause may not work, however, interval in image magick doesn't work either). I'm open to saving in other video formats as well.

How to split a polygon and fill areas along skew values?

I know how to split and fill areas of a polygon along a horizontal line, if the values are quite simple.
x <- 9:15
y1 <- c(5, 6, 5, 4, 5, 6, 5)
plot(x, y1, type="l")
abline(h=5, col="red", lty=2)
polygon(x[c(1:3, 5:7)], y1[c(1:3, 5:7)], col="green")
polygon(x[3:5], y1[3:5], col="red")
y2 <- c(5, 6, 4, 7, 5, 6, 5)
plot(x, y2, type="l")
abline(h=5, col="red", lty=2)
But how to get the result if the values are a bit more skew?
Expected output (photoshopped):
As pointed out by #Henrik in comments we can interpolate the missing points.
If the data is centered around another value than zero – as in my case – we need to adapt the method a little.
x <- 9:15
y2 <- c(5, 6, 4, 7, 5, 6, 5)
zp <- 5 # zero point
d <- data.frame(x, y=y2 - zp) # scale at zero point
# kohske's method
new_d <- do.call(rbind,
sapply(1:(nrow(d) - 1), function(i) {
f <- lm(x ~ y, d[i:(i + 1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata=data.frame(y=0))
if(d[i, ]$x < r & r < d[i + 1, ]$x)
return(data.frame(x=r, y=0))
else return(NULL)
})
)
d2 <- rbind(d, new_d)
d2 <- transform(d2, y=y + zp) # descale
d2 <- unique(round(d2[order(d2$x), ], 4)) # get rid of duplicates
# plot
plot(d2, type="l")
abline(h=5, col="red", lty=2)
polygon(d2$x[c(1:3, 5:9)], d2$y[c(1:3, 5:9)], col="green")
polygon(d2$x[3:5], d2$y[3:5], col="red")
Result

connecting dots in 2 different data sets in R

I have 2 data sets (DSA and DSB) that contain x & y coordinates
tumor<- data.frame(DSA[,c("X_Parameter","Y_Parameter")])
cells<-data.frame(DSB[,c ("X_Parameter","Y_Parameter")])
plot(cells, xlim=c(1,1300), ylim=c(1,1000), col="red")
par(new=TRUE)
plot(tumor, xlim=c(1,1300), ylim=c(1,1000), col="blue")
the plots make this graph
I want to be able to draw a connecting line from every red dot to every blue dot.
Does anyone know if this can be done. thanks
Sample
DSA=(5,5 6,6 5,6 6,5) DSB=(1,1 10,10 10,1 1,10)
what the plot should look like
Brute-force, perhaps inelegant:
DSA <- data.frame(x = c(5, 6, 5, 6),
y = c(5, 6, 6, 5))
DSB <- data.frame(x = c(1, 10, 10, 1),
y = c(1, 10, 1, 10))
plot(y ~ x, DSB, col = "red")
points(DSA, col = "blue")
for (r in seq_len(nrow(DSA))) {
segments(DSA$x[r], DSA$y[r], DSB$x, DSB$y)
}
Edit: more directly:
nA <- nrow(DSA)
nB <- nrow(DSB)
plot(y ~ x, DSB, col = "red")
points(DSA, col = "blue")
segments(rep(DSA$x, each = nB), rep(DSA$y, each = nB),
rep(DSB$x, times = nA), rep(DSB$y, times = nA))
(I still can't figure out an elegant solution with #42's recommendation for combn or outer.)

Overlay many plots with a different range of x

I would like to make a plot like the this image what I want, however I don't know how. I wrote the code below but I don't find a way to obtain the plot. The point here is to add density lines to my original plot (Relation Masa-SFR) the density is supposed to be every 0.3 in x. I mean one line from 7 to 7.3, the next one from 7.3 to 7.6 and so on. With the code below (continue until x=12), I obtain the this [plot][2]
plot(SFsl$MEDMASS, SFR_SalpToMPA,xlim= range(7:12),
ylim= range(-3:2.5),ylab="log(SFR(M(sun)/yr)",
xlab="log(M(star)/(M(sun)")
title("Relacion Masa-SFR")
par(new=TRUE)
FCUTsfrsl1=(SFsl$MEDMASS >= 7 & SFsl$MEDMASS <=7.3 &
SFR_SalpToMPA < 2 & SFR_SalpToMPA > -3)
x <- SFR_SalpToMPA[FCUTsfrsl1]
y <- density(x)
plot(y$y, y$x, type='l',ylim=range(-3:2.5), col="red",
ylab="", xlab="", axes=FALSE)
I did what you said but I obtained this plot, I don't know if I did something wrong
Since I don't have your data, I had to make some up. If this does what you want, I think you can adapt it to your actual data.
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y)
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values for density calc
for (i in 1:length(intx3)) {
xx <- seq(min(intx3[[i]]), max(intx3[[i]]), length.out = 512)
lines(xx, density(inty[[i]])$y, col = "red")
}
This produce the following image. You need to look closely but there is a separate density plot for each 0.3 unit interval.
EDIT Change the dimension that is used to compute the density
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y, xlim = c(7, 15))
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values
# This gives the density values in the horizontal direction (desired)
# This is the change, the above is unchanged.
for (i in 1:length(intx3)) {
yy <- seq(min(inty[[i]]), max(inty[[i]]), length.out = 512)
offset <- min(intx3[[i]])
lines(density(intx3[[i]])$y + offset, yy, col = "red")
}
Which gives:

Plot a system of equations in R

Suppose you have a system of equations (5 equations and 2 variables) that look like this:
Ax + By = C
AB <- matrix(runif(10), 5)
C <- c(5, 10, 15, 20, 25)
How do you plot this system of equations in R, without first manually converting into
y = (C - Ax) / B
Are you looking for something like this?
set.seed(101)
AB <- matrix(runif(10), 5)
C <- c(5, 10, 15, 20, 25)
x = seq(-70,70,1)
plot(x, (C[1] - AB[1,1]*x)/AB[1,2], col=1, type="l", ylim=c(-100,200))
for (i in 2:nrow(AB)) {
lines(x, (C[i] - AB[i,1]*x)/AB[i,2], col=i, type="l")
}

Resources