2017-09-24 1 views
1

目標: "X1" - "X4"と "Y1"の各組み合わせに対して値zを示す3Dバープロットを作成したい" - " Y4 "ここで、ラベルはz変数のランクに対応するものとする。R格子/ LatticeExtraバープロットとTextplotを組み合わせる - ラベルが正しく表示されない

問題:下記のように、画像のラベルはzの順位付け値(ランク1 = zの最小値、ランク16 = zの最高値)と一致しません。たとえば、「X1-Y3」の組み合わせは、Z値が最も低いため、8ではなく1にする必要があります。したがって、どうすればこの問題を解決できますか?

画像出力(間違ったラベル付き):ここでは、画像出力が間違ったラベルで表示されます(ラベルがz軸値のランクに対応していません)。

3D Barplot/Textplot from reproducible R code above

R-コード:上記画像について、Iはbarplotにtextplotをオーバーレイ。

# load necessary libraries 
library(lattice) 
library(latticeExtra) 

# create dataframe 
df.test <- data.frame(matrix(NA, nrow=16, ncol=4)) 
names(df.test) <- c("x", "y", "z", "z.rank") 

# fill dataframe 
df.test$x <- as.factor(rep(c("X1", "X2", "X3", "X4"), times=4)) 
df.test$y <- as.factor(rep(paste0("Y", 1:4), each=4)) 
set.seed(2); df.test$z <- abs(rnorm(16, 0, 1)) 

# labels (rankings of z, from largest to smallest) 
df.test$z.rank <- as.numeric(rank(df.test$z)) 


# plot 1 (bars) 
p1.test <- cloud(z~x+y, data=df.test, panel.3d.cloud=panel.3dbars, 
      ylab="Y", xlab="X", zlab="Z", 
      xbase=0.2, ybase=0.2, scales=list(arrows=FALSE, col="black", distance=1), 
      par.settings = list(axis.line = list(col = "transparent")), 
      screen = list(z = 35, x = -35, y=0), 
      alpha.facet = 1.00, border = "transparent", 
      zoom=1.00 
); print(p1.test) 

# plot 2 (labels) 
p2.test <- cloud(z~x+y, data=df.test, panel.3d.cloud=panel.3dtext, 
      labels=as.character(df.test$z.rank), 
      ylab="", xlab="", zlab="", 
      par.settings = list(axis.line = list(col = "transparent")), 
      screen = list(z = 35, x = -35, y=0), 
      alpha.facet = 1.00, border = "transparent", 
      zoom=1.00, cex=0.5, pos=3, offset=1.75 
); print(p2.test) 

# plot both (overlay p2.test onto p1.test) 
print(p1.test, more=TRUE) 
print(p2.test, more=FALSE) 

答えて

2
library(lattice) 
library(latticeExtra) 
df.test <- data.frame(matrix(NA, nrow=16, ncol=4)) 
names(df.test) <- c("x", "y", "z", "zrank") 
df.test$x <- as.factor(rep(c("X1", "X2", "X3", "X4"), times=4)) 
df.test$y <- as.factor(rep(paste0("Y", 1:4), each=4)) 
set.seed(2) 
df.test$z <- abs(rnorm(16, 0, 1)) 
df.test$zrank <- as.numeric(rank(df.test$z)) 

p1.test <- cloud(z ~ x * y, data=df.test, panel.3d.cloud=panel.3dbars, 
      ylab="Y", xlab="X", zlab="Z", 
      xbase=0.2, ybase=0.2, scales=list(arrows=FALSE, col="black", distance=1), 
      par.settings = list(axis.line = list(col = "transparent")), 
      screen = list(z = 35, x = -35, y=0), 
      alpha.facet = 1.00, border = "transparent", 
      zoom=1.00) 

# A modified version of panel.3dtext 
mypanel.3dtext <- function (x, y, z, labels = seq_along(x), rot.mat = diag(4), 
    distance, ...) { 
    if (all(is.na(x) | is.na(y) | is.na(z))) return() 
    m <- ltransform3dto3d(rbind(x, y, z), rot.mat, distance) 
    panel.text(x = m[1, ], y = m[2, ], labels = labels, ...)} 

p2.test <- cloud(z ~ x * y, data=df.test, panel.3d.cloud=mypanel.3dtext, 
      labels=df.test$zrank, 
      ylab="", xlab="", zlab="", col="red", 
      par.settings = list(axis.line = list(col = "transparent")), 
      screen = list(z = 35, x = -35, y=0), 
      alpha.facet = 1.00, border = "transparent", 
      zoom=1.00, cex=0.5, pos=3, offset=1.75) 

print(p1.test, more=TRUE) 
print(p2.test, more=FALSE) 

enter image description here

関連する問題