# 關節shorts分析
## 多個變數對「觀看次數」影響(GLM model)
> 結果：所有變數與「觀看次數」顯著相關
## 係數解讀(非線性模型之係數無法直接解讀)
> 結果:
> 1. 在其他條件不變的情況下，已新增留言每多一個，觀看次數增加0.028%
> 2. 在其他條件不變的情況下，分享次數每多一個，觀看次數減少-0.009%
> 3. 在其他條件不變的情況下，觀看 (相較於滑掉)每增加1%，觀看次數增加1.31%
> 4. 在其他條件不變的情況下，平均觀看比例每增加1%，觀看次數增加0.86%
> 5. 在其他條件不變的情況下，觀看時間每增加一小時，觀看次數增加0.05%
> 6. 在其他條件不變的情況下，曝光點閱率每增加1%，觀看次數增加15.3%
> 7. 在其他條件不變的情況下，平均觀看時間每增加1秒，觀看次數減少1.5%
## 散佈圖
## 長條圖與折線圖
紅色折線為平均觀看時間
藍色長條圖為曝光點閱率
紅色折線為觀看次數
藍色長條圖為曝光點閱率
## 程式碼
```{r}
library(readxl)
df <- read_excel("C:/Users/user/Desktop/Shorts數據_2023-11-01_2024-01-30.xlsx")
View(df)
```
```{r}
df$平均觀看時間 <- as.integer(gsub("0:00:","",df$平均觀看時間))
library(MASS)
model_poisson <- glm(觀看次數 ~ 平均觀看時間 + 已新增留言+分享次數+ `觀看 (相較於滑掉) (%)` +`平均觀看比例 (%)`+`觀看時間 (小時)`+ `曝光點閱率 (%)`, family = poisson, data = df)
# 查看摘要統計
summary(model_poisson)
exp(coef(model_poisson))
#全部都顯著相關(p<0.05)
#已新增留言每多一個，觀看次數增加0.031%
#分享次數每多一個，觀看次數減少-0.01%
#觀看 (相較於滑掉)每增加1%，觀看次數增加1.41%
#平均觀看比例每增加1%，觀看次數增加0.80%
#觀看時間每增加一小時，觀看次數增加0.05%
#曝光點閱率每增加1%，觀看次數增加15.3%
#options(scipen = 999)
100*(exp(coef(model_poisson))-1)
df$平均觀看時間 <- as.integer(gsub("0:00:","",df$平均觀看時間))
```
```{r}
par(mfrow = c(3, 4))
plot(df$觀看次數,df$平均觀看時間)
plot(df$觀看次數,df$已新增留言)
plot(df$觀看次數,df$分享次數)
plot(df$觀看次數,df$`觀看 (相較於滑掉) (%)`)
plot(df$觀看次數,df$`平均觀看比例 (%)`)
plot(df$觀看次數,df$`觀看時間 (小時)`)
plot(df$觀看次數,df$`曝光點閱率 (%)`)
```
```{r}
# 假設df是你的數據框架
df_standardized <- scale(df[, c( '已新增留言','分享次數')])
df_standardized <- as.data.frame(df_standardized)
df_standardized$觀看次數 <- df$觀看次數 # 添加非標準化的依變數
model_standardized <- glm(觀看次數 ~ ., family = poisson, data = df_standardized)
summary(model_standardized)
```
```{r}
library(jiebaRD)
library(jiebaR)
df$影片標題 <- gsub("志祺七七","",df$影片標題)
df$影片標題 <- gsub("#shorts","",df$影片標題)
df$影片標題 <- gsub("｜","",df$影片標題)
content <- df$影片標題
content = gsub("(@|#)\\w+", " ", content) #去除@或#後有數字,字母,底線 (標記人名或hashtag)
content = gsub("(http|https)://.*", " ", content) #去除網址(.:任意字元，*:0次以上)
content = gsub("[ \t]{2,}", "", content) #去除兩個以上空格或tab
content = gsub("\\n"," ",content) #去除換行
content = gsub("\\s+"," ",content) #去除一個或多個空格(+:一次以上)
content = gsub("^\\s+|\\s+$"," ",content) #去除開頭/結尾有一個或多個空格
content = gsub("&.*;"," ",content) #去除html特殊字元編碼
content = gsub("[[:digit:]]"," ",content) #去除數字
content = gsub("[[:lower:]]"," ",content) #去除小寫英文字母
content = gsub("[[:upper:]]"," ",content) #去除大寫英文字母
content = gsub("[[:punct:]]"," ",content) #去除標點符號
content = gsub("\\r", " ",content) #去除回歸鍵
cutter <- worker(bylines = TRUE)#, stop_word = "stop_word_all.txt"
segcon <- segment(as.character(content), cutter)
segcon_doc <- data.frame(do.call(rbind, lapply(segcon, paste0, collapse = ' ')))
colnames(segcon_doc)[1] <- 'segcon'
segcon_doc$segcon <- as.character(segcon_doc$segcon)
df$segcon <- segcon_doc$segcon
```
```{r}
# 原始日期字符串
date_string <- df$影片發布時間
# 使用strptime解析日期
parsed_date <- strptime(df$影片發布時間, format = "%b %d, %Y")
# 使用format格式化日期
df$影片發布時間 <- format(parsed_date, "%Y-%m-%d")
```
```{r}
df$影片發布時間 <- as.Date(df$影片發布時間)
plot(df$影片發布時間,df$`曝光點閱率 (%)`)
plot(df$影片發布時間,df$`曝光點閱率 (%)`, type = "l", col = "blue", xlab = "影片發布時間", ylab = "曝光點閱率 (%)", main = "Counts Over Time")
df <- df[order(df$影片發布時間),]
month_names <- format(df$影片發布時間, "%Y-%m-%d")
barplot(df$`曝光點閱率 (%)`, names.arg = month_names, col = "blue", xlab = "影片發布時間", ylab = "曝光點閱率 (%)")
par(new = TRUE)
plot(df$平均觀看時間, type = "o", col = "red", xaxt = "n", yaxt = "n", xlab = "", ylab = "", ylim = c(min(df$平均觀看時間), max(df$平均觀看時間)))
axis(4)
mtext("Values", side = 4, line = 3)
barplot(df$`曝光點閱率 (%)`, names.arg = month_names, col = "white", xlab = "影片發布時間", ylab = "曝光點閱率 (%)")
par(new = TRUE)
plot(df$觀看次數, type = "o", col = "red", xaxt = "n", yaxt = "n", xlab = "", ylab = "", ylim = c(min(df$觀看次數), max(df$觀看次數)))
axis(4)
mtext("Values", side = 4, line = 3)
```
```{r}
mean(df$觀看次數)
quantile(df$觀看次數, probs=0.25)
quantile(df$觀看次數, probs=0.75)
title <- c(NA)
time <- c(NA)
for(i in c(1:length(df$segcon))){
if(df$觀看次數[i]>=as.numeric(quantile(df$觀看次數, probs=0.75))){
print(df$影片標題[i])
title <- c(title,df$影片標題[i])
print(df$影片發布時間[i])
time <- c(time,df$影片發布時間[i])
}
}
barplot(title, names.arg = time, col = "white", xlab = "影片發布時間", ylab = "曝光點閱率 (%)")
```
Sign in with Wallet
Connect another wallet