[英]Creating a 3D histogram with R
如何用R創建3D直方圖?
例如,我有兩個變量要計算它們落入定義的二維bin的次數。 所以我在X和Y軸上有兩個變量,而Z軸是兩個變量的計數。
查看包hexbin來計算和顯示,或者例如ggplot的stat_bin2d
/ stat_binhex
用於顯示。 你得到2個空間坐標,這是你的所有屏幕或紙張可以做的加上第三個顏色編碼的尺寸。
請注意, 如何在R中繪制3D堆疊直方圖? 與這個問題完全相同(但第三維在那里進行了空間討論)。
rgl包有一個函數hist3d(實際上不在doc中,但你可以調用它,也可以看到代碼)。
雖然這個hist3d是,我為3維展示了二維直方圖(input = x,y)。
如果這就是你想要的代碼(來自rgl):
> hist3d
function(x,y=NULL,nclass="auto",alpha=1,col="#ff0000",scale=10)
{
save <- par3d(skipRedraw=TRUE)
on.exit(par3d(save))
xy <- xy.coords(x,y)
x <- xy$x
y <- xy$y
n<-length(x)
if (nclass == "auto") { nclass<-ceiling(sqrt(nclass.Sturges(x))) }
breaks.x <- seq(min(x),max(x),length=(nclass+1))
breaks.y <- seq(min(y),max(y),length=(nclass+1))
z<-matrix(0,(nclass),(nclass))
for (i in 1:nclass)
{
for (j in 1:nclass)
{
z[i, j] <- (1/n)*sum(x < breaks.x[i+1] & y < breaks.y[j+1] &
x >= breaks.x[i] & y >= breaks.y[j])
binplot.3d(c(breaks.x[i],breaks.x[i+1]),c(breaks.y[j],breaks.y[j+1]),
scale*z[i,j],alpha=alpha,topcol=col)
}
}
}
我建立了自己的hist3d來返回三維直方圖(例如在紅綠藍上使用):
my_hist3d <- function(x,y=NULL,z=NULL, nclass="auto",alpha=1,col="#ff0000",scale=10)
{
xyz <- xyz.coords(x,y,z)
x <- xyz$x
y <- xyz$y
z <- xyz$z
n<-length(x)
if (nclass == "auto") { nclass<-ceiling(sqrt(nclass.Sturges(x))) }
breaks.x <- seq(min(x),max(x),length=(nclass+1))
breaks.y <- seq(min(y),max(y),length=(nclass+1))
breaks.z <- seq(min(z),max(z),length=(nclass+1))
h = array(1:(nclass^3), dim=c(nclass,nclass,nclass))
for (i in 1:nclass)
{
for (j in 1:nclass)
{
for (k in 1:nclass)
{
h[i,j,k] <- (1/n)*sum(x < breaks.x[i+1] & y < breaks.y[j+1] & x >= breaks.x[i] & y >= breaks.y[j] & z < breaks.z[k+1] & z >= breaks.z[k])
}
}
}
return(h)
}
返回的變量(h)是大小為nclass ^ 3的三維矩陣(nclass是每個維度中的bin的數量)。
您可以使用基於圖森函數的下一個函數在3d中繪制直方圖。
my_hist3d <- function(x, y, freq=FALSE, nclass="auto") {
n<-length(x)
if (nclass == "auto") { nclass<-ceiling(sqrt(nclass.Sturges(x))) }
breaks.x <- seq(min(x),max(x),length=(nclass+1))
breaks.y <- seq(min(y),max(y),length=(nclass+1))
h <- NULL
for (i in 1:nclass)
for (j in 1:nclass)
h <- c(h, sum(x <= breaks.x[j+1] & x >= breaks.x[j] & y <= breaks.y[i+1] & y >= breaks.y[i] ) )
if (freq) h <- h / n
xx <- as.factor(round(mean(breaks.x[1:2])+(0:(nclass-1))*diff(breaks.x[1:2]), 1))
yy <- as.factor(round(mean(breaks.y[1:2])+(0:(nclass-1))*diff(breaks.y[1:2]), 1))
res <- cbind(expand.grid(xx,yy), h)
colnames(res) <- c(deparse(substitute(x)),deparse(substitute(y)),'Frequency')
formu <- as.formula(paste("Frequency ~ ", paste(colnames(res)[1:2], collapse= "+")))
cloud(formu, res, panel.3d.cloud=panel.3dbars, col.facet='lightblue',
xbase=1, ybase=1, scales=list(arrows=FALSE, col=1),
par.settings = list(axis.line = list(col = "transparent")))
}
library(latticeExtra)
height <- rbeta(2000, 2, 5)
weight <- rgamma(2000, 10)
my_hist3d(height, weight, nclass=10)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.