Phân tích mạng lưới các nhân vật trong "Tình yêu thực sự"


Vũ Từ Dung
3 năm trước
Hữu ích 5 Chia sẻ Viết bình luận 0
Đã xem 4374

Mỗi đêm Giáng sinh, gia đình tôi đều xem Love Thật . Về mặt khách quan, đây không phải là một bộ phim hay, đặc biệt, nhưng nó rất phù hợp với truyền thống ngày lễ. ( Vox đã đưa tôi trở lại đây .)

Ngay cả ở lần xem thứ tám hoặc thứ chín, thật ấn tượng với một mạng lưới các nhân vật phức tạp mà nó xây dựng. Điều này khiến tôi tự hỏi làm thế nào chúng ta có thể hình dung các kết nối một cách định lượng dựa trên tần suất các nhân vật chia sẻ cảnh. Vì vậy, trong khi gia đình tôi đang xem phim gần đây, tôi đã tải lên RStudio, tải xuống bản dịch và bắt đầu phân tích.

Phân tích cú pháp

Thật dễ dàng để sử dụng R để phân tích tập lệnh thô vào khung dữ liệu bằng cách sử dụng kết hợp dplyr , stringrtidyr . (Vì lý do pháp lý, tôi không muốn tự lưu trữ tệp tập lệnh, nhưng đó thực sự là kết quả đầu tiên của Google cho "Tập lệnh tình yêu thực sự." Chỉ cần sao chép .doc nội dung vào tệp văn bản có tên love_actually.txt.)

library(dplyr)
library(stringr)
library(tidyr)

raw <- readLines("love_actually.txt")

lines <- data_frame(raw = raw) %>%
    filter(raw != "", !str_detect(raw, "(song)")) %>%
    mutate(is_scene = str_detect(raw, " Scene "),
           scene = cumsum(is_scene)) %>%
    filter(!is_scene) %>%
    separate(raw, c("speaker", "dialogue"), sep = ":", fill = "left") %>%
    group_by(scene, line = cumsum(!is.na(speaker))) %>%
    summarize(speaker = speaker[1], dialogue = str_c(dialogue, collapse = " "))

Tôi cũng thiết lập một tệp CSV khớp các ký tự cho các tác nhân của chúng, mà bạn có thể đọc riêng. (Tôi đã chọn 20 nhân vật có vai trò đáng chú ý trong câu chuyện.)

cast <- read.csv(url("http://varianceexplained.org/files/love_actually_cast.csv"))

lines <- lines %>%
    inner_join(cast) %>%
    mutate(character = paste0(speaker, " (", actor, ")"))

Bây giờ, chúng ta có một khung dữ liệu gọn gàng với một hàng trên mỗi dòng, cùng với các cột mô tả số cảnh và ký tự:

Từ đây, thật dễ dàng để đếm các dòng trên mỗi cảnh trên mỗi ký tự và biến nó thành ma trận nhị phân giữa các loa.

by_speaker_scene <- lines %>%
    count(scene, character)

by_speaker_scene
## Source: local data frame [162 x 3]
## Groups: scene [?]
## 
##    scene                character     n
##    (int)                    (chr) (int)
## 1      2       Billy (Bill Nighy)     5
## 2      2      Joe (Gregor Fisher)     3
## 3      3      Jamie (Colin Firth)     5
## 4      4     Daniel (Liam Neeson)     3
## 5      4    Karen (Emma Thompson)     6
## 6      5    Colin (Kris Marshall)     4
## 7      6    Jack (Martin Freeman)     2
## 8      6       Judy (Joanna Page)     1
## 9      7    Mark (Andrew Lincoln)     4
## 10     7 Peter (Chiwetel Ejiofor)     4
## ..   ...                      ...   ...
library(reshape2)
speaker_scene_matrix <- by_speaker_scene %>%
    acast(character ~ scene, fun.aggregate = length)

dim(speaker_scene_matrix)

Bây giờ chúng ta có thể đến những thứ thú vị!

Phân tích

Bất cứ khi nào chúng ta có một ma trận, đáng để cố gắng phân cụm nó. Hãy bắt đầu với phân cụm theo cấp bậc.

norm <- speaker_scene_matrix / rowSums(speaker_scene_matrix)
h <- hclust(dist(norm, method = "manhattan"))
plot(h)

Điều này có vẻ đúng! Hầu như tất cả các cặp đôi lãng mạn đều ở bên nhau (Natalia / PM; Aurelia / Jamie, Harry / Karen; Karl / Sarah; Juliet / Peter; Jack / Judy), cũng như những người bạn (Colin / Tony; Billy / Joe) và gia đình (Daniel / Sam).

Một điều mà cây này là hoàn hảo để đưa ra một trật tự đặt các nhân vật tương tự gần nhau:

ordering <- h$labels[h$order]
ordering
##  [1] "Natalie (Martine McCutcheon)" "PM (Hugh Grant)"             
##  [3] "Aurelia (Lúcia Moniz)"        "Jamie (Colin Firth)"         
##  [5] "Daniel (Liam Neeson)"         "Sam (Thomas Sangster)"       
##  [7] "Jack (Martin Freeman)"        "Judy (Joanna Page)"          
##  [9] "Colin (Kris Marshall)"        "Tony (Abdul Salis)"          
## [11] "Billy (Bill Nighy)"           "Joe (Gregor Fisher)"         
## [13] "Mark (Andrew Lincoln)"        "Juliet (Keira Knightley)"    
## [15] "Peter (Chiwetel Ejiofor)"     "Karl (Rodrigo Santoro)"      
## [17] "Sarah (Laura Linney)"         "Mia (Heike Makatsch)"        
## [19] "Harry (Alan Rickman)"         "Karen (Emma Thompson)"

Thứ tự này có thể được sử dụng để làm cho các biểu đồ khác có nhiều thông tin hơn. Chẳng hạn, chúng ta có thể hình dung một dòng thời gian của tất cả các cảnh:

scenes <- by_speaker_scene %>%
    filter(n() > 1) %>%        # scenes with > 1 character
    ungroup() %>%
    mutate(scene = as.numeric(factor(scene)),
           character = factor(character, levels = ordering))

ggplot(scenes, aes(scene, character)) +
    geom_point() +
    geom_path(aes(group = scene))

Nếu bạn đã xem bộ phim nhiều lần như tôi (bạn chưa ...), bạn có thể nhìn chằm chằm vào biểu đồ này và các cảnh của bộ phim xuất hiện, giống như các ghi chú được khắc bằng nhựa vinyl.

Một lý do tốt để bố trí dữ liệu thô như thế này (trái ngược với các số liệu được xử lý như khoảng cách) là sự bất thường nổi bật. Chẳng hạn, hãy nhìn vào cảnh cuối cùng - đó là "coda" tại sân bay có 15 nhân vật (!). Nếu chúng ta sẽ vẽ điều này như một mạng (và chúng ta hoàn toàn là vậy!), Chúng ta phải bỏ qua cảnh đó, hoặc nếu không thì có vẻ như hầu hết mọi người đều kết nối với mọi người khác.

Sau đó, chúng ta có thể tạo ma trận cùng xuất hiện ( xem tại đây ) chứa số lần hai nhân vật chia sẻ cảnh:

non_airport_scenes <- speaker_scene_matrix[, colSums(speaker_scene_matrix) < 10]
cooccur <- non_airport_scenes %*% t(non_airport_scenes)
heatmap(cooccur)

Điều này cho chúng ta cảm giác về cách phân cụm trong biểu đồ trên xảy ra. Sau đó chúng ta có thể sử dụng gói igraph để vẽ mạng.

Một vài mẫu bật ra khỏi hình dung này. Chúng ta thấy rằng phần lớn các nhân vật được kết nối chặt chẽ (thường là bởi các cảnh trong vở kịch của trường, hoặc bởi Karen [Emma Thompson], bạn bè hoặc gia đình của nhiều nhân vật chính). Nhưng chúng ta thấy cốt truyện của Bill Nighy xảy ra gần như tách biệt hoàn toàn với mọi người khác và năm nhân vật khác được liên kết với mạng chính chỉ bằng một chủ đề (cuộc trò chuyện của Sarah với Mark trong đám cưới).

Một khía cạnh thú vị của dữ liệu này là mạng này được xây dựng trong suốt quá trình của bộ phim, phát triển các nút và kết nối khi các nhân vật và mối quan hệ được giới thiệu. Có một số cách để hiển thị mạng đang phát triển này (chẳng hạn như hoạt hình), nhưng tôi đã quyết định biến nó thành một ứng dụng Shiny tương tác , cho phép người dùng chỉ định cảnh và hiển thị mạng mà phim đã xây dựng đến thời điểm đó.

(Bạn có thể xem mã cho ứng dụng Shiny trên GitHub .)

Dữ liệu thực tế

Bạn đã nghe khiếu nại rằng chúng tôi đang "chìm đắm trong dữ liệu" chưa? Làm thế nào về những câu chuyện kinh dị về cách không ai hiểu số liệu thống kê, và chúng ta cần các nhà thống kê được đào tạo như là "cảnh sát" để giữ mọi người không hiểu sai phương pháp của họ? Nó chắc chắn làm cho khoa học dữ liệu nghe có vẻ quan trọng, công việc buồn tẻ.

Bất cứ khi nào tôi cảm thấy ảm đạm về những chủ đề đó, tôi cố gắng dành một chút thời gian cho các dự án ngớ ngẩn như thế này để nhắc nhở tôi tại sao tôi học lập trình thống kê ngay từ đầu. Phải mất vài phút để tải xuống một kịch bản phim và biến nó thành dữ liệu có thể sử dụng được, và trong vài giờ, tôi đã có thể xem phim theo một cách mới. Chúng ta đang sống trong một thế giới tuyệt vời: một với các công cụ mạnh mẽ như R và Shiny, và một tràn ngập các tài nguyên chỉ là một tìm kiếm Google.

Có thể bạn không thích Tình yêu thực sự ; bạn thích Chiến tranh giữa các vì sao . Hoặc bạn thích bóng chày , hoặc bạn thích so sánh các ngôn ngữ lập trình . Hoặc bạn thích hẹn hò , hoặc hip hop . Bất kể câu hỏi nào bạn quan tâm, câu trả lời chỉ là tìm kiếm và viết kịch bản. Nếu bạn tìm nó, tôi có cảm giác lén lút bạn sẽ thấy rằng dữ liệu thực sự ở xung quanh chúng ta.

Hữu ích 5 Chia sẻ Viết bình luận 0
Đã xem 4374