Related
Could you please help me how to generate the 3D plot something as below?
dat <- tibble::tribble(
~subject, ~response, ~duration,
'1', 10, 20,
'2', -7, 30,
'3', 5, 20,
'4', 7, 50,
'5', -5, 40
)
Here's something a little closer to the original using plot3D
First draw the box, axes, title and plane:
library(plot3D)
persp3D(c(min(as.numeric(dat$subject)) - 1, max(as.numeric(dat$subject)) + 1),
c(0, max(dat$duration)),d = 50, phi = 30, theta = 55, xlab = "subject",
ylab = "Duration", zlab = "Response", ticktype = "detailed",
matrix(rep(range(dat$response), 2), 2, 2), lwd = 3,
col.panel = "gray95", colkey = FALSE, bty = "u")
title("Tumor response and duration", cex.main = 2)
rect3D(min(as.numeric(dat$subject)) - 1, 0, min(dat$response),
max(as.numeric(dat$subject)) + 1,
max(dat$duration), NULL,
col = "#e7e7e7", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, 0, min(dat$response),
NULL,
max(dat$duration),
max(dat$response),
col = "#e0e0e0", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, max(dat$duration), min(dat$response),
max(as.numeric(dat$subject)) + 1, NULL,
max(dat$response),
col = "#f0f0f0", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, 0, 0,
max(as.numeric(dat$subject)) + 1,
max(dat$duration), NULL,
col = "#FFFFFF20", border = "gray50", add = TRUE)
Now the bars using rect3D
for(i in seq(nrow(dat))) {
rect3D(as.numeric(dat$subject[i]) - 0.2, 0, 0,
as.numeric(dat$subject[i]) + 0.2, dat$duration[i], NULL,
col = "#7c95ca", add = TRUE)
}
for(i in seq(nrow(dat))) {
rect3D(as.numeric(dat$subject[i]) - 0.2, 0, 0,
as.numeric(dat$subject[i]) + 0.2, NULL,
dat$response[i],
col = "#de7e6f", add = TRUE)
}
Finally, add the box outlines:
lines3D(c(min(as.numeric(dat$subject)) - 1, max(as.numeric(dat$subject)) + 1),
c(0, 0), rep(max(dat$response), 2), lty = 2, add = TRUE, col = "black")
lines3D(rep(max(as.numeric(dat$subject)) + 1, 2),
c(0, max(dat$duration)), rep(max(dat$response), 2),
lty = 2, add = TRUE, col = "black")
lines3D(rep(max(as.numeric(dat$subject)) + 1, 2),
c(0, 0), range(dat$response),
lty = 2, add = TRUE, col = "black")
lines3D(c(rep(min(as.numeric(dat$subject)) - 1, 3),
rep(max(as.numeric(dat$subject)) + 1, 3),
min(as.numeric(dat$subject)) - 1),
c(0, 0, rep(max(dat$duration), 3), 0, 0),
c(min(dat$response), rep(max(dat$response), 3),
rep(min(dat$response),3)),add = TRUE, col = "black", lwd = 5)
However, as others have pointed out in the comments, although such a plot is superficially impressive, it is actually less useful than displaying the data in a more familiar, elegant 2-D plot. Such a plot is also far easier to create, and contains all the same information in a more readable format
library(ggplot2)
ggplot(dat, aes(response, duration)) +
geom_point(size = 6, aes(color = "(subject id)"), alpha = 0.5) +
geom_text(aes(label = subject), nudge_x = 0.5, nudge_y = 1) +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0) +
ggtitle("Tumor response versus duration") +
scale_color_manual(NULL, values = "navy") +
theme_minimal(base_size = 20) +
theme(plot.margin = margin(20, 20, 50, 20),
plot.title = element_text(size = 32, color = "gray20",
margin = margin(10, 10, 50, 10)))
I think you'll have to write that yourself. Here are a couple of half-hearted attempts; you'll need to clean them up a lot.
library(scatterplot3d)
dat <- tibble::tribble(
~subject, ~response, ~duration,
'1', 10, 20,
'2', -7, 30,
'3', 5, 20,
'4', 7, 50,
'5', -5, 40
)
rectx <- c(-0.4, 0.4, 0.4, -0.4, -0.4, NA)
recty <- c(0, 0, 1, 1, 0, NA)
rectangles <- data.frame(x = numeric(), y = numeric(), z = numeric() )
for (i in seq_len(nrow(dat))) {
subj <- as.numeric(dat$subject[i])
rectangles <- rbind(rectangles,
data.frame(x = rectx + subj,
y = 0,
z = recty*dat$response[i]),
data.frame(x = rectx + subj,
y = recty*dat$duration[i],
z = 0))
}
with(dat, scatterplot3d(x = rectangles,
type= "l",
xlab = "Subject",
ylab = "Duration",
zlab = "Response"))
i <- seq_len(nrow(rectangles))
drop <- which(is.na(rectangles[i, 1]) )
drop <- c(drop, drop-1)
rectangles <- rectangles[!(i %in% drop),]
library(rgl)
open3d()
#> glX
#> 1
quads3d(rectangles, col = c(rep("red",4), rep("blue", 4)))
aspect3d(1,1,1)
decorate3d(xlab = "Subject",
ylab = "Duration",
zlab = "Response")
Created on 2023-01-07 with reprex v2.0.2
I want to add axes labels to the plot generated by the following code. Specifically, I would want an x-axis label that reads "Fibril Diameter (nm)" and a y-axis label that reads "Density". Any idea how I could accomplish this? Thanks!
den1 = density(CDE1$V1)
den2 = density(CDE1$V2)
col1 = hsv(h = 0.65, s = 0.6, v = 0.8, alpha = 0.5)
col2 = hsv(h = 0.85, s = 0.6, v = 0.8, alpha = 0.5)
op = par(mar = c(3, 3, 2, 2))
plot.new( )
plot.window(xlim = c(25,65), ylim = c(0, 0.14))
axis(side = 1, pos = 0, at = seq(from = 25, to = 65, by = 5), col = "gray20",
lwd.ticks = 0.25, cex.axis = 1, col.axis = "gray20", lwd = 1.5)
axis(side = 2, pos = 25, at = seq(from = 0, to = 0.14, by = 0.02), col = "gray20",
las = 2, lwd.ticks = 0.5, cex.axis = 1, col.axis = "gray20", lwd = 1.5)
polygon(den1$x, den1$y, col = col1, border ="black",lwd = 2)
polygon(den2$x, den2$y, col = col2, border ="black",lwd = 2)
text(52, 0.10, labels ="CDET", col =col1, cex = 1.25,font=2)
text(35, 0.03, labels ="SDFT", col =col2, cex = 1.25,font=2)
par(op)
title(main="Gestational Day 100/283")
Here's a picture of what the code generates so far...
Image
You can add your axis labels using title()
title(main="Gestational Day 100/283",
xlab="Fibril Diameter (nm)",
ylab="Density")
or with mtext() which will make it easier for you to fine-tune their exact positioning:
mtext("Fibril Diameter (nm)", side=1, line=2)
mtext("Density", side=2, line=2)
In either case, you will probably need to increase your bottom and left plot margins so that the labels are actually visible, e.g. like this:
op = par(mar=c(4.5, 4.5, 2, 2))
I am trying to plot a besselJ() function of order 0 (nu = 0) for x = 0 to x = 20 in R (working in RStudio).
Here is my current code:
plot (
x = NULL,
xlim = c(0, 20),
ylim = c(-0.4, 1),
main = "Plot of Bessel functions",
xlab = "x",
ylab = "J_nu(x)"
)
# grid
grid(
col = "gray60",
lwd = 1.5
)
# horizontal reference line
segments(
x0 = 0,
y0 = 0,
x1 = 20,
y1 = 0,
lty = "solid",
lwd = 2,
col = "gray50"
)
# vertical reference line
segments(
x0 = 0,
y0 = -0.4,
x1 = 0,
y1 = 1,
lty = "solid",
lwd = 2,
col = "gray50"
)
curve(
besselJ(0:20, 1),
lty = "solid",
lwd = 3,
col = "salmon2",
add = TRUE
)
This results in the following error:
Error in curve(besselJ(0:20, 1), lty = "solid", lwd = 3, col =
"salmon2", : 'expr' must be a function, or a call or an expression
containing 'x'
My working thought is that besselJ() returns a value y for a particular value x, which is why curve() is not treating besselJ as a 'function'
Anyone else have other ideas?
For example, I would like to plot a box with grids inside, the code show below:
plot(rnorm(10), rnorm(10), type = "n", asp = 1, xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, pty = "s", bty = "o", xlab = "", ylab = "")
abline(h = seq(0, 1, 0.2), v = seq(0, 1, 0.2), col = "lightgray")
abline(a = 0, b = 1, col = "lightgray")
axis(1, seq(0, 1, 0.2), seq(0, 1, 0.2), pos = 0)
axis(2, seq(0, 1, 0.2), seq(0, 1, 0.2), pos = 0)
But the lines exceed the area (0, 0) to (1, 1), just like box with whisker. It may be the problem with plot region, and how can I confine the plot region to exactly area for example from (0, 0) to (1, 1)?
Thanks a lot!
plot(rnorm(10), rnorm(10), type = "n", asp = 1, xlim = c(0, 1), ylim = c(0, 1),
axes = FALSE, pty = "s", bty = "o", xlab = "", ylab = "")
axis(1, seq(0, 1, 0.2), seq(0, 1, 0.2), pos = 0)
axis(2, seq(0, 1, 0.2), seq(0, 1, 0.2), pos = 0, las=1)
You can use clip to prevent annotations extending beyond the clip region. The four arguments determine the two coordinates of the rectangle for clipping.
clip(0,1,0,1)
abline(h = seq(0, 1, 0.2), v = seq(0, 1, 0.2), col = "lightgray")
abline(a = 0, b = 1, col = "lightgray")
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.