Is it possible to generate a 3D bar chart in r - r

Question

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
)

Answer 1

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)))

Answer 2

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