Read Data

library(tidyverse)
library(tidymodels)
library(gridExtra)
library(lubridate)
library(ggplot2)

set.seed(123)
walmart <- read.csv("C:/Users/Naftali Brigitta/Documents/Kampus/PDS/UTS/Walmart.csv")

data.frame("total_data" = dim(walmart)[1],
           "total_variable" = dim(walmart)[2])

Dataset ini terdiri dari 6435 data dengan 8 variabelnya.

head(walmart, 10)

tail(walmart, 10)

Variable Description

Berikut ini deskripsi atau keterangan dari masing-masing variabel yang terdapat pada dataset ini :

Data Structure

Berikut ini struktur pada dataset yang kita miliki:

glimpse(walmart)

## Rows: 6,435
## Columns: 8
## $ Store        <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ~
## $ Date         <chr> "05-02-2010", "12-02-2010", "19-02-2010", "26-02-2010", "~
## $ Weekly_Sales <dbl> 1643691, 1641957, 1611968, 1409728, 1554807, 1439542, 147~
## $ Holiday_Flag <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ~
## $ Temperature  <dbl> 42.31, 38.51, 39.93, 46.63, 46.50, 57.79, 54.58, 51.45, 6~
## $ Fuel_Price   <dbl> 2.572, 2.548, 2.514, 2.561, 2.625, 2.667, 2.720, 2.732, 2~
## $ CPI          <dbl> 211.0964, 211.2422, 211.2891, 211.3196, 211.3501, 211.380~
## $ Unemployment <dbl> 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 7~

Karena ada tipe data yang belum sesuai, kita harus sesuaikan dengan cara:

walmart <- walmart %>%
  mutate(
    Store = as.factor(Store),
    Holiday_Flag = as.factor(Holiday_Flag),
  )

head(walmart, 10)

Missing Value

colSums(is.na(walmart))

##        Store         Date Weekly_Sales Holiday_Flag  Temperature   Fuel_Price 
##            0            0            0            0            0            0 
##          CPI Unemployment 
##            0            0

Ternyata, dataset kita tidak memiliki missing value atau nilai yang error atau hilang, jadi kita bisa lanjut untuk langkah selanjutnya.

Store

  Kita mencari tahu bagaimana penjualan mingguan pada setiap store yang terdata di data walmart.

walmart%>%
  ggplot(aes(Weekly_Sales, reorder(Store,
                                   FUN = sum, Weekly_Sales)))+
  geom_boxplot(fill=rainbow(45), color="azure4")+
  labs(title = 'Store: There are difference in weekly sales',
       x='Weekly sales',
       y='Store')+
  theme_minimal()

Dari grafik tersebut, dapat kita sadari bahwa setiap Store memiliki jumlah penjualan yang berbeda satu dengan lainnya. Kita dapat melihat bahwa Store 14 memiliki penjualan mingguan tertinggi dibanding yang lainnya.

Pengaruh Hari Libur/Tidak

walmart%>%
  ggplot(aes(as_factor(Holiday_Flag), Weekly_Sales))+
  geom_boxplot(fill = c("blue", "gold"))+
  labs(title = 'Pengaruh Hari Libur dan Tidak',
       y='Weekly sales',
       x='Holiday Flag')+
  theme_minimal()

Terlihat bahwa ketika hari tidak libur, penjualan lebih banyak atau tinggi dibanding hari libur.

Fuel Price

walmart%>%
  ggplot(aes(Fuel_Price))+
  geom_histogram(bins=50, fill=rainbow(50), color="azure2")+
  labs(
       y='Count',
       x='Fuel Price')+
  theme_bw()

walmart%>%
  ggplot(aes(Fuel_Price, Weekly_Sales))+
  geom_point(alpha =1/10)+
  labs(
       y='Weekly sales',
       x='Fuel Price')+
  theme_bw()

Hasil tersebut membuat kita menyimpulkan bahwa tidak ada hubungan yang kuat antara penjualan dengan harga bahan bakar di setiap kota.

CPI

  Kita akan melihat apakah perbedaan indeks penjualan akan memengaruhi penjualan?

walmart%>%
  ggplot(aes(CPI))+
  geom_histogram(bins=100, fill=rainbow(100), color="azure2")+
  labs(title = 'CPI: There are data ranging from 125-150, 175-200, 200-225',
       y='Count',
       x='CPI')+
  theme_bw()

walmart%>%
  ggplot(aes(CPI, Weekly_Sales))+
  geom_point(alpha =1/10)+
  labs(title = 'CPI: Seems that different range of CPI have same sales distributions',
       y='Weekly sales',
       x='CPI')+
  theme_bw()

Pada grafik sebaran tersebut, ternyata rentang CPI yang berbeda memiliki distribusi penjualan yang sama.

Unemployment

  Kita akan lihat terdapat hubungan atau tidak antara Unemployment dengan penjualan mingguan.

walmart%>%
  ggplot(aes(Unemployment))+
  geom_histogram(bins=50, fill=rainbow(50), color="azure3")+
  labs(
       y='Count',
       x='Unemployment')+
  theme_bw()

Ternyata, tingkat Unemployment yang rendah memiliki penjualan yang tinggi.

walmart%>%
  mutate(Date = as.Date(Date, "%d-%m-%Y"))

Sales per Year

  Di sini kita ingin mencari tahu apakah terdapat perbedaan total penjualan perbulannya pada tahun yang berbeda dan didapat hasil sebagai berikut.

walmart <- separate(walmart, "Date", c("Year", "Month", "Day"), sep = "-")

ggplot(walmart, aes(x = Month, y = Weekly_Sales))+
  geom_col(fill="red")+
  facet_wrap(~Day)+
  ggtitle("Weekly")

Pada tahun 2012 terdapat data yang hilang, yaitu pada bulan November dan Desember yang merupakan data penjualan yang lumayan tinggi pada tahun-tahun sebelumnya. Dari grafik di atas kita dapat melihat bahwa penjualan mengalami perbedaan di setiap bulan dan tahunnya.

Mendeskripsikan setiap kolom dari data Walmart

Nah, dari data di atas kita bisa melihat bahwa kolom Holiday_Flag merupakan bentuk dalam Character. Karena dalam kondisi ini kolom Holiday_Flag merupakan kolom dari jenis yang mewakili data, makanya kita perlu mengubah menjadi factor dengan menggunakan fungsi as_factor.

walmart <- walmart |>
  mutate(Holiday_Flag = as_factor(Holiday_Flag))
glimpse(walmart)

## Rows: 6,435
## Columns: 10
## $ Store        <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ~
## $ Year         <chr> "05", "12", "19", "26", "05", "12", "19", "26", "02", "09~
## $ Month        <chr> "02", "02", "02", "02", "03", "03", "03", "03", "04", "04~
## $ Day          <chr> "2010", "2010", "2010", "2010", "2010", "2010", "2010", "~
## $ Weekly_Sales <dbl> 1643691, 1641957, 1611968, 1409728, 1554807, 1439542, 147~
## $ Holiday_Flag <fct> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ~
## $ Temperature  <dbl> 42.31, 38.51, 39.93, 46.63, 46.50, 57.79, 54.58, 51.45, 6~
## $ Fuel_Price   <dbl> 2.572, 2.548, 2.514, 2.561, 2.625, 2.667, 2.720, 2.732, 2~
## $ CPI          <dbl> 211.0964, 211.2422, 211.2891, 211.3196, 211.3501, 211.380~
## $ Unemployment <dbl> 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 7~

Untuk melihat kategori yang ada di dalam kolom Holiday_Flag, kita menggunakan fungsi pull untuk mengesktrak 1 kolom, lalu fungsi levels untuk melihat kategori apa saja yang ada di dalam kolom itu. Dan hasil yang dapat kita lihat, yaitu terdapat kategori 0 dan 1 dalam kolom Holiday_Flag

walmart |>
  pull(Holiday_Flag) |>
  levels()

## [1] "0" "1"

Exploring the walmart data

Untuk mengetahui frekuensi dari tiap kolom Holiday_Flag, yaitu mengetahui data menunjukkan berapa jumlah Holiday_Flag yang bernilai 0 (no), dan 1 (yes). Kita akan menggunakan fungsi group_by. Setelah itu, kita juga perlu mengetahui presentase setiap Holiday_Flag yang bernilai 0 (no), dan 1 (yes), lalu kita akan mengkalkulasikan dengan memakai fungsi count, dimana kita akan membagi frekuensi Numerik yang ada di Holiday_Flag dengan kolom yang dikali dengan 100.

num_obs <- nrow(walmart)
walmart |>
  group_by(Holiday_Flag) |>
  summarize(
    count = n(),
    percentage = n() / num_obs * 100
  )

dari data diatas, persentasi 0 (no) sebesar 93% dan persentasi 1 (yes) sebesar 7%.

Create the train / test split K-nearest neighbor

  Kita perlu membagi data yang kita import menjadi training set dan test set untuk memutuskan sebuah hasil dari prediksi yang kita rancangkan. Pada umumnya, training set terdiri dari 50% dan 95% data yang kita miliki, sedangkan test set terdiri dari 5% sampai dengan 50%. Untuk mendapatkan model yang akurat dan evaluasi yang akurat kita akan menggunakan 75% dan 25%.

  Dalam proses pemisahan data ini, kita dapat menggunakan fungsi initial_splituntuk membuat training set dan test set dengan prop = 0.75. Untuk memastikan bahwa subset training dan test berisi proporsi yang tepat, maka kita harus mengatur strata ke label kategori.

walmart_split <- initial_split(walmart, prop = 0.75, strata = Holiday_Flag)
walmart_train <- training(walmart_split)
walmart_test <- testing(walmart_split)

selanjutnya, kita dapat memanggil data yang sudah dipisah dengan menggunakan fungsi glimpse

glimpse(walmart_train)

## Rows: 4,826
## Columns: 10
## $ Store        <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ~
## $ Year         <chr> "05", "12", "19", "26", "05", "12", "19", "26", "02", "09~
## $ Month        <chr> "02", "02", "02", "02", "03", "03", "03", "03", "04", "04~
## $ Day          <chr> "2010", "2010", "2010", "2010", "2010", "2010", "2010", "~
## $ Weekly_Sales <dbl> 1643691, 1641957, 1611968, 1409728, 1554807, 1439542, 147~
## $ Holiday_Flag <fct> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ~
## $ Temperature  <dbl> 42.31, 38.51, 39.93, 46.63, 46.50, 57.79, 54.58, 51.45, 6~
## $ Fuel_Price   <dbl> 2.572, 2.548, 2.514, 2.561, 2.625, 2.667, 2.720, 2.732, 2~
## $ CPI          <dbl> 211.0964, 211.2422, 211.2891, 211.3196, 211.3501, 211.380~
## $ Unemployment <dbl> 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 8.106, 7~

glimpse(walmart_test)

## Rows: 1,609
## Columns: 10
## $ Store        <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ~
## $ Year         <chr> "07", "28", "04", "02", "06", "03", "17", "01", "29", "05~
## $ Month        <chr> "05", "05", "06", "07", "08", "09", "09", "10", "10", "11~
## $ Day          <chr> "2010", "2010", "2010", "2010", "2010", "2010", "2010", "~
## $ Weekly_Sales <dbl> 1603955, 1432070, 1615525, 1492418, 1605492, 1540164, 143~
## $ Holiday_Flag <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ~
## $ Temperature  <dbl> 72.55, 80.44, 80.69, 80.91, 87.16, 81.21, 82.11, 71.89, 6~
## $ Fuel_Price   <dbl> 2.835, 2.759, 2.705, 2.669, 2.627, 2.577, 2.582, 2.603, 2~
## $ CPI          <dbl> 210.3400, 210.8968, 211.1764, 211.2235, 211.5047, 211.531~
## $ Unemployment <dbl> 7.808, 7.808, 7.808, 7.787, 7.787, 7.787, 7.787, 7.838, 7~

kemudian, kita dapat menggunakan group_by dan summarize untuk menentukan persentase hari libur berpengaruh pada pendapatan mingguan dari data walmart_train.

walmart_percentage <- walmart_train |>
  group_by(Holiday_Flag) |>
  summarize(n = n()) |>
  mutate(percent = n/nrow(walmart_train)*100)

walmart_percentage

Dari hasil tersebut dapat kita lihat bahwa 93% libur tidak berpengaruh terhadap pendapatan dan 7% libur berpengaruh terhadap pendapatan berdasarkan data training.

Preprocess the Data K-nearest neighbor

  Kita perlu membuat preprocess agar data memenuhi standard, berdasarkan chapter yang sebelumnya disebutkan bahwa algoritma KKN sangat sensitif terhadap jarak prediktornya. Kita akan menggunakan data training dalam hal ini untuk memastikan bahwa data test tidak memengaruhi aspek apapun. Untuk membuat prepocess standarization, kita akan menggunakan fungsi recipe untuk memecahkan masalah ini.

walmart_recipe <- recipe(Holiday_Flag ~ Weekly_Sales + CPI, data = walmart_train) |>
  step_scale(all_predictors()) |>
  step_center(all_predictors())

4.4.3 Train the classifier

  Kita sudah membagi data kita menjadi training dan test, lalu kita bisa membuat K-nearest neighbors dengan menggunakan data training saja. Di sini kita coba menggunakan nilai K = 3 dan menggunakan Weekly_Sales dan CPI sebagai predictornya. Sebelum kita membuat sebuah klasifikasi haruslah kita membuat workflow terlebih dahulu dengan memadukan model spesifikasi dengan recipe.

knn_spec <- nearest_neighbor(weight_func = "rectangular", neighbors = 3) |>
  set_engine("kknn") |>
  set_mode("classification")

knn_fit <- workflow() |>
  add_recipe(walmart_recipe) |>
  add_model(knn_spec) |>
  fit(data = walmart_train)

knn_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: nearest_neighbor()
## 
## -- Preprocessor ----------------------------------------------------------------
## 2 Recipe Steps
## 
## * step_scale()
## * step_center()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:
## kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(3,     data, 5), kernel = ~"rectangular")
## 
## Type of response variable: nominal
## Minimal misclassification: 0.07604642
## Best kernel: rectangular
## Best k: 3

Predict the labels in the test set K-nearest neighbor

  Objek klasifikasi yang sudah kita dapat akan digunakan untuk memprediksi label untuk data test yang tadi kita buat.

walmart_test_predictions <- predict(knn_fit, walmart_test) |>
  bind_cols(walmart_test)

walmart_test_predictions

Compute the accuracy K-nearest neighbor

  Selanjutnya, kita dapat menentukan akurasi dari klasifikasi yang sudah kita buat. Kita menggunakan fungsi metrics untuk mendapat informasi statistik.

walmart_test_predictions |>
  metrics(truth = Holiday_Flag, estimate = .pred_class) |>
  filter(.metric == "accuracy")

berdasarkan informasi tersebut, dapat kita ketahui bahwa kurang lebih 93% keakurasian dari klasifikasi yang kita buat. Dan kita juga dapat mencari seberapa banyak observasi yang benar dan keliru dengan confusion matrix.

konpusion <- walmart_test_predictions |>
  conf_mat(truth = Holiday_Flag, estimate = .pred_class)

konpusion

##           Truth
## Prediction    0    1
##          0 1478  112
##          1   17    2

berdasarkan informasi tersebut dapat kita ketahui bahwa terdapat 1495 observasi libur terhadap pendapatan yang benar dan 0 observasi libur terhadap pendapatan yang benar. Sedangkan, terdapat juga 96 observasi libur terhadap pendapatan yang ternyata tidak berpengaruh dan 18 observasi libur terhadap pendapatan yang berpengaruh.

Cross-validation K-nearest neighbor

Langkah pertama dalam memilih parameter \(K\) adalah dapat mengevaluasi pengklasifikasi dengan menggunakan training data. Jika memungkinkan, kita dapat membandingkan kinerja pengklasifikasi untuk nilai \(K\) yang berbeda dan memilih yang terbaik dengan menggunakan training data. Seperti yang kami katakan, kami akan menyelesaikan ini dengan memisahkan data pelatihan, pelatihan pada satu subset, dan mengevaluasi subset lainnya. Subset data pelatihan yang digunakan untuk evaluasi sering disebut validation set (set validasi). Ada satu perbedaan utama dari pemisahan kereta/pengujian yang kami lakukan sebelumnya. Secara khusus, kami hanya membuat satu pemisahan data, karena pada akhirnya kita harus menghasilkan satu pengklasifikasi. Jika kita memiliki beberapa pemisahan data yang berbeda menjadi data pelatihan dan pengujian, hasil yang akan keluar menjadi beberapa pengklasifikasi yang berbeda. Sekarang ayo kita coba kerjakan! Kita akan menghasilkan 5 pemisahan validasi, melatih 5 model \(K\)-nearest neighbor yang berbeda-beda.

walmart_split <- initial_split(walmart_train, prop = 0.75, strata = Holiday_Flag)
walmart_subtrain <- training(walmart_split)
walmart_validation <- testing(walmart_split)



walmart_recipe <- recipe(Holiday_Flag ~ Holiday_Flag + Weekly_Sales, 
                         data = walmart_train) |>
  step_scale(all_predictors()) |>
  step_center(all_predictors())


knn_fit <- workflow() |>
  add_recipe(walmart_recipe) |>
  add_model(knn_spec) |>
  fit(data = walmart_subtrain)


validation_predicted <- predict(knn_fit, walmart_validation) |>
  bind_cols(walmart_validation)

acc <- validation_predicted |>
  metrics(truth = Holiday_Flag, estimate = .pred_class) |>
  filter(.metric == "accuracy") |>
  select(.estimate) |>
  pull()

acc

## [1] 0.9212925

Estimasi akurasi dengan memakai split ini adalah 91,6%. Sekarang, ayo kita ulangi kode di atas sebanyak 4 kali. Setelah dihitung kembali, kami mendapatkan hasil yang berbeda-beda, antara lain : 91,6% ; 91,7% ; 91,4% ; 91,6%. Kelima hasil itu hanya perkiraan dari akurasi dasar yang sebenarnya, dari kelima perhitungan tersebut, kami mengambil rata-ratanya adalah 91,58% (pendekatan hasil rata-rata 91,6%).

Untuk menunjukkan cross-validation sebanyak 5 kali dengan tidymodels, kita harus menggunakan fungsi vfold_cv. Guna dari fungsi itu adalah untuk membagi data pelatihan menjadi lipatan v secara otomatis. Kami men-set argumen strata ke variabel label kategoris (Holiday_Flag) untuk memastikan bahwa subset pelatihan dan validasi berisi proporsi yang tepat dari setiap kategori pengamatan.

walmart_vfold <- vfold_cv(walmart_train, v = 5, strata = Holiday_Flag)
walmart_vfold

Selanjutnya, kita membuat data analysis workflow menggunakan fungsi fit_resamples, fungsi fit gunanya untuk training. Guna dari fungsi diatas adalah untuk menjalankan cross-validation pada pemisahahan kereta/validasi.

walmart_recipe <- recipe(Holiday_Flag ~ Holiday_Flag + Weekly_Sales, 
                         data = walmart_train) |>
  step_scale(all_predictors()) |>
  step_center(all_predictors())


knn_fit <- workflow() |>
  add_recipe(walmart_recipe) |>
  add_model(knn_spec) |>
  fit_resamples(resamples = walmart_vfold)

knn_fit

Fungsi collect_metrics berguna untuk menggabungkan rata-rata dan standar error pada akurasi validasi pengklasifikasi di seluruh lipatan. Anda akan menemukan hasil yang terkait dengan akurasi di baris dengan akurasi yang tercantum di bawah kolom .metrik. Anda harus mempertimbangkan mean (rata-rata) sebagai akurasi yang diperkirakan, sedangkan kesalahan standar (std_err) adalah ukuran seberapa tidak pasti kita dalam nilai rata-rata.

knn_fit |> 
  collect_metrics()

Kami dapat memilih jumlah lipatan berapa pun, dan biasanya semakin banyak kami menggunakan, semakin baik perkiraan akurasi kami (kesalahan standar lebih rendah). Di bawah ini, kita akan menunjukkan bagaimana kesalahan standar berkurang ketika kami menggunakan cross-validation 10 kali lipat daripada 5 kali lipat:

walmart_vfold <- vfold_cv(walmart_train, v = 10, strata = Holiday_Flag)

vfold_metrics <- workflow() |>
                  add_recipe(walmart_recipe) |>
                  add_model(knn_spec) |>
                  fit_resamples(resamples = walmart_vfold) |>
                  collect_metrics()

vfold_metrics