作業九:實作(HTML檔) 作業說明
網絡分析實作 資料:Task1.RData (igraph format)

說明:Records of contacts among patients and various types of health care workers in the geriatric unit of a hospital in Lyon, France, in 2010, from 1pm on Monday, December 6 to 2pm on Friday, December 10. Each of the 75 people in this study consented to wear RFID sensors on small identification badges during this period, which made it possible to record when any two of them were in face-to-face contact with each other (i.e., within 1-1.5 m of each other) during a 20-second interval of time. 節點屬性 Status codes: ADM (行政人員)、MED (醫師)、NUR(護理人員)、PAT (病人) 線段屬性 Time (接觸時間,單位: 秒)

題目:計算該醫院內各類型人員接觸網絡的 weighted degree centrality (以接觸時間為權重)

1. input data

#install.packages("lubridate")
rm(list=ls(all=TRUE))
library(igraph)
library(sna)
library(knitr)
library(lubridate)
setwd("~/Downloads/Data")
load("Task1.RData")
rfid #網絡的圖資料
## IGRAPH efde728 U--- 75 32424 -- RFID hospital encounter network
## + attr: name (g/c), Citation (g/c), Status (v/c), Time (e/n)
## + edges from efde728:
##  [1] 15--31 15--22 15--16 15--16 16--22 16--22 16--22 16--22 16--22 11--16
## [11] 11--22 11--22 11--22 11--22 11--22 11--22 11--22 11--22 11--22 11--22
## [21] 11--22 15--16 11--22 11--16 15--16 11--16 15--16 11--16 11--16 14--22
## [31] 14--22 14--22  3--37  3--37 15--22 15--22 15--22  3--37  3--37  5--37
## [41]  3--37  3-- 6  3--37  5-- 7  5-- 7  5--37  1--20  3-- 5  3--37  1--17
## [51]  3--37  8--17 17--37 31--37  3--37  5--17  8--17  8--37  5--31  8--17
## [61]  5--31  6--37 23--31  5--31  8--17  5--23 23--37 10--13  5--31  1-- 6
## [71]  8--17  5--37 23--37  8--23 17--23  8--17 23--37  8--23 17--37 17--23
## + ... omitted several edges
V(rfid) #點資料 V=vertex
## + 75/75 vertices, from efde728:
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [26] 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
## [51] 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
PL=V(rfid)$Status
table(PL)
## PL
## ADM MED NUR PAT 
##   8  11  27  29
plot(rfid)

#plot(PL)

#E(rfid)$Time
Statuslist <- c("ADM","MED","NUR","PAT")
meanlist <- c()
Varlist <- c()


for (i in c(1: length(Statuslist) )){
ma <- which(V(rfid)$Status == Statuslist[i])
g1=rfid
# we want a sub-network containing the floowing nodes:
subv <- ma
# first method: 
# create a sub-network composed by ONLY the nodes in subv and the edges
# between them
g2 <- induced.subgraph(graph=g1,vids=subv)
V(g2)$name <-ma
plot(g2,edge.width=(E(g2)$Time)*0.000005,edge.color="darkred",main=paste("The Contact Network within ",Statuslist[i]))
edge_attr(g2)
E(g2)$Time
m<- get.adjacency(g2)
m1 <- as.matrix(m)

# 中心性度數 Degree:Weighted centrality
#考慮線段的權重(使用接觸時間加權計算)
d1 <- degree(m1,ignore.eval=F) #should edge values be ignored when computing degree scores?
var(d1)
mean(d1)

meanlist[i]=mean(d1)
Varlist[i]=var(d1)
}

OPTable <- rbind(meanlist,Varlist)
colnames(OPTable) <- Statuslist
rownames(OPTable) <- c("Mean","Var")
knitr::kable(OPTable)
ADM MED NUR PAT
Mean 139.50 2058.182 1880.741 28.82759
Var 43684.29 1477101.964 3115397.584 2718.71921