绘制随时间的分布

Question

对 R 来说非常陌生。

我一直在努力解决一个非常简单的问题，但我找不到解决方法 我需要能够看到资产随时间的分布。 这是代码。我想到的是一个 3D 图，轴是：时间、密度和资产。由于某种原因，该情节不起作用。

library(fdicdata)
library(lubridate)
library(dplyr)
library(ggplot2)
library(plotly)


data <- getInstitutionsAll()
#data_history <- getHistory()
bank_data <- data[,c('CERT', 'ASSET', 'DATEUPDT', 'DEP', 'EQ', 'ESTYMD', 'INSDATE', 'NEWCERT', 'REPDTE', 'RISDATE',
                     'ROA', 'ROAPTX', 'ROE', 'DEPDOM', 'NETINC')]


bank_data <- bank_data %>%
  mutate_at(vars(REPDTE, RISDATE,DATEUPDT, INSDATE), mdy)%>%
  mutate_at(vars(ASSET, DEP, EQ, ROA, ROAPTX, ROE, DEPDOM ,NETINC), as.numeric)

fails <- getFailures(c("CERT", "NAME", "FAILDATE", "CITY", "STATE", 'SAVR', 'COST', 'QBFDEP', 'QBFASSET', 'PSTALP'), range = c(1992, 2023))


densities <- bank_data %>%
  group_by(REPDTE) %>%
  filter(sum(!is.na(ASSET)) >= 2) %>%
  do({
    d <- density(.$ASSET, na.rm = TRUE)
    data.frame(REPDTE = unique(.$REPDTE), 
               density_x = d$x, 
               density_y = d$y)
  }) %>%
  ungroup()

# Prepare data for 3D plotting
# Convert the data frame into matrices for plotly's surface plot
time_unique <- unique(densities$REPDTE)
x_values <- sort(unique(densities$density_x))

# Create a matrix of density values for each time point
density_matrix <- matrix(NA, nrow = length(x_values), ncol = length(time_unique))

for (i in 1:length(time_unique)) {
  subset_data <- densities %>% filter(REPDTE == time_unique[i])
  density_matrix[, i] <- approx(subset_data$density_x, subset_data$density_y, xout = x_values, rule = 2)$y
}

# Plot 3D surface
p1 <- plot_ly(x = x_values, 
        y = time_unique, 
        z = t(density_matrix), # Transpose to align with time and asset values
        type = "surface") %>%
  layout(title = "3D Plot of Asset Densities Over Time",
         scene = list(xaxis = list(title = "Asset Values"),
                      yaxis = list(title = "Time"),
                      zaxis = list(title = "Density")))

我得到一个灰色盒子。

Answer 1

正如@Seth 指出的那样，

尝试使用

rgl

包，希望它的性能会更高一些（尽管可能更难美化）：

rgl::persp3d(x_values, time_unique, density_matrix, col = "gray")

（在中档现代笔记本电脑上渲染大约需要 15 秒。）

这可能更容易看到，尽管仍然有点难看：

d3d <- log10(density_matrix+1e-10)  ## 
rgl::persp3d(x_values, time_unique, d3d, col = "gray")