R的哈维球

Question

如何在R中创建如下图表？

一些玩具数据看起来像这样:

# Data
data <- rep(c(0, 25, 50, 75, 100),6) 
data <-  matrix(data, ncol=3, byrow=TRUE) 
colnames(data) <- paste0("factor_", seq(3))
rownames(data) <- paste0("observation_", seq(10))


#                factor_1 factor_2 factor_3
# observation_1         0       25       50
# observation_2        75      100        0
# observation_3        25       50       75
# observation_4       100        0       25
# observation_5        50       75      100
# observation_6         0       25       50
# observation_7        75      100        0
# observation_8        25       50       75
# observation_9       100        0       25
# observation_10       50       75      100

谢谢.

Answer 1

这是使用基本图形和unicode符号的快速而肮脏的解决方案:

library(extrafont)
# font_import() # ... if you need to
loadfonts()
getPch <- function(x) {
  sapply(x, function(x) {
    switch(as.character(x), 
    "0"=-9675,
    "25"=-9684,
    "50"=-9682,
    "75"=-9685,
    "100"=-9679
  )})
}
par(mar=c(2, 7, 2, 4))
plot(y =rep(1:nrow(data), ncol(data)), 
     x = rep(1:ncol(data), each=nrow(data)), 
     pch = getPch(as.vector(data)), 
     axes = F, xlab = "", ylab = "",
     cex = 3, xlim = c(.5, ncol(data) + .5),
     family = "Arial Unicode MS")
abline(v = 0:ncol(data)+.5)
abline(h = 1:nrow(data) + .5)
mtext(side = 1, at=1:ncol(data), text=colnames(data))
mtext(side = 2, at=1:nrow(data), text=rownames(data), las=2)

Answer 2

Jeez,我浪费了太多时间......

它并不完美 - 人们需要使用轴的单位才能使它始终产生"圆形"圆圈(而不是椭圆形),但是你得到了要点:

# Data
data <- rep(c(0, 25, 50, 75, 100),6) 
data <-  matrix(data, ncol=3, byrow=TRUE) 
colnames(data) <- paste0("factor_", seq(3))
rownames(data) <- paste0("observation_", seq(10))

#plot
data <- t(data)

par(mar=c(1,8,8,1))
image(x=seq(nrow(data)), y=seq(ncol(data)), z=data, col=NA, axes=FALSE, xlab="", ylab="")
axis(3, at=seq(nrow(data)), labels=rownames(data), las=2)
axis(2, at=seq(ncol(data)), labels=colnames(data), las=2)
rad <- 0.25
n <- 100
full.circ <- data.frame(x=cos(seq(0,2*pi,,n))*rad,  y=sin(seq(0,2*pi,,n))*rad)
bottom.circ <- data.frame(x=cos(seq(1*pi,2*pi,,n))*rad,  y=sin(seq(1*pi,2*pi,,n))*rad)
top.circ <- data.frame(x=cos(seq(0,1*pi,,n))*rad,  y=sin(seq(0,1*pi,,n))*rad)
for(i in seq(data)){
    val <- data[i]
    xi <- (i-1) %% nrow(data) +1
    yi <- (i-1) %/% nrow(data) +1
    if(val>=0 & val<25){
        polygon(x=xi+full.circ$x, y=yi+full.circ$y)
    }
    if(val>=25 & val<50){
        polygon(x=xi+full.circ$x, y=yi+full.circ$y)
        polygon(x=xi+bottom.circ$x, y=yi+bottom.circ$y, col=1)
    }
    if(val>=50 & val<75){
        polygon(x=xi+full.circ$x, y=yi+full.circ$y)
        polygon(x=xi+top.circ$x, y=yi+top.circ$y, col=1)
    }       
    if(val>=75 & val<=100){
        polygon(x=xi+full.circ$x, y=yi+full.circ$y, col=1)
    }       
}