网络分析-入门实验 R语言-igraph-斯坦福大学

文章原来地址来源:https://sna.stanford.edu/lab.php?l=1
入门实验室
#这个实验的重点是向学生介绍两个包SNA和 Igraph,以涵盖一些基本的R命令,加载和管理数据,以生成图形可视化,并导出数据在别处使用。

所有需要安装的包的地址如下,建议直接安装
source(“http://sna.stanford.edu/setup.R“)

install.packages("ergm", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("reshape", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("igraph", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("sna", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("numDeriv", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("MatchIt", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("coin", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("boot", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("Hmisc", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("lattice", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("triads", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("psych", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("nFactors", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("animation", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("NetData", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("NetCluster", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)
install.packages("igraphtosonia", repos = "http://cran.cnr.berkeley.edu/", dependencies = TRUE)

第一个实验需要加载包

library(igraph)

如果需要把这个包删除请执行

detach(package:igraph)

第一步 导入数据

用这个函数read.table()

advice_data_frame <- read.table('http://sna.stanford.edu/sna_R_labs/data/Krack-High-Tec-edgelist-Advice.txt')
friendship_data_frame <- read.table('http://sna.stanford.edu/sna_R_labs/data/Krack-High-Tec-edgelist-Friendship.txt')
reports_to_data_frame <- read.table('http://sna.stanford.edu/sna_R_labs/data/Krack-High-Tec-edgelist-ReportsTo.txt')

如果你的数据是个文件,放在某个地方,可以这样做

setwd('path/to/your_directory')
your_data_frame <- read.table('your_file_name')

看数据表的前6行

head(friendship_data_frame)

或者后6行

tail(reports_to_data_frame)

或者以表格的形式打开

fix(reports_to_data_frame)

如何读取csv格式表格

attributes <- read.csv('http://sna.stanford.edu/sna_R_labs/data/Krack-High-Tec-Attributes.csv', header=T)
attributes

分隔文本的文件如何打开,通过设置SEP达到目的

f <- read.delim("tab_delimited_file.txt")
f <- read.delim("colon_delimited_file.txt", sep=':')

同理 read.spss() 读取spss文件
STATA files via read.dta().
数据直接来自文件包里的时候,data(kracknets, package = “NetData”)

第二步 载入数据
将标题的名字换一个

colnames(advice_data_frame) <- c('ego', 'alter', 'advice_tie')
head(advice_data_frame)
colnames(friendship_data_frame) <- c('ego', 'alter', 'friendship_tie')
head(friendship_data_frame) 
colnames(reports_to_data_frame) <- c('ego', 'alter', 'reports_to_tie')
head(reports_to_data_frame)
fix(advice_data_frame)
fix(friendship_data_frame)
fix(reports_to_data_frame)

验证每张表相同参数的字段是否一致

advice_data_frame$ego == friendship_data_frame$ego
which(advice_data_frame$ego != friendship_data_frame$ego)
which(advice_data_frame$alter != friendship_data_frame$alter)
which(reports_to_data_frame$alter != friendship_data_frame$alter)
which(reports_to_data_frame$ego != friendship_data_frame$ego)

合并到一张表

krack_full_data_frame <- cbind(advice_data_frame, 
    friendship_data_frame$friendship_tie, 
    reports_to_data_frame$reports_to_tie)
head(krack_full_data_frame)
names(krack_full_data_frame)[4:5] <- c("friendship_tie", 
    "reports_to_tie")  
head(krack_full_data_frame)

另外一种方式合并

krack_full_data_frame <- data.frame(ego = advice_data_frame[,1],
    alter = advice_data_frame[,2],
    advice_tie = advice_data_frame[,3],
    friendship_tie = friendship_data_frame[,3], 
    reports_to_tie = reports_to_data_frame[,3])
head(krack_full_data_frame)

把数据集中没有共同边的数据直接去掉了 (至少有一个大于0 )
逻辑运算:
&,|,!。(与,或,非。)

krack_full_nonzero_edges <- subset(krack_full_data_frame, 
    (advice_tie > 0 | friendship_tie > 0 | reports_to_tie > 0))
head(krack_full_nonzero_edges)

导入数据到graph图表,默认前两列是图的节点,后面的参数是边的属性。

krack_full <- graph.data.frame(krack_full_nonzero_edges) 
summary(krack_full)

为了得到边的特性用到get.edge.attribute函数,其实还是最后一列的数据
只是单独提取出来了。

get.edge.attribute(krack_full, 'advice_tie')
get.edge.attribute(krack_full, 'friendship_tie')
get.edge.attribute(krack_full, 'reports_to_tie')

as.undirected()改成无向图,把不对称的图形变成对称的图形

krack_full_symmetrized <- as.undirected(krack_full, mode='collapse')
summary(krack_full_symmetrized)

第三部分 把顶点的信息添加到图中
iterate
将属性添加到图形对象的一种方法是迭代,通过每个属性和每个顶点。 这意味着我们会,一次添加一个属性到网络中的每个顶点。

for (i in V(krack_full)) {
    for (j in names(attributes)) {
        krack_full <- set.vertex.attribute(krack_full, 
                                           j, 
                                           index = i, 
                                           attributes[i + 1, j])
    }
}

只读属性名称
attributes = cbind(1:length(attributes[,1]), attributes)krack_full <- graph.data.frame(d = krack_full_nonzero_edges,
vertices = attributes)
summary(krack_full)
点的信息

get.vertex.attribute(krack_full, 'AGE')
get.vertex.attribute(krack_full, 'TENURE')
get.vertex.attribute(krack_full, 'LEVEL')
get.vertex.attribute(krack_full, 'DEPT')  

第四部、可视化网络图

画个简单的图形,设置出图形的存储位置。

setwd("")
pdf("1.1_Krackhardt_Full.pdf")
plot(krack_full)
dev.off()

单个因素的无向图的 绘制
advice only

krack_advice_only <- delete.edges(krack_full, 
    E(krack_full)[get.edge.attribute(krack_full,
    name = "advice_tie") == 0])
summary(krack_advice_only)
pdf("1.2_Krackhardt_Advice.pdf")
plot(krack_advice_only)
dev.off()

同理
friendship only

krack_friendship_only <- delete.edges(krack_full, 
    E(krack_full)[get.edge.attribute(krack_full, 
    name = "friendship_tie") == 0])
summary(krack_friendship_only)
pdf("1.3_Krackhardt_Friendship.pdf")
plot(krack_friendship_only)
dev.off() 

reports-to only
同理

krack_reports_to_only <- delete.edges(krack_full, 
    E(krack_full)[get.edge.attribute(krack_full, 
    name = "reports_to_tie") == 0])
summary(krack_reports_to_only)
pdf("1.4_Krackhardt_Reports.pdf")
plot(krack_reports_to_only)
dev.off()

*****the layout algorithm
chterman-Rheingold*****重点内容**

reports_to_layout <- layout.fruchterman.reingold(krack_reports_to_only)
pdf("1.5_Krackhardt_Reports_Fruchterman_Reingold.pdf")
plot(krack_reports_to_only, 
     layout=reports_to_layout)
dev.off()

现在让我们按部门对顶点进行颜色编码并清理
通过去除顶点标签并缩小箭头大小来绘制阴谋。

dept_vertex_colors = get.vertex.attribute(krack_full,"DEPT")
colors = c('Black', 'Red', 'Blue', 'Yellow', 'Green')
dept_vertex_colors[dept_vertex_colors == 0] = colors[1]
dept_vertex_colors[dept_vertex_colors == 1] = colors[2]
dept_vertex_colors[dept_vertex_colors == 2] = colors[3]
dept_vertex_colors[dept_vertex_colors == 3] = colors[4] 
dept_vertex_colors[dept_vertex_colors == 4] = colors[5]

pdf("1.6_Krackhardt_Reports_Color.pdf") 
plot(krack_reports_to_only, 
    layout=reports_to_layout, 
    vertex.color=dept_vertex_colors, 
    vertex.label=NA, 
    edge.arrow.size=.5)
dev.off() 

设置顶点的大小

tenure_vertex_sizes = get.vertex.attribute(krack_full,"TENURE")
pdf("1.7_Krackhardt_Reports_Vertex_Size.pdf") 
plot(krack_reports_to_only, 
     layout=reports_to_layout, 
     vertex.color=dept_vertex_colors, 
     vertex.label=NA, 
     edge.arrow.size=.5,
     vertex.size=tenure_vertex_sizes)
dev.off() 

advice and friendship ties in red and blue.
给其他两个属性添加颜色

tie_type_colors = c(rgb(1,0,0,.5), rgb(0,0,1,.5), rgb(0,0,0,.5))
E(krack_full)$color[ E(krack_full)$advice_tie==1 ] = tie_type_colors[1]
E(krack_full)$color[ E(krack_full)$friendship_tie==1 ] = tie_type_colors[2]
E(krack_full)$color[ E(krack_full)$reports_to_tie==1 ] = tie_type_colors[3]
E(krack_full)$arrow.size=.5 
V(krack_full)$color = dept_vertex_colors
V(krack_full)$frame = dept_vertex_colors

pdf("1.8_Krackhardt_Overlayed_Ties.pdf")
plot(krack_full, 
     layout=reports_to_layout, 
     vertex.color=dept_vertex_colors, 
     vertex.label=NA, 
     edge.arrow.size=.5,
     vertex.size=tenure_vertex_sizes)

添加图例

legend(1, 
       1.25,
       legend = c('Advice', 
                  'Friendship',
                  'Reports To'), 
       col = tie_type_colors, 
       lty=1,
       cex = .7)
dev.off() 

另外一种方式显示数据结构布局和最终的图形数据换一个参考标准

pdf("1.9_Krackhardt_Overlayed_Structure.pdf")
plot(krack_friendship_only, 
     layout=reports_to_layout, 
     vertex.color=dept_vertex_colors, 
     vertex.label=NA, 
     edge.arrow.size=.5,
     vertex.size=tenure_vertex_sizes, 
     main='Krackhardt High-Tech Managers')
dev.off() 

第五部分 导出这个网络图的数据

write.graph(krack_full, file='krack_full.dl', format="pajek")
write.graph(krack_full, file='krack_full.txt', format="edgelist")
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值