Μια κλινική θέλει ένα διαφανές, ελέγξιμο σύστημα υποστήριξης απόφασης που να προτείνει φάρμακο για νέο ασθενή. Επειδή πρόκειται για ιατρική απόφαση, οι γιατροί απαιτούν ένα μοντέλο που να μπορεί να εξηγηθεί ως σαφείς κανόνες «αν–τότε», όχι ως «μαύρο κουτί».
Καθώς πρόκειται για αποφάσεις που πρέπει να ληφθούν με σαφείς κανόνες, η μέθοδος που θα χρησιμοποιηθεί είναι τα δέντρα απόφασης.
Ένα δένδρο απόφασης μπορεί να εξάγει κανόνες οι οποίοι μπορούν εύκολα να κατανοηθούν και να ερμηνευτούν από το χρήστη. Παράγουν προβλέψεις σε μορφή κανόνων και, άρα, ερμηνεύσιμα από τον χρήστη αποτελέσματα.
#About Dataset ##Content The target feature is
Drug typeThe feature sets are:
Age
Sex
Blood Pressure Levels (BP)
Cholesterol Levels
Na to Potassium Rationdata <- read_csv("drug200.csv")## Rows: 200 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): Sex, BP, Cholesterol, Drug
## dbl (2): Age, Na_to_K
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.View(data)
summary(data)## Age Sex BP Cholesterol
## Min. :15.00 Length:200 Length:200 Length:200
## 1st Qu.:31.00 Class :character Class :character Class :character
## Median :45.00 Mode :character Mode :character Mode :character
## Mean :44.31
## 3rd Qu.:58.00
## Max. :74.00
## Na_to_K Drug
## Min. : 6.269 Length:200
## 1st Qu.:10.445 Class :character
## Median :13.937 Mode :character
## Mean :16.084
## 3rd Qu.:19.380
## Max. :38.247#Ερώτηση 1
#Δημιουργία μοντέλου CART
install.packages("caTools")## Installing package into 'C:/Users/stavr/AppData/Local/R/win-library/4.5'
## (as 'lib' is unspecified)## package 'caTools' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\stavr\AppData\Local\Temp\RtmpoDKX6X\downloaded_packageslibrary(caTools)## Warning: package 'caTools' was built under R version 4.5.3set.seed(3000)
spl <- sample.split(data$Drug, SplitRatio = 0.7)
Train <- subset(data, spl==TRUE)
Test <- subset(data, spl==FALSE)
install.packages("rpart")## Installing package into 'C:/Users/stavr/AppData/Local/R/win-library/4.5'
## (as 'lib' is unspecified)## package 'rpart' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\stavr\AppData\Local\Temp\RtmpoDKX6X\downloaded_packageslibrary(rpart)## Warning: package 'rpart' was built under R version 4.5.3install.packages("rpart.plot")## Installing package into 'C:/Users/stavr/AppData/Local/R/win-library/4.5'
## (as 'lib' is unspecified)## package 'rpart.plot' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\stavr\AppData\Local\Temp\RtmpoDKX6X\downloaded_packageslibrary(rpart.plot)## Warning: package 'rpart.plot' was built under R version 4.5.3DrugTree <- rpart(Drug ~ Age + Sex + BP + Cholesterol + Na_to_K, data = Train, method="class", minbucket=25)
summary(DrugTree)## Call:
## rpart(formula = Drug ~ Age + Sex + BP + Cholesterol + Na_to_K,
## data = Train, method = "class", minbucket = 25)
## n= 140
##
## CP nsplit rel error xerror xstd
## 1 0.5000000 0 1.0000000 1.0000000 0.07755667
## 2 0.2105263 1 0.5000000 0.5131579 0.06979356
## 3 0.0100000 2 0.2894737 0.5131579 0.06979356
##
## Variable importance
## Na_to_K BP Age
## 66 30 4
##
## Node number 1: 140 observations, complexity param=0.5
## predicted class=DrugY expected loss=0.5428571 P(node) =1
## class counts: 16 11 11 38 64
## probabilities: 0.114 0.079 0.079 0.271 0.457
## left son=2 (76 obs) right son=3 (64 obs)
## Primary splits:
## Na_to_K < 14.8285 to the left, improve=46.4240600, (0 missing)
## BP splits as LRR, improve=11.6393400, (0 missing)
## Age < 48.5 to the left, improve= 2.6315610, (0 missing)
## Cholesterol splits as LR, improve= 2.1412700, (0 missing)
## Sex splits as RL, improve= 0.2096639, (0 missing)
## Surrogate splits:
## Age < 18.5 to the right, agree=0.564, adj=0.047, (0 split)
## BP splits as RLL, agree=0.550, adj=0.016, (0 split)
##
## Node number 2: 76 observations, complexity param=0.2105263
## predicted class=drugX expected loss=0.5 P(node) =0.5428571
## class counts: 16 11 11 38 0
## probabilities: 0.211 0.145 0.145 0.500 0.000
## left son=4 (27 obs) right son=5 (49 obs)
## Primary splits:
## BP splits as LRR, improve=20.3491100, (0 missing)
## Age < 53.5 to the left, improve= 4.7568920, (0 missing)
## Cholesterol splits as LR, improve= 3.6961490, (0 missing)
## Na_to_K < 10.1085 to the right, improve= 0.9276552, (0 missing)
## Sex splits as RL, improve= 0.2187970, (0 missing)
## Surrogate splits:
## Age < 67.5 to the right, agree=0.658, adj=0.037, (0 split)
## Na_to_K < 12.7345 to the right, agree=0.658, adj=0.037, (0 split)
##
## Node number 3: 64 observations
## predicted class=DrugY expected loss=0 P(node) =0.4571429
## class counts: 0 0 0 0 64
## probabilities: 0.000 0.000 0.000 0.000 1.000
##
## Node number 4: 27 observations
## predicted class=drugA expected loss=0.4074074 P(node) =0.1928571
## class counts: 16 11 0 0 0
## probabilities: 0.593 0.407 0.000 0.000 0.000
##
## Node number 5: 49 observations
## predicted class=drugX expected loss=0.2244898 P(node) =0.35
## class counts: 0 0 11 38 0
## probabilities: 0.000 0.000 0.224 0.776 0.000Παρατηρούμε ότι η μεταβλητή με τη μεγαλύτερη σημασία είναι η Na_to_K.
#Πρόβλεψη
PredictCART <- predict (DrugTree, newdata=Test, type='class')
table(Test$Drug, PredictCART)## PredictCART
## drugA drugB drugC drugX DrugY
## drugA 7 0 0 0 0
## drugB 5 0 0 0 0
## drugC 0 0 0 5 0
## drugX 0 0 0 16 0
## DrugY 0 0 0 0 27##Ερώτηση 2 Αν Na_to_K > 15 τότε DrugY Αν Na_to_K < 10 και BP = NORMAL τότε DrugX
##Ερώτηση 3 Στο εύρος τιμών του Na_to_K 15 - 40 επικρατεί μία τιμή φαρμάκων.
##Ερώτηση 4 Δυσκολότερο να προβλεφθεί είναι το DrugY, μιας και έχει το μεγαλύτερο ποσοστό expected loss.
Αυτό ίσως συμβαίνει εξαιτίας του μεγάλου εύρους των τιμών στη μεταβλητή Na_to_K και της μεγάλης σημασίας της μεταβλητής αυτής.
##Ερώτηση 5