Library
Beberapa Library yang digunakan pada praktikum kali ini :
library(readxl)
library(caret)
library(tidyverse)
library(knitr)
library(ggplot2)
library(tidyr)
library(e1071)
library(ROCR)
library(InformationValue)
library(rpart)
library(UBL)
library(neuralnet)
library(ROSE)
library(cvms)
library(rminer)
library(hrbrthemes)Dataset
Pada Praktikum ini digunakan 4 peubah numerik yang merupakan variabel importance dari model-model sebelumnya yaitu Scopus_H_Index, WOS_H_Index, WOS_Artikel, dan Scopus_Artikel.
Preprocessing
setwd("C:/Users/falco/Documents")
eksak<-read_excel("~/Gabs.xlsx")
eksak<-eksak[-c(1,2,15,30,52,59,66,67,72,73),]
eksak<-eksak[which(eksak$Jenjang!="D3"& eksak$Jenjang!="D4" & eksak$`Rasio Dosen Tetap dan Mahasiswa 2018/2019`!=Inf),]
set.seed(14);eksak$y<-as.factor(ifelse(eksak$`Rasio Dosen Tetap dan Mahasiswa 2018/2019`<=0.34, 1,0))
eksak <- eksak[,-c(1:4,11,13)]
eksak$`Rasio Dosen Tetap dan Mahasiswa 2018/2019` <- as.numeric(eksak$`Rasio Dosen Tetap dan Mahasiswa 2018/2019`)
str(eksak)## tibble [71 x 19] (S3: tbl_df/tbl/data.frame)
## $ Jumlah Dosen Tetap 2018/2019 : num [1:71] 10 10 10 10 10 10 10 10 10 10 ...
## $ Jumlah Mahasiswa 2018/2019 : num [1:71] 92 92 92 92 92 92 92 21 21 21 ...
## $ Rasio Dosen Tetap dan Mahasiswa 2018/2019: num [1:71] 0.11 0.11 0.11 0.11 0.11 0.11 0.11 0.48 0.48 0.48 ...
## $ Jumlah Dosen Tetap 2019/2020 : num [1:71] 8 8 8 8 8 8 8 3 3 3 ...
## $ Jumlah Mahasiswa 2019/2020 : num [1:71] 94 94 94 94 94 94 94 20 20 20 ...
## $ Rasio Dosen Tetap dan Mahasiswa 2019/2020: chr [1:71] "0.08" "0.08" "0.08" "0.08" ...
## $ SINTA_ID : num [1:71] 5988462 5996901 5974052 5983398 5980523 ...
## $ SINTA_Score_Overall : num [1:71] 3282 2339 2287 2724 2338 ...
## $ SINTA_Score_3Yr : num [1:71] 1906 1255 1180 1177 1167 ...
## $ Scopus_Artikel : num [1:71] 102 50 51 63 62 30 18 18 36 40 ...
## $ Scopus_Citation : num [1:71] 686 427 149 388 143 152 8 40 158 304 ...
## $ Scopus_H_Index : num [1:71] 14 9 8 11 6 6 2 3 8 7 ...
## $ GScholar_Artikel : num [1:71] 735 353 475 581 239 110 64 75 104 132 ...
## $ GScholar_Citation : num [1:71] 6439 2548 980 9379 1442 ...
## $ GScholar_H_Index : num [1:71] 34 24 14 29 19 14 7 9 19 12 ...
## $ WOS_Artikel : num [1:71] 0 8 23 21 31 19 7 11 22 15 ...
## $ WOS_Citation : num [1:71] 0 14 46 135 36 69 1 4 59 224 ...
## $ WOS_H_Index : num [1:71] 0 2 4 7 4 4 1 1 5 5 ...
## $ y : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 1 1 1 ...Reformat peubah respon y menjadi faktor
eksak$y <- as.factor(eksak$y)
head(eksak)## # A tibble: 6 x 19
## `Jumlah Dosen Tetap 2018/~` `Jumlah Mahasi~` `Rasio Dosen T~` `Jumlah Dosen ~`
## <dbl> <dbl> <dbl> <dbl>
## 1 10 92 0.11 8
## 2 10 92 0.11 8
## 3 10 92 0.11 8
## 4 10 92 0.11 8
## 5 10 92 0.11 8
## 6 10 92 0.11 8
## # ... with 15 more variables: `Jumlah Mahasiswa 2019/2020` <dbl>,
## # `Rasio Dosen Tetap dan Mahasiswa 2019/2020` <chr>, SINTA_ID <dbl>,
## # SINTA_Score_Overall <dbl>, SINTA_Score_3Yr <dbl>, Scopus_Artikel <dbl>,
## # Scopus_Citation <dbl>, Scopus_H_Index <dbl>, GScholar_Artikel <dbl>,
## # GScholar_Citation <dbl>, GScholar_H_Index <dbl>, WOS_Artikel <dbl>,
## # WOS_Citation <dbl>, WOS_H_Index <dbl>, y <fct>Spliting Data
set.seed(123)
eksak<-eksak[,c(12,18,16,10,19)]
itrain <- createDataPartition(as.factor(eksak$y),p=0.7,list=F) #partisi data
etrain <- eksak[itrain,] #data training utk modelling
etest<- eksak[-itrain,] #data testing utk evaluasi model
round(prop.table(table(etrain$y)), digits = 4)##
## 0 1
## 0.2157 0.7843round(prop.table(table(etest$y)), digits = 4)##
## 0 1
## 0.2 0.8Oversampling
pada praktikum ini akan digunakan oversampling sebagai perlakuan penanganan imbalanced class, karena banyak data keseluruhan sudah terbilang sedikit
set.seed(123)
overtrain <- ovun.sample(y~Scopus_H_Index+WOS_H_Index+WOS_Artikel+Scopus_Artikel, etrain,method="over")
round((table(overtrain$data$y)), digits = 4)##
## 1 0
## 40 38round(prop.table(table(overtrain$data$y)), digits = 4)##
## 1 0
## 0.5128 0.4872Model Neuralnet
Model 1
Jumlah layer 1 (jumlah neuron 1)
set.seed(2111)
MODEL_NN1 <- neuralnet(y~Scopus_H_Index+WOS_H_Index+WOS_Artikel+Scopus_Artikel, data = overtrain$data,
hidden =1,act.fct = "logistic",
linear.output = FALSE, err.fct = "ce", likelihood = TRUE)
summary(MODEL_NN1)## Length Class Mode
## call 8 -none- call
## response 156 -none- logical
## covariate 312 -none- numeric
## model.list 2 -none- list
## err.fct 1 -none- function
## act.fct 1 -none- function
## linear.output 1 -none- logical
## data 5 data.frame list
## exclude 0 -none- NULL
## net.result 1 -none- list
## weights 1 -none- list
## generalized.weights 1 -none- list
## startweights 1 -none- list
## result.matrix 14 -none- numericplot(MODEL_NN1, rep = "best")
output1 <- compute(MODEL_NN1, etest[,-5])
head(output1$net.result)## [,1] [,2]
## [1,] 0.6135406 0.3864650
## [2,] 0.6135406 0.3864650
## [3,] 0.6135406 0.3864650
## [4,] 0.6135406 0.3864650
## [5,] 0.6135406 0.3864650
## [6,] 0.6135401 0.3864655results1 = data.frame(data=etest$y,Prediksi=output1$net.result)
actual <- etest$y
prediction1 <- ifelse(output1$net.result[,2]>optimalCutoff(actual,output1$net.result[,2]), 1, 0)
mtab1 <- table(actual,prediction1)
CM1 <- caret::confusionMatrix(mtab1,positive = "1")
CM1## Confusion Matrix and Statistics
##
## prediction1
## actual 0 1
## 0 4 0
## 1 12 4
##
## Accuracy : 0.4
## 95% CI : (0.1912, 0.6395)
## No Information Rate : 0.8
## P-Value [Acc > NIR] : 0.999985
##
## Kappa : 0.1176
##
## Mcnemar's Test P-Value : 0.001496
##
## Sensitivity : 1.000
## Specificity : 0.250
## Pos Pred Value : 0.250
## Neg Pred Value : 1.000
## Prevalence : 0.200
## Detection Rate : 0.200
## Detection Prevalence : 0.800
## Balanced Accuracy : 0.625
##
## 'Positive' Class : 1
## Model 2
Jumlah layer 2 : layer 1 terdapat 2 neuron, dan layer 2 terdapat 1 neuron
set.seed(2111)
MODEL_NN2 <- neuralnet(y~Scopus_H_Index+WOS_H_Index+WOS_Artikel+Scopus_Artikel, data = overtrain$data,
hidden = c(2,1),act.fct = "logistic",
linear.output = FALSE, err.fct = "ce", likelihood = TRUE)
summary(MODEL_NN2)## Length Class Mode
## call 8 -none- call
## response 156 -none- logical
## covariate 312 -none- numeric
## model.list 2 -none- list
## err.fct 1 -none- function
## act.fct 1 -none- function
## linear.output 1 -none- logical
## data 5 data.frame list
## exclude 0 -none- NULL
## net.result 1 -none- list
## weights 1 -none- list
## generalized.weights 1 -none- list
## startweights 1 -none- list
## result.matrix 22 -none- numericplot(MODEL_NN2, rep = "best")
output2 <- compute(MODEL_NN2, etest[,-5])
head(output2$net.result)## [,1] [,2]
## [1,] 0.7530540 0.2469460
## [2,] 0.7619051 0.2380949
## [3,] 0.1666665 0.8333336
## [4,] 0.7619051 0.2380949
## [5,] 0.1666665 0.8333336
## [6,] 0.1666665 0.8333336results2 = data.frame(data=etest$y,Prediksi=output2$net.result)
actual <- etest$y
prediction2 <- ifelse(output2$net.result[,2]>optimalCutoff(actual,output2$net.result[,2]), 1, 0)
mtab2 <- table(actual,prediction2)
CM2 <- caret::confusionMatrix(mtab2,positive = "1")
CM2## Confusion Matrix and Statistics
##
## prediction2
## actual 0 1
## 0 1 3
## 1 5 11
##
## Accuracy : 0.6
## 95% CI : (0.3605, 0.8088)
## No Information Rate : 0.7
## P-Value [Acc > NIR] : 0.8867
##
## Kappa : -0.0526
##
## Mcnemar's Test P-Value : 0.7237
##
## Sensitivity : 0.7857
## Specificity : 0.1667
## Pos Pred Value : 0.6875
## Neg Pred Value : 0.2500
## Prevalence : 0.7000
## Detection Rate : 0.5500
## Detection Prevalence : 0.8000
## Balanced Accuracy : 0.4762
##
## 'Positive' Class : 1
## Perbandingan Model
banding<-data.frame(Akurasi=round(c(CM1$overall[1],CM2$overall[1]),2),Sensitivitas=round(c(CM1$byClass[1], CM2$byClass[1]),2),Spesifisitas=round(c(CM1$byClass[2],CM2$byClass[2]),2))
rownames(banding)<-c("Model 1", "Model 2");banding## Akurasi Sensitivitas Spesifisitas
## Model 1 0.4 1.00 0.25
## Model 2 0.6 0.79 0.17Berdasarkan tabel di atas, terlihat bahwa model 2 memiliki akurasi yang lebih tinggi bahkan melebihi 50%, dan ketimpangan nilai sensitivitas dengan spesifisitas lebih rendah. Maka, dapat disimpulkan bahwa model 2 yaitu neuralnetwork dengan 2 layer yang masing-masing secara berurut, terdiri dari 2 neuron dan 1 neuron, memiliki performa yang lebih baik dibandingkan dengan model 1 yang hanya dengan 1 layer.
SVM
Best Kernel
k<-tune(svm,y~.,data=overtrain$data,
ranges=list(kernel=c("radial","linear","polynomial","sigmoid")));k$best.model##
## Call:
## best.tune(method = svm, train.x = y ~ ., data = overtrain$data, ranges = list(kernel = c("radial",
## "linear", "polynomial", "sigmoid")))
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 1
##
## Number of Support Vectors: 59k$best.parameters #radial is the best for this case## kernel
## 1 radialk$performances ## kernel error dispersion
## 1 radial 0.2642857 0.2228449
## 2 linear 0.3839286 0.1938412
## 3 polynomial 0.5339286 0.1414740
## 4 sigmoid 0.3035714 0.1846198Didapatkan bahwa kernel dengan performa model terbaik pada kasus ini adalah radial
SVM-Best Kernel
#Pemodelan
m1<-svm(y~.,overtrain$data,type="C-classification",kernel="radial");m1##
## Call:
## svm(formula = y ~ ., data = overtrain$data, type = "C-classification",
## kernel = "radial")
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 1
##
## Number of Support Vectors: 59prediks <- predict(m1, newdata=etest);prediks## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1
## Levels: 1 0#Pengklasifikasian
par(mfrow=c(2,2));p<-plot(y~.,overtrain$data,type="C-classification",kernel="radial",col=c("coral","lightblue"))
Confusion Matrix
eval1 <- caret::confusionMatrix(etest$y,prediks,positive="1");eval1## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 0
## 1 12 4
## 0 4 0
##
## Accuracy : 0.6
## 95% CI : (0.3605, 0.8088)
## No Information Rate : 0.8
## P-Value [Acc > NIR] : 0.99
##
## Kappa : -0.25
##
## Mcnemar's Test P-Value : 1.00
##
## Sensitivity : 0.750
## Specificity : 0.000
## Pos Pred Value : 0.750
## Neg Pred Value : 0.000
## Prevalence : 0.800
## Detection Rate : 0.600
## Detection Prevalence : 0.800
## Balanced Accuracy : 0.375
##
## 'Positive' Class : 1
## t1<-as_tibble(eval1$table);t1## # A tibble: 4 x 3
## Prediction Reference n
## <chr> <chr> <int>
## 1 1 1 12
## 2 0 1 4
## 3 1 0 4
## 4 0 0 0plot_confusion_matrix(t1,target_col="Reference",prediction_col = "Prediction",counts_col = "n")
Tuning Hyperparameter
t<-tune(svm,y~.,data=overtrain$data,type="C-classification",kernel="radial",
ranges=list(gamma=c(0.1:10),cost=10^(-0.1:2)));t$best.model##
## Call:
## best.tune(method = svm, train.x = y ~ ., data = overtrain$data, ranges = list(gamma = c(0.1:10),
## cost = 10^(-0.1:2)), type = "C-classification", kernel = "radial")
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 7.943282
##
## Number of Support Vectors: 43gamma=t$best.parameters$gamma
cost=t$best.parameters$costSVM-Best Hyper & Kernel
st<-svm(y~.,overtrain$data,type="C-classification",kernel="radial",gamma=gamma,cost=cost);st##
## Call:
## svm(formula = y ~ ., data = overtrain$data, type = "C-classification",
## kernel = "radial", gamma = gamma, cost = cost)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 7.943282
##
## Number of Support Vectors: 43predikS<-predict(st,newdata=etest)
eval2<-caret::confusionMatrix(etest$y,predikS,positive="1");eval2## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 0
## 1 15 1
## 0 3 1
##
## Accuracy : 0.8
## 95% CI : (0.5634, 0.9427)
## No Information Rate : 0.9
## P-Value [Acc > NIR] : 0.9568
##
## Kappa : 0.2308
##
## Mcnemar's Test P-Value : 0.6171
##
## Sensitivity : 0.8333
## Specificity : 0.5000
## Pos Pred Value : 0.9375
## Neg Pred Value : 0.2500
## Prevalence : 0.9000
## Detection Rate : 0.7500
## Detection Prevalence : 0.8000
## Balanced Accuracy : 0.6667
##
## 'Positive' Class : 1
## t2<-as_tibble(eval2$table);t2## # A tibble: 4 x 3
## Prediction Reference n
## <chr> <chr> <int>
## 1 1 1 15
## 2 0 1 3
## 3 1 0 1
## 4 0 0 1plot_confusion_matrix(t2,target_col="Reference",prediction_col = "Prediction",counts_col = "n")
Sebelum vs Sesudah Tuning
compare<-data.frame(Akurasi=c(eval1$overall[1],eval2$overall[1]),Sensitivitas=round(c(eval1$byClass[1],eval2$byClass[1]),2),Spesifisitas=round(c(eval1$byClass[2],eval2$byClass[2]),2))
rownames(compare)<-c("Sebelum","Sesudah");compare## Akurasi Sensitivitas Spesifisitas
## Sebelum 0.6 0.75 0.0
## Sesudah 0.8 0.83 0.5Didapatkan akurasi dan sensitivitas jauh lebih baik pada model sesudah tuning, selain itu model juga jadi memiliki spesifisitas, dibandingkan pada model neuralnetwork yang bahkan tadinya pada angka ini bernilai nol atau tidak bisa sama sekali memprediksi kelas mayor/negatif (rasio > 0.34). Dengan demikian, terbukti bahwa tuning parameter dan best kernel, dapat memperbaiki performa model svm.
Perbandingan Model SVM & Neuralnetwork
compare<-data.frame(Akurasi=c(CM2$overall[1],eval2$overall[1]),Sensitivitas=round(c(CM2$byClass[1],eval2$byClass[1]),2),Spesifisitas=round(c(CM2$byClass[2],eval2$byClass[2]),2))
rownames(compare)<-c("Neuralnetwork","Support Vector Machine");compare## Akurasi Sensitivitas Spesifisitas
## Neuralnetwork 0.6 0.79 0.17
## Support Vector Machine 0.8 0.83 0.50Didapatkan akurasi dan sensitivitas tertinggi pada model SVM, selain itu spesifisitasnya juga jauh lebih baik dibandingkan pada model neuralnetwork, atau dengan kata lain prediksi kelas minor ataupun mayor tidak timpang hasilnya, tetapi prioritas model akan lebih baik digunakan untuk memprediksi kelas minor/positif, yaitu prodi di UNM yang rasio dosen tetap dan mahasiswanya pada periode 2018/2019 dekat dengan 25% data yang diamati lebih kecil (rasio < 0.34)