## corrplot 0.95 loaded

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Cvičenie 12.1 Jednoduchá logistická regresia

Zadanie: Vytvorte logistický regresný model modelujúci prejdenie skúškou (premenná pass) v závislosti od počtu hodín venovaných príprave (premenná study_hours). Vypočítajte koreláciu medzi premennými. Tiež vyrátajte confusion maticu a metriky modelu. Prešiel by, na základe modelu, student, ktorý venoval príprave 6 hodín?

data1 <- data.frame( 
              study_hours = c(2, 3, 5, 7, 8, 10, 11, 13, 15, 16), 
              pass = c(0, 0, 0, 1, 1, 1, 1, 1, 1, 1) # 0: fail, 1: pass 
                  )

Pozrime si rozdelenie prediktora.

boxplot(data1$study_hours, main="Študijné hodiny")

Korelácia medzi premennými:

cor <- cor(data1) 
cor

##             study_hours      pass
## study_hours   1.0000000 0.8056963
## pass          0.8056963 1.0000000

Vidíme, že korelácia je vysoká (0,806) premenné závisia jedna od druhej.

Samotný model logistickej regresie.

model<- glm(pass ~ study_hours, data = data1, family = binomial)
summary(model)

## 
## Call:
## glm(formula = pass ~ study_hours, family = binomial, data = data1)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)
## (Intercept)   -134.44  193058.17  -0.001    0.999
## study_hours     22.39   31296.13   0.001    0.999
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1.2217e+01  on 9  degrees of freedom
## Residual deviance: 7.5703e-10  on 8  degrees of freedom
## AIC: 4
## 
## Number of Fisher Scoring iterations: 25

Koeficienty modelu v interepretovateľnej forme.

exp(coef(model))

##  (Intercept)  study_hours 
## 4.111488e-59 5.304319e+09

Predikcie modelu.

glm.probs <- predict(model,type = "response")
glm.probs

##            1            2            3            4            5            6 
## 2.220446e-16 2.220446e-16 1.726423e-10 1.000000e+00 1.000000e+00 1.000000e+00 
##            7            8            9           10 
## 1.000000e+00 1.000000e+00 1.000000e+00 1.000000e+00

Nastavíme tzv. treshold a podľa neho predikcie zaradíme do dvoch kategórií, aby boli porovnateľné s vysvetľovanou premennou.

treshold <- 0.5
glm.pred <- ifelse(glm.probs > treshold, "POS", "NEG")

Confusion matica modelu.

cm <- table(glm.pred,data1$pass)
cm

##         
## glm.pred 0 1
##      NEG 3 0
##      POS 0 7

Metriky modelu binárnej klasifikácie.

accuracy <- sum(diag(cm)) / sum(cm)
precision <- cm[4] / (cm[4] + cm[2])
recall <- cm[4] / (cm[4] + cm[3])

cat("Accuracy: ", accuracy ,"\n")

## Accuracy:  1

cat("Precision: ", precision ,"\n")

## Precision:  1

cat("Recall: ", recall ,"\n")

## Recall:  1

datatest <- data.frame( 
              study_hours = c(6)
            )
p1 <-predict(model, datatest, type = "response")
p1

##         1 
## 0.4780112

Vidíme, že naš predict (0.478) je menši ako treshold (0.5), preto podľa nášho modelu 6 hodín prípravy na zloženie skúšky nestačí.

Cvičenie 12.2 Násobná logistická regresia – generované dáta

Zadanie: Vytvorte logistický regresný model modelujúci pravdepodobnosť kúpenia produktu (premenná purchase) v závislosti od premenných age, gender, income a ad_click. Vypočítajte koreláciu medzi vysvetľujúcimi premennými. Tiež vyrátajte confusion maticu a metriky modelu a zhodnoťte ich.

data2 <- data.frame( 
                age = c(25, 30, 35, 40, 45, 50, 55, 60, 65, 70), 
                #gender = factor(c("male", "female", "female", "male", "male", "female", "female", "male", "male", "female")),
                gender = c(0, 1, 1, 0, 0, 1, 1, 0, 0, 1), # 0: male, 1: female
                income = c(50, 55, 60, 65, 70, 75, 80, 85, 90, 95), 
                ad_click = c(1, 1, 0, 0, 1, 0, 1, 1, 0, 1), 
                purchase = c(0, 0, 1, 1, 0, 1, 0, 1, 1, 0) # 0: no, 1: yes 
                )

Pozrime si rozdelenie prediktorov.

par(mfrow=c(1,4))
for(i in 1:4) {
  boxplot(data2[,i], main=names(data2)[i])
}

Korelácia medzi vysvetľujúcimi premennými - stojí za zváženie tie silne korelované z dát odstrániť.

cors <- cor(data2[,1:4])
corrplot.mixed(cors)

Teda odstránenim stĺpec “income”:

data2 <- data2[,!names(data2) %in% c("income")]

Rozdelenie premenných vzhľadom na dve kategórie targetu.

invisible(lapply(1:3, function(i) boxplot(data2[, i]~data2$purchase, main=names(data2)[i])))

Samotný model logistickej regresie.

model2<- glm(purchase ~., data = data2, family = binomial)
summary(model2)

## 
## Call:
## glm(formula = purchase ~ ., family = binomial, data = data2)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)     -5.312 197706.169   0.000        1
## age              3.084   6025.081   0.001        1
## gender         -78.168 157973.344   0.000        1
## ad_click      -156.524 266443.736  -0.001        1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1.3863e+01  on 9  degrees of freedom
## Residual deviance: 4.7545e-10  on 6  degrees of freedom
## AIC: 8
## 
## Number of Fisher Scoring iterations: 25

Koeficienty modelu v interepretovateľnej forme.

exp(coef(model2))

##  (Intercept)          age       gender     ad_click 
## 4.933786e-03 2.184083e+01 1.127377e-34 1.052980e-68

Predikcie modelu.

glm.probs <- predict(model2,type = "response")

Nastavíme tzv. treshold a podľa neho predikcie zaradíme do dvoch kategórií, aby boli porovnateľné s vysvetľovanou premennou.

treshold <- 0.5
glm.pred <- ifelse(glm.probs > treshold, "POS", "NEG")

Confusion matica modelu.

cm <- table(glm.pred,data2$purchase)
cm

##         
## glm.pred 0 1
##      NEG 5 0
##      POS 0 5

Metriky modelu binárnej klasifikácie.

accuracy <- sum(diag(cm)) / sum(cm)
precision <- cm[4] / (cm[4] + cm[2])
recall <- cm[4] / (cm[4] + cm[3])

cat("Accuracy: ", accuracy ,"\n")

## Accuracy:  1

cat("Precision: ", precision ,"\n")

## Precision:  1

cat("Recall: ", recall ,"\n")

## Recall:  1

Cvičenie 12.3 Násobná logistická regresia - dataset

Zadanie: Vytvorte logistický regresný model predikujúci, či má auto automatickú (premenná am, hodnota 0) alebo manuálnu (premenná am, hodnota 1) prevodovku v závislosti od premenných hp a wt, všetky sa nachádzajú v datasete mtcars. Vypočítajte confusion maticu a metriky modelu a zhodnoťte ich. Sú v danom datasete premenné, ktoré dávajú lepší model a ak áno, ktoré to sú?

data3 <- datasets::mtcars
data3 <- data3[,names(data3) %in% c("hp","wt","am")]

Pozrime si rozdelenie prediktorov.

par(mfrow=c(1,2))
for(i in 1:2) {
  boxplot(data3[,i], main=names(data3)[i])
}

Korelácia medzi vysvetľujúcimi premennými - stojí za zváženie tie silne korelované z dát odstrániť.

cors <- cor(data3[,1:2])
corrplot.mixed(cors)

Rozdelenie premenných vzhľadom na dve kategórie targetu.

invisible(lapply(1:2, function(i) boxplot(data3[, i]~data3$am, main=names(data3)[i])))

Samotný model logistickej regresie.

model3<- glm(am ~., data = data3, family = binomial)
summary(model3)

## 
## Call:
## glm(formula = am ~ ., family = binomial, data = data3)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept) 18.86630    7.44356   2.535  0.01126 * 
## hp           0.03626    0.01773   2.044  0.04091 * 
## wt          -8.08348    3.06868  -2.634  0.00843 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 43.230  on 31  degrees of freedom
## Residual deviance: 10.059  on 29  degrees of freedom
## AIC: 16.059
## 
## Number of Fisher Scoring iterations: 8

Koeficienty modelu v interepretovateľnej forme.

exp(coef(model3))

##  (Intercept)           hp           wt 
## 1.561455e+08 1.036921e+00 3.085967e-04

Predikcie modelu.

glm.probs <- predict(model3,type = "response")

Nastavíme tzv. treshold a podľa neho predikcie zaradíme do dvoch kategórií, aby boli porovnateľné s vysvetľovanou premennou.

treshold <- 0.5
glm.pred <- ifelse(glm.probs > treshold, "POS", "NEG")

Confusion matica modelu.

cm <- table(glm.pred,data3$am)
cm

##         
## glm.pred  0  1
##      NEG 18  1
##      POS  1 12

Metriky modelu binárnej klasifikácie.

accuracy <- sum(diag(cm)) / sum(cm)
precision <- cm[4] / (cm[4] + cm[2])
recall <- cm[4] / (cm[4] + cm[3])

cat("Accuracy: ", accuracy ,"\n")

## Accuracy:  0.9375

cat("Precision: ", precision ,"\n")

## Precision:  0.9230769

cat("Recall: ", recall ,"\n")

## Recall:  0.9230769

ROC krivka a AUC

p <- predict(model3, data3, type="response")
roc_score<-roc(data3$am,p)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

auc(roc_score)

## Area under the curve: 0.9838

plot(roc_score ,main ="ROC curve -- Logistic Regression ")

Skúsme vytvoriť model s inými premennými a uvidíme, či bude lepší ako prvý model.

data31 <- datasets::mtcars
data31 <- data31[,names(data31) %in% c("mpg","gear","am")]

Samotný model logistickej regresie.

model31<- glm(am ~., data = data31, family = binomial)
summary(model31)

## 
## Call:
## glm(formula = am ~ ., family = binomial, data = data31)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)   -88.2992 13878.8098  -0.006    0.995
## mpg             0.3366     0.2457   1.370    0.171
## gear           20.3062  3469.7018   0.006    0.995
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 43.230  on 31  degrees of freedom
## Residual deviance: 11.659  on 29  degrees of freedom
## AIC: 17.659
## 
## Number of Fisher Scoring iterations: 19

Koeficienty modelu v interepretovateľnej forme.

exp(coef(model31))

##  (Intercept)          mpg         gear 
## 4.488777e-39 1.400182e+00 6.589663e+08

Predikcie modelu.

glm.probs <- predict(model31,type = "response")

Nastavíme tzv. treshold a podľa neho predikcie zaradíme do dvoch kategórií, aby boli porovnateľné s vysvetľovanou premennou.

treshold <- 0.5
glm.pred <- ifelse(glm.probs > treshold, "POS", "NEG")

Confusion matica modelu.

cm <- table(glm.pred,data31$am)
cm

##         
## glm.pred  0  1
##      NEG 17  2
##      POS  2 11

Metriky modelu binárnej klasifikácie.

accuracy <- sum(diag(cm)) / sum(cm)
precision <- cm[4] / (cm[4] + cm[2])
recall <- cm[4] / (cm[4] + cm[3])

cat("Accuracy: ", accuracy ,"\n")

## Accuracy:  0.875

cat("Precision: ", precision ,"\n")

## Precision:  0.8461538

cat("Recall: ", recall ,"\n")

## Recall:  0.8461538

ROC krivka a AUC

p <- predict(model31, data31, type="response")
roc_score<-roc(data31$am,p)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

auc(roc_score)

## Area under the curve: 0.9696

plot(roc_score, main ="ROC curve -- Logistic Regression ")

Vidíme, že prvý model má najlepšie metriky, takže tento model je najlepší z týchto dvoch.

Cv12_Kharlamau

Mikhail Kharlamau

2024-12-16

Cvičenie 12.1 Jednoduchá logistická regresia

Cvičenie 12.2 Násobná logistická regresia – generované dáta

Cvičenie 12.3 Násobná logistická regresia - dataset