如何繪製漂亮間隔的數據標籤？在情節

Question

標籤的數據點可以得到笨拙：

隨機抽樣幾個標籤可能會失望：

這將是一個很好的方式來挑選一小套精美，空間數據的標籤？也就是說，要隨機挑選標籤不重疊的代表。

# demo data 
set.seed(123) 
N <- 50 
x <- runif(N) 
y <- x + rnorm(N, 0, x) 
data <- data.frame(x, y, labels=state.name) 

# plot with labels 
plot(x,y) 
text(x,y,labels) 

# plot a few labels 
frame() 
few_labels <- data[sample(N, 10), ] 
plot(x,y) 
with(few_labels, text(x,y,labels)) 

Answer 1

一種方法是通過聚類。這是一個與stats::hclust解決方案。我們將聚類數據點聚集在一起，然後從每個聚類中挑選一個隨機觀察。

few_labels <- function(df, coord=1:ncol(df),grp=5){ 

    require(dplyr) 
    df$cl <- cutree(hclust(dist(df[,coord])),grp) 
    few_labels <- df %>% group_by(cl) %>% 
    do(sample_n(.,1)) 
    return(few_labels) 
} 

# demo data 
set.seed(123) 
N <- 50 
x <- runif(N) 
y <- x + rnorm(N, 0, x) 
data <- data.frame(x, y, labels=state.name) 

# plot a few labels 
frame() 
few_labels <- few_labels(data,coord=1:2,grp=12) 
plot(x,y) 
with(few_labels, text(x,y,labels)) 

Answer 2

對於所有標籤：

xlims=c(-1,2) 
plot(x,y,xlim=xlims) 
#text(x,y,data$labels,pos = 2,cex=0.7) 
library(plotrix) 
spread.labels(x,y,data$labels,cex=0.7,ony=NA) 

Answer 3

另一種方法是隨機選取一個點，拋出所有靠近的人，依此類推，直到沒有一點左：

radius <- .1 # of a ball containing the largest label 

d <- as.matrix(dist(data[, c("x","y")], upper=TRUE, diag=TRUE)) 
remaining <- 1:N 
spaced <- numeric() 
i <- 1 
while(length(remaining)>0) { 
    p <- ifelse(length(remaining)>1, sample(remaining, 1), remaining) 
    spaced <- c(spaced, p) # ... 
    remaining <- setdiff(remaining, which(d[p, ] < 2*radius)) 
    i <- i + 1 
} 

frame() 
plot(x,y) 
spaced_labels <- data[spaced, ] 
with(spaced_labels, text(x,y,labels))