在图中绘制职业道路 [英] Plotting career path in graph
问题描述
我有dataframe
test< - structure（list（
y2002 = c（freshman ，新生，新生，大二，大二，高年级），
y2003 = c（新生，初中， 高级），
y2004 = c（初级，大二，大二，高级，高级，不适用），
y2005 = c（高级， ），
.Names = c（2002，2003，2004，2005），
row.names = c（ c（1：6）），
class =data.frame）
>测试
2002 2003 2004 2005
1大一新生初中高中
2新生初中二年级高中
3新生初中二年级高中
4二年级大二高年级< NA>
5二年级大二高年级< NA>
6名高级资深< NA> < NA>
我想创建一个图形，它应该类似下面的丑陋文字图形：
大一新生----初中---------------------- \
新生----初中---大二--------高中
大二=============== ================= /
高级----------------------- ---------- /
换句话说，我需要在绘制可能的路径为高级，根据使用该路径的案例数量给边权。
第一次尝试
这段代码会生成一个图表，但不是与上面的文字相似的图表。
library（ （测试）），函数（i）{
x< - as.character（test [i，]）
x< - 独特的（na.omit（x））
x <-rep（x，each = 2）
x < - x [-1]
x < - x [-length（x）]如果（nrow（r）> 0）{
r< - 矩阵（x，ncol = 2，byrow = TRUE） r < - cbind（r，i）} else {r < - cbind（r，numeric（））}
r
}）
结果< - as。 data.frame（do.call（rbind，elist））
名称（结果）< -c（vertex，edge，id）
categories< - data.frame（名称= c（新生，初级，大二，高级））
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）
结果（不是我想要的）
* *此问题与此帖子 *
**和 这是一个完全解决方案。一个人必须自己读下面的图表，记住每个人都是代表他们职业生涯路径的垂直线。是的，我确实沟通了iGraph完成这项任务。 \o / I have the dataframe and I want to create a graph that should resemble the ugly text art below: In other words, I need to show in a graph the possible paths to "senior", giving weights to edges according to the number of cases using that path. First attempt
This code generates a graph, but not one similar to the text art above. Result (not what I wanted) **This question is related to this post* **And this post is a necessary step for solving this question* This is a completely worked out solution. One has to read the graph bottom up, bearing in mind that each individual is represented as a vertical line that represents their career path. Yes, I did ditch iGraph for this task. \o/
这篇关于在图中绘制职业道路的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
require（reshape2）
熔丝路径< - function（x）{
require data.table）
x< - melt（data = x，id.vars ='id'，measure.vars = names（x）[ - 1]）$ b $ b 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 =' （数据表，max_x = max（数据表$ count））{
要求（ggplot2））
return（x）
}
carpath<
p = ggplot（datatable，aes（x = count，y = year，fill = category））+
geom_tile（）+
scale_y_discrete（name =year \\\
，
breaks = rev（levels（datatable $ year）））+
scale_x_continuous（name =cumulative count，
limits = c（0，m （panel_grid.major = element_blank（），
guides）（fill = guide_legend（title =职业阶段\ n，
reverse = TRUE））+
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，color =black），
legend .title = element_text（size = 15），
legend.text = element_text（size = 15））+
scale_fill_brewer（palette =Dark2）+
ggtitle学生年份）
p
}
test< - 结构（列表（
id = 1：6，
y2002 = c（新生大一，大一，大二，大四，大二），
y2003 = c（新生，大三，大二 ，高级），
y2004 = c（初级，大二，大二，se nior，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）
$增长数据集
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]）$ b $ b名称（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。大一， 2。初级， 3。大二， 4。高级'））
test1 < - test1 [order（test1 $ category），]
test1 <-dcast（test1，id_ year）
test1< - test1 [order test1 $'2005'，test1 $'2004'，test1 $'2003'，test1 $'2002'），]
test2< - melpath（test1）
carpath（test2）
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)
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)
