```{r}
# 필요한 라이브러리 로드
library(readr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(stringr)
library(lubridate)
library(tidyverse)
# 필요한 데이터 로드, 저장 및 확인
# 파일 경로는 기기에 따라 수정 필요
file_path <- "C:\\\\Users\\\\오권영\\\\Desktop\\\\2501\\\\문데분\\\\simple.csv"
ytb_df <- read.csv(file_path, fileEncoding = "UTF-8")
head(df)
nrow(df)
#전처리
#1)결측치 확인
# 진짜 NA + 빈 문자열 + "NA"라는 문자열까지 감지
sapply(ytb_df, function(x) sum(is.na(x) | x == "" | x == "NA"))
#description :497, video_tags =4669, language=2780
#2)결측지 제거
# video_tags 결측값 → "기타"로 처리
ytb_df$video_tags[is.na(ytb_df$video_tags)] <- "기타"
ytb_df <- na.omit(ytb_df)
nrow(ytb_df)
#정상 처리 확인
colSums(is.na(ytb_df[c("video_tags","video_category_id")]))
#3)날짜 정제->Date타입으로
ytb_df$video_published <- as.Date(ytb_df$video_published_at)
#4)날짜별 정렬
ytb_df <- ytb_df %>%
arrange(video_published)
# #오채원
```r
(오채원)
```{r}
# 1) 여러 번 등장한 채널
ytb_df %>%
group_by(channel_name) %>%
summarise(count = n()) %>%
arrange(desc(count))
# 태그 리스트로 나누기
ytb_df$tags <- strsplit(ytb_df$video_tags, ",")
# 2) 전체 태그 순위 확인(중복 영상 포함함)
ytb_df %>%
select(tags) %>%
unnest(tags) %>%
filter(!is.na(tags)) %>%
group_by(tags) %>%
summarise(count = n(), .groups = "drop") %>%
arrange(desc(count))
# 3) 중복 영상 제외 태그 순위
ytb_df %>%
select(video_id, tags) %>%
unnest(tags) %>%
filter(!is.na(tags)) %>%
distinct(video_id, tags) %>%
group_by(tags) %>%
summarise(count = n(), .groups = "drop") %>%
arrange(desc(count))
# 4) 가장 오래 인급동을 유지한...
ytb_df %>%
select(video_title, trending_span) %>%
arrange(desc(trending_span))
# 5) 좋아요 / 조회수 살펴보기
ytb_df %>%
mutate(lpv = avg_log_likes / avg_log_views) %>%
group_by(video_id) %>%
slice_max(lpv, n = 1, with_ties = FALSE) %>% # lpv가 가장 큰큰
ungroup() %>%
select(video_title, channel_name, lpv) %>%
arrange(desc(lpv))
# 대부분이 아이돌, kpop 관련 => 충성도 높음
# 6) 좋아요 - 댓글수 많은... (논란 여지 있는?)
ytb_df %>%
mutate(lmc = avg_log_likes - avg_log_comments) %>%
group_by(video_id) %>%
slice_min(lmc, n = 1, with_ties = FALSE) %>% # lmc가 가장 작은 한 행만(차이가 가장 크다는...)
ungroup() %>%
select(video_title, channel_name, lmc) %>%
arrange(lmc)
# 7) 월별 인기 동영상
ytb_df %>%
mutate(
month = format(as.Date(video_published), "%Y-%m") # 월 단위로 변환
) %>%
filter(month >= "2023-11" & month <= "2025-05") %>%
group_by(month, video_id, video_title) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(month) %>%
slice_max(count, n = 5, with_ties = FALSE) %>%
select(month, video_title, count) %>%
arrange(month, desc(count))
# 8) 7번의 시각화
# 1. 전처리: 월별 top 10 태그 계산
top_tags <- ytb_df %>%
mutate(month = format(as.Date(video_published), "%Y-%m")) %>%
filter(month >= "2023-11" & month <= "2025-05") %>%
select(month, tags) %>%
unnest(tags) %>%
filter(!is.na(tags)) %>%
group_by(month, tags) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(month) %>%
slice_max(count, n = 10, with_ties = FALSE)
# 2. 월별로 하나씩 그래프 출력
months <- unique(top_tags$month)
for (m in months) {
cat("\\n\\n📊", m, "\\n") # 월 출력
p <- top_tags %>%
filter(month == m) %>%
ggplot(aes(x = reorder(tags, count), y = count)) +
geom_col(fill = "yellowgreen") +
coord_flip() +
labs(title = paste("Top 10 Tags in", m), x = "Tag", y = "Count") +
theme_minimal()
print(p) # 그래프 출력
Sys.sleep(1.5) # 잠시 멈추기 (옵션) — 그래프가 보이게 하려면 IDE에 따라 필요하다네염
}
library(tidyverse)
# 전처리: 월별 top 10 태그 계산
top_tags <- ytb_df %>%
mutate(month = format(as.Date(video_published), "%Y-%m")) %>%
filter(month >= "2023-11" & month <= "2025-05") %>%
select(month, tags) %>%
unnest(tags) %>%
filter(!is.na(tags)) %>%
group_by(month, tags) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(month) %>%
slice_max(count, n = 10, with_ties = FALSE)
# 월 목록 정렬
months <- sort(unique(top_tags$month))
# 월별 그래프 출력
for (m in months) {
cat("\\n\\n📊", m, "\\n")
plot_data <- top_tags %>% filter(month == m)
p <- ggplot(plot_data, aes(x = reorder(tags, count), y = count, fill = count)) +
geom_col() +
scale_fill_gradient(
low = "yellow", # 연한 노랑
high = "yellowgreen", # 진한 노랑
guide = "none"
) +
coord_flip() +
labs(
title = paste("Top 10 Tags in", m),
x = "Tag",
y = "Count"
) +
theme_minimal(base_size = 14)
print(p)
Sys.sleep(1.5)
}
------------여기까지 EDA----------------- 인사이트 : 좋아요, 댓글 등 단순 시청 뿐만 아니라 반응도도 높은 것은 k-pop 관련! 단순히 조회수가 높은 것은 먹방, 브이로그 등임. 우리가 할 수 있는 것은 무엇?
```r
```{r}
# 태그 별 평균 좋아요
tag_likes_avg <- ytb_df %>%
select(tags, avg_log_likes) %>%
unnest(tags) %>%
filter(!is.na(tags)) %>%
group_by(tags) %>%
summarise(
total_likes = sum(avg_log_likes, na.rm = TRUE),
tag_count = n(),
avg_likes = total_likes / tag_count
) %>%
arrange(desc(avg_likes))
tag_likes_avg
tag_likes_avg %>%
slice_max(total_likes, n = 20) %>%
ggplot(aes(x = reorder(tags, avg_likes), y = avg_likes, fill = avg_likes)) +
geom_col() +
coord_flip() +
scale_fill_gradient(low = "#FFE082", high = "#FF6F00") +
labs(
title = "태그별 좋아요 합계 (상위 20개)",
x = "태그",
y = "좋아요 합계"
) +
theme_minimal(base_size = 14)
```{r}
# 1) 조회수 vs 좋아요 상관관계 시각화
ggplot(ytb_df, aes(x = avg_log_views, y = avg_log_likes)) +
geom_point(color = "black", alpha = 0.6) +
labs(title = "view vs likes", x = "view수", y = "likes") +
theme_minimal() +
scale_x_log10() +
scale_y_log10()
# 2) 조회수 vs 댓글 상관관계 시각화
ggplot(ytb_df, aes(x = avg_log_views, y = avg_log_comments)) +
geom_point(color = "skyblue", alpha = 0.6) +
labs(title = "View vs Comments", x = "View", y = "Comments") +
theme_minimal() +
scale_x_log10() +
scale_y_log10()
# 3) 조회수 vs 구독자 상관관계 시각화
ggplot(ytb_df, aes(x = avg_log_views, y = channel_subscriber_count)) +
geom_point(color = "red", alpha = 0.6) +
labs(title = "조회수 vs 구독자 수", x = "로그 조회수", y = "구독자 수") +
theme_minimal() +
scale_x_log10() +
scale_y_log10()
# 4) 조회수와 가장 관련 있는 요소는? (피어슨 상관계수)
# 변수 추출
df_corr <- ytb_df %>%
select(avg_log_views, avg_log_likes, avg_log_comments, channel_subscriber_count) %>%
na.omit()
#피어슨 상관계수 계산
corr_results <- data.frame(
variable = c("구독자 수", "좋아요 수", "댓글 수"),
pearson_r = c(
cor(df_corr$avg_log_views, df_corr$channel_subscriber_count, method = "pearson"),
cor(df_corr$avg_log_views, df_corr$avg_log_likes, method = "pearson"),
cor(df_corr$avg_log_views, df_corr$avg_log_comments, method = "pearson")
)
)
print(corr_results)
#피어슨 상관계수 막대그래프 시각화
ggplot(corr_results, aes(x = reorder(variable, pearson_r), y = pearson_r, fill = variable)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(pearson_r, 3)), vjust = -0.5, size = 5) +
labs(title = "조회수와의 피어슨 상관계수",
x = "변수", y = "피어슨 상관계수") +
ylim(0, 1) +
theme_minimal() +
theme(legend.position = "none",
text = element_text(size = 14))
# 적은 구독자 대비 높은 좋아유
#구독자 2만 이하 좋아요 수 내림차순
df_20k <- ytb_df %>%
filter(channel_subscriber_count <= 20000) %>%
arrange(desc(avg_log_likes)) %>%
distinct(video_id, .keep_all = TRUE)
#구독자 5만 이하 좋아요 수 내림차순
df_50k <- ytb_df %>%
filter(channel_subscriber_count <= 50000) %>%
arrange(desc(avg_log_likes)) %>%
distinct(video_id, .keep_all = TRUE)
head(df_20k[, c("video_title", "channel_subscriber_count", "avg_log_likes")])
head(df_50k[, c("video_title", "channel_subscriber_count", "avg_log_likes")])
```{r}
# 1) 동영상 길이와 인기 지속 기간의 상관관계
# 'PT34M29S' 형식을 초 단위로 변환하는 함수 정의
duration_to_seconds <- function(duration) {
# 정규식을 이용해 분(M)과 초(S) 추출
mins <- str_extract(duration, "(?<=PT)\\\\d+(?=M)")
secs <- str_extract(duration, "(?<=M)\\\\d+(?=S)")
# 결측값 간처리: M이나 S가 없으면 0으로 처리
mins_num <- as.numeric(ifelse(is.na(mins), 0, mins))
secs_num <- as.numeric(ifelse(is.na(secs), 0, secs))
# 분 * 60 + 초 계산
return(mins_num * 60 + secs_num)
}
# video_duration 컬럼을 초 단위로 변환
ytb_df$duration_sec <- sapply(ytb_df$video_duration, duration_to_seconds)
# 분 단위 변환
ytb_df$duration_min <- ytb_df$duration_sec / 60
# 변환 후 확인
head(ytb_df[, c("video_duration", "duration_min")])
# 동영상 길이와 인기 지속 기간 사이 상관관계 산점도
ggplot(ytb_df, aes(x = duration_min, y = trending_span)) +
geom_point(color = "blue", alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE, color = "red") + # 선형 회귀선
labs(title = "동영상 길이와 인기 지속 기간의 상관관계",
x = "동영상 길이 (분)",
y = "인기 지속 기간 (일)") +
theme_minimal()
# 선형 회귀 모델 만들기
model <- lm(trending_span ~ duration_min, data = ytb_df)
# 회귀 모델 요약 출력
summary(model)
# 2) 게시 시간대와 영상의 인기
# 인기 지속 기간이 높은 상위 100개 영상 선택
top_100_videos <- ytb_df %>%
arrange(desc(trending_span)) %>% # 인기 지속 기간 기준 내림차순 정렬
head(100) # 상위 100개 선택
# 업로드 시점을 시각화
ggplot(top_100_videos, aes(x = as.POSIXct(video_published_at, format = "%Y-%m-%d %H:%M:%S"))) +
geom_histogram(binwidth = 3600, fill = "steelblue", color = "black") + # 1시간 단위로 binning
labs(title = "인기 지속 기간이 높은 100개 영상의 업로드 시점",
x = "업로드 시점", y = "업로드 빈도 (1시간 단위)") +
theme_minimal()
top_100_videos <- top_100_videos %>%
mutate(publish_hour = hour(as.POSIXct(video_published_at, format = "%Y-%m-%d %H:%M:%S"))) # 게시 시간대 추출
ggplot(top_100_videos, aes(x = as.factor(publish_hour))) +
geom_bar(fill = "lightgreen") +
labs(title = "상위 100개 영상의 게시 시간대 분포",
x = "게시 시간대 (시)", y = "영상 수") +
theme_minimal()
# 3) 인기 영상들의 영상 길이
# 인기 지속 기간이 높은 상위 100개 영상 선택
top_100_videos <- ytb_df %>%
arrange(desc(trending_span)) %>% # 인기 지속 기간 기준 내림차순 정렬
head(100) # 상위 100개 선택
# 'video_duration'을 초 단위로 변환하는 함수 정의
duration_to_seconds <- function(duration) {
mins <- str_extract(duration, "(?<=PT)\\\\d+(?=M)")
secs <- str_extract(duration, "(?<=M)\\\\d+(?=S)")
mins_num <- as.numeric(ifelse(is.na(mins), 0, mins))
secs_num <- as.numeric(ifelse(is.na(secs), 0, secs))
return(mins_num * 60 + secs_num)
}
# video_duration 컬럼을 초 단위로 변환
top_100_videos$duration_sec <- sapply(top_100_videos$video_duration, duration_to_seconds)
# 초 단위로 변환된 동영상 길이를 분 단위로 변환
ytb_df$duration_min <- ytb_df$duration_sec / 60
# 영상 길이를 나타내는 히스토그램 그리기
ggplot(top_100_videos, aes(x = duration_min)) +
geom_histogram(binwidth = 5, fill = "steelblue", color = "black") + # 1분 단위로 binning
labs(title = "인기 지속 기간 상위 100개 영상의 영상 길이",
x = "영상 길이 (분)",
y = "영상 수") +
theme_minimal()
ggplot(top_100_videos, aes(x = "", y = duration_min)) +
geom_boxplot(fill = "lightgreen") +
labs(title = "인기 지속 기간 상위 100개 영상의 영상 길이 분포",
x = "", y = "영상 길이 (분)") +
theme_minimal()
```{r}
# 구독자 수 대비 조회수 비율 상위 100개
high_logview_ratio_df <- ytb_df %>%
mutate(logview_sub_ratio = avg_log_views / channel_subscriber_count) %>%
arrange(desc(logview_sub_ratio)) %>%
distinct(video_id, .keep_all = TRUE) %>%
slice_head(n = 100) # 또는 head(., 100)
# 구독자 수 대비 인급동 기간 비율 상위 100개
high_trend_ratio_df <- ytb_df %>%
mutate(trending_sub_ratio = trending_span / channel_subscriber_count) %>%
arrange(desc(trending_sub_ratio)) %>%
distinct(video_id, .keep_all = TRUE) %>%
slice_head(n = 100)
# 1. 두 video_id 목록의 합집합
union_ids <- union(high_logview_ratio_df$video_id, high_trend_ratio_df$video_id)
# 2. 합집합에 해당하는 영상만 추출 (video_id 기준 중복 제거)
union_top100_df <- ytb_df %>%
filter(video_id %in% union_ids) %>%
distinct(video_id, .keep_all = TRUE)
#카테고리별 조회수
# 1. 카테고리별로 조회수 상위 영상 (avg_log_views 기준 정렬)
top_views_by_category <- union_top100_df %>%
group_by(video_category_id) %>%
arrange(desc(avg_log_views), .by_group = TRUE) %>%
slice_head(n = 1) %>% # 각 카테고리에서 가장 높은 영상 1개
ungroup()
# 2. 시각화
ggplot(top_views_by_category, aes(x = reorder(video_category_id, avg_log_views),
y = avg_log_views,
fill = avg_log_views)) +
geom_col() +
coord_flip() +
scale_fill_gradient(
low = "gold", # 밝은 노랑
high = "red", # 진한 빨강
guide = "none"
) +
labs(
title = "카테고리별 avg_log_views 기준 상위 영상",
x = "Video Category ID",
y = "평균 로그 조회수"
) +
theme_minimal()
# 카테고리가 People$ & Blogs 인 영상 특징 분석
# 1. People & Blogs 카테고리 필터링
people_df <- ytb_df %>%
filter(video_category_id == "People & Blogs")
View(people_df)
# 2. 업로드 시간(시각) 추출
people_df <- people_df %>%
mutate(hour = hour(as.POSIXct(video_published_at)))
# 3. 시각별 영상 수 집계 & 시각화
people_df %>%
count(hour) %>%
ggplot(aes(x = hour, y = n)) +
geom_col(fill = "steelblue") +
scale_x_continuous(breaks = 0:23) +
labs(
title = "시간대별 영상 업로드 수 (People & Blogs)",
x = "업로드 시간대 (시)",
y = "영상 수"
) +
theme_minimal()
# 1. 숫자형으로 변환 (필요 시)
# 'PT34M29S' 형식을 초 단위로 변환하는 함수 정의
duration_to_seconds <- function(duration) {
# 정규식을 이용해 분(M)과 초(S) 추출
mins <- str_extract(duration, "(?<=PT)\\\\d+(?=M)")
secs <- str_extract(duration, "(?<=M)\\\\d+(?=S)")
# 결측값 처리: M이나 S가 없으면 0으로 처리
mins_num <- as.numeric(ifelse(is.na(mins), 0, mins))
secs_num <- as.numeric(ifelse(is.na(secs), 0, secs))
# 분 * 60 + 초 계산
return(mins_num * 60 + secs_num)
}
# video_duration 컬럼을 초 단위로 변환
ytb_df$duration_sec <- sapply(ytb_df$video_duration, duration_to_seconds)
# 변환 후 확인
head(ytb_df[, c("video_duration", "duration_sec")])
# 초 단위로 변환된 동영상 길이를 분 단위로 변환
ytb_df$duration_min <- ytb_df$duration_sec / 60
# 히스토그램 시각화 (duration_min 기준)
ggplot(people_df, aes(x = duration_min)) +
geom_histogram(fill = "tomato", bins = 30) +
labs(
title = "영상 길이 분포 (People & Blogs)",
x = "Video Duration (minutes)",
y = "영상 수"
) +
theme_minimal()
# 산점도 + 회귀선 시각화
ggplot(people_df, aes(x = duration_min, y = avg_log_views)) +
geom_point(alpha = 0.6, color = "orange") +
geom_smooth(method = "lm", se = TRUE, color = "darkgreen") +
labs(
title = "영상 길이 vs. 평균 로그 조회수 (People & Blogs)",
x = "영상 길이 (분)",
y = "평균 로그 조회수"
) +
theme_minimal()
#제목 길이와 조회수 상관관계
# 1. 제목 길이 변수 추가
union_top100_df <- union_top100_df %>%
mutate(title_length = nchar(video_title))
# 2. 시각화: 제목 길이 vs 평균 로그 조회수
ggplot(union_top100_df, aes(x = title_length, y = avg_log_views)) +
geom_point(color = "pink", alpha = 0.7) +
geom_smooth(method = "lm", se = TRUE, color = "steelblue") +
labs(
title = "제목 길이와 평균 로그 조회수의 상관관계",
x = "제목 길이 (글자 수)",
y = "평균 로그 조회수"
) +
theme_minimal()
# 1. 필요한 패키지 로드
library(dplyr)
library(tidytext)
library(stringr)
install.packages("wordcloud")
library(wordcloud)
library(RColorBrewer)
# 2. 윈도우 한글 폰트 등록
windowsFonts(malgun = windowsFont("맑은 고딕"))
par(family = "malgun")
# 3. 합집합 데이터프레임에서 제목 추출
title_df <- union_top100_df %>%
select(video_title)
# 4. 제목에서 단어 추출 (띄어쓰기 기준)
tokenized <- title_df %>%
unnest_tokens(word, video_title, token = "words", drop = TRUE)
# 5. 단어 정제: 2글자 이상만 추출하고 빈도수 계산
word_freq <- tokenized %>%
filter(str_length(word) >= 2) %>%
count(word, sort = TRUE)
# 6. 워드클라우드 시각화
set.seed(1234)
wordcloud(
words = word_freq$word,
freq = word_freq$n,
min.freq = 1,
max.words = 100,
random.order = FALSE,
colors = brewer.pal(8, "Dark2"),
family = "malgun"
)
# 1. 2025년 데이터 필터링
title_df <- ytb_df %>%
filter(format(as.Date(video_published_at), "%Y") == "2025") %>%
select(video_title)
# 2. 제목에서 단어 분리 (띄어쓰기 기준)
tokenized <- title_df %>%
unnest_tokens(word, video_title, token = "words", drop = TRUE)
# 3. 2글자 이상 단어만 남기고 빈도수 계산
word_freq <- tokenized %>%
filter(str_length(word) >= 2) %>%
count(word, sort = TRUE)
# 4. 워드클라우드 시각화
set.seed(1234)
wordcloud(
words = word_freq$word,
freq = word_freq$n,
min.freq = 1,
max.words = 100,
random.order = FALSE,
colors = brewer.pal(8, "Dark2"),
family = "malgun"
)
# #김채윤
(다른 데이터 사용)
```r
```{r}
#데이터 불러오기
file_path <- "~/Desktop/mproject/yt_kr_data.csv"
df <- read.csv(file_path, fileEncoding = "UTF-8")
head(df)
nrow(df)
#1)결측치 확인
# 진짜 NA + 빈 문자열 + "NA"라는 문자열까지 감지
sapply(df, function(x) sum(is.na(x) | x == "" | x == "NA"))
#description :497, video_tags =4669, language=2780
#1)결측지 제거
# description 결측값 → 빈 문자열 처리
df$description[is.na(df$description)] <- ""
# video_tags 결측값 → "기타"로 처리
df$video_tags[is.na(df$video_tags)] <- "기타"
# langauge 결측값 → "unknown"으로 처리
df$langauge[is.na(df$langauge)] <- "unknown"
#정상 처리 확인
colSums(is.na(df[c("description", "video_tags", "langauge")]))
#2)날짜 정제->Date타입으로
df$snapshot_date <- as.Date(df$snapshot_date)
df$publish_date <- as.Date(df$publish_date)
#2)title->리스트화
#title리스트화 함
library(dplyr)
library(stringr)
# 조사 리스트
particles <- c("은", "는", "이", "가", "을", "를", "에", "에서", "도", "만", "와", "과", "으로", "로", "한", "하고")
# strsplit과 조사 제거 적용
df$title <- df$title %>%
lapply(function(x) setdiff(unlist(strsplit(x, "[ ,]+")), particles))
df$title[1]
#3) vedio_tags->list화
df$video_tags <- strsplit(df$video_tags, ",\\\\s*")
str(df$video_tags[1:2])
#3)순위별 정렬
library(dplyr)
df <- df %>%
arrange(snapshot_date, daily_rank)
#3.5)날짜 별로 어떤 콘텐츠가 트렌드인지 10위권까지 정렬->10위만 가지고 시각화 해도 좋을듯
library(dplyr)
daily_top10 <- df %>%
group_by(snapshot_date) %>%
arrange(daily_rank, .by_group = TRUE) %>%
slice(1:10) %>%
ungroup()
#4)로그 스케일링
df$log_views <- log1p(df$view_count)
df$log_likes <- log1p(df$like_count)
df$log_comments <- log1p(df$comment_count)
#5)이상치 제거:lm로 결측치에 넣을 값을 예측하는 방법으로 이상치를 제거함.
# 이상치 탐지 함수 정의 (IQR 기반)
remove_outliers <- function(x) {
q1 <- quantile(x, 0.25, na.rm = TRUE)
q3 <- quantile(x, 0.75, na.rm = TRUE)
iqr <- q3 - q1
lower <- q1 - 1.5 * iqr
upper <- q3 + 1.5 * iqr
return(x >= lower & x <= upper)
}
# 1. 이상치를 NA로 처리
df$log_views_clean <- ifelse(remove_outliers(df$log_views), df$log_views, NA)
df$log_likes_clean <- ifelse(remove_outliers(df$log_likes), df$log_likes, NA)
df$log_comments_clean <- ifelse(remove_outliers(df$log_comments), df$log_comments, NA)
# 2. 각 변수에 대해 회귀 모델로 결측치 예측 (다른 두 변수로 예측)
# log_views 예측
model_views <- lm(log_views_clean ~ log_likes_clean + log_comments_clean, data = df)
df$log_views_imputed <- ifelse(is.na(df$log_views_clean),
predict(model_views, newdata = df),
df$log_views_clean)
# log_likes 예측
model_likes <- lm(log_likes_clean ~ log_views_imputed + log_comments_clean, data = df)
df$log_likes_imputed <- ifelse(is.na(df$log_likes_clean),
predict(model_likes, newdata = df),
df$log_likes_clean)
# log_comments 예측
model_comments <- lm(log_comments_clean ~ log_views_imputed + log_likes_imputed, data = df)
df$log_comments_imputed <- ifelse(is.na(df$log_comments_clean),
predict(model_comments, newdata = df),
df$log_comments_clean)
# log로 시작하지만 imputed만 유지
log_cols <- names(df)[grepl("^log_", names(df))]
log_cols_to_keep <- grep("imputed$", log_cols, value = TRUE)
# 나머지 log 관련 컬럼은 제거
df <- df[, c(setdiff(names(df), log_cols), log_cols_to_keep)]
head(df)
min(df$snapshot_date) # 가장 오래된 날짜
max(df$snapshot_date) # 가장 최신 날짜
####3.2.1.1.Load Datest2
file_path <- "~/Desktop/mproject/kr_yt.csv"
df2 <- read.csv(file_path, fileEncoding = "UTF-8")
# 진짜 NA + 빈 문자열 + "NA"라는 문자열까지 감지
sapply(df2, function(x) sum(is.na(x) | x == "" | x == "NA"))
#description :497, video_tags =4669, language=2780
# 개수 맞춰서 정확히 대체
df2$video_description[is.na(df2$video_description)] <- rep("", sum(is.na(df2$video_description)))
df2$channel_description[is.na(df2$channel_description)] <- rep("", sum(is.na(df2$channel_description)))
df2$channel_localized_description[is.na(df2$channel_localized_description)] <- rep("", sum(is.na(df2$channel_localized_description)))
# 카테고리 NA는 "기타"로
df2$video_category_id <- as.character(df2$video_category_id)
df2$video_category_id[is.na(df2$video_category_id)] <- rep("기타", sum(is.na(df2$video_category_id)))
colSums(is.na(df2[c("video_description",
"channel_description",
"channel_localized_description",
"video_category_id")]))
head(df2)
library(stringr)
particles <- c("은", "는", "이", "가", "을", "를", "에", "에서", "도", "만",
"와", "과", "으로", "로", "한", "하고")
# 특수문자 제거 → 공백 기준으로 자르기 → 조사 제거
df2$vedio_title_lists <- df2$video_title %>%
str_replace_all("[^가-힣a-zA-Z0-9 ]", " ") %>% # 특수문자 제거
str_split("\\\\s+") %>% # 공백으로 단어 분리
lapply(function(words) setdiff(words, particles)) # 조사 제거
df2$tag_tokens <- strsplit(df2$video_tags, "\\\\|")
# 원본 유지: 시간 포함된 POSIXct로 저장
df2$video_published_at <- as.POSIXct(df2$video_published_at, format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
# 포맷 변경 후 날짜 처리
df2$video_trending_date <- as.Date(gsub("\\\\.", "-", df2$video_trending__date), format = "%Y-%m-%d")
#날짜기준 정렬
df2 <- df2 %>%
arrange(video_trending_date)
#1.로그변환
df2$log_views <- log1p(df2$video_view_count)
df2$log_likes <- log1p(df2$video_like_count)
df2$log_comments <- log1p(df2$video_comment_count)
df2$log_channel_views <- log1p(df2$channel_view_count)
df2$log_subscribers <- log1p(df2$channel_subscriber_count)
df2$log_channel_videos <- log1p(df2$channel_video_count)
#2.이상치제거
remove_outliers <- function(x) {
q1 <- quantile(x, 0.25, na.rm = TRUE)
q3 <- quantile(x, 0.75, na.rm = TRUE)
iqr <- q3 - q1
return(x >= (q1 - 1.5 * iqr) & x <= (q3 + 1.5 * iqr))
}
# 이상치 → NA로 바꾸기
for (col in c("log_views", "log_likes", "log_comments",
"log_channel_views", "log_subscribers", "log_channel_videos")) {
df2[[paste0(col, "_clean")]] <- ifelse(remove_outliers(df2[[col]]), df2[[col]], NA)
}
#3.회귀로 NA(NA+이상치)를 기댓값을 예측해서 넣음
# log_views 예측
model_views <- lm(log_views_clean ~ log_likes_clean + log_comments_clean, data = df2)
df2$log_views_imputed <- ifelse(is.na(df2$log_views_clean),
predict(model_views, newdata = df2),
df2$log_views_clean)
# log_likes 예측
model_likes <- lm(log_likes_clean ~ log_views_imputed + log_comments_clean, data = df2)
df2$log_likes_imputed <- ifelse(is.na(df2$log_likes_clean),
predict(model_likes, newdata = df2),
df2$log_likes_clean)
# log_comments 예측
model_comments <- lm(log_comments_clean ~ log_views_imputed + log_likes_imputed, data = df2)
df2$log_comments_imputed <- ifelse(is.na(df2$log_comments_clean),
predict(model_comments, newdata = df2),
df2$log_comments_clean)
#log imputed만 남기기
# 모든 log_ 변수 중에서 imputed만 남기고 나머지는 제거
log_cols <- names(df2)[grepl("^log_", names(df2))]
log_cols_to_keep <- grep("imputed$", log_cols, value = TRUE)
# 나머지는 제거
df2 <- df2[, c(setdiff(names(df2), log_cols), log_cols_to_keep)]
head(df2)
merged_df <- df2 %>%
inner_join(df, by = "video_id")
#중복 확인
head(merged_df)
remove_cols <- c(
"channel_id.y", # channel_id → channel_id.x만 남김
"video_tags.y", # video_tags → video_tags.x만 남김
"title", # video_title로 대체
"description", # video_description로 대체
"thumbnail_url" # video_default_thumbnail로 대체
)
merged_df <- merged_df[, !(names(merged_df) %in% remove_cols)]
names(merged_df)[names(merged_df) == "channel_id.x"] <- "channel_id"
names(merged_df)[names(merged_df) == "video_tags.x"] <- "video_tags"
nrow(merged_df)
merged_df
names(df)
head(df2)
##EDA
# 영상 ID(video_id)별로 묶고 날짜 기준으로 정렬
df_agro_base <- merged_df %>%
group_by(video_id) %>%
arrange(snapshot_date)
# n_days_trending: 이 영상이 트렌드에 등장한 "날짜 수" → 인기도의 지속성
df_agro_days <- df_agro_base %>%
summarise(
n_days_trending = n_distinct(snapshot_date)
)
# view_growth: 트렌딩 시작부터 끝까지 조회수가 얼마나 증가했는지
# growth_rate: 하루 평균 얼마나 급격히 올랐는지
df_agro_growth <- df_agro_base %>%
summarise(
first_views = first(view_count), # 트렌드 시작 시점 조회수
last_views = last(view_count), # 트렌드 마지막 시점 조회수
view_growth = last_views - first_views, # 총 증가량
growth_rate = view_growth / n_distinct(snapshot_date) # 일 평균 증가량
)
# max_views: 영상이 기록한 최대 조회수 → 전체 인기도 크기
df_agro_peak <- df_agro_base %>%
summarise(
max_views = max(view_count)
)
# peak_like_ratio: 가장 높은 좋아요 비율 (좋아요 / 조회수)
# peak_comment_ratio: 가장 높은 댓글 비율 (댓글 / 조회수)
df_agro_engagement <- df_agro_base %>%
summarise(
peak_like_ratio = max(like_count / pmax(view_count, 1)),
peak_comment_ratio = max(comment_count / pmax(view_count, 1))
)
# 위에서 만든 요약 데이터프레임들을 하나로 결합
df_agro_summary <- df_agro_days %>%
inner_join(df_agro_growth, by = "video_id") %>%
inner_join(df_agro_peak, by = "video_id") %>%
inner_join(df_agro_engagement, by = "video_id")
# relative_engagement: 구독자 수 대비 조회수 → 작지만 강한 채널?
# small_channel_flag: 구독자 20000명 이하 플래그 → 필터링 기준
df_agro_final <- df_agro_summary %>%
left_join(
df2 %>% select(video_id, title = video_title, video_category_id, channel_subscriber_count),
by = "video_id"
) %>%
filter(!is.na(channel_subscriber_count)) %>% # NA 제거
mutate(
relative_engagement = max_views / (channel_subscriber_count + 1),
small_channel_flag = channel_subscriber_count < 20000 # 작지만 강한 채널 구분
)
# agro_score_final: 영상 지표 + 채널 약점까지 반영한 최종 점수
df_agro_final <- df_agro_final %>%
mutate(
agro_score_final = scale(max_views)[,1] +
scale(growth_rate)[,1] +
scale(n_days_trending)[,1] +
scale(peak_like_ratio)[,1] +
scale(relative_engagement)[,1]
)
df_agro_final
threshold <- quantile(df_agro_final$agro_score_final, 0.75, na.rm = TRUE)
df_agro_final <- df_agro_final %>%
mutate(superhit = agro_score_final >= threshold)
df_agro_final %>%
filter(small_channel_flag == TRUE, superhit == TRUE)
library(tidyr)
# 1. superhit 정보 추출
superhit_info <- df_agro_final %>%
select(video_id, superhit) %>%
distinct(video_id, .keep_all = TRUE) # 중복 제거
# 2. merged_df에 superhit 붙이기
merged_df_with_hit <- merged_df %>%
left_join(superhit_info, by = "video_id")
# 3. 토큰 테이블 만들기
# 3. 토큰 테이블 만들기 + 영어 제거 포함
df_tokens <- merged_df_with_hit %>%
select(video_id, video_category_id, superhit, vedio_title_lists) %>%
unnest(vedio_title_lists) %>%
rename(word = vedio_title_lists) %>%
filter(!str_detect(word, "^[A-Za-z]+$")) # 영어 제거를 여기서!
# 구독자 20,000명 이하 + superhit 영상만 필터링
target_videos <- df_agro_final %>%
filter(small_channel_flag == TRUE, superhit == TRUE) %>%
select(video_id)
# 해당 영상만 필터링해서 word 토큰 테이블 만들기
df_tokens_filtered <- df_tokens %>%
filter(video_id %in% target_videos$video_id)
# (수정한 부분: df_tokens → df_tokens_filtered)
word_agro_score <- df_tokens_filtered %>%
group_by(word) %>%
summarise(
n_superhit = sum(superhit, na.rm = TRUE),
n_normal = sum(!superhit, na.rm = TRUE),
n_total = n(),
agro_score = (n_superhit + 1) / (n_normal + 1),
agro_score_adjusted = agro_score * log1p(n_total)
) %>%
filter(n_total >= 5) %>%
arrange(desc(agro_score_adjusted))
library(wordcloud2)
library(dplyr)
# 1. 상위 35개 단어만 추출
top_words <- word_agro_score %>%
slice_max(order_by = agro_score_adjusted, n = 35) %>%
select(word, freq = agro_score_adjusted)
# 2. 예쁜 색상 팔레트 지정 (레드→핑크→오렌지 계열 그라데이션)
nice_colors <- c(
"#FF6F61", "#FF8C42", "#FFBB33", "#FF5E78", "#F56A79",
"#FF9966", "#FF4444", "#FC5185", "#FF7F50", "#E94B3C"
)
# 3. 워드클라우드 시각화
wordcloud2(top_words,
size = 1.3,
color = rep(nice_colors, length.out = nrow(top_words)), # 반복 색상 적용
backgroundColor = "white",
fontFamily = "Nanum Gothic") # 또는 AppleGothic
### 📦 1. KR 전용 merged_df 필터링
merged_df_kr <- merged_df %>%
filter(video_trending_country == "KR")
### 📊 2. KR 버전 어그로 베이스 전처리
# 2-1. 영상별로 정렬
df_agro_base_kr <- merged_df_kr %>%
group_by(video_id) %>%
arrange(snapshot_date)
# 2-2. 트렌딩 일수 계산
df_agro_days_kr <- df_agro_base_kr %>%
summarise(n_days_trending = n_distinct(snapshot_date))
# 2-3. 조회수 증가량 계산
df_agro_growth_kr <- df_agro_base_kr %>%
summarise(
first_views = first(view_count),
last_views = last(view_count),
view_growth = last_views - first_views,
growth_rate = view_growth / n_distinct(snapshot_date)
)
# 2-4. 최대 조회수
df_agro_peak_kr <- df_agro_base_kr %>%
summarise(max_views = max(view_count))
# 2-5. 반응도
df_agro_engagement_kr <- df_agro_base_kr %>%
summarise(
peak_like_ratio = max(like_count / pmax(view_count, 1)),
peak_comment_ratio = max(comment_count / pmax(view_count, 1))
)
# 2-6. 합치기
df_agro_summary_kr <- df_agro_days_kr %>%
inner_join(df_agro_growth_kr, by = "video_id") %>%
inner_join(df_agro_peak_kr, by = "video_id") %>%
inner_join(df_agro_engagement_kr, by = "video_id")
### 2단계: 구독자 수 병합 및 어그로 점수 계산
library(stringr)
# df_agro_final_kr 생성
df_agro_final_kr <- df_agro_summary_kr %>%
left_join(
df2 %>% select(video_id, title = video_title, video_category_id,
channel_subscriber_count, video_trending_country),
by = "video_id"
) %>%
filter(!is.na(channel_subscriber_count)) %>% # NA 제거
mutate(
relative_engagement = max_views / (channel_subscriber_count + 1),
small_channel_flag = channel_subscriber_count < 20000 # 구독자 2만명 미만이면 TRUE
)
# 어그로 점수 계산
df_agro_final_kr <- df_agro_final_kr %>%
mutate(
agro_score_final = scale(max_views)[,1] +
scale(growth_rate)[,1] +
scale(n_days_trending)[,1] +
scale(peak_like_ratio)[,1] +
scale(relative_engagement)[,1]
)
### 3단계: 상위 25% superhit 플래그 생성
threshold_kr <- quantile(df_agro_final_kr$agro_score_final, 0.75, na.rm = TRUE)
# 상위 25%를 superhit으로 설정
df_agro_final_kr <- df_agro_final_kr %>%
mutate(superhit = agro_score_final >= threshold_kr)
### 4단계: superhit 정보 병합 → df_tokens 생성 및 영어 제거
superhit_info_kr <- df_agro_final_kr %>%
select(video_id, superhit) %>%
distinct(video_id, .keep_all = TRUE)
merged_df_with_hit_kr <- merged_df %>%
left_join(superhit_info_kr, by = "video_id")
# vedio_title_lists에서 영어 제거 포함한 단어 테이블 생성
df_tokens_kr <- merged_df_with_hit_kr %>%
filter(video_trending_country == "KR") %>%
select(video_id, video_category_id, superhit, vedio_title_lists) %>%
unnest(vedio_title_lists) %>%
rename(word = vedio_title_lists) %>%
filter(!str_detect(word, "^[A-Za-z]+$"))
# 구독자 20,000 이하 + superhit 영상만 필터링
small_superhit_kr <- df_agro_final_kr %>%
filter(small_channel_flag == TRUE, superhit == TRUE) %>%
select(video_id)
df_tokens_kr_filtered <- df_tokens_kr %>%
filter(video_id %in% small_superhit_kr$video_id)
### 5단계: 단어별 어그로 점수 계산
word_agro_score_kr <- df_tokens_kr_filtered %>%
group_by(word) %>%
summarise(
n_superhit = sum(superhit, na.rm = TRUE),
n_normal = sum(!superhit, na.rm = TRUE),
n_total = n(),
agro_score = (n_superhit + 1) / (n_normal + 1),
agro_score_adjusted = agro_score * log1p(n_total)
) %>%
filter(n_total >= 5) %>%
arrange(desc(agro_score_adjusted))
library(wordcloud2)
library(dplyr)
# 1. 상위 35개 단어만 추출
top_words <- word_agro_score %>%
slice_max(order_by = agro_score_adjusted, n = 35) %>%
select(word, freq = agro_score_adjusted)
# 2. 예쁜 색상 팔레트 지정 (레드→핑크→오렌지 계열 그라데이션)
nice_colors <- c(
"#FF6F61", "#FF8C42", "#FFBB33", "#FF5E78", "#F56A79",
"#FF9966", "#FF4444", "#FC5185", "#FF7F50", "#E94B3C"
)
# 3. 워드클라우드 시각화
wordcloud2(top_words,
size = 1.3,
color = rep(nice_colors, length.out = nrow(top_words)), # 반복 색상 적용
backgroundColor = "white",
fontFamily = "Nanum Gothic") # 또는 "AppleGothic" (Mac 유저용)