0

我有数据框

test <- structure(list(
     y2002 = c("freshman","freshman","freshman","sophomore","sophomore","senior"),
     y2003 = c("freshman","junior","junior","sophomore","sophomore","senior"),
     y2004 = c("junior","sophomore","sophomore","senior","senior",NA),
     y2005 = c("senior","senior","senior",NA, NA, NA)), 
              .Names = c("2002","2003","2004","2005"),
              row.names = c(c(1:6)),
              class = "data.frame")
> test
       2002      2003      2004   2005
1  freshman  freshman    junior senior
2  freshman    junior sophomore senior
3  freshman    junior sophomore senior
4 sophomore sophomore    senior   <NA>
5 sophomore sophomore    senior   <NA>
6    senior    senior      <NA>   <NA>

我想创建一个应该类似于下面丑陋的文字艺术的图表：

freshman ---- junior ----------------------\

freshman ---- junior --- sophomore -------- senior

sophomore ================================/

senior ---------------------------------/

换句话说，我需要在图表中显示通往“高级”的可能路径，根据使用该路径的案例数量为边赋予权重。

第一次尝试 此代码生成一个图形，但与上面的文本艺术不同。

library(igraph)
elist <- lapply(seq_len(nrow(test)), function(i) {
  x <- as.character(test[i,])
  x <- unique(na.omit(x))
  x <- rep(x, each=2)
  x <- x[-1]
  x <- x[-length(x)]
  r <- matrix(x, ncol=2, byrow=TRUE)
  if (nrow(r) > 0) { r <- cbind(r, i) } else { r <- cbind(r, numeric()) }
  r
})

result <- as.data.frame(do.call(rbind, elist))
names(result) <- c("vertex","edge", "id")
categories <- data.frame(name=c("freshman","junior","sophomore","senior"))
g <- graph.data.frame(result,directed=T,vertices=categories)
g <- set.edge.attribute(g, "weight", value=runif(ecount(g))*10)
igraph.par("plot.layout", layout.reingold.tilford)
plot(g, vertex.label=categories$name, vertex.label.dist=7, 
     edge.width=get.edge.attribute(g,"weight"), edge.arrow.size=1.5)

结果（不是我想要的）

结果图像

**这个问题与这篇文章有关*

**而这篇文章是解决这个问题的必要步骤*

4

2 回答 2

3

这是一个完全可行的解决方案。必须自下而上阅读图表，记住每个人都被表示为代表他们职业道路的垂直线。是的，我确实为这项任务放弃了 iGraph。\o/

在此处输入图像描述

require(reshape2)

meltpath <- function(x){
  require(data.table)
  x <- melt(data = x, id.vars = 'id', measure.vars = names(x)[-1])
  names(x) <- c('id','year','category')
  x$year <- factor(x$year)
  id <- unique(x$id)
  idtable <- data.table(id = id, count = 1:length(id))
  x <- x[order(x$id), ]
  x <- merge(x, idtable, by='id')
  return(x)
}

carpath <- function(datatable, max_x = max(datatable$count)){
  require(ggplot2)
  p = ggplot(datatable, aes(x = count, y = year, fill = category)) + 
    geom_tile() +
    scale_y_discrete(name = "year\n", 
                     breaks = rev(levels(datatable$year))) + 
    scale_x_continuous(name = "cumulative count", 
                      limits = c(0,max_x)) +
    guides(fill = guide_legend(title="Career stage\n",
                               reverse=TRUE)) +
    theme(panel.grid.major = element_blank(), 
         panel.background = element_blank(), 
         axis.ticks = element_blank(),
         plot.title = element_text(vjust = 1.2, face="bold", size=20),
         axis.title.y = element_text(size=15, face="bold"),
         axis.text.y = element_text(size=15, colour="black"),
         legend.title = element_text(size = 15),
         legend.text = element_text(size = 15)) +
         scale_fill_brewer(palette = "Dark2") +
    ggtitle("Career path of individual Students by year")
  p
}

test <- structure(list(
  id = 1:6,
  y2002 = c("freshman","freshman","freshman","sophomore","sophomore","senior"),
  y2003 = c("freshman","junior","sophomore","sophomore","sophomore","senior"),
  y2004 = c("junior","sophomore","sophomore","senior","senior",NA),
  y2005 = c("senior","senior","senior",NA, NA, NA)), 
                  .Names = c("id","2002","2003","2004","2005"),
                  row.names = c(c(1:6)),
                  class = "data.frame")
# Grow dataset
testg = data.frame()
for (i in rownames(test)) {
  test0 <- test[rep(i, each=abs(floor(rnorm(1)*100))),]
  testg <- rbind(testg, test0)
}
testg$id <- 1:nrow(testg)
# Munge
test0 <- testg
test1 <- melt(data = test0, id.vars = 'id', measure.vars = names(test0)[-1])
names(test1) <- c('id','year','category')
test1$category[test1$category == 'freshman'] <- 1
test1$category[test1$category == 'junior'] <- 2
test1$category[test1$category == 'sophomore'] <- 3
test1$category[test1$category == 'senior'] <- 4
test1$category <- factor(test1$category, levels=1:4, labels = c('1. freshman','2. junior','3. sophomore','4. senior'))
test1 <- test1[order(test1$category), ]
test1 <- dcast(test1, id ~ year)
test1 <- test1[order(test1$'2005',test1$'2004',test1$'2003',test1$'2002'), ]
test2 <- meltpath(test1)
carpath(test2)
于 2012-11-30T02:30:46.800 回答
2

我认为您并不完全了解您在做什么，在您的图表示例草图中，您有 8 个节点。但是在您制作的图中，您只有 4 个节点。这是因为在您创建的图表中，您只有 4 个节点。igraph将处理具有相同名称的节点（例如，两个大二学生作为同一个节点但有两条边）

但是，一旦您制作了具有多个大二等节点的图表。例如大二1和大二。然后，您可以将节点放置在您想要的位置，layout如下所示

 df<- read.table(text="vertex edge weight
 freshman junior 2
 junior    senior 2
 freshman2 junior2 2
 junior2 sophomore 2
 sophomore senior 2
 sophomore2 senior 3
 senior2   senior 2",header=TRUE)
 categories <-data.frame(name=c("freshman","junior","sophomore","senior","freshman2",
 "junior2","sophomore2","senior2"))

g <- graph.data.frame(df,directed=T,vertices=categories)
layOUT<-data.frame(x=c(1,2,3,4,1,2,1,1),y=c(4,4,3,3,3,3,2,1))
l<-as.matrix(layOUT)
plot(g,layout=l)

在此处输入图像描述

于 2012-09-12T10:46:56.683 回答