如何使用ggplot2在R中绘制菱形？

Question

我正在尝试在R中复制以下图片，尤其是使用ggplot2

我能够绘制红色的rss轮廓线，但是我不知道如何绘制菱形（如左图所示）。 “预期输出”应该是一种以给定边长绘制菱形的方法。

编辑：这是一个简短的可复制示例，可将钻石随机添加到以下情节中：

mlb<- read.table('https://umich.instructure.com/files/330381/download?download_frd=1', as.is=T, header=T)
str(mlb)

fit<-lm(Height~Weight+Age-1, data = as.data.frame(scale(mlb[,4:6])))
points = data.frame(x=c(0,fit$coefficients[1]),y=c(0,fit$coefficients[2]),z=c("(0,0)","OLS Coef"))

Y=scale(mlb$Height)
X = scale(mlb[,c(5,6)])
beta1=seq(-0.556, 1.556, length.out = 100)
beta2=seq(-0.661, 0.3386, length.out = 100)
df <- expand.grid(beta1 = beta1, beta2 = beta2)

b = as.matrix(df)
df$sse <- rep(t(Y)%*%Y,100*100) - 2*b%*%t(X)%*%Y + diag(b%*%t(X)%*%X%*%t(b))

base <- ggplot() + 
  stat_contour(data=df, aes(beta1, beta2, z = sse),breaks = round(quantile(df$sse, seq(0, 0.2, 0.03)), 0), 
               size = 0.5,color="darkorchid2",alpha=0.8) +

  scale_x_continuous(limits = c(-0.4,1))+
  scale_y_continuous(limits = c(-0.55,0.4))+
  geom_point(data = points,aes(x,y))+
  geom_text(data = points,aes(x,y,label=z),vjust = 2,size=3.5)    
  base

Answer 1

您可以使用geom_polygon绘制形状。

library(ggplot2)
df <- data.frame(x = c(1, 0, -1, 0), y = c(0, 1, 0, -1))
ggplot(df) + geom_polygon(aes(x = x, y = y))

如果要从中心和边长生成坐标，则可以变换基本矩阵。您还可以通过将坐标提供给geom的数据参数而不是提供给ggplot()来将其与现有图结合，如图所示。如果要将角到中心而不是边长作为参数，请更改sqrt2缩放比例。

diamond <- function(side_length, center) {
  base <- matrix(c(1, 0, 0, 1, -1, 0, 0, -1), nrow = 2) * sqrt(2) / 2
  trans <- (base * side_length) + center
  as.data.frame(t(trans))
}

ggplot() + geom_polygon(data = diamond(2, c(1, 2)), mapping = aes(x = V1, y = V2))

这里是将其添加到您提供的数据中的示例。请注意，我将其放在文本之前（下面），并命名了要清楚的参数（可能是该object coercible by fortify错误的来源。

mlb <- read.table("https://umich.instructure.com/files/330381/download?download_frd=1", as.is = T, header = T)

fit <- lm(Height ~ Weight + Age - 1, data = as.data.frame(scale(mlb[, 4:6])))
points <- data.frame(x = c(0, fit$coefficients[1]), y = c(0, fit$coefficients[2]), z = c("(0,0)", "OLS Coef"))

Y <- scale(mlb$Height)
X <- scale(mlb[, c(5, 6)])
beta1 <- seq(-0.556, 1.556, length.out = 100)
beta2 <- seq(-0.661, 0.3386, length.out = 100)
df <- expand.grid(beta1 = beta1, beta2 = beta2)

b <- as.matrix(df)
df$sse <- rep(t(Y) %*% Y, 100 * 100) - 2 * b %*% t(X) %*% Y + diag(b %*% t(X) %*% X %*% t(b))

ggplot(df) +
  stat_contour(aes(beta1, beta2, z = sse),
               breaks = round(quantile(df$sse, seq(0, 0.2, 0.03)), 0),
               size = 0.5, color = "darkorchid2", alpha = 0.8
  ) +
  geom_polygon(data = diamond(0.1, c(0, 0)), mapping = aes(x = V1, y = V2), fill = "cadetblue1") +
  scale_x_continuous(limits = c(-0.4, 1)) +
  scale_y_continuous(limits = c(-0.55, 0.4)) +
  geom_point(data = points, aes(x, y)) +
  geom_text(data = points, aes(x, y, label = z), vjust = 2, size = 3.5)
#> Warning: Removed 4215 rows containing non-finite values (stat_contour).

由reprex package（v0.2.0）于2018-08-01创建。