2012-01-04 67 views
2

我已经使用以下代码生成附双标图:主成分分析双标图与凸多边形

dd = data.frame(x = runif(10), y=runif(10)) 
pcr = prcomp(~x + y, data=dd) 
biplot(pcr) 

这产生表示X和Y与各10个数据点的轴线的双标图。可以说10个数据点由2个不同的组(5个在一个组中,5个在另一个组中)组成。我怎样才能在每个组周围生成一个带有最小凸多边形的双标图,以显示两组的分割?

+1

如果您还没有找到它,请查看'chull'(简称'凸包')。它位于基本的R软件包'grDevices'中,所以只需输入'?chull',以获得如何从一组x-y坐标计算和绘制最小凸多边形的示例。 – 2012-01-04 16:58:50

+0

另一个指针:要获得PC空间中点的x-y坐标,输入'pcr $ x'。 – 2012-01-04 17:07:07

+1

也可以看看来自素食包 – EDi 2012-01-04 17:37:35

回答

5

我看着统计::: biplot.default统计::: biplot.prcomp,我接近你想要什么。您可以修改此代码以满足您的需求。 (我使用了虹膜数据集)

require(plyr) 

data(iris) 

pcr <- prcomp(~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = iris) 

indiv <- data.frame(pcr$x[,1:2]) 

indiv$species <- iris$Species 

column <- data.frame(pcr$rotation[ ,1:2]) 

n <- nrow(indiv) 

eigenval <- pcr$sdev[1:2] 

eigenval <- eigenval * sqrt(n) 

indiv <- transform(indiv, pc1 = PC1/eigenval[1], pc2 = PC2/eigenval[2]) 

column <- transform(column, pc1 = PC1 * eigenval[1], pc2 = PC2 * eigenval[2]) 

### based on stats:::biplot.default 

unsigned.range <- function(x) c(-abs(min(x, na.rm = TRUE)), abs(max(x, na.rm = TRUE))) 

rangx1 <- unsigned.range(indiv[, 4]) 
rangx2 <- unsigned.range(indiv[, 5]) 
rangy1 <- unsigned.range(column[, 3]) 
rangy2 <- unsigned.range(column[, 4]) 

mylim <- range(rangx1, rangx2) 
ratio <- max(rangy1/rangx1, rangy2/rangx2) 

nspecies <- table(iris$Species) 

# compute the convex hull for each species 
hull <- dlply(indiv[,1:3], .(species), chull) 

# get points connected 
hull <- llply(hull, function(x) c(x, x[1])) 


plot(pc2 ~ pc1, data = indiv, cex = 0.5, col = c("blue", "yellow", "green")[iris$Species], xlim = mylim, ylim = mylim) 

lines(indiv$pc1[hull$setosa], indiv$pc2[hull$setosa] , col = "blue") 

lines(indiv$pc1[cumsum(nspecies)[1] + hull$versicolor], indiv$pc2[cumsum(nspecies)[1] + hull$versicolor], col = "yellow") 

lines(indiv$pc1[cumsum(nspecies)[2] + hull$virginica], indiv$pc2[cumsum(nspecies)[2] + hull$virginica], col = "green") 

par(new = TRUE) 

plot(pc1 ~ pc2, data = column, axes = FALSE, type = "n", xlim = mylim * ratio, ylim = mylim * ratio, xlab = "", ylab = "") 

text(column$pc1, column$pc2, labels = rownames(column), cex = 0.5, col = "red") 

arrows(0, 0, column$pc1 * 0.8, column$pc2 * 0.8, col = "red", length = 0.2) 

axis(3, col = "red") 

axis(4, col = "red")