2012-12-21 150 views
11

我想创建一个组织结构(层次结构)的三角形图,显示不同公司各级员工的数量。组织结构图三角形图

下面是一些示例数据:

mylabd <- data.frame (company = rep(c("A", "B", "C"), each = 7), 
skillsDg = rep(c("Basic", "HighSc", "Undgd", "MAST", "PHD", "EXPD", "EXECT"), 3), 
number = c(200, 100, 40, 30, 10, 0, 0, 
      220, 110, 35, 10, 0, 4, 1, 
      140, 80, 120, 50, 52, 52, 3) 
      ) 
    company skillsDg number 
1  A Basic 200 
2  A HighSc 100 
3  A Undgd  40 
4  A  MAST  30 
5  A  PHD  10 
6  A  EXPD  0 
7  A EXECT  0 
8  B Basic 220 
9  B HighSc 110 
10  B Undgd  35 
11  B  MAST  10 
12  B  PHD  0 
13  B  EXPD  4 
14  B EXECT  1 
15  C Basic 140 
16  C HighSc  80 
17  C Undgd 120 
18  C  MAST  50 
19  C  PHD  52 
20  C  EXPD  52 
21  C EXECT  3 

目的是为了反映不同公司如何聘请不同技能或学位的工人。

假设数字是这样的(尽管颜色填充不完美)。 enter image description here 这个想法是,在每个阶段线的宽度是成比例的,然后连接线。如果在后续级别中没有类别,则不会连接(如在公司B中)。我找不到可以做到这一点的计划,但都无法弄清楚。任何想法 ?

编辑:

我没有很多关于R,但这里是我如何我的想法正在形成。它将每一条线段从一个点分成两部分,以使其合并。然后连接绘制的水平线。

enter image description here

+0

您是否尝试过小提琴阴谋? – James

+0

我不确定它voilin阴谋作品的双向分类变量(而不是定量变量的频率分布),可能需要技巧来适应它! – rdorlearn

回答

15

我不知道任何功能的这样做,但这里是一个从无到有:

my1 <- data.frame (company = rep(c("A", "B", "C"), each = 7), skillsDg = rep(c("Basic", "HighSc", "Undgd", "MAST", "PHD", "EXPD", "EXECT"), 3), number = c(200, 100, 40, 30, 10, 0, 0, 220, 110, 35, 10, 0, 4, 1, 140, 80, 120, 50, 52, 52, 3)) 

my2 <- split(my1,my1$company) #split your dataframe into a list where each element is a company 
# The next line create the layout 
layout(matrix(1:(length(my2)+1), nrow=1), width=c(1,rep(4,length(my2)))) 
# Then we draw the x-axis: 
par(mar=c(3,0,3,0)) 
plot(NA,axes=F, xlim=c(0,1),ylim=c(1,nlevels(my1$skillsDg))) 
axis(side=4,tick=F,labels=unique(my1$skillsDg), 
    at=seq_along(unique(my1$skillsDg)), las=2, line=-4) 
# Then we apply a graphing function to each company: 
lapply(my2,function(x){ 
    par(mar=c(3,0,3,0)) 
    plot(NA, xlim=c(-max(my1$number),max(my1$number)), 
      ylim=c(1,nlevels(my1$skillsDg)),axes=F) 
    title(sub=x$company[1],line=1) 
    abline(h=seq_along(x$skillsDg), col="grey80") 
    polygon(x=c(x$number,rev(-1*x$number)), 
      y=c(seq_along(x$skillsDg),rev(seq_along(x$skillsDg))), 
      col=as.numeric(x$company)) 
    }) 

enter image description here

编辑: 当然,你可以添加任何你想要在lapply的图形函数内部(但在某些情况下,这可能意味着改变图的尺寸):

layout(matrix(1:(length(my2)+1), nrow=1), width=c(1,rep(4,length(my2)))) 
par(mar=c(3,0,3,0)) 
plot(NA,axes=F, xlim=c(0,1),ylim=c(1,nlevels(my1$skillsDg))) 
axis(side=4,tick=F,labels=unique(my1$skillsDg), 
    at=seq_along(unique(my1$skillsDg)), las=2, line=-4) 
lapply(my2,function(x){ 
    par(mar=c(3,0,3,0)) 
    plot(NA, xlim=c(-max(my1$number)-50,max(my1$number)+50), 
     ylim=c(1,nlevels(my1$skillsDg)),axes=F) 
    title(sub=x$company[1],line=1) 
    abline(h=seq_along(x$skillsDg), col="grey80") 
    text(x=x$number+5, y=seq_along(x$skillsDg)+.1, label=x$number, pos=4) 
    polygon(x=c(x$number,rev(-1*x$number)), 
     y=c(seq_along(x$skillsDg),rev(seq_along(x$skillsDg))), 
     col=as.numeric(x$company)) 
    }) 

enter image description here

+0

太棒了!谢谢 !!我认为标签是按字母顺序缩短的 - 例如Exect遵循Basic,我认为数据点是正确的,只是标签 – rdorlearn

+2

我的不好。我纠正了它。我想使用这个事实,即这个类别是因素,但忘记了因素的默认值是按字母顺序排列的。 – plannapus

+1

只是小的要求(希望我不要求太多),我们可以在每个阶段添加数字,可能在每个教育级别的线路的右侧或左侧 – rdorlearn

1

不同的图表比你要求的,而是试图遵循一些共同的可视化原则:

library(ggplot2) 
mylabd$skillsDg <- factor(mylabd$skillsDg, levels = c("Basic", "HighSc", "Undgd", "MAST", "PHD", "EXPD", "EXECT")) 
p <- ggplot(data=mylabd, aes(x=skillsDg, y=number, fill = skillsDg)) 
p <- p + geom_bar(stat = "identity") + coord_flip() 
p <- p + facet_wrap(~ company, ncol = 1, nrow=3) 
plot(p) 

enter image description here

5

使用电网包,我们可以有这样的东西:

enter image description here

mylabd <- data.frame (company = rep(c("A", "B", "C"), each = 7), 
         skillsDg = rep(c("Basic", "HighSc", "Undgd", "MAST", "PHD", "EXPD", "EXECT"), 3), 
         number = c(200, 100, 40, 30, 10, 0, 0, 
           220, 110, 35, 10, 0, 4, 1, 
           140, 80, 120, 50, 52, 52, 3) 
) 



## to comapre we need o have the same scales for all organizations 
nskills <- nlevels(mylabd$skillsDg) 
ncompany <- nlevels(mylabd$company) 
barYscale <- c(0, nskills) * 1.05 
barXscale <- c(0, max(mylabd$number))* 1.05 
## the global scene 
vp <- plotViewport(c(5, 4, 4, 1), 
        yscale = barYscale, 
        layout = grid.layout(nrow=1,ncol=nbars)) 

pushViewport(vp) 
grid.rect() 
grid.yaxis(at=c(1:nlevels(mylabd$skillsDg)),label=unique(mylabd$skillsDg)) 
grid.grill() 

## split data by companya 
data.splitted <- split(mylabd,f=mylabd$company) 
lapply(1:3,function(company){ 

    x <- data.splitted[[company]] 
    vv <- x$number 
    companyName <- unique(x$company) 

    pushViewport(viewport(layout.pos.col=company,  
         xscale = barXscale, 
         yscale = barYscale)) 
    grid.rect() 
# grid.xaxis(at= mean(x$number),label = companyName) 
    grid.xaxis() 
    grid.polygon(x = unit.c(unit(0.5,'npc')-unit(vv/2,'native'), 
          unit(0.5,'npc')+unit(rev(vv)/2,'native')), 
       y = unit.c(unit(1:nmeasures,'native'), 
          unit(rev(1:nmeasures),'native')), 
       gp=gpar(fill = rainbow(nmeasures)[company])) 
    grid.polygon(x = unit.c(unit(0.5,'npc')-unit(vv/2,'native'), 
          unit(0.5,'npc')+unit(rev(vv)/2,'native')), 
       y = unit.c(unit(1:nmeasures,'native'), 
          unit(rev(1:nmeasures),'native')), 
       id = c(1:nmeasures,rev(1:nmeasures)), 
       gp=gpar(fill = NA)) 

    grid.text(x = unit(0.5,'npc'), 
      y = unit(0.5,'native'), 
      label = unique(x$company)) 

    popViewport() 

}) 

popViewport() 
+0

+1非常好! – rdorlearn