W8&9_TYP友誼網絡練習
楊庭宇_0063
2025-04-07
W8練習
TYP - Friendship Network in a Junior high School Class
資料檔變項描述：
- Classid：班級id
- Id1：個人id
- Gender：性別(1：男生，0：女生)
- W1F1-W1F3：國一時期依友好順序提名的三位好友(0、99998、99999為缺失值)
- W2F1-W2F3：國二時期依友好順序提名的三位好友(0、99998、99999為缺失值)
- W3F1-W3F3：國三時期依友好順序提名的三位好友(0、99998、99999為缺失值)
- AS_GRA1-AS_GRA3：分別為國一、國二、國三時期在班級內的排名，1-5，分數愈高，表排名在班級的愈前面，亦即，分數愈高，成績愈好。(空白為缺失值)
- DEP_Y1-DEP_Y3：分別為國一、國二、國三時期的該名學生的憂鬱分數，分數愈高，愈憂鬱。(空白為缺失值)
- SE_W1-SE_W3：分別為國一、國二、國三時期的該名學生的自尊分數，分數愈高，自尊愈好。(空白為缺失值)
- PEDU：父親教育程度，分數愈高，表示父親的教育程度愈高。(空白為缺失值)
- FSES：家庭社經階級，分數愈高，表家庭的社經階級愈高。(空白為缺失值)
請使用以上資料完成以下練習：
- 1.請將你拿到的資料，包含網絡資料以及個人屬性變項匯至R軟中(請記得宣告缺失值)，請利用head和tail語法印出你的資料檔。
url1 <- "C:/Users/user/OneDrive/桌面/輔仁大學/113-2課程/社會網絡(選)/TYP友誼網絡練習/c1141414.csv"
class_attributes <- read.csv(file = url1, na.strings = c("", "0", "99998", "99999"))head(class_attributes)## CLASSID id1 GENDER W1F1 W1F2 W1F3 W2F1 W2F2 W2F3 W3F1 W3F2 W3F3
## 1 1141414 10171 1 10176 10174 10172 10203 NA NA NA NA NA
## 2 1141414 10172 1 NA 10171 NA NA 10174 10171 10199 10203 10186
## 3 1141414 10173 NA 10179 NA 10196 10195 10197 10182 10195 10182 10197
## 4 1141414 10174 1 10172 10203 NA 10203 10172 10204 NA 10202 NA
## 5 1141414 10175 1 10186 NA 10174 10199 10186 10174 10199 10186 10171
## 6 1141414 10176 1 10171 NA NA NA 10171 10185 10189 10171 10203
## AS_GRA1 AS_GRA2 AS_GRA3 DEP_Y1 DEP_Y2 DEP_Y3 SE_W1 SE_W2 SE_W3 PEDU FSES
## 1 4 4 NA 22 27 31 18 19 19 5 12
## 2 1 1 NA 18 20 19 18 17 16 2 10
## 3 1 1 2 17 20 29 19 18 18 4 9
## 4 4 4 NA 24 21 26 20 19 18 3 12
## 5 1 2 NA 30 45 41 19 12 10 3 8
## 6 4 4 NA 25 23 29 16 21 15 6 15tail(class_attributes)## CLASSID id1 GENDER W1F1 W1F2 W1F3 W2F1 W2F2 W2F3 W3F1 W3F2 W3F3
## 32 1141414 10202 1 NA 10200 10189 10189 10186 10174 10174 10189 10186
## 33 1141414 10203 1 NA NA NA NA 10174 10171 10199 10174 NA
## 34 1141414 10204 NA NA NA NA 10187 10182 10174 10187 NA NA
## 35 1141414 10205 1 10207 10180 NA 10207 10178 10184 10207 10178 10184
## 36 1141414 10206 NA NA NA NA NA 10181 10187 10177 10198 NA
## 37 1141414 10207 1 10205 10199 10180 10205 NA NA 10205 NA 10180
## AS_GRA1 AS_GRA2 AS_GRA3 DEP_Y1 DEP_Y2 DEP_Y3 SE_W1 SE_W2 SE_W3 PEDU FSES
## 32 2 2 NA 19 18 19 16 17 21 4 11
## 33 3 3 NA 27 27 44 14 17 16 5 14
## 34 3 2 2 16 26 23 16 11 15 3 9
## 35 2 2 NA 21 23 24 20 21 18 NA NA
## 36 2 2 NA 25 27 34 15 12 13 1 7
## 37 3 2 NA 36 42 24 22 22 24 5 14- 2.請列出國一至國三期間憂鬱分數的描述性統計資料(最小值、最大值、中位數、平均數、標準差等)，請簡單說明這些學生在國一至國三期間的憂鬱變化。
library(psych)## Warning: 套件 'psych' 是用 R 版本 4.4.3 來建造的describe(class_attributes[, c("DEP_Y1", "DEP_Y2", "DEP_Y3")])## vars n mean sd median trimmed mad min max range skew kurtosis se
## DEP_Y1 1 35 23.77 6.02 23 23.34 5.93 16 36 20 0.57 -0.72 1.02
## DEP_Y2 2 37 24.35 6.83 24 23.61 7.41 16 45 29 1.09 1.09 1.12
## DEP_Y3 3 37 27.19 7.55 26 26.74 7.41 16 44 28 0.56 -0.70 1.24library(ggplot2)##
## 載入套件：'ggplot2'## 下列物件被遮斷自 'package:psych':
##
## %+%, alphalibrary(tidyr)
dep_data <- class_attributes[, c("DEP_Y1", "DEP_Y2", "DEP_Y3")]
dep_data_long <- pivot_longer(as.data.frame(dep_data),
cols = everything(),
names_to = "Year",
values_to = "Score")
dep_data_long$Year <- factor(dep_data_long$Year,
levels = c("DEP_Y1", "DEP_Y2", "DEP_Y3"),
labels = c("國一", "國二", "國三"))
ggplot(dep_data_long, aes(x = Year, y = Score)) +
geom_boxplot(fill = "skyblue") +
labs(title = "國一到國三憂鬱分數變化", x = "年級", y = "憂鬱分數")## Warning: Removed 2 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
根據描述性統計資料顯示，國一時期學生的平均憂鬱分數為23.77分，至國二略微上升至24.35分，並在國三進一步上升至27.19分。中位數也隨之上升，由國一的23分提升至國三的26分，顯示整體學生的憂鬱感受逐年加重。標準差方面，從國一的6.02分上升到國三的7.55分，代表學生之間的憂鬱分數差異逐漸擴大，個體差異性增強。最大值從國一的36分上升到國三的44分，顯示有部分學生的憂鬱程度在國三時期顯著惡化。綜上，學生憂鬱程度隨著年級提升逐步加重，顯示隨著學業壓力與未來升學壓力增加，學生心理健康狀態值得特別關注。- 3.請使用 鄰接列表（Adjacency List） 構建網絡，並繪製國三時期的網絡圖。
edges <- class_attributes[, c("id1", "W3F1", "W3F2", "W3F3")]
edges_long <- tidyr::pivot_longer(edges,
cols = starts_with("W3F"),
names_to = "tie_order",
values_to = "friend_id")
edges_long <- na.omit(edges_long)
edges_long## # A tibble: 77 × 3
## id1 tie_order friend_id
## <int> <chr> <int>
## 1 10172 W3F1 10199
## 2 10172 W3F2 10203
## 3 10172 W3F3 10186
## 4 10173 W3F1 10195
## 5 10173 W3F2 10182
## 6 10173 W3F3 10197
## 7 10174 W3F2 10202
## 8 10175 W3F1 10199
## 9 10175 W3F2 10186
## 10 10175 W3F3 10171
## # ℹ 67 more rowslibrary(igraph)##
## 載入套件：'igraph'## 下列物件被遮斷自 'package:tidyr':
##
## crossing## 下列物件被遮斷自 'package:stats':
##
## decompose, spectrum## 下列物件被遮斷自 'package:base':
##
## uniong <- graph_from_data_frame(edges_long[, c("id1", "friend_id")], directed = TRUE)
summary(g)## IGRAPH 6b39466 DN-- 36 77 --
## + attr: name (v/c)plot(g,
vertex.size = 15,
vertex.label.cex = 0.5,
edge.arrow.size = 0.5,
main = "國三友誼網絡圖")
- 4.請將鄰接列表（Adjacency List）轉換為 edgelist 格式並列印出來。
edgelist <- edges_long[, c("id1", "friend_id")]
print(as.data.frame(edgelist))## id1 friend_id
## 1 10172 10199
## 2 10172 10203
## 3 10172 10186
## 4 10173 10195
## 5 10173 10182
## 6 10173 10197
## 7 10174 10202
## 8 10175 10199
## 9 10175 10186
## 10 10175 10171
## 11 10176 10189
## 12 10176 10171
## 13 10176 10203
## 14 10177 10206
## 15 10177 10182
## 16 10178 10184
## 17 10178 10207
## 18 10178 10205
## 19 10179 10188
## 20 10179 10193
## 21 10180 10176
## 22 10181 10198
## 23 10182 10192
## 24 10182 10187
## 25 10183 10180
## 26 10183 10184
## 27 10183 10178
## 28 10184 10178
## 29 10185 10190
## 30 10185 10174
## 31 10185 10202
## 32 10186 10199
## 33 10186 10175
## 34 10187 10204
## 35 10187 10198
## 36 10188 10193
## 37 10188 10179
## 38 10189 10186
## 39 10189 10176
## 40 10190 10174
## 41 10190 10185
## 42 10191 10182
## 43 10191 10183
## 44 10191 10180
## 45 10192 10182
## 46 10192 10187
## 47 10193 10188
## 48 10193 10179
## 49 10193 10197
## 50 10194 10207
## 51 10194 10180
## 52 10195 10173
## 53 10197 10193
## 54 10197 10173
## 55 10198 10181
## 56 10198 10187
## 57 10198 10206
## 58 10199 10203
## 59 10199 10175
## 60 10199 10186
## 61 10200 10189
## 62 10200 10174
## 63 10200 10190
## 64 10201 10179
## 65 10202 10174
## 66 10202 10189
## 67 10202 10186
## 68 10203 10199
## 69 10203 10174
## 70 10204 10187
## 71 10205 10207
## 72 10205 10178
## 73 10205 10184
## 74 10206 10177
## 75 10206 10198
## 76 10207 10205
## 77 10207 10180W9練習
請繼續使用被分配到的TYP - Friendship Network in a Junior high School Class進行下列練習。
- 1.請將第一年的網絡資料轉換建立不帶標籤的邊列表。
# 載入所需套件
library(tidyr)
# 提取第一年資料
edges_w1 <- class_attributes[, c("id1", "W1F1", "W1F2", "W1F3")]
# 長格式轉換
edges_long_w1 <- pivot_longer(edges_w1,
cols = starts_with("W1F"),
names_to = "tie_order",
values_to = "friend_id")
# 移除缺失值
edges_long_w1 <- na.omit(edges_long_w1)
# 移除標籤欄位，只保留 sender → receiver
edgelist_w1_nolabel <- edges_long_w1[, c("id1", "friend_id")]
# 顯示前幾列
head(edgelist_w1_nolabel)## # A tibble: 6 × 2
## id1 friend_id
## <int> <int>
## 1 10171 10176
## 2 10171 10174
## 3 10171 10172
## 4 10172 10171
## 5 10173 10179
## 6 10173 10196- 2.使用list函數將國中三年的網絡資料建立為網絡清單(net list)。
# 建立一個函數：從某年份的 W1F1~W1F3 等欄位轉換為邊列表
create_edgelist <- function(data, from_id, friend_vars) {
edge_data <- data[, c(from_id, friend_vars)]
edge_long <- pivot_longer(edge_data,
cols = all_of(friend_vars),
names_to = "tie_order",
values_to = "friend_id")
edge_long <- na.omit(edge_long)
return(edge_long[, c(from_id, "friend_id")])
}
# 使用該函數處理國一、國二、國三
edge_w1 <- create_edgelist(class_attributes, "id1", c("W1F1", "W1F2", "W1F3"))
edge_w2 <- create_edgelist(class_attributes, "id1", c("W2F1", "W2F2", "W2F3"))
edge_w3 <- create_edgelist(class_attributes, "id1", c("W3F1", "W3F2", "W3F3"))
# 建立網絡清單（net list）
net_list <- list(year1 = edge_w1,
year2 = edge_w2,
year3 = edge_w3)
# 檢查網絡清單內容（顯示前幾筆）
lapply(net_list, head)## $year1
## # A tibble: 6 × 2
## id1 friend_id
## <int> <int>
## 1 10171 10176
## 2 10171 10174
## 3 10171 10172
## 4 10172 10171
## 5 10173 10179
## 6 10173 10196
##
## $year2
## # A tibble: 6 × 2
## id1 friend_id
## <int> <int>
## 1 10171 10203
## 2 10172 10174
## 3 10172 10171
## 4 10173 10195
## 5 10173 10197
## 6 10173 10182
##
## $year3
## # A tibble: 6 × 2
## id1 friend_id
## <int> <int>
## 1 10172 10199
## 2 10172 10203
## 3 10172 10186
## 4 10173 10195
## 5 10173 10182
## 6 10173 10197- 3.將三年網絡合併成一個 networkDynamic 物件，並列印出這個物件，簡單說明你的網絡資料中各個節點隨時間變動的狀況。
library(network)## Warning: 套件 'network' 是用 R 版本 4.4.3 來建造的##
## 'network' 1.19.0 (2024-12-08), part of the Statnet Project
## * 'news(package="network")' for changes since last version
## * 'citation("network")' for citation information
## * 'https://statnet.org' for help, support, and other information##
## 載入套件：'network'## 下列物件被遮斷自 'package:igraph':
##
## %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
## get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
## is.directed, list.edge.attributes, list.vertex.attributes,
## set.edge.attribute, set.vertex.attributelibrary(networkDynamic)## Warning: 套件 'networkDynamic' 是用 R 版本 4.4.3 來建造的##
## 'networkDynamic' 0.11.5 (2024-11-21), part of the Statnet Project
## * 'news(package="networkDynamic")' for changes since last version
## * 'citation("networkDynamic")' for citation information
## * 'https://statnet.org' for help, support, and other information# 將三年的邊列表加上時間資訊
edge_w1$onset <- 1; edge_w1$terminus <- 2
edge_w2$onset <- 2; edge_w2$terminus <- 3
edge_w3$onset <- 3; edge_w3$terminus <- 4
# 合併所有邊
all_edges <- rbind(edge_w1, edge_w2, edge_w3)
# 建立節點與對應索引
all_vertices <- unique(c(all_edges$id1, all_edges$friend_id)) # 所有出現過的 ID
id_index_map <- setNames(seq_along(all_vertices), all_vertices) # ID → index 對照表
tail_index <- id_index_map[as.character(all_edges$id1)]
head_index <- id_index_map[as.character(all_edges$friend_id)]
# 建立 networkDynamic 物件
base_net <- network.initialize(length(all_vertices), directed = TRUE)
set.vertex.attribute(base_net, "vertex.names", all_vertices)
dyn_net <- networkDynamic(base.net = base_net)## Warning in networkDynamic(base.net = base_net): neither edge or vertex data
## were included for network construction## Warning in min(x): min 中沒有無漏失的引數; 回傳 Inf## Warning in max(x): max 中沒有無漏失的引數；回傳 -Inf## Created net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: -Inf until Inf
## Temporal mode: discrete
## Time unit: step
## Suggested time increment: 1# 將邊加進 networkDynamic，並套上時間
add.edges.active(dyn_net,
tail = tail_index,
head = head_index,
onset = all_edges$onset,
terminus = all_edges$terminus)
summary(dyn_net)## Network attributes:
## vertices = 37
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## net.obs.period:
## Length Class Mode
## observations 1 -none- list
## mode 1 -none- character
## time.increment 1 -none- numeric
## time.unit 1 -none- character
## total edges = 213
## missing edges = 0
## non-missing edges = 213
## density = 0.1599099
##
## Vertex attributes:
## vertex.names:
## character valued attribute
## 37 valid vertex names
##
## Edge attributes:
##
## active:
## mixed class attribute
## 213 values
##
## Network edgelist matrix:
## [,1] [,2]
## [1,] 1 6
## [2,] 1 4
## [3,] 1 2
## [4,] 2 1
## [5,] 3 31
## [6,] 3 33
## [7,] 4 2
## [8,] 4 34
## [9,] 5 15
## [10,] 5 4
## [11,] 6 1
## [12,] 7 11
## [13,] 8 13
## [14,] 9 18
## [15,] 10 24
## [16,] 10 27
## [17,] 10 24
## [18,] 11 32
## [19,] 11 7
## [20,] 11 4
## [21,] 12 9
## [22,] 12 22
## [23,] 13 28
## [24,] 13 12
## [25,] 14 19
## [26,] 15 5
## [27,] 15 26
## [28,] 16 24
## [29,] 17 21
## [30,] 17 23
## [31,] 18 28
## [32,] 18 26
## [33,] 19 14
## [34,] 20 14
## [35,] 20 33
## [36,] 20 31
## [37,] 21 17
## [38,] 22 9
## [39,] 22 10
## [40,] 23 21
## [41,] 24 10
## [42,] 25 2
## [43,] 25 6
## [44,] 26 28
## [45,] 26 18
## [46,] 26 15
## [47,] 27 10
## [48,] 27 7
## [49,] 27 23
## [50,] 28 26
## [51,] 28 18
## [52,] 29 30
## [53,] 29 9
## [54,] 30 29
## [55,] 30 25
## [56,] 30 9
## [57,] 1 34
## [58,] 2 4
## [59,] 2 1
## [60,] 3 37
## [61,] 3 23
## [62,] 3 11
## [63,] 4 34
## [64,] 4 2
## [65,] 4 35
## [66,] 5 25
## [67,] 5 15
## [68,] 5 4
## [69,] 6 1
## [70,] 6 14
## [71,] 7 16
## [72,] 7 37
## [73,] 7 36
## [74,] 8 29
## [75,] 8 13
## [76,] 31 17
## [77,] 31 21
## [78,] 9 11
## [79,] 9 12
## [80,] 10 24
## [81,] 10 36
## [82,] 10 31
## [83,] 11 32
## [84,] 11 35
## [85,] 12 9
## [86,] 12 22
## [87,] 12 29
## [88,] 13 28
## [89,] 14 19
## [90,] 14 6
## [91,] 14 4
## [92,] 15 25
## [93,] 15 28
## [94,] 16 35
## [95,] 16 24
## [96,] 16 36
## [97,] 17 21
## [98,] 18 19
## [99,] 18 15
## [100,] 19 14
## [101,] 20 11
## [102,] 20 31
## [103,] 20 21
## [104,] 32 11
## [105,] 21 17
## [106,] 22 12
## [107,] 22 8
## [108,] 33 3
## [109,] 23 21
## [110,] 23 31
## [111,] 23 3
## [112,] 24 10
## [113,] 24 16
## [114,] 25 5
## [115,] 25 34
## [116,] 25 28
## [117,] 26 14
## [118,] 26 19
## [119,] 26 34
## [120,] 27 21
## [121,] 27 24
## [122,] 27 16
## [123,] 28 18
## [124,] 28 15
## [125,] 28 4
## [126,] 34 4
## [127,] 34 1
## [128,] 35 16
## [129,] 35 11
## [130,] 35 4
## [131,] 29 30
## [132,] 29 8
## [133,] 29 13
## [134,] 36 10
## [135,] 36 16
## [136,] 30 29
## [137,] 2 25
## [138,] 2 34
## [139,] 2 15
## [140,] 3 37
## [141,] 3 11
## [142,] 3 23
## [143,] 4 28
## [144,] 5 25
## [145,] 5 15
## [146,] 5 1
## [147,] 6 18
## [148,] 6 1
## [149,] 6 34
## [150,] 7 36
## [151,] 7 11
## [152,] 8 13
## [153,] 8 30
## [154,] 8 29
## [155,] 31 17
## [156,] 31 21
## [157,] 9 6
## [158,] 10 24
## [159,] 11 32
## [160,] 11 16
## [161,] 12 9
## [162,] 12 13
## [163,] 12 8
## [164,] 13 8
## [165,] 14 19
## [166,] 14 4
## [167,] 14 28
## [168,] 15 25
## [169,] 15 5
## [170,] 16 35
## [171,] 16 24
## [172,] 17 21
## [173,] 17 31
## [174,] 18 15
## [175,] 18 6
## [176,] 19 4
## [177,] 19 14
## [178,] 20 11
## [179,] 20 12
## [180,] 20 9
## [181,] 32 11
## [182,] 32 16
## [183,] 21 17
## [184,] 21 31
## [185,] 21 23
## [186,] 22 30
## [187,] 22 9
## [188,] 37 3
## [189,] 23 21
## [190,] 23 3
## [191,] 24 10
## [192,] 24 16
## [193,] 24 36
## [194,] 25 34
## [195,] 25 5
## [196,] 25 15
## [197,] 26 18
## [198,] 26 4
## [199,] 26 19
## [200,] 27 31
## [201,] 28 4
## [202,] 28 18
## [203,] 28 15
## [204,] 34 25
## [205,] 34 4
## [206,] 35 16
## [207,] 29 30
## [208,] 29 8
## [209,] 29 13
## [210,] 36 7
## [211,] 36 24
## [212,] 30 29
## [213,] 30 9本研究建立的 networkDynamic 物件包含：37 位學生（節點）、213 條友誼邊（導向性）、每條邊皆具有時間屬性，對應於國一至國三的友誼提名關係。
根據網絡結構與動態屬性可觀察到以下現象：
1.節點總數在三年間保持穩定，表示學生樣本無明顯流失，且網絡中的主要參與者大致固定。
2.邊的變化頻繁，每年提名的對象有明顯更動，部分學生在某一年間未出現提名（進出邊變動），顯示友誼關係具有動態性與階段性。
3.持續性的關係較少，大多數邊只存在於單一年級，顯示在國中階段友誼關係處於不穩定或重塑狀態。
4.密度為 0.16 左右，代表在整體潛在可連結中，實際發生的提名比例不高，符合現實中友誼關係具有選擇性與限制性的特性。- 4.計算三個年度的網絡密度和degree centrality。
# 建立函數：計算年度網絡的密度與中心性
analyze_network <- function(edge_df, year_label) {
g <- graph_from_data_frame(edge_df, directed = TRUE)
# 計算密度
net_density <- edge_density(g)
# 計算程度中心性（出度 + 入度）
degree_centrality <- degree(g, mode = "all")
# 顯示結果
cat(paste0("【", year_label, "】\n"))
cat("網絡密度：", round(net_density, 4), "\n")
cat("程度中心性（前10名）:\n")
print(sort(degree_centrality, decreasing = TRUE)[1:10])
cat("\n----------------------\n")
}
# 分析國一、國二、國三
analyze_network(edge_w1[, c("id1", "friend_id")], "國一")## 【國一】
## 網絡密度： 0.0499
## 程度中心性（前10名）:
## 10181 10200 10171 10174 10180 10189 10202 10172 10182 10186
## 6 6 5 5 5 5 5 4 4 4
##
## ----------------------analyze_network(edge_w2[, c("id1", "friend_id")], "國二")## 【國二】
## 網絡密度： 0.0601
## 程度中心性（前10名）:
## 10174 10187 10182 10185 10193 10202 10203 10204 10205 10173
## 9 8 7 6 6 6 6 6 6 5
##
## ----------------------analyze_network(edge_w3[, c("id1", "friend_id")], "國三")## 【國三】
## 網絡密度： 0.0611
## 程度中心性（前10名）:
## 10186 10199 10174 10178 10182 10187 10193 10198 10173 10175
## 7 7 6 6 6 6 6 6 5 5
##
## ----------------------- 5.將PEDU(父親教育程度)設為不隨時間變動的屬性資料。
# 建立節點 ID 與 PEDU 對應表
pedu_map <- class_attributes[, c("id1", "PEDU")]
# 將 networkDynamic 內部節點名稱提取出來（建立 ID → index 對照）
net_ids <- get.vertex.attribute(dyn_net, "vertex.names")
# 按照 network 中的節點順序匹配 PEDU 值
pedu_ordered <- pedu_map$PEDU[match(net_ids, pedu_map$id1)]
# 設定不隨時間變動的節點屬性（static vertex attribute）
set.vertex.attribute(dyn_net, "PEDU", pedu_ordered)
# 檢查結果
get.vertex.attribute(dyn_net, "PEDU")[1:10] # 顯示前 10 筆## [1] 5 2 4 3 3 6 1 4 3 4- 6.試著將三個年度的degree centrality以及SE_W1、SE_W2、SE_W3設為隨時間變動的屬性資料。
# 建立函數：計算出每位學生的 degree centrality
calc_degree <- function(edge_df, ids) {
g <- graph_from_data_frame(edge_df, directed = TRUE, vertices = ids)
deg <- degree(g, mode = "all")
return(deg)
}
# 所有節點名稱（networkDynamic 裡的順序）
vertex_ids <- get.vertex.attribute(dyn_net, "vertex.names")
# 三年度的 degree centrality（對齊 networkDynamic 的節點順序）
deg_y1 <- calc_degree(edge_w1[, c("id1", "friend_id")], vertex_ids)
deg_y2 <- calc_degree(edge_w2[, c("id1", "friend_id")], vertex_ids)
deg_y3 <- calc_degree(edge_w3[, c("id1", "friend_id")], vertex_ids)
se_map <- class_attributes[, c("id1", "SE_W1", "SE_W2", "SE_W3")]
se_w1 <- se_map$SE_W1[match(vertex_ids, se_map$id1)]
se_w2 <- se_map$SE_W2[match(vertex_ids, se_map$id1)]
se_w3 <- se_map$SE_W3[match(vertex_ids, se_map$id1)]
# degree centrality
activate.vertex.attribute(dyn_net, "degree", value = deg_y1, onset = 1, terminus = 2)
activate.vertex.attribute(dyn_net, "degree", value = deg_y2, onset = 2, terminus = 3)
activate.vertex.attribute(dyn_net, "degree", value = deg_y3, onset = 3, terminus = 4)
# 自尊分數
activate.vertex.attribute(dyn_net, "self_esteem", value = se_w1, onset = 1, terminus = 2)
activate.vertex.attribute(dyn_net, "self_esteem", value = se_w2, onset = 2, terminus = 3)
activate.vertex.attribute(dyn_net, "self_esteem", value = se_w3, onset = 3, terminus = 4)
# 檢查其中一位節點的屬性時間變化
get.vertex.attribute.active(dyn_net, "self_esteem", v = 1, at = 1:3)## [1] 18 17 18 20 12 15 18 21 15 19 16 20 NA 23 20 20 18 17 15 20 17 22 16 14 24
## [26] 20 16 16 21 24 22 23 14 14 11 13 20- 7.列印出你的網絡物件。
# 列印出 networkDynamic 物件的結構摘要
print(dyn_net)## NetworkDynamic properties:
## distinct change times: 4
## maximal time range: 1 until 4
##
## Dynamic (TEA) attributes:
## Vertex TEAs: degree.active
## self_esteem.active
##
## Includes optional net.obs.period attribute:
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: -Inf until Inf
## Temporal mode: discrete
## Time unit: step
## Suggested time increment: 1
##
## Network attributes:
## vertices = 37
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## net.obs.period: (not shown)
## total edges= 213
## missing edges= 0
## non-missing edges= 213
##
## Vertex attribute names:
## degree.active PEDU self_esteem.active vertex.names
##
## Edge attribute names:
## active- 8.試著固定節點位置，繪制國中三年的網絡圖，並使用par(mfrow = c(1, 3))，讓三張圖並排陳現。另外，請使用父親教育程度為節點著色，父親教育程度請重新編碼為2類，PEDU>=4為大學以上、PEDU<=3為高中及以下，請用父育教育程度2分類為節點上色。
# --- Step 1：建立 PEDU 兩類分類 (大學以上 vs 高中以下) ---
pedu_map <- class_attributes[, c("id1", "PEDU")]
pedu_map$PEDU_group <- ifelse(pedu_map$PEDU >= 4, "大學以上", "高中及以下")
# 對照 network 中的節點順序
vertex_ids <- get.vertex.attribute(dyn_net, "vertex.names")
pedu_group <- pedu_map$PEDU_group[match(vertex_ids, pedu_map$id1)]
# 指定顏色
color_map <- c("大學以上" = "steelblue", "高中及以下" = "tomato")
vertex_colors <- color_map[pedu_group]
# --- Step 2：建立三年 igraph 物件，並固定 layout ---
g1 <- graph_from_data_frame(edge_w1, directed = TRUE, vertices = data.frame(name = vertex_ids))
g2 <- graph_from_data_frame(edge_w2, directed = TRUE, vertices = data.frame(name = vertex_ids))
g3 <- graph_from_data_frame(edge_w3, directed = TRUE, vertices = data.frame(name = vertex_ids))
# 固定 layout（只用一次，三張圖共享）
fixed_layout <- layout_with_fr(g1)
# --- Step 3：繪圖設定與出圖 ---
par(mfrow = c(1, 3), mar = c(1, 1, 3, 1)) # 三圖並排、標題留空間
plot(g1,
layout = fixed_layout,
vertex.color = vertex_colors,
vertex.label = NA,
main = "國一網絡")
plot(g2,
layout = fixed_layout,
vertex.color = vertex_colors,
vertex.label = NA,
main = "國二網絡")
plot(g3,
layout = fixed_layout,
vertex.color = vertex_colors,
vertex.label = NA,
main = "國三網絡")