19

を使用して叙階パッケージに取り組んでいますggplot2。現在、ローディングを矢印で表す従来の方法でバイプロットを作成しています。キャリブレーションされた軸を使用し、負荷軸を原点を通る線として表し、負荷ラベルをプロット領域の外側に表示することにも興味があります。ベースRでは、これは実装されています

library(OpenRepGrid)
biplot2d(boeker)

ここに画像の説明を入力

しかし、私は解決策を探していggplot2ます。でこのようなことを達成する方法を考えている人はいますggplot2か? プロット領域の外側に変数名を追加することは、ここのように行うことができると思いますが、プロット領域の外側の線分をどのようにプロットできますか?

現在私が持っているのは

install.packages("devtools")
library(devtools)
install_github("fawda123/ggord")
library(ggord)
data(iris)
ord <- prcomp(iris[,1:4],scale=TRUE)
ggord(ord, iris$Species)

ここに画像の説明を入力

積載量はord$rotation

                    PC1         PC2        PC3        PC4
Sepal.Length  0.5210659 -0.37741762  0.7195664  0.2612863
Sepal.Width  -0.2693474 -0.92329566 -0.2443818 -0.1235096
Petal.Length  0.5804131 -0.02449161 -0.1421264 -0.8014492
Petal.Width   0.5648565 -0.06694199 -0.6342727  0.5235971

原点、外側の目盛り、および軸領域の外側のラベルを通る線を追加するにはどうすればよいですか (ラベルの重なりに対して上記で適用されたクールなジッターを含む可能性があります)。

注意: クリッピングをオフにしたくありません。プロット要素の一部がバウンディング ボックスの外に出てしまうことがあるためです。

編集:他の誰かが以前に同様の質問をしたようですが、質問にはまだ答えがありません。ベースRでこのようなことを行うには(醜い方法ではありますが)、たとえばできることを指摘しています。

plot(-1:1, -1:1, asp = 1, type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
abline(a = 0, b = -0.75)
abline(a = 0, b = 0.25)
abline(a = 0, b = 2)
mtext("V1", side = 4, at = -0.75*par("usr")[2])
mtext("V2", side = 2, at = 0.25*par("usr")[1])
mtext("V3", side = 3, at = par("usr")[4]/2)

ここに画像の説明を入力

最小限の実行可能な例は次のとおりggplot2です

library(ggplot2)
df <- data.frame(x = -1:1, y = -1:1)
dfLabs <- data.frame(x = c(1, -1, 1/2), y = c(-0.75, -0.25, 1), labels = paste0("V", 1:3))
p <- ggplot(data = df, aes(x = x, y = y)) +  geom_blank() +
  geom_abline(intercept = rep(0, 3), slope = c(-0.75, 0.25, 2)) +
  theme_bw() + coord_cartesian(xlim = c(-1, 1), ylim = c(-1, 1)) +
  theme(axis.title = element_blank(), axis.text = element_blank(), axis.ticks = element_blank(),
        panel.grid = element_blank())
p + geom_text(data = dfLabs, mapping = aes(label = labels))

ここに画像の説明を入力

しかし、ラベルには運がないことがわかるので、クリッピングをオフにする必要のない解決策を探しています。

EDIT2:関連する質問のビットは、因子負荷の座標系を表示するために、X軸の上部とY軸の右側にカスタムブレーク/目盛りとラベルを赤で追加する方法です? (矢印をより明確にするために因子スコアに相対的にスケーリングする場合、通常は単位円と組み合わせます)

4

2 に答える 2

6

別の方法として、デフォルトのパネル ボックスと軸を完全に削除し、代わりにプロット領域に小さな四角形を描画することもできます。テキスト ラベルと衝突しないように行をクリッピングするのは少し難しいですが、これでうまくいくかもしれません。

ここに画像の説明を入力

df <- data.frame(x = -1:1, y = -1:1)
dfLabs <- data.frame(x = c(1, -1, 1/2), y = c(-0.75, -0.25, 1), 
                     labels = paste0("V", 1:3))
p <- ggplot(data = df, aes(x = x, y = y)) +  
  geom_blank() +
  geom_blank(data=dfLabs, aes(x = x, y = y)) +
  geom_text(data = dfLabs, mapping = aes(label = labels)) +
  geom_abline(intercept = rep(0, 3), slope = c(-0.75, 0.25, 2)) +
  theme_grey() +
  theme(axis.title = element_blank(), 
        axis.text = element_blank(), 
        axis.ticks = element_blank(),
        panel.grid = element_blank()) + 
  theme()

library(grid)
element_grob.element_custom <- function(element, ...)  {
  rectGrob(0.5,0.5, 0.8, 0.8, gp=gpar(fill="grey95"))
}

panel_custom <- function(...){ # dummy wrapper
  structure(
    list(...), 
    class = c("element_custom","element_blank", "element") 
  ) 

}

p <- p + theme(panel.background=panel_custom())


clip_layer <- function(g, layer="segment", width=1, height=1){
  id <- grep(layer, names(g$grobs[[4]][["children"]]))
  newvp <- viewport(width=unit(width, "npc"), 
                    height=unit(height, "npc"), clip=TRUE)
  g$grobs[[4]][["children"]][[id]][["vp"]] <- newvp

  g
}

g <- ggplotGrob(p)
g <- clip_layer(g, "segment", 0.85, 0.85)
grid.newpage()
grid.draw(g)
于 2015-08-16T09:49:38.917 に答える
1

これはどうですか:

ここに画像の説明を入力

次のコードを使用します。上部と右側にもラベルが必要な場合は、http: //rpubs.com/kohske/dual_axis_in_ggplot2をご覧ください。

require(ggplot2)

data(iris)
ord <- prcomp(iris[,1:4],scale=TRUE)

slope <- ord$rotation[,2]/ord$rotation[,1]

p <- ggplot() + 
  geom_point(data = as.data.frame(ord$x), aes(x = PC1, y = PC2)) +
  geom_abline(data = as.data.frame(slope), aes(slope=slope))

info <- ggplot_build(p)

x <- info$panel$ranges[[1]]$x.range[1]
y <- info$panel$ranges[[1]]$y.range[1]

p + 
  scale_x_continuous(breaks=y/slope, labels=names(slope)) +
  scale_y_continuous(breaks=x*slope, labels=names(slope)) +
  theme(axis.text.x  = element_text(angle=90, vjust=0.5),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank()) 
于 2015-08-16T12:21:11.087 に答える