network analysis extra
Yang
5/24/2021
Network_HW5_ Centrality (Individual-level)
r09228001 臺大地理所碩一 楊宇翔 2021/05/24 (Mon.)
加分題：超級接觸者（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.
20秒為一個單位
節點屬性 Status codes: ADM (行政人員)、MED (醫師)、NUR(護理人員)、PAT (病人) 線段屬性 Time (接觸時間，單位: 秒)
計算該醫院內各類型人員在各時段(白天、晚上、深夜)的相互接觸型態(接觸人數與時間)。並討論當發生院內感染時 (e.g.COVID-19)，如何依照接觸型態找出「超級接觸者」，進行隔離措施。
定義時間： 白天：6:00-14:00 晚上：14:00-22:00 深夜：22:00-6:00 (day+1)
rm(list=ls(all=TRUE))
library(igraph)
library(sna)
library(knitr)
library(lubridate)
library(dplyr)Load data
setwd("~/Desktop/network model/network extra/Data 2")
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 edgesV(rfid) #點資料 Ｖ＝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 75PL=V(rfid)$Status
tP=table(PL)
tP## PL
## ADM MED NUR PAT
## 8 11 27 29barplot(tP,ylim=c(0,30), col="darkred",main="75 sensor holders' categories")
plot(rfid)
#E(rfid)$Timeㄧ、資料處理
建立兩種矩陣：接觸人數、接觸時間
m2 <- get.adjacency(rfid) #接觸的鄰近矩陣
m1 <- as.matrix(m2)
Statuslist <- c("ADM","MED","NUR","PAT") #建立種類別
meanlist <- c()#平均
Varlist <- c()#變異數#分早中晚
time_interval <-8*60*60 #每個時段8小時，最小單位是秒 。
hour <- seq(0,3600,20) # 每個小時有3600秒，每20秒為一次感測器的單位。
morning_time <- c(hour)
night_time <- c(seq(max(morning_time)+20,max(morning_time)+time_interval,20))
late_time <- c(seq(max(night_time)+20,max(night_time)+time_interval,20))
for(i in 1:3){
morning_time <- c(morning_time,seq(max(late_time)+20,max(late_time)+time_interval,20))
night_time <- c(night_time,seq(max(morning_time)+20,max(morning_time)+time_interval,20))
late_time <- c(late_time,seq(max(night_time)+20,max(night_time)+time_interval,20))
}
morning_time <- c(morning_time,seq(max(late_time)+20,max(late_time)+time_interval,20))
# 用自己創建的矩陣，去篩選時段
morning_index <- c()
night_index <- c()
late_index <- c()
for(i in 1:length(E(rfid)$Time)){
if(sum(E(rfid)$Time[i]==morning_time)>=1){
morning_index <- c(morning_index,i)
}else if(sum(E(rfid)$Time[i]==night_time)>=1){
night_index <- c(night_index,i)
}
else{
late_index <- c(late_index ,i)
}
}
#分時段：利用不同的時間段的index，利用函數 delete_edge，選出目標時段的graph edge。
morning<-delete_edges(rfid,c(night_index,late_index))
night<-delete_edges(rfid,c(morning_index,late_index))
late<-delete_edges(rfid,c(morning_index,night_index))
#用函數 get.adjacency把連線資料 edge改成關聯矩陣matrix。 Sparse=F，就是不要使用「稀疏矩陣」，也就是說，要把值為0的資料也呈現出來。
morning_matrix<-get.adjacency(morning,sparse = F)
night_matrix<-get.adjacency(night,sparse = F)
late_matrix<-get.adjacency(late,sparse = F)
#把原本標記行列座標的行列名稱，改欄位名稱，為醫療機構的四種不同人員類型。
#早上
colnames(morning_matrix) <- V(rfid)$Status
rownames(morning_matrix) <- V(rfid)$Status
#晚上
colnames(night_matrix) <- V(rfid)$Status
rownames(night_matrix) <- V(rfid)$Status
#深夜
colnames(late_matrix) <- V(rfid)$Status
rownames(late_matrix) <- V(rfid)$Status
# 製作資料表格 data frame
#6 am - 2pm
row <- rep(colnames(morning_matrix),75) #行：來源 #rep=75，是因為重複75次因為有75的醫院受試者。
col<-c()
for(i in 1:75){
col <- c(col,rep(colnames(morning_matrix)[i],75)) #列：接收者
}
mor_da<-as.vector(morning_matrix) #接觸時間
mor_data <- data.frame(
from = row,
to = col,
count = mor_da
)
#接觸時間
mor_group<- group_by(mor_data, from,to)
sum<-summarise(mor_group ,Time=sum(count*20))## `summarise()` has grouped output by 'from'. You can override using the `.groups` argument.mor_time <- matrix(sum$Time,ncol = 4,nrow=4)
colnames(mor_time) <- c("ADM","MED","NUR","PAT")
rownames(mor_time) <- c("ADM","MED","NUR","PAT")
diag(mor_time) <- diag(mor_time)/2 #因為會重複計算，所以除以2。
#接觸人數
mor_data_t <- mor_data[mor_data$count!=0,]
mor_peo<-table(mor_data_t$from,mor_data_t$to) #接觸的次數＝人數
diag(mor_peo)<-diag(mor_peo)/2 #因為會重複計算，所以除以2。
# 2pm - 10pm
row <- rep(colnames(night_matrix),75)
col<-c()
for(i in 1:75){
col <- c(col,rep(colnames(night_matrix)[i],75))
}
night_da<-as.vector(night_matrix)
night_data <- data.frame(
from = row,
to = col,
count = night_da
)
#接觸時間
night_group<- group_by(night_data, from,to)
sum<-summarise(night_group ,Time=sum(count*20))## `summarise()` has grouped output by 'from'. You can override using the `.groups` argument.night_time <- matrix(sum$Time,ncol = 4,nrow=4)
colnames(night_time) <- c("ADM","MED","NUR","PAT")
rownames(night_time) <- c("ADM","MED","NUR","PAT")
diag(night_time) <- diag(night_time)/2
#night_time
#接觸人數
night_data_t <- night_data[night_data$count!=0,]
night_peo<-table(night_data_t$from,night_data_t$to)
diag(night_peo)<-diag(night_peo)/2
# 10pm - 6am
row <- rep(colnames(late_matrix),75)
col<-c()
for(i in 1:75){
col <- c(col,rep(colnames(late_matrix)[i],75))
}
late_da<-as.vector(late_matrix)
late_data <- data.frame(
from = row,
to = col,
count = late_da
)
#接觸時間
late_group<- group_by(late_data, from,to) #?Group by=Group by one or more variables
sum<-summarise(late_group ,Time=sum(count*20))## `summarise()` has grouped output by 'from'. You can override using the `.groups` argument.late_time <- matrix(sum$Time,ncol = 4,nrow=4)
colnames(late_time) <- c("ADM","MED","NUR","PAT")
rownames(late_time) <- c("ADM","MED","NUR","PAT")
diag(late_time) <- diag(late_time)/2 #late_time
#接觸人數
late_data_t <- late_data[late_data$count!=0,]
late_peo<-table(late_data_t$from,late_data_t$to)
diag(late_peo)<-diag(late_peo)/21.1 白天接觸時間
mor_time## ADM MED NUR PAT
## ADM 5260 6400 37000 5060
## MED 6400 57820 28340 16920
## NUR 37000 28340 196980 103660
## PAT 5060 16920 103660 2360二、結果表格
1.2 白天接觸人數
mor_peo##
## ADM MED NUR PAT
## ADM 10 34 76 54
## MED 34 44 119 84
## NUR 76 119 144 245
## PAT 54 84 245 102.1 晚上接觸時間
night_time## ADM MED NUR PAT
## ADM 320 2780 14920 3760
## MED 2780 55380 7040 12500
## NUR 14920 7040 51980 25100
## PAT 3760 12500 25100 12002.2 晚上接觸人數
night_peo##
## ADM MED NUR PAT
## ADM 6 23 59 24
## MED 23 44 76 44
## NUR 59 76 133 157
## PAT 24 44 157 73.1 深夜接觸時間
late_time## ADM MED NUR PAT
## ADM 0 0 0 0
## MED 0 0 0 0
## NUR 0 0 4940 8140
## PAT 0 0 8140 6203.2 深夜接觸人數
late_peo##
## NUR PAT
## NUR 3 52
## PAT 52 3三、討論
回顧屬性代號與名稱的關係。ADM (行政人員)、MED (醫師)、NUR(護理人員)、PAT (病人)。從表上來看，在白天班的時候，病人跟護理人員的接觸人數最多，接觸時間來看，護理人員跟護理人員接觸的時間最多。晚上班的時候，病人跟護理人員的接觸人數最多。接觸時間來看，醫生跟醫生接觸的時間最多。大夜班的時候，病人跟護理人員的接觸人數最多，接觸時間來看，護理人員跟病人接觸的時間最多。
綜合來看，護理人員在大多的時間，是醫院裡接觸的人最多，且接觸時間最長的人員類別，因此最有可能是題意當中的「超級接觸者」，當Covid-19爆發時，可能有最高的風險，要進行隔離措施。
然而，拉回一開始的配戴感測器的人員選擇，ADM=8， MED＝11， NUR＝27 ，PAT ＝29 。這樣的選擇一開始就不平均，護理人員的選擇比醫師的兩倍還多，故這樣的研究設計，可能會導致具有偏見（bias）的結論，因此需要小心解釋。
.
.
作答完畢
r09228001 臺大地理所碩一 楊宇翔
.
.
結束