1 . Intoduction

Perkenlakan nama saya Saputra Wijaya. Hari ini saya akan menerapkan Data Visualization pada project yang akan saya buat. Hopefully bisa berguna. Saya sedang mengikuti Pelatihan di Algoritma

1.1 . Library

Langkah pertama yang harus kita lakukan adalah dengan cara mendownload atau menerapkan beberapa Library yang akan kita butuhkan. Dapat dilihat dibawah ini :

library(ggplot2)
library(GGally)
library(ggthemes)
library(ggpubr)

## Loading required package: magrittr

library(leaflet)
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following object is masked from 'package:base':
## 
##     date

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:lubridate':
## 
##     intersect, setdiff, union

## The following object is masked from 'package:GGally':
## 
##     nasa

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(reshape2)
library(ggrepel)

1.2 . Dataset

Pada Project hari ini data yang akan saya gunakan adalah Kumpulan data video dari Youtube US atau United States. Saya sangat tertarik untuk melihat Analisa apa saja yang dapat saya hasilkan dari Data yang ada

vids <- read.csv("USvideos.csv")
names(vids)

##  [1] "trending_date"          "title"                 
##  [3] "channel_title"          "category_id"           
##  [5] "publish_time"           "views"                 
##  [7] "likes"                  "dislikes"              
##  [9] "comment_count"          "comments_disabled"     
## [11] "ratings_disabled"       "video_error_or_removed"

str(vids)

## 'data.frame':    13400 obs. of  12 variables:
##  $ trending_date         : Factor w/ 67 levels "17.01.12","17.02.12",..: 14 14 14 14 14 14 14 14 14 14 ...
##  $ title                 : Factor w/ 2986 levels "'I have dad moves': Barack Obama discusses dancing on David Letterman's new Netflix show",..: 2802 2574 2081 1903 1231 89 2164 143 2482 2920 ...
##  $ channel_title         : Factor w/ 1408 levels "_¢_Á_\235","÷\201\220µ_â¬_\220 Korean Englishman",..: 195 686 1046 472 902 559 1063 283 6 1358 ...
##  $ category_id           : int  22 24 23 24 24 28 24 28 1 25 ...
##  $ publish_time          : Factor w/ 2903 levels "2008-04-05T18:22:40.000Z",..: 302 271 255 275 253 307 240 258 281 279 ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...

1.3 . Restructure Our Dataset

Setelah kita melihat data yang kita miliki. Maka langkah pertama yang tentu harus kita lakukan adalah membetulkan Structure atau bentuk data agar dapat kebih mudah diolah kedepannya

vids$trending_date <- ydm(vids$trending_date) 
vids$title <- as.character(vids$title)
vids$channel_title <- as.character(vids$channel_title)
str(vids)

## 'data.frame':    13400 obs. of  12 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : int  22 24 23 24 24 28 24 28 1 25 ...
##  $ publish_time          : Factor w/ 2903 levels "2008-04-05T18:22:40.000Z",..: 302 271 255 275 253 307 240 258 281 279 ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...

class(vids)

## [1] "data.frame"

Fun Fact : Kita dapat menggunakan function class untuk membantu kita melihat Data Type dari Field yang kita ingi, contohnya adalah

class(vids$title)

## [1] "character"

Setelah kita membetulkan data yang kita telah olah. Maka untuk mempermudah pengolahan data kita bisa menggunakan fucntion Suplly untuk field Category agar tidak hanya angka, melainkan berupa Characters

vids$category_id <- sapply(as.character(vids$category_id), switch, 
                           "1" = "Film and Animation",
                           "2" = "Autos and Vehicles", 
                           "10" = "Music", 
                           "15" = "Pets and Animals", 
                           "17" = "Sports",
                           "19" = "Travel and Events", 
                           "20" = "Gaming", 
                           "22" = "People and Blogs", 
                           "23" = "Comedy",
                           "24" = "Entertainment", 
                           "25" = "News and Politics",
                           "26" = "Howto and Style", 
                           "27" = "Education",
                           "28" = "Science and Technology", 
                           "29" = "Nonprofit and Activism",
                           "43" = "Shows")
vids$category_id <- as.factor(vids$category_id)

class(vids$category_id)

## [1] "factor"

str(vids)

## 'data.frame':    13400 obs. of  12 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : Factor w/ 2903 levels "2008-04-05T18:22:40.000Z",..: 302 271 255 275 253 307 240 258 281 279 ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...

Setelah kita mengubah field Category ID kita menjadi Character, Saya juga akan melakukan penambahan publish_wday untuk melihat tanggal upload dari masing-masing video lalu langkah selanjutnya adalah mengubah waktu publish yang ada sesuai dengan di America agar dapat dengan mudah diolah.

head(vids$publish_time)

## [1] 2017-11-13T17:13:01.000Z 2017-11-13T07:30:00.000Z
## [3] 2017-11-12T19:05:24.000Z 2017-11-13T11:00:04.000Z
## [5] 2017-11-12T18:01:41.000Z 2017-11-13T19:07:23.000Z
## 2903 Levels: 2008-04-05T18:22:40.000Z ... 2018-01-21T05:44:30.000Z

vids$publish_time <- ymd_hms(vids$publish_time,tz="America/New_York")

## Date in ISO8601 format; converting timezone from UTC to "America/New_York".

str(vids$publish_time)

##  POSIXct[1:13400], format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...

pw <- function(x){
    if(x < 8){
      x <- "12am to 8am"
    }else if(x >= 8 & x < 16){
      x <- "8am to 3pm"
    }else{
      x <- "3pm to 12am"
    }  
}


vids$publish_hour <- hour(vids$publish_time)

vids$publish_when <- as.factor(sapply(vids$publish_hour, pw)) 
table(vids$publish_when)

## 
## 12am to 8am 3pm to 12am  8am to 3pm 
##        2392        3511        7497

vids$publish_wday <- as.factor(day(vids$publish_time))
table(vids$publish_wday)

## 
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18 
## 362 311 304 344 409 265 323 355 346 445 522 661 647 618 600 590 535 505 
##  19  20  21  22  23  24  25  26  27  28  29  30  31 
## 584 663 832 661 281 124 204 258 395 448 474 287  47

str(vids)

## 'data.frame':    13400 obs. of  15 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  12 2 14 6 13 14 0 16 9 8 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 1 3 1 3 3 1 2 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 13 12 13 12 12 13 13 ...

1.4 . Most Data

Langkah selanjutnya adalah kita membuat sebuah data baru yang berisi video yang memiliki views terbanyak.

most <- vids[vids$views == max(vids$views),]
most

##      trending_date                                              title
## 6182    2017-12-14 YouTube Rewind: The Shape of 2017 | #YouTubeRewind
##          channel_title   category_id        publish_time     views   likes
## 6182 YouTube Spotlight Entertainment 2017-12-06 12:58:51 149376127 3093544
##      dislikes comment_count comments_disabled ratings_disabled
## 6182  1643059        810698             FALSE            FALSE
##      video_error_or_removed publish_hour publish_when publish_wday
## 6182                  FALSE           12   8am to 3pm            6

str(vids)

## 'data.frame':    13400 obs. of  15 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  12 2 14 6 13 14 0 16 9 8 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 1 3 1 3 3 1 2 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 13 12 13 12 12 13 13 ...

Hasilnya adalah Video “YouTube Rewind: The Shape of 2017 | #YouTubeRewind” adalah Video dengan views terbanyak di dataset yang kita miliki.

2 . Data Visualization

Let’s begin !

2.1 . Simple Plot

Data Visualization pertama yang akan kita akan lakukan adalah melakukan plot category_id dengan jumlah views

plot(vids$category_id,  vids$views)

str(vids)

## 'data.frame':    13400 obs. of  15 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...
##  $ views                 : int  748374 2418783 3191434 343168 2095731 119180 2103417 817732 826059 256426 ...
##  $ likes                 : int  57527 97185 146033 10172 132235 9763 15993 23663 3543 12654 ...
##  $ dislikes              : int  2966 6146 5339 666 1989 511 2445 778 119 1363 ...
##  $ comment_count         : int  15954 12703 8181 2146 17518 1434 1970 3432 340 2368 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  12 2 14 6 13 14 0 16 9 8 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 1 3 1 3 3 1 2 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 13 12 13 12 12 13 13 ...

Diatas adalahh contoh penerapan Function plot(). Berikut ini adalah hasil visualisasi yang lain

plot(vids$publish_wday, vids$view)

Dari pengolaahan data diatas dapat dilihat bahwa video yang diupload tanggal 6 itu memiliki views yang sangat tinggi dibanding video yang lain. Mungkin juga data ini diperoleh dari banyaknya Video menarik yang di-upload pada tanggal 6.

Selanjutanya kita dapat melakukan pengolahan data dengan cara membuat field baru yaitu views, likes, dislikes, comment_count pada data kita

vids[,c("views", "likes", "dislikes", "comment_count")] <- lapply(vids[,c("views", "likes", "dislikes", "comment_count")], as.numeric)
str(vids)

## 'data.frame':    13400 obs. of  15 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...
##  $ views                 : num  748374 2418783 3191434 343168 2095731 ...
##  $ likes                 : num  57527 97185 146033 10172 132235 ...
##  $ dislikes              : num  2966 6146 5339 666 1989 ...
##  $ comment_count         : num  15954 12703 8181 2146 17518 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  12 2 14 6 13 14 0 16 9 8 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 1 3 1 3 3 1 2 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 13 12 13 12 12 13 13 ...

Langkah selanjutnya adalah kita dapat membuat data baru dengan nama vids.u untuk mencari atau membuat variable baru dan melakukan pengolahan dengan menambahkan beberapa field

vids.u <- vids[match(unique(vids$title), vids$title),]
vids.u$timetotrend <- vids.u$trending_date - as.Date(vids.u$publish_time)
vids.u$timetotrend <- as.factor(ifelse(vids.u$timetotrend <= 7, vids.u$timetotrend, "8+"))
str(vids.u)

## 'data.frame':    2986 obs. of  16 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "WE WANT TO TALK ABOUT OUR MARRIAGE" "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Racist Superman | Rudy Mancuso, King Bach & Lele Pons" "Nickelback Lyrics: Real or Fake?" ...
##  $ channel_title         : chr  "CaseyNeistat" "LastWeekTonight" "Rudy Mancuso" "Good Mythical Morning" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 11 4 2 4 4 13 4 13 5 9 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 12:13:01" "2017-11-13 02:30:00" ...
##  $ views                 : num  748374 2418783 3191434 343168 2095731 ...
##  $ likes                 : num  57527 97185 146033 10172 132235 ...
##  $ dislikes              : num  2966 6146 5339 666 1989 ...
##  $ comment_count         : num  15954 12703 8181 2146 17518 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  12 2 14 6 13 14 0 16 9 8 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 1 3 1 3 3 1 2 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 13 12 13 12 12 13 13 ...
##  $ timetotrend           : Factor w/ 9 levels "0","1","2","3",..: 2 2 3 2 3 2 3 3 2 2 ...

head(vids.u)

##   trending_date
## 1    2017-11-14
## 2    2017-11-14
## 3    2017-11-14
## 4    2017-11-14
## 5    2017-11-14
## 6    2017-11-14
##                                                            title
## 1                             WE WANT TO TALK ABOUT OUR MARRIAGE
## 2 The Trump Presidency: Last Week Tonight with John Oliver (HBO)
## 3          Racist Superman | Rudy Mancuso, King Bach & Lele Pons
## 4                               Nickelback Lyrics: Real or Fake?
## 5                                       I Dare You: GOING BALD!?
## 6                                          2 Weeks with iPhone X
##           channel_title            category_id        publish_time   views
## 1          CaseyNeistat       People and Blogs 2017-11-13 12:13:01  748374
## 2       LastWeekTonight          Entertainment 2017-11-13 02:30:00 2418783
## 3          Rudy Mancuso                 Comedy 2017-11-12 14:05:24 3191434
## 4 Good Mythical Morning          Entertainment 2017-11-13 06:00:04  343168
## 5              nigahiga          Entertainment 2017-11-12 13:01:41 2095731
## 6              iJustine Science and Technology 2017-11-13 14:07:23  119180
##    likes dislikes comment_count comments_disabled ratings_disabled
## 1  57527     2966         15954             FALSE            FALSE
## 2  97185     6146         12703             FALSE            FALSE
## 3 146033     5339          8181             FALSE            FALSE
## 4  10172      666          2146             FALSE            FALSE
## 5 132235     1989         17518             FALSE            FALSE
## 6   9763      511          1434             FALSE            FALSE
##   video_error_or_removed publish_hour publish_when publish_wday
## 1                  FALSE           12   8am to 3pm           13
## 2                  FALSE            2  12am to 8am           13
## 3                  FALSE           14   8am to 3pm           12
## 4                  FALSE            6  12am to 8am           13
## 5                  FALSE           13   8am to 3pm           12
## 6                  FALSE           14   8am to 3pm           13
##   timetotrend
## 1           1
## 2           1
## 3           2
## 4           1
## 5           2
## 6           1

2.2 . Implementation of Plot

Selanjutnya kita dapat melakukan melakukan visualisai dengan menggunakan Plot. Berikut adalah penjelasannya :

plot(as.factor(vids.u$publish_hour), vids.u$likes/vids.u$views)

plot(as.factor(vids.u$publish_when), vids.u$likes/vids.u$views)

Plot pertama menghasilkan data bahwa paling banyak video di-upload pada pukul 11.00 dan fakta lainnya adalah terdapat video yang di upload pada pukul 23.00 dengan ration likes/views nya paling besar yaitu menyampai 0.30. Sedangkan plot kedua semakin menguatkan plot pertama dengan bukti bahwa paling banyak video di-upload pada pukul 08 am hingga 3 pm, sehingga sesuai dengan plot pertama yaitu pada jam 11.00. Lalu video yang paling banyak ditonton yaitu pada pukul 3 pm hingga 12 am, sesuai dengan data pada plot pertama yaitu pada pukul 23.00 atau 11 pm.

Lalu kita akan melakukan anlisa dengan menggunakan data yang lain. Saya memilih 3 Category yaitu Howto and Style, Music, dan Entertainment karena setelah melakukan riset ketiga category tersebut adalah yang paling teratas.

table(vids.u$category_id)

## 
##     Autos and Vehicles                 Comedy              Education 
##                     41                    273                    107 
##          Entertainment     Film and Animation                 Gaming 
##                    736                    152                     30 
##        Howto and Style                  Music      News and Politics 
##                    285                    391                    271 
## Nonprofit and Activism       People and Blogs       Pets and Animals 
##                      8                    228                     66 
## Science and Technology                  Shows                 Sports 
##                    175                      1                    188 
##      Travel and Events 
##                     34

vids.fav <- vids.u[vids.u$category_id == "Howto and Style" | vids.u$category_id == "Music" | vids.u$category_id == "Entertainment",]

Lalu dengan vids.fav kita akan melakukan plot untuk menyimpulkan beberapa hal

plot(vids.fav$likes, vids.fav$dislikes)

plot((vids.fav$likes/vids.fav$dislikes)/1000, vids.fav$comment_count)

Hasilnya adalah banyak video dengan 3 cateogry terbanyak belum tentu mendapatkan likes yang banyak. Masih ada juga video yang mendapatkan dislikes sangat banyak, walau ada juga video yang mendapatkan likes yang sangat banyak. Lalu pada plot kedua kita melihat fakta bahwa Video dengan ration Likes yang banyak belum tentu mendapatkan banyak komentar oleh pengguna. Bahkan video yang lebih banyak dislikes nya biasanya lebih banyak comment. Hal ini memunculkan spekulasi bahwa masyarakat lebih suka melakukan kritikan atau comment hal yang kurang baik dibandingkan dengan pujian dan sejenisnya

Kita telah mendapatkan banyak sekali hasil yang cukup menarik hanya dari plot saja. Baiklah kita akan coba dengan hal yang lebih jauh. Selanjutnya saya membuat ratio untuk likesratio dan dislikeratio

vids.fav$category_id <- factor(vids.fav$category_id)
head(vids.fav$category_id)

## [1] Entertainment Entertainment Entertainment Entertainment Entertainment
## [6] Music        
## Levels: Entertainment Howto and Style Music

vids.fav$likesratio <- (vids.fav$likes/vids.fav$views)
vids.fav$dislikesratio <- (vids.fav$dislikes/vids.fav$views)
str(vids.fav)

## 'data.frame':    1412 obs. of  18 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-14" ...
##  $ title                 : chr  "The Trump Presidency: Last Week Tonight with John Oliver (HBO)" "Nickelback Lyrics: Real or Fake?" "I Dare You: GOING BALD!?" "Roy Moore & Jeff Sessions Cold Open - SNL" ...
##  $ channel_title         : chr  "LastWeekTonight" "Good Mythical Morning" "nigahiga" "Saturday Night Live" ...
##  $ category_id           : Factor w/ 3 levels "Entertainment",..: 1 1 1 1 1 3 2 1 2 1 ...
##  $ publish_time          : POSIXct, format: "2017-11-13 02:30:00" "2017-11-13 06:00:04" ...
##  $ views                 : num  2418783 343168 2095731 2103417 104578 ...
##  $ likes                 : num  97185 10172 132235 15993 1576 ...
##  $ dislikes              : num  6146 666 1989 2445 303 ...
##  $ comment_count         : num  12703 2146 17518 1970 1279 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  2 6 13 0 22 12 11 9 11 12 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 1 1 3 1 2 3 3 3 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 13 13 12 12 12 13 12 12 13 6 ...
##  $ timetotrend           : Factor w/ 9 levels "0","1","2","3",..: 2 2 3 3 2 2 3 3 2 9 ...
##  $ likesratio            : num  0.0402 0.0296 0.0631 0.0076 0.0151 ...
##  $ dislikesratio         : num  0.002541 0.001941 0.000949 0.001162 0.002897 ...

Lalu selanjutnya saya kaan membuat 1 buah plot dan 1 buah histogram untuk melakukan perbandingan video dengan parameter likesratio dan dislikesratio.

plot(x = vids.fav$likesratio, y = vids.fav$dislikesratio, col = vids.fav$category_id, pch = 20) 
abline(lm(vids.fav$dislikesratio ~ vids.fav$likesratio), col=8, lwd=2, lty=1)
legend("topright", legend=levels(vids.fav$category_id), fill=1:3)

hist(vids.fav$likesratio)
lines(density(vids.fav$likesratio , col="darkblue")) #ini bisa dibutuhkan atau enggak

## Warning: In density.default(vids.fav$likesratio, col = "darkblue") :
##  extra argument 'col' will be disregarded

Dapat dilihat dari plot bahwa Music masih cukup unggul untuk likesratio dibanding dengan kategori yang lain. Sedangkan untuk dislikesratio terbesar dipegang oleh category Entertainment atau hiburan. Sedangkan dibandingkan dengan Entertainment, Howto dan Style masih mendapatkan likesratio yang cukup baik.

2.3 . Pie

Lalu untuk melakukan analisa yang lebih mendalam. Saya akan melakukan filter lagi yaitu video dengan 3 category tersebut dan dengan syarat bahwa views nya harus lebih besar dari 1 juta viewers

vids.fav.lot <- vids.fav[vids.fav$views > 1000000, ] #lebih dari 1 M views

head(vids.fav.lot)

##    trending_date
## 2     2017-11-14
## 5     2017-11-14
## 7     2017-11-14
## 33    2017-11-14
## 46    2017-11-14
## 50    2017-11-14
##                                                             title
## 2  The Trump Presidency: Last Week Tonight with John Oliver (HBO)
## 5                                        I Dare You: GOING BALD!?
## 7                       Roy Moore & Jeff Sessions Cold Open - SNL
## 33                    Eminem - Walk On Water (Audio) ft. BeyoncÌ©
## 46               iPhone X vs Makeup Transformation (Face ID TEST)
## 50        ELDERS REACT TO iPHONE X (Facial Recognition, Animojis)
##          channel_title     category_id        publish_time    views  likes
## 2      LastWeekTonight   Entertainment 2017-11-13 02:30:00  2418783  97185
## 5             nigahiga   Entertainment 2017-11-12 13:01:41  2095731 132235
## 7  Saturday Night Live   Entertainment 2017-11-12 00:37:17  2103417  15993
## 33          EminemVEVO           Music 2017-11-10 12:00:03 17158531 787419
## 46            dope2111 Howto and Style 2017-11-11 19:45:54  1456472  33505
## 50                 FBE   Entertainment 2017-11-10 18:05:25  2045386  45406
##    dislikes comment_count comments_disabled ratings_disabled
## 2      6146         12703             FALSE            FALSE
## 5      1989         17518             FALSE            FALSE
## 7      2445          1970             FALSE            FALSE
## 33    43420        125882             FALSE            FALSE
## 46     1660          2160             FALSE            FALSE
## 50     2842          8309             FALSE            FALSE
##    video_error_or_removed publish_hour publish_when publish_wday
## 2                   FALSE            2  12am to 8am           13
## 5                   FALSE           13   8am to 3pm           12
## 7                   FALSE            0  12am to 8am           12
## 33                  FALSE           12   8am to 3pm           10
## 46                  FALSE           19  3pm to 12am           11
## 50                  FALSE           18  3pm to 12am           10
##    timetotrend  likesratio dislikesratio
## 2            1 0.040179297  0.0025409472
## 5            2 0.063097315  0.0009490722
## 7            2 0.007603343  0.0011623943
## 33           4 0.045890817  0.0025305197
## 46           2 0.023004218  0.0011397404
## 50           4 0.022199233  0.0013894688

pie(table(vids.fav.lot$category_id), labels=names(table(vids.fav.lot$category_id)), col=topo.colors(20))

Pie bukan lah salah satu diagram yang terbaik tapi kita dapat lihat bahwa Entertainment memiliki jumlah video terbanyak untuk filter viewers lebih dair 1.000.000 Lalu diikuti oleh Music dan Howto and Style. Hal ini membuktikan bahwa Entertainment tetap menjadi bagian yang menarik untuk Masyrakat karena tujuan masyrakat menonton youtube mayoritasnya adalah untuk hiburan, dan salah satu method dari hiburan adalah music. Walau Entertainment seperti vlog, QnA, dan sebagainya masih sangat amat banyak peminatnya.

2.4 . library(ggplot)

Perkenalkan salah satu library yang paling powerful yang ada di R, yaitu ggplot, berikut ini adalah hasil penerapan saya :

ggplot(data = vids.fav, aes(x=category_id, y=likes, size=comment_count/views))+
  geom_boxplot()+
  geom_jitter(aes(col=publish_time))+
  theme(legend.position = "bottom")+
  labs(title = "Data Visualization 1", x="Category ID", y = "Likes", subtitle =  "Algoritma", caption = "Made by Saputra Wijaya")

Dapat dilihat diatas bahwa Music memiliki jumlah likes yang cukup banyak dibandingkan dengan yang lain. Hal ini juga dapat dilihat bahwa Likes terbanyak dipegang oleh video dari category Music. Lalu dengan ratio Comment_count/views yang cukup baik juga. Hasil analisa selanjutnya adalah

ggplot(data = vids.fav, aes(x=category_id, y=likesratio, size=views))+
  geom_boxplot()+
  geom_jitter(aes(col=publish_when))+
  theme(legend.position = "bottom")+
  labs(title = "Data Visualization 2", x="Category ID", y = "Likes Ratio", subtitle =  "Algoritma", caption = "Made by Saputra Wijaya")

Hasil data visualization diatas dapat kita lihat bahwa Music sangat unggul untuk views di masyarakat dan memiliki Likes ratio paling tinggi. Lalu dapat kita lihat bahwa Category music biasanya di upload pada pukul 12 am to 8 am. Namun, fakta menarik music yang diupload pada pukul 3 pm to 12 am lah yang mengungguli. Dari data diatas kita juga dapat melihat bahwa untuk masing-masing kategori, video yang di-upload pada 3 pm to 12 am lah yang memiliki likes ratio tertinggi.

ggplot(vids.fav, aes(x=publish_when, y=likesratio, size= views))+
  geom_jitter(aes(col=publish_when))+
  labs(title = "Data Visualization 3", x="Publish When", y = "Like Ratio", subtitle =  "Algoritma", caption = "Made by Saputra Wijaya")

Hasil analisa selanjutnya menyatakan bahwa terbanyak adalah video yang di-upload pada jam 8 am to 3 pm. Hal ini menyimpulkan bahwa para pemilik Channel Youtube lebih sering upload diatas jam kerja, namun fakta menarik nya adalah likesratio terbesar dipegang oleh video yang diupload pukul 3 pm to 12 am. Lalu video yang di upload pada 12 am to 8 adalah yang terdikit dengan 300 video saja

temp2 <- aggregate.data.frame(vids.fav$dislikes, by=list(vids.fav$category_id), mean)
head(temp2)

##           Group.1         x
## 1   Entertainment 2303.7745
## 2 Howto and Style  598.0912
## 3           Music 1814.7647

ggplot(temp2, aes(x=Group.1, y=x))+
  geom_col(aes(fill = Group.1))+
  theme(axis.text.x = element_text(angle = 90, hjust = 1))+
  coord_flip(xlim=  , ylim =) +
  labs(x = "Category", y = "Dislikes", title = "Average Dislike by category", subtitle = "Algoritma", caption = "made by Saputra Wijaya")

Hasil data diatas dapat kita lihat bahwa Entertainment memiliki rata-rata jumlah dislikes yang cukup tinggi dibandingkan dengan 2 Category yang lain. Hal ini menyimpulkan walau Entertainment adalah video yang terbanyak namun banyak juga yang tidak menyukai content dari category tersebut. Berbeda dengan Music yang masih memiliki mean dislikes ratio lebih rendah dibandingkan dengan Entertainment

ggplot(vids.fav, aes(x=category_id, y=likesratio))+
  geom_col(position="dodge", aes(fill=vids.fav$likes))+
  coord_flip()

Hasil selanjutnya adalah Music melupakan Category yang memiliki likesratio yang cukup tinggi dan tentu semakin menjadikan Music sebagai salah satu Category yang tervaforit

max(vids.fav.lot$channel_title)

## [1] "Zoella"

vids.zoella <- vids[vids$channel_title == "Zoella",]

vids.zoella$sentiment <- (vids.zoella$likes/vids.zoella$dislikes)*100

str(vids.zoella)

## 'data.frame':    14 obs. of  16 variables:
##  $ trending_date         : Date, format: "2017-11-14" "2017-11-23" ...
##  $ title                 : chr  "My Every Day Autumn Makeup | Zoella" "Easy Festive DIY Ideas | Zoella" "Easy Festive DIY Ideas | Zoella" "Easy Festive DIY Ideas | Zoella" ...
##  $ channel_title         : chr  "Zoella" "Zoella" "Zoella" "Zoella" ...
##  $ category_id           : Factor w/ 16 levels "Autos and Vehicles",..: 7 7 7 7 7 7 7 7 7 7 ...
##  $ publish_time          : POSIXct, format: "2017-11-08 13:24:16" "2017-11-22 13:00:02" ...
##  $ views                 : num  1390440 431883 694652 785042 869739 ...
##  $ likes                 : num  86207 40912 54674 58918 62866 ...
##  $ dislikes              : num  1775 1134 1848 2150 2436 ...
##  $ comment_count         : num  710 2174 2726 429 613 ...
##  $ comments_disabled     : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ ratings_disabled      : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ video_error_or_removed: logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ publish_hour          : int  13 13 13 13 13 13 13 13 13 13 ...
##  $ publish_when          : Factor w/ 3 levels "12am to 8am",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ publish_wday          : Factor w/ 31 levels "1","2","3","4",..: 8 22 22 22 22 22 22 22 7 7 ...
##  $ sentiment             : num  4857 3608 2959 2740 2581 ...

Kita dapat lihat bahwa Channel title yang paling banyak membuat video dan memiliki viewers lebih dari 1.000.000 adalah Zoella. Oleh karena itu kita akan coba melihat Sentiment apa saja yang mungkin terjadi dan kita akan mencoba melakukan analisa nya dengan ggplot

zoella.agg <- aggregate.data.frame(vids.zoella$views, by = list(vids.zoella$title), mean)
names(zoella.agg) <- c("title", "mean")

g1 <- ggplot(vids.zoella, aes(x=trending_date, y=views))+
  geom_col()+
  geom_point(aes(col=likes/dislikes))+
  geom_hline(data=zoella.agg, aes(yintercept=mean),linetype=2)

g1 +
  geom_line(col="black")+
  facet_wrap(~as.factor(title), ncol=2)+
  scale_color_gradient(low="yellow", high="green2")+
  theme(legend.position = "none", 
        strip.text=element_text(size=7))

## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?

Dari hasil data diatas kita dapat melihat bahwa Video dengan judul “My Every Day Autumn Makeup” mendapatkan view terbanyak diikuti oleh 2 video lainnya. Lalu sisanya video terkait tidak mencapi views mencapi 1.000.000

Lalu saya akan mencoba analisa terakhir saya yaitu :

max(vids.fav.lot$channel_title[vids.fav.lot$category_id == "Music"])

## [1] "TroyeSivanVEVO"

vids.troye <- vids.fav.lot[vids.fav.lot$channel_title == "TroyeSivanVEVO",]

vids.troye$sentiment <- (vids.troye$likes/vids.troye$comment_count)

ggplot(vids.troye, aes(x=sentiment, y=views, size= views))+
  geom_jitter(aes(col=publish_when))+
  coord_flip() +
  labs(title = "Data Visualization 3", x="Sentiment", y = "Views", subtitle =  "Algoritma", caption = "Made by Saputra Wijaya")

Ternyata data hanya memunculkan bahwa Troye hanya memiliki 1 video di list dataset kita namun dengan angka yang cukup tinggi untuk viewers dan kita dapat lihat bahwa hal unik terjadi Troye melakukan upload video pada pukul 12 am to 8 am.

3 . Summary

Kesimpulannya adalah Youtube saat ini masih sangat dikuasai untuk hal yang berbau Entertainment. Ini menyimpulkan bahwa Yotube saat ini masih digunakan untuk media hiburan saja belum mencapai titik sebagai media belajar yang efektif. Hal ini juga di dorong dengan adanya perpindahan Music dari konvensional menjadi digital. Hal ini semakin mendukung penggunaan youtube sebagai sebagai jejaring sosial yang digunakan untuk media hiburan. Fakta menarik lainnya adalah banyak sekali Channel Youtube yang melakukan upload pada pukul 3 pm - 12 am. Lalu Youtube video terbanyak dipegang oleh Youtube Rewind 2017. Sekian dari saya semoga data visualization ini dapat berguna. Terimakasih

Data Visualization Project from Saputra

Saputra Wijaya

Updated: March 15, 2019