Instruksi tentang pengiriman jawaban UTS

  1. Gunakan package/lab R (R-studio) UTS-21042024.Rmd yang dibagikan pada saat ujian dalam menjawab pertanyaan-pertanyaan di bawah!
  2. Jawaban UTS di-knit dalam format HTML (.html) lalu dikirimkan via LMS sesuai batas waktu yang ditetapkan.
  3. Jawablah pertanyaan-pertanyaan di bawah ini.
  4. Replace NIM below with your MM NIM
library(stringr)

NIM = 1402201207

#Number of stores
NIM = as.numeric(str_sub(as.character(NIM), - 6, - 1))
set.seed(NIM)
rand1=400
rand2=600
nb_stores <- round(runif(1, rand1, rand2))
nb_stores
## [1] 594

Load libraries

library(rattle)  
## Loading required package: tibble
## Loading required package: bitops
## Rattle: A free graphical interface for data science with R.
## Version 5.5.1 Copyright (c) 2006-2021 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.
library(magrittr) # Utilise %>% and %<>% pipeline operators.
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gplots, quietly=TRUE)
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
library("ISLR")

==========================================================================================================

Load dataset: Sales of Child Car Seats from package Carseats {ISLR}

Description A simulated data set containing sales of child car seats at 400 different stores. - Usage: Carseats - Format: A data frame with 400 observations on the following 11 variables. - Sales: Unit sales (in thousands) at each location - CompPrice: Price charged by competitor at each location - Income: Community income level (in thousands of dollars) - Advertising: Local advertising budget for company at each location (in thousands of dollars) - Population: Population size in region (in thousands) - Price: Price company charges for car seats at each site - ShelveLoc: A factor with levels Bad, Good and Medium indicating the quality of the shelving location for the car seats at each site - Age: Average age of the local population - Education: Education level at each location - Urban: A factor with levels No and Yes to indicate whether the store is in an urban or rural location - US: A factor with levels No and Yes to indicate whether the store is in the US or not - Source: Simulated data

References James, G., Witten, D., Hastie, T., and Tibshirani, R. (2013) An Introduction to Statistical Learning with applications in R, www.StatLearning.com, Springer-Verlag, New York

#A pre-defined value is used to reset the random seed so that results are repeatable.
crv$seed <- NIM 

#Load the Carseats data
attach(ISLR::Carseats)

#Assign to dummy variable
crs$dataset <- synthpop::syn(data=Carseats, k = nb_stores, seed = NIM, proper = TRUE)$syn
## Sample(s) of size 594 will be generated from original data of size 400.
## 
## 
## Synthesis
## -----------
##  Sales CompPrice Income Advertising Population Price ShelveLoc Age Education Urban
##  US
View(crs$dataset)

Create vector High that represent high sales and merge with original Carseats.

Saudara tidak memutuskan berapa threshold untuk menyatakan sales High tapi menyerahkan ke pada random number antara rand1 dan rand2. TETAPKANLAH rand1 dan rand2 antara 7 dan 10.

rand1=7
rand2=10
threshold <- runif(1, rand1, rand2)
threshold
## [1] 8.330188
crs$dataset$SalesDisk = sample(crs$dataset$Sales)
crs$dataset = crs$dataset %>%
  mutate(SalesDisk = as.factor(ifelse(Sales <= threshold, "Low", "High")))
tail(crs$dataset,5)
##     Sales CompPrice Income Advertising Population Price ShelveLoc Age Education
## 590  4.38       123    105           5         71   123       Bad  55        14
## 591  4.62       129     62           0        333   133       Bad  33        11
## 592  8.55       139     77          18        481   126      Good  44        16
## 593  7.58       116     89           0        244    90    Medium  77        12
## 594  5.27       128     77           0        199   122       Bad  34        11
##     Urban  US SalesDisk
## 590   Yes Yes       Low
## 591    No  No       Low
## 592   Yes Yes      High
## 593   Yes  No       Low
## 594    No  No       Low

#Define the following variable selections.

crs$input     <- c("CompPrice", "Income", "Advertising",
                   "Population", "Price", "ShelveLoc", "Age",
                   "Education", "Urban", "US")

crs$numeric   <- c("CompPrice", "Income", "Advertising",
                   "Population", "Price", "Age", "Education")

crs$categoric <- c("ShelveLoc", "Urban", "US")

crs$target    <- "SalesDisk"
crs$risk      <- NULL
crs$ident     <- NULL
crs$ignore    <- "Sales"
crs$weights   <- NULL

Now the dataset is ready for the following process

===================================================================================================

Data exploration

Obtain a summary of the dataset.

summary(crs$dataset[c(crs$input, crs$risk, crs$target, crs$ignore)])
##    CompPrice         Income        Advertising       Population   
##  Min.   : 85.0   Min.   : 21.00   Min.   : 0.000   Min.   : 10.0  
##  1st Qu.:117.0   1st Qu.: 42.25   1st Qu.: 0.000   1st Qu.:129.8  
##  Median :125.0   Median : 69.50   Median : 3.000   Median :287.0  
##  Mean   :125.6   Mean   : 69.29   Mean   : 5.636   Mean   :268.7  
##  3rd Qu.:136.0   3rd Qu.: 93.00   3rd Qu.:10.000   3rd Qu.:407.0  
##  Max.   :162.0   Max.   :120.00   Max.   :29.000   Max.   :509.0  
##      Price        ShelveLoc        Age          Education     Urban    
##  Min.   : 24.0   Bad   :149   Min.   :25.00   Min.   :10.00   No :178  
##  1st Qu.:100.0   Good  :103   1st Qu.:41.00   1st Qu.:12.00   Yes:416  
##  Median :116.0   Medium:342   Median :55.50   Median :15.00            
##  Mean   :117.7                Mean   :53.72   Mean   :14.18            
##  3rd Qu.:132.8                3rd Qu.:66.00   3rd Qu.:16.00            
##  Max.   :185.0                Max.   :80.00   Max.   :18.00            
##    US      SalesDisk      Sales       
##  No :249   High:197   Min.   : 0.000  
##  Yes:345   Low :397   1st Qu.: 5.040  
##                       Median : 7.450  
##                       Mean   : 7.091  
##                       3rd Qu.: 9.000  
##                       Max.   :14.370

========================================================================================================

Pertanyaan 1

Jelaskan boxplot Sales di bawah ini!

Jawaban: Plot ini menunjukkan distribusi penjualan di berbagai kategori ‘ShelveLoc’: Bad, Good, Medium, dan kategori keseluruhan berlabel ‘All’. Harga jual rata-rata bervariasi di berbagai kategori ‘ShelveLoc’.Rentang interkuartil (IQR), yang menunjukkan median 50% penjualan juga bervariasi antar kategori. Hal ini menunjukkan terdapat variabilitas dalam kinerja penjualan dari katergori - kategori ini.

Generate a Price box plot.

p01 <- crs %>%
  with(dataset) %>%
  dplyr::mutate(ShelveLoc=as.factor(ShelveLoc)) %>%
  ggplot2::ggplot(ggplot2::aes(y=Price)) +
  ggplot2::geom_boxplot(ggplot2::aes(x="All"), notch=TRUE, fill="grey") +
  ggplot2::stat_summary(ggplot2::aes(x="All"), fun.y = mean, geom="point", shape=8) +
  ggplot2::geom_boxplot(ggplot2::aes(x=ShelveLoc, fill=SalesDisk), notch=TRUE) +
  ggplot2::stat_summary(ggplot2::aes(x=ShelveLoc), fun.y = mean, geom="point", shape=8) +
  ggplot2::xlab("ShelveLoc") +
  ggplot2::ggtitle("Distribution of Price by ShelveLoc and SalesDisk",
                   sub=paste("Rattle", format(Sys.time(), 
                                              "%Y-%b-%d %H:%M:%S"))) +
  ggplot2::theme(legend.position="none")
## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#Display the plots.
gridExtra::grid.arrange(p01)
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?

==========================================================================================================

Pertanyaan 2

Bandingkan 2 boxplot di bawah ini! Kesimpulan apakah yang Saudara dapatkan dari membandingkan dua boxplot tersebut?

Jawaban: … Kedua grafik tersebut merupakan diagram kotak yang mewakili distribusi harga (baik ‘CompPrice’ atau ‘Price’) di berbagai kategori ‘SalesDisk’ (High, Low, dan All). Pada kedua grafik, setiap diagram kotak memberikan ringkasan visual titik data harga minimum, kuartil pertama (Q1), median (Q2), kuartil ketiga (Q3), dan maksimum untuk setiap kategori ‘SalesDisk’ dalam setiap ‘ShelveLoc’. Bagian ‘kotak’ dari plot blox mewakili rentang interkuartil (IQR), yaitu rentang antara Q1 dan Q3. Garis di dalam kotak menunjukkan harga median.Distribusi harga bervariasi di berbagai kategori ‘SalesDisk’ dan ‘ShelveLoc’ di kedua grafik. Hal ini menunjukkan variabilitas dalam penetapan harga berdasarkan kategori-kategori ini.

#Box plot for CompPrice
p02 <- crs %>%   
  with(dataset) %>%
  dplyr::mutate(SalesDisk=as.factor(SalesDisk)) %>%
  ggplot2::ggplot(ggplot2::aes(y=CompPrice)) +
  ggplot2::geom_boxplot(ggplot2::aes(x="All"), notch=TRUE, fill="grey") +
  ggplot2::stat_summary(ggplot2::aes(x="All"), fun.y=mean, geom="point", shape=8) +
  ggplot2::geom_boxplot(ggplot2::aes(x=SalesDisk, fill=ShelveLoc), notch=TRUE) +
  ggplot2::stat_summary(ggplot2::aes(x=SalesDisk), fun.y=mean, geom="point", shape=8) +
  ggplot2::xlab("SalesDisk") +
  ggplot2::ggtitle("Distribution of CompPrice by SalesDisk and ShelveLoc",
                   sub=paste("Rattle", format(Sys.time(), 
                                              "%Y-%b-%d %H:%M:%S"), Sys.info()["user"])) +
  ggplot2::theme(legend.position="none")

#Box plot for Price

p06 <- crs %>%
  with(dataset) %>%
  dplyr::mutate(SalesDisk=as.factor(SalesDisk)) %>%
  ggplot2::ggplot(ggplot2::aes(y=Price)) +
  ggplot2::geom_boxplot(ggplot2::aes(x="All"), notch=TRUE, fill="grey") +
  ggplot2::stat_summary(ggplot2::aes(x="All"), fun.y=mean, geom="point", shape=8) +
  ggplot2::geom_boxplot(ggplot2::aes(x=SalesDisk, fill=ShelveLoc), notch=TRUE) +
  ggplot2::stat_summary(ggplot2::aes(x=SalesDisk), fun.y=mean, geom="point", shape=8) +
  ggplot2::xlab("SalesDisk") +
  ggplot2::ggtitle("Distribution of Price by SalesDisk and ShelveLoc",
                   sub=paste("Rattle", format(Sys.time(), 
                                              "%Y-%b-%d %H:%M:%S"), Sys.info()["user"])) +
  ggplot2::theme(legend.position="none")

#Display the plots
gridExtra::grid.arrange(p02)
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?

gridExtra::grid.arrange(p06)
## Notch went outside hinges
## ℹ Do you want `notch = FALSE`?

===================================================================================================

Pertanyaan 3

Jelaskan barplot Urban di bawah ini! Apa kesimpulan Saudara?

Jawaban: … - Sumbu x menunjukkan apakah distrik penjualan merupakan wilayah urban (‘Ya’) atau tidak (‘Tidak’). - Sumbu y mewakili frekuensi setiap kategori, mulai dari 0 hingga 700. - Ada bar untuk setiap kategori ‘urban’: satu untuk penjualan ‘Rendah’ (hijau), satu untuk penjualan ‘Semua’ (merah), dan satu untuk penjualan ‘Tinggi’ (biru). - Untuk kategori ‘Ya’, frekuensi penjualan ‘Semua’, ‘Tinggi’, dan ‘rendah’ masing-masing sekitar 416, 283, dan 133. - Untuk kategori ‘Tidak’, frekuensi penjualan ‘Semua’, ‘Tinggi’, dan ‘rendah’ masing-masing adalah sekitar 178, lebih dari 114, dan 64. Dapat dikatakan bahwa barplot menunjukkan bahwa terdapat lebih banyak penjualan di wilayah urban (‘Ya’) di semua tingkat disk penjualan.

#Generate the summary data for plotting.
ds <- rbind(summary(as.factor(na.omit(crs$dataset$Urban))),
    summary(as.factor(na.omit(crs$dataset[crs$dataset$SalesDisk=='Low',]$Urban))),
    summary(as.factor(na.omit(crs$dataset[crs$dataset$SalesDisk=='High',]$Urban))))

# Sort the entries.

ord <- order(ds[1,], decreasing=TRUE)

# Plot the data.

bp <-  barplot2(ds[,ord], beside=TRUE, ylab="Frequency", xlab="Urban", 
                ylim=c(0, 700), col=colorspace::rainbow_hcl(3))

# Add the actual frequencies.

text(bp, as.numeric(ds[,ord])+8, as.numeric(ds[,ord]))

# Add a legend to the plot.

legend("topright", bty="n", c("All","Low","High"),  fill=colorspace::rainbow_hcl(3))

# Add a title to the plot.

title(main="Distribution of Urban by SalesDisk",
    sub=paste("Rattle", format(Sys.time(), "%Y-%b-%d %H:%M:%S"), Sys.info()["user"]))

==========================================================================================================

Pertanyaan 4

Bandingkan barplot di bawah ini dengan barplot sebelumnya (pertanyaan 3)! Kesimpulan apakah yang Saudara dapatkan dari membandingkan dua barplot tersebut?

Jawaban: … kedua grafik menunjukkan distribusi penjualan di berbagai kategori. Namun, kategori-kategori tersebut berbeda dalam kategori yang diwakilinya - satu kategori menunjukkan distribusi berdasarkan apakah distrik penjualan berada di urban atau tidak, sedangkan kategori lainnya menunjukkan distribusi berdasarkan apakah distrik penjualan berada di AS atau tidak. Pada kedua grafik, kategori penjualan ‘All’ memiliki frekuensi tertinggi pada kategori ‘Ya’ dan ‘Tidak’. Hal ini menunjukkan bahwa terlepas dari apakah distrik penjualan berada di perkotaan atau di AS, sebagian besar penjualan berada dalam kategori ‘All’.

Bar Plot US

#Generate the summary data for plotting.
ds <- rbind(summary(as.factor(na.omit(crs$dataset$US))),
    summary(as.factor(na.omit(crs$dataset[crs$dataset$SalesDisk=='Low',]$US))),
    summary(as.factor(na.omit(crs$dataset[crs$dataset$SalesDisk=='High',]$US))))

# Sort the entries.

ord <- order(ds[1,], decreasing=TRUE)

# Plot the data.

bp <-  barplot2(ds[,ord], beside=TRUE, ylab="Frequency", xlab="US", 
                ylim=c(0, 700), col=colorspace::rainbow_hcl(3))

# Add the actual frequencies.

text(bp, as.numeric(ds[,ord])+7, as.numeric(ds[,ord]))

# Add a legend to the plot.

legend("topright", bty="n", c("All","Low","High"),  fill=colorspace::rainbow_hcl(3))

# Add a title to the plot.

title(main="Distribution of US by SalesDisk",
    sub=paste("Rattle", format(Sys.time(), "%Y-%b-%d %H:%M:%S"), Sys.info()["user"]))

==========================================================================================================

Pertanyaan 5

Jelaskan pairplot di bawah ini! Apa kesimpulan Saudara?

Jawaban: … Grafik ini memberikan gambaran tentang hubungan antara dua variabel yaitu price dan sales’. Dalam grafik dinyatakan “Corr: -0,432” yang menunjukkan korelasi negatif antara kedua variabel ini.“High: -0,389” dan “Low: -0,290”, kemungkinan mengacu pada nilai atau ambang batas korelasi yang lebih tinggi dan lebih rendah dalam sub data. Grafik ini memberikan representasi visual tentang hubungan antara dua variabel numerik. Serta nilai korelasi yang memberikan ukuran kuantitatif mengenai kekuatan dan arah hubungan.

# Display a pairs plot for the selected numeric variables c(1,6).

crs$dataset %>%
  dplyr::mutate(High=as.factor(SalesDisk)) %>%
  GGally::ggpairs(columns=c(1,6),
        mapping=ggplot2::aes(colour=SalesDisk, alpha=0.5),
                diag=list(continuous="densityDiag",
                          discrete="barDiag"),
                upper=list(continuous="cor",
                           combo="box",
                           discrete="ratio"),
                lower=list(continuous="points",
                           combo="denstrip",
                           discrete="facetbar")) +
  ggplot2::ggtitle("Paired plot of numeric variables", 
                   sub=paste("Rattle", format(Sys.time(), 
                                              "%Y-%b-%d %H:%M:%S"), Sys.info()["user"])) +
  ggplot2::theme(panel.grid.major=ggplot2::element_blank())
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2

==========================================================================================================

Pertanyaan 6

Jelaskan pairplot di bawah ini! Apa kesimpulan Saudara?

#Display a pairs plot for the selected categoric variables c(1,7,10).
crs$dataset %>%
  dplyr::mutate(High=as.factor(SalesDisk)) %>%
  GGally::ggpairs(columns=c(1,7,10),
        mapping=ggplot2::aes(colour=SalesDisk, alpha=0.5),
                diag=list(continuous="densityDiag",
                          discrete="barDiag"),
                upper=list(continuous="cor",
                           combo="box",
                           discrete="ratio"),
                lower=list(continuous="points",
                           combo="denstrip",
                           discrete="facetbar")) +
  ggplot2::ggtitle("Paired plot of categoric variables", 
                   sub=paste("Rattle", format(Sys.time(), 
                                              "%Y-%b-%d %H:%M:%S"), Sys.info()["user"])) +
  ggplot2::theme(panel.grid.major=ggplot2::element_blank())
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 23 rows containing missing values or values outside the scale range
## (`geom_bar()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_bar()`).

====================================================================================================

Pertanyaan 6

Variabel2 apa saja yang memprediksi sales High? Jelaskan!

Jawaban: 1. ShelveLoc: Kualitas lokasi rak (Good, Medium, Bad) merupakan prediktor yang signifikan. Misalnya, jika ShelveLoc Good atau Medium, dan Harganya kurang dari 104,5, maka penjualannya diperkirakan ‘High’. 2. Harga: Harga produk juga memainkan peran penting. Misalnya, ketika Harga kurang dari 104,5 dan Usia kurang dari 49, maka penjualan diprediksi akan Tinggi. 3. Usia: Usia pelanggan merupakan faktor penting lainnya. Misalnya, ketika Usia kurang dari 49 dan Harga kurang dari 104,5, penjualan diperkirakan akan Tingg. 4. CompPrice: Harga yang kompetitif juga merupakan faktor yang signifikan. Misalnya, ketika CompPrice lebih besar atau sama dengan 119,5 dan Price lebih besar atau sama dengan 73,5, maka penjualan diprediksi Tinggi. 5. Pendapatan: Pendapatan pelanggan merupakan faktor penting lainnya. Misalnya, ketika Pendapatan lebih besar atau sama dengan 80 dan Harga lebih besar atau sama dengan 73,5, maka penjualan diprediksi Tinggi. 6. Periklanan: Tingkat periklanan juga berperan. Misalnya, ketika Periklanan lebih besar atau sama dengan 7,5 dan Harga kurang dari 133,5, maka penjualan diperkirakan ‘Tinggi’. 7. Populasi: Besarnya populasi merupakan prediktor penting lainnya. Misalnya, ketika Populasi lebih besar atau sama dengan 234,5 dan Pendapatan lebih besar atau sama dengan 38,5, maka penjualan diprediksi Tinggi.

Decision Tree

The ‘rpart’ package provides the ‘rpart’ function.

library(rpart, quietly=TRUE)

# Reset the random number seed to obtain the same results each time.
set.seed(crv$seed)

# Build the Decision Tree model.
crs$rpart <- rpart(SalesDisk ~ .,
    data=crs$dataset[c(crs$input, crs$target)],
    method="class",
    parms=list(split="information"),
    model=TRUE)

# Generate a textual view of the Decision Tree model.
print(crs$rpart)
## n= 594 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 594 197 Low (0.33164983 0.66835017)  
##     2) Price< 89.5 67  10 High (0.85074627 0.14925373)  
##       4) Advertising>=6 37   0 High (1.00000000 0.00000000) *
##       5) Advertising< 6 30  10 High (0.66666667 0.33333333)  
##        10) Age< 57.5 21   3 High (0.85714286 0.14285714) *
##        11) Age>=57.5 9   2 Low (0.22222222 0.77777778) *
##     3) Price>=89.5 527 140 Low (0.26565465 0.73434535)  
##       6) CompPrice>=124.5 286 117 Low (0.40909091 0.59090909)  
##        12) Price< 142 201  91 High (0.54726368 0.45273632)  
##          24) ShelveLoc=Good,Medium 165  60 High (0.63636364 0.36363636)  
##            48) Advertising>=6 65   9 High (0.86153846 0.13846154) *
##            49) Advertising< 6 100  49 Low (0.49000000 0.51000000)  
##              98) CompPrice>=140.5 33   6 High (0.81818182 0.18181818) *
##              99) CompPrice< 140.5 67  22 Low (0.32835821 0.67164179)  
##               198) Age< 44.5 27  12 High (0.55555556 0.44444444)  
##                 396) Income>=37.5 20   5 High (0.75000000 0.25000000) *
##                 397) Income< 37.5 7   0 Low (0.00000000 1.00000000) *
##               199) Age>=44.5 40   7 Low (0.17500000 0.82500000) *
##          25) ShelveLoc=Bad 36   5 Low (0.13888889 0.86111111) *
##        13) Price>=142 85   7 Low (0.08235294 0.91764706) *
##       7) CompPrice< 124.5 241  23 Low (0.09543568 0.90456432)  
##        14) Advertising>=9.5 59  17 Low (0.28813559 0.71186441)  
##          28) ShelveLoc=Good,Medium 37  17 Low (0.45945946 0.54054054)  
##            56) Income>=72 24   9 High (0.62500000 0.37500000) *
##            57) Income< 72 13   2 Low (0.15384615 0.84615385) *
##          29) ShelveLoc=Bad 22   0 Low (0.00000000 1.00000000) *
##        15) Advertising< 9.5 182   6 Low (0.03296703 0.96703297) *
printcp(crs$rpart)
## 
## Classification tree:
## rpart(formula = SalesDisk ~ ., data = crs$dataset[c(crs$input, 
##     crs$target)], method = "class", model = TRUE, parms = list(split = "information"))
## 
## Variables actually used in tree construction:
## [1] Advertising Age         CompPrice   Income      Price       ShelveLoc  
## 
## Root node error: 197/594 = 0.33165
## 
## n= 594 
## 
##         CP nsplit rel error  xerror     xstd
## 1 0.238579      0   1.00000 1.00000 0.058246
## 2 0.076142      1   0.76142 0.82234 0.055099
## 3 0.058376      4   0.53299 0.71066 0.052509
## 4 0.025381      6   0.41624 0.59391 0.049203
## 5 0.012690      8   0.36548 0.45685 0.044359
## 6 0.010152     10   0.34010 0.48223 0.045347
## 7 0.010000     13   0.30964 0.46701 0.044760
cat("\n")

==========================================================================================================

Pertanyaan 7

Dari daftar rules di bawah ini, mana yang menurut Saudara paling menarik (interesting) dan baik untuk difollow-up? Jelaskan alasan Saudara dan rencana atau strategi follow-upnya!

Jawaban : Rule 397 merupakan yang paling menarik untuk difollow-up. Karena menargetkan demografi tertentu yaitu individu di bawah usia 44,5 dengan pendapatan yang lebih rendah (Pendapatan < 37,5), memberikan gambaran tentang pola pembelian mereka mengenai produk yang ditawarkan dengan harga kompetitif (CompPrice < 140,5) yang tidak terlalu mahal (Harga < 142). lalu, ada potensi untuk menjual lebih mahal dalam segmen ini dan ada peluang untuk mengeksplorasi apakah mereka mungkin tertarik pada opsi yang sedikit lebih mahal yang menawarkan fitur atau manfaat tambahan. Selain itu, pengeluaran iklan juga rendah (Iklan < 6). Hal ini mendorong penyelidikan untuk mengetahui apakah iklan yang ditargetkan dapat memengaruhi demografi ini untuk mempertimbangkan alternatif dengan harga lebih tinggi.

Rencana yang dapat diterapkan yaitu meneliti data pembelian masa lalu dalam demografi yang diidentifikasi untuk menemukan pola pembelian yang terlihat dalam perilaku mereka. Analisis ini dapat mengungkap apakah mereka secara konsisten memilih opsi dengan harga lebih rendah atau telah menunjukkan kecenderungan untuk menginvestasikan produk dengan harga lebih tinggi dalam kategori yang sama.

#List the rules from the tree using a Rattle support function.
asRules(crs$rpart)
## 
##  Rule number: 29 [SalesDisk=Low cover=22 (4%) prob=1.00]
##    Price>=89.5
##    CompPrice< 124.5
##    Advertising>=9.5
##    ShelveLoc=Bad
## 
##  Rule number: 397 [SalesDisk=Low cover=7 (1%) prob=1.00]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Good,Medium
##    Advertising< 6
##    CompPrice< 140.5
##    Age< 44.5
##    Income< 37.5
## 
##  Rule number: 15 [SalesDisk=Low cover=182 (31%) prob=0.97]
##    Price>=89.5
##    CompPrice< 124.5
##    Advertising< 9.5
## 
##  Rule number: 13 [SalesDisk=Low cover=85 (14%) prob=0.92]
##    Price>=89.5
##    CompPrice>=124.5
##    Price>=142
## 
##  Rule number: 25 [SalesDisk=Low cover=36 (6%) prob=0.86]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Bad
## 
##  Rule number: 57 [SalesDisk=Low cover=13 (2%) prob=0.85]
##    Price>=89.5
##    CompPrice< 124.5
##    Advertising>=9.5
##    ShelveLoc=Good,Medium
##    Income< 72
## 
##  Rule number: 199 [SalesDisk=Low cover=40 (7%) prob=0.82]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Good,Medium
##    Advertising< 6
##    CompPrice< 140.5
##    Age>=44.5
## 
##  Rule number: 11 [SalesDisk=Low cover=9 (2%) prob=0.78]
##    Price< 89.5
##    Advertising< 6
##    Age>=57.5
## 
##  Rule number: 56 [SalesDisk=High cover=24 (4%) prob=0.38]
##    Price>=89.5
##    CompPrice< 124.5
##    Advertising>=9.5
##    ShelveLoc=Good,Medium
##    Income>=72
## 
##  Rule number: 396 [SalesDisk=High cover=20 (3%) prob=0.25]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Good,Medium
##    Advertising< 6
##    CompPrice< 140.5
##    Age< 44.5
##    Income>=37.5
## 
##  Rule number: 98 [SalesDisk=High cover=33 (6%) prob=0.18]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Good,Medium
##    Advertising< 6
##    CompPrice>=140.5
## 
##  Rule number: 10 [SalesDisk=High cover=21 (4%) prob=0.14]
##    Price< 89.5
##    Advertising< 6
##    Age< 57.5
## 
##  Rule number: 48 [SalesDisk=High cover=65 (11%) prob=0.14]
##    Price>=89.5
##    CompPrice>=124.5
##    Price< 142
##    ShelveLoc=Good,Medium
##    Advertising>=6
## 
##  Rule number: 4 [SalesDisk=High cover=37 (6%) prob=0.00]
##    Price< 89.5
##    Advertising>=6

==========================================================================================================

Pertanyaan 8

Gambar di bawah ini adalah gambar pohon keputusan (decision tree). 1. Berdasarkan gambar pohon tersebut, variabel2 apa yang memprediksi High 2. Tetapkan berdasarkan gambar tersebut (bisa Saudara konsultasikan/bandingan dengan summary decision tree di pertanyaan 6), jalur keputusan mana mana yang akan berpengaruh terhadap lebih dari 60% penjualan produk Saudara?

#Plot the resulting Decision Tree. 
#We use the rpart.plot package.
font_size <- 0.5

# Create the plot using rpart.plot with font size adjustment
fancyRpartPlot(crs$rpart, main="Decision Tree Carseats SalesDisk", cex=font_size, 
               sub = paste0("Rattle ", format(Sys.time(), "%Y-%b-%d %H:%M:%S "), Sys.info()["user"]))

==========================================================================================================

Pertanyaan 9

Berdasarkan kurva ROC di bawah ini, lakukan asesmen terhadap model decision tree Saudara! Bagaimana kurva tersebut membantu Saudara menghitung resiko pengambilan keputusan global?

#Evaluate model performance on the testing dataset. ROC

library(ROCR) #ROC Curve: requires the ROCR package.

# ROC Curve: requires the ggplot2 package.
library(ggplot2, quietly=TRUE)

# Generate an ROC Curve for the rpart model.
crs$pr <- predict(crs$rpart, newdata=crs$dataset[c(crs$input, crs$target)])[,2]

# Remove observations with missing target.
no.miss   <- na.omit(crs$dataset[c(crs$input, crs$target)]$SalesDisk)
miss.list <- attr(no.miss, "na.action")
attributes(no.miss) <- NULL

if (length(miss.list))
{
  pred <- prediction(crs$pr[-miss.list], no.miss)
} else
{
  pred <- prediction(crs$pr, no.miss)
}

pe <- performance(pred, "tpr", "fpr")
au <- performance(pred, "auc")@y.values[[1]]
pd <- data.frame(fpr=unlist(pe@x.values), tpr=unlist(pe@y.values))
p <- ggplot(pd, aes(x=fpr, y=tpr))
p <- p + geom_line(colour="red")
p <- p + xlab("False Positive Rate") + ylab("True Positive Rate")
p <- p + ggtitle("ROC Curve Decision Tree Carseats SalesDisk=High", 
                 sub=paste("Rattle", format(Sys.time(), "%Y-%b-%d %H:%M:%S"), Sys.info()["user"]))
p <- p + theme(plot.title=element_text(size=10))
p <- p + geom_line(data=data.frame(), aes(x=c(0,1), y=c(0,1)), colour="grey")
p <- p + annotate("text", x=0.50, y=0.00, hjust=0, vjust=0, size=5,
                   label=paste("AUC =", round(au, 2)))
print(p)

# Calculate the area under the curve for the plot.

# Remove observations with missing target.
no.miss   <- na.omit(crs$dataset[c(crs$input, crs$target)]$SalesDisk)
miss.list <- attr(no.miss, "na.action")
attributes(no.miss) <- NULL

if (length(miss.list))
{
  pred <- prediction(crs$pr[-miss.list], no.miss)
} else
{
  pred <- prediction(crs$pr, no.miss)
}
performance(pred, "auc")
## A performance instance
##   'Area under the ROC curve'

==========================================================================================================

Pertanyaan 10 Prediksi

Toko dengan kondisi sebagai berikut: CompPrice=115, Income=28, Advertising=11, Population=29, Price=86, ShelveLoc=Bad, Age=53, Education=18, Urban=Yes, US=No.

  1. Lakukan prediksi apakah “SalesDisk=High” atau “SalesDisk=Low”!
  2. Variable mana yang tidak berpengaruh terhadap prediksi? Tunjukkan dengan bukti hasil prediksi!

==========================================================================================================