Memuat Package yang Digunakan
library(tidyverse)
library(mlbench)
library(purrr)Membandingkan model linear dengan model polinom derajat dua.
Root Mean Square Error (RMSE)
cars<-as_tibble(cars)
line <- cars %>%
lm(dist ~ speed, data = .)
poly <- cars %>%
lm(dist ~ speed + I(speed^2), data = .)
rmse <- function(x,t) {
sqrt(mean(sum((t - x)^2
)
)
)
}
rmse(predict(line, cars), cars$dist) ## [1] 106.5529rmse(predict(poly, cars), cars$dist) ## [1] 104.0419Pada hasil diatas terlihat error pada model polinom lebih kecil dibandingkan pada model linear. Hal ini menandakan model polinom lebih baik daripada model linear. Menggunakan semua data untuk mendapatkan model yang sesuai adalah ide yang bagus pada umumnya. Namun untuk membandingkan model dibutukan data yang tidak digunakan pada penyesuaian model. Hal ini agar dapat terlihat seberapa baik model menggeneralisasi, seberapa baik model mengrjakan data yang belum dilihat dan digunakan agar sesuai dengan parameter pada model.
Data dibagi menjadi dua set. Satu digunakan untuk training dan satu lagi digunakan untuk test.
1-25 training
26-50 test
training_data <- cars[1:25,]
test_data <- cars[26:50,]
line <- training_data %>%
lm(dist ~ speed, data = .)
poly <- training_data %>%
lm(dist ~ speed + I(speed^2), data = .)
rmse(predict(line, test_data),
test_data$dist) ## [1] 88.89189rmse(predict(poly, test_data), test_data$dist)## [1] 83.84263Model polinom masih lebih baik. Namun pada dataset diatas merupakan data yang diurutkan, sehingga trdapat kecenderungan data training merupakan short distance dan data test merupakan long distance. Karena datanya tidak sama maka itu merupakan kurang baik.
Agar meminimalsir hal tersemut gunakan sample.
sampled_cars <- cars %>%
mutate(training = sample(0:1,
nrow(cars),
replace = TRUE))
sampled_cars## # A tibble: 50 x 3
## speed dist training
## <dbl> <dbl> <int>
## 1 4 2 0
## 2 4 10 0
## 3 7 4 0
## 4 7 22 1
## 5 8 16 0
## 6 9 10 1
## 7 10 18 1
## 8 10 26 0
## 9 10 34 1
## 10 11 17 0
## # ... with 40 more rowstraining_data <- sampled_cars %>%
filter(training == 1)
test_data <- sampled_cars %>%
filter(training == 0)
training_data ## # A tibble: 27 x 3
## speed dist training
## <dbl> <dbl> <int>
## 1 7 22 1
## 2 9 10 1
## 3 10 18 1
## 4 10 34 1
## 5 11 28 1
## 6 12 20 1
## 7 12 24 1
## 8 12 28 1
## 9 13 46 1
## 10 14 80 1
## # ... with 17 more rowstest_data## # A tibble: 23 x 3
## speed dist training
## <dbl> <dbl> <int>
## 1 4 2 0
## 2 4 10 0
## 3 7 4 0
## 4 8 16 0
## 5 10 26 0
## 6 11 17 0
## 7 12 14 0
## 8 13 26 0
## 9 13 34 0
## 10 13 34 0
## # ... with 13 more rowsline <- training_data %>%
lm(dist ~ speed, data = .)
poly <- training_data %>%
lm(dist ~ speed + I(speed^2), data = .)
rmse(predict(line, test_data),
test_data$dist) ## [1] 58.91309rmse(predict(poly, test_data),
test_data$dist) ## [1] 63.44335Memisahkan data hanyalah alat untuk mengevaluasi seberapa baik model berbeda bekerja (mencari model terbaik). Pada model yang dipilih yang akan dikerjakan selalu akan disesuaikan dengan semua data yang dimiliki.
data("BreastCancer")
as_tibble(BreastCancer)## # A tibble: 699 x 11
## Id Cl.thickness Cell.size Cell.shape Marg.adhesion Epith.c.size
## <chr> <ord> <ord> <ord> <ord> <ord>
## 1 1000~ 5 1 1 1 2
## 2 1002~ 5 4 4 5 7
## 3 1015~ 3 1 1 1 2
## 4 1016~ 6 8 8 1 3
## 5 1017~ 4 1 1 3 2
## 6 1017~ 8 10 10 8 7
## 7 1018~ 1 1 1 1 2
## 8 1018~ 2 1 2 1 2
## 9 1033~ 2 1 1 1 2
## 10 1033~ 4 2 1 1 2
## # ... with 689 more rows, and 5 more variables: Bare.nuclei <fct>,
## # Bl.cromatin <fct>, Normal.nucleoli <fct>, Mitoses <fct>, Class <fct># Mengubah variabell cl.thickness dan cell.size menjadi numerik dan mengubah jika data merupakan benign menjadi 1 dan malignant menjadi 2
formatted_data <- BreastCancer %>%
mutate(Cl.thickness.numeric =
as.numeric(
as.character(Cl.thickness)),
Cell.size.numeric =
as.numeric(
as.character(Cell.size))) %>%
mutate(IsMalignant =
ifelse(Class == "benign", 0, 1))
# Model
fitted_model <- formatted_data %>%
glm(
IsMalignant ~ Cl.thickness.numeric + Cell.size.numeric,
data = .)
# Prediksi peluang dari regresi logstik
as_tibble(predict(fitted_model,
formatted_data,
type = "response") )## # A tibble: 699 x 1
## value
## <dbl>
## 1 0.174
## 2 0.459
## 3 0.0646
## 4 0.893
## 5 0.119
## 6 1.19
## 7 -0.0444
## 8 0.0101
## 9 0.0101
## 10 0.214
## # ... with 689 more rows# Kondisi jika kurang dari 0.5 menjadi 0 (benign) dan lebih atau sama dengan menjadi 1 (malignant)
classify <- function(probability) {
ifelse(probability < 0.5, 0, 1)
}
classified_malignant <- classify(
predict(fitted_model, formatted_data))
as.tibble(classified_malignant)## Warning: `as.tibble()` is deprecated as of tibble 2.0.0.
## Please use `as_tibble()` instead.
## The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## # A tibble: 699 x 1
## value
## <dbl>
## 1 0
## 2 0
## 3 0
## 4 1
## 5 0
## 6 1
## 7 0
## 8 0
## 9 0
## 10 0
## # ... with 689 more rows#Confusion matrix
table(formatted_data$IsMalignant,
classified_malignant) ## classified_malignant
## 0 1
## 0 450 8
## 1 42 199table(formatted_data$IsMalignant,
classified_malignant,
dnn=c("Data", "Predictions")) ## Predictions
## Data 0 1
## 0 450 8
## 1 42 199classify <- function(probability) {
ifelse(probability < 0.5,
"benign",
"malignant")
}
classified <- classify(
predict(fitted_model,
formatted_data))
table(formatted_data$Class,
classified,
dnn=c("Data", "Predictions")) ## Predictions
## Data benign malignant
## benign 450 8
## malignant 42 199accuracy <- function(confusion_matrix) {
sum(diag(confusion_matrix))/sum(confusion_matrix)
}
specificity <- function(confusion_matrix) {
confusion_matrix[1,1]/
(confusion_matrix[1,1]+confusion_matrix[1,2])
}
sensitivity <- function(confusion_matrix) {
confusion_matrix[2,2]/
(confusion_matrix[2,1]+confusion_matrix[2,2])
}
prediction_summary <- function(confusion_matrix) {
c("accuracy" = accuracy(confusion_matrix),
"specificity" = specificity(confusion_matrix),
"sensitivity" = sensitivity(confusion_matrix))
}
random_prediction_summary <- function() {
prediction_summary(table(BreastCancer$Class,
sample(BreastCancer$Class)))
}
replicate(5, random_prediction_summary())## [,1] [,2] [,3] [,4] [,5]
## accuracy 0.5593705 0.5393419 0.5336195 0.5565093 0.5507868
## specificity 0.6637555 0.6484716 0.6441048 0.6615721 0.6572052
## sensitivity 0.3609959 0.3319502 0.3236515 0.3568465 0.3485477Pada bagian sebelumnya data cars dibagi menjadi dua dataset. Hal ini merupakan cara yang umum dilakukan. Namun terkadang data perlu diklasifikasikan menjadi beberapa data set (lebih dari dua dataset).
# Mengacak urutan dataset menggukan sample
permuted_cars <- cars[sample(1:nrow(cars)),]
permuted_cars ## # A tibble: 50 x 2
## speed dist
## <dbl> <dbl>
## 1 16 32
## 2 11 17
## 3 8 16
## 4 20 64
## 5 19 68
## 6 15 54
## 7 14 26
## 8 4 10
## 9 4 2
## 10 15 26
## # ... with 40 more rows# Dibuat menadi sebuah function
permute_rows <- function(df) {
df[sample(1:nrow(df)),]
}
permuted_cars <- cars %>% permute_rows
permuted_cars## # A tibble: 50 x 2
## speed dist
## <dbl> <dbl>
## 1 8 16
## 2 25 85
## 3 19 36
## 4 24 92
## 5 16 40
## 6 15 54
## 7 17 40
## 8 13 46
## 9 22 66
## 10 19 46
## # ... with 40 more rows# Datasets dibagi menjadi lima dataset
group_data <- function(df, n) {
groups <- rep(1:n, each = nrow(df)/n)
split(df, groups) }
grouped_cars<- cars %>%
permute_rows %>%
group_data(5)
# Dataset pertama dari lima dataset baru
grouped_cars[[1]]## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 11 17
## 2 14 80
## 3 18 42
## 4 12 28
## 5 16 40
## 6 4 10
## 7 17 50
## 8 13 46
## 9 16 32
## 10 19 36# Model dari dataset pertama
grouped_cars[[1]] %>%
lm(dist ~ speed, data = .) %>%
.$coefficients## (Intercept) speed
## 6.437209 2.261628# Model seluruh dataset dibuat menjadi list
estimates <- grouped_cars %>%
map(. %>%
lm(dist ~ speed,
data = .) %>%
.$coefficients)
estimates## $`1`
## (Intercept) speed
## 6.437209 2.261628
##
## $`2`
## (Intercept) speed
## -30.052137 5.009944
##
## $`3`
## (Intercept) speed
## -21.610220 4.130261
##
## $`4`
## (Intercept) speed
## -9.000000 2.924242
##
## $`5`
## (Intercept) speed
## -14.694915 3.824859# Model sebuah dataset dibuat menjadi array
estimates <- grouped_cars %>%
map(. %>%
lm(dist ~ speed,
data = .) %>%
.$coefficients) %>%
do.call("rbind", .)
estimates## (Intercept) speed
## 1 6.437209 2.261628
## 2 -30.052137 5.009944
## 3 -21.610220 4.130261
## 4 -9.000000 2.924242
## 5 -14.694915 3.824859Apabila dataset dibagi menjadi beberapa dataset, validasi yang dilakukan adalah dengan cross validasi. Misal dataset dibagi menjadi lima dataset, maka dari lima dataset tersebut diambil empat dataset menjadi data training dan satu dataset menjadi data test. Kemudian diambil lagi dari lima dataset tersebut diambil empat dataset menjadi data training dan satu dataset yang berbeda dengan datatest sebelumnya menjadi data test. Hal tersebut dilakukan sampai k kali dalam kasus ini lima kali.
# Mengurangi satu dataset berbeda pada k (lima) dataset sampai k (lima) dataet
cross_validation_groups <- function(grouped_df) {
result <- vector(mode = "list",
length = length(grouped_df))
for (i in seq_along(grouped_df)) {
result[[i]] <- grouped_df[-i] %>%
do.call("rbind", .) }
result }
# Model setela dikurangi masing2 satu dataset berbeda
cars %>%
permute_rows %>%
group_data(5) %>%
cross_validation_groups %>%
map(. %>%
lm(dist ~ speed, data = .) %>%
.$coefficients) %>%
do.call("rbind", .)## (Intercept) speed
## [1,] -12.05345 3.569354
## [2,] -16.82946 3.820845
## [3,] -17.61710 4.004393
## [4,] -22.70808 4.250115
## [5,] -18.79131 4.019518# Menunjukkan data yang menjadi data training dan data test
cross_validation_split <- function(grouped_df) {
result <- vector(mode = "list",
length = length(grouped_df))
for (i in seq_along(grouped_df)) {
training <- grouped_df[-i] %>%
do.call("rbind", .)
test <- grouped_df[[i]]
result[[i]] <- list(training = training,
test = test) }
result
}
cars %>%
permute_rows %>%
group_data(5) %>%
cross_validation_split## [[1]]
## [[1]]$training
## # A tibble: 40 x 2
## speed dist
## * <dbl> <dbl>
## 1 18 42
## 2 13 46
## 3 15 54
## 4 4 2
## 5 18 76
## 6 14 60
## 7 13 26
## 8 13 34
## 9 19 46
## 10 20 56
## # ... with 30 more rows
##
## [[1]]$test
## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 11 17
## 2 17 40
## 3 14 26
## 4 14 36
## 5 13 34
## 6 19 36
## 7 22 66
## 8 10 26
## 9 17 50
## 10 12 28
##
##
## [[2]]
## [[2]]$training
## # A tibble: 40 x 2
## speed dist
## * <dbl> <dbl>
## 1 11 17
## 2 17 40
## 3 14 26
## 4 14 36
## 5 13 34
## 6 19 36
## 7 22 66
## 8 10 26
## 9 17 50
## 10 12 28
## # ... with 30 more rows
##
## [[2]]$test
## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 18 42
## 2 13 46
## 3 15 54
## 4 4 2
## 5 18 76
## 6 14 60
## 7 13 26
## 8 13 34
## 9 19 46
## 10 20 56
##
##
## [[3]]
## [[3]]$training
## # A tibble: 40 x 2
## speed dist
## * <dbl> <dbl>
## 1 11 17
## 2 17 40
## 3 14 26
## 4 14 36
## 5 13 34
## 6 19 36
## 7 22 66
## 8 10 26
## 9 17 50
## 10 12 28
## # ... with 30 more rows
##
## [[3]]$test
## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 12 24
## 2 15 20
## 3 15 26
## 4 18 84
## 5 16 32
## 6 9 10
## 7 12 14
## 8 20 48
## 9 7 4
## 10 17 32
##
##
## [[4]]
## [[4]]$training
## # A tibble: 40 x 2
## speed dist
## * <dbl> <dbl>
## 1 11 17
## 2 17 40
## 3 14 26
## 4 14 36
## 5 13 34
## 6 19 36
## 7 22 66
## 8 10 26
## 9 17 50
## 10 12 28
## # ... with 30 more rows
##
## [[4]]$test
## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 7 22
## 2 23 54
## 3 12 20
## 4 24 93
## 5 19 68
## 6 10 18
## 7 24 92
## 8 8 16
## 9 25 85
## 10 20 52
##
##
## [[5]]
## [[5]]$training
## # A tibble: 40 x 2
## speed dist
## * <dbl> <dbl>
## 1 11 17
## 2 17 40
## 3 14 26
## 4 14 36
## 5 13 34
## 6 19 36
## 7 22 66
## 8 10 26
## 9 17 50
## 10 12 28
## # ... with 30 more rows
##
## [[5]]$test
## # A tibble: 10 x 2
## speed dist
## <dbl> <dbl>
## 1 4 10
## 2 14 80
## 3 10 34
## 4 18 56
## 5 24 70
## 6 24 120
## 7 20 32
## 8 11 28
## 9 20 64
## 10 16 40# Accuracy (antara prediksi dari darat training dan data test)
prediction_accuracy_cars <-
function(test_and_training) {
result <- vector(mode = "numeric",
length = length(test_and_training))
for (i in seq_along(test_and_training)) {
training <-
test_and_training[[i]]$training
test <- test_and_training[[i]]$test
model <- training %>%
lm(dist ~ speed, data = .)
predictions <- test %>%
predict(model, data = .)
targets <- test$dist
result[i] <- rmse(targets, predictions) }
result
}
cars %>%
permute_rows %>%
group_data(5) %>%
cross_validation_split %>%
prediction_accuracy_cars## [1] 215.1998 185.9728 255.2628 175.8417 224.1311Pada pemisahan dataset diatas terlihat seperti terdapat struktur yang membuat dataset tidak acak. Contoh dataset test pertama sama dengan sepuluh data awal dataset training kedua sampai kelima.
random_group <- function(n, probs) {
probs <- probs / sum(probs)
g <- findInterval(seq(0, 1, length = n),
c(0, cumsum(probs)),
rightmost.closed = TRUE)
names(probs)[sample(g)]
}
random_group(8, c(training = 0.5, test = 0.5)) ## [1] "training" "test" "training" "test" "test" "training" "test"
## [8] "training"random_group(8, c(training = 0.5, test = 0.5))## [1] "test" "training" "training" "test" "test" "test" "training"
## [8] "training"random_group(8, c(training = 0.8, test = 0.2))## [1] "training" "training" "training" "test" "training" "training" "training"
## [8] "test"partition <- function(df, n, probs) {
replicate(n,
split(df, random_group(nrow(df),
probs)),
FALSE)
}
random_cars <- cars %>% partition(4, c(training = 0.5, test = 0.5))
random_cars %>% prediction_accuracy_cars## [1] 93.03321 73.86013 96.64436 83.03945