你能帮我生成如下的3D图吗?
dat <- tibble::tribble( ~subject, ~response, ~duration, '1', 10, 20, '2', -7, 30, '3', 5, 20, '4', 7, 50, '5', -5, 40 )
wrrgggsh1#
下面是使用plot3D时与原始代码更接近的代码首先绘制框、轴、标题和平面:
plot3D
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)
现在使用rect3D的条形图
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) }
最后,添加方框轮廓:
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)
然而,正如其他人在评论中指出的那样,尽管这样的图表面上令人印象深刻,但实际上不如用更熟悉、更优雅的2-D图显示数据有用。这样的图也更容易创建,并且以更可读的格式包含所有相同的信息
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)))
7kjnsjlb2#
我想你得自己写了。这里有几个半心半意的尝试;你得把它们清理干净。
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")
创建于2023年1月7日,使用reprex v2.0.2
2条答案
按热度按时间wrrgggsh1#
下面是使用
plot3D
时与原始代码更接近的代码首先绘制框、轴、标题和平面:
现在使用
rect3D
的条形图最后,添加方框轮廓:
然而,正如其他人在评论中指出的那样,尽管这样的图表面上令人印象深刻,但实际上不如用更熟悉、更优雅的2-D图显示数据有用。这样的图也更容易创建,并且以更可读的格式包含所有相同的信息
7kjnsjlb2#
我想你得自己写了。这里有几个半心半意的尝试;你得把它们清理干净。
创建于2023年1月7日,使用reprex v2.0.2