DISKRIMINANTNA ANALIZA
dr.sc.Luka Sikic
30/03/2020
CILJEVI PREDAVANJA
- Diskriminantna analiza
- Linearna diskriminantna analiza
- Logistička regresija
- Primjeri
DEFINICIJA
Linearna regresija je načešće korišten statistički model. Razlog za popularnost linearnog regresijskog modela je što omogućava predviđanje i razumijevanje odnosa između metričkih varijabli. U slučaju kada je potrebno predvidjeti nemetričku (kategoričku;faktorsku) zavisnu varijablu, regresijski model nije odgovarajući statistički pristup i potrbno je primijeniti neki od modela diskriminantne analize. Najčešće korišteni pristupi diskriminantne analize su: linearna diskriminantna analiza i logistička regresija. Osnovna svrha diskriminantne analize je procjena odnosa između nemetričke zavisne varijable i skupa metričkih (i/ili nemetričkih) nezavisnih varijabli. Linearna diskriminantna analiza primjenu nalazi u situacijama u kojima je potrebno identificirati grupu kojoj neki objekt (osoba, tvrka, proizvod) pripada. Primjena linearne diskriminantne analize je česta u analizi uspjeha novog proizvoda, selekciji pristupnika, procjeni kreditnog rizika i bankrota i dr. Osim same selekcije, ova analiza omogućava i utvrđivanje najvažnijih varijabli i intenziteta njihovog utjecaja na svrstavanje u grupe. Drugi često korišteni model diskriminantne analize je logistička regresija koja također omogućava analizu odnosa nemetričkih zavisnih varijabli i metričkih nezavisnih varijabli, pri čemu nezavisna varijabla može biti isključivo binarna. Dodatni razlog popularnosti logističke regresije je što ne zahtjeva modelske pretpostavke poput linearnog odnosa zavisne i nezavisnih varijabli te normalnosti distibucije nezavisnih varijabli.
LINEARNA DISKRIMINANTNA ANALIZA
Cilj LDA je procijeniti linearnu kombinaciju varijabli koja najbolje diskriminira pripadnost individualnih elemenata određenoj grupi. Diskriminacija se postiže izračunom ponedriranog (linearnog) odnosa varijabli za svaki individualni element na način da se maksimizira razlika među grupama (relativni odnos varijance među grupama i unutar grupa) pri čemu je moguće, ovisno o istraživačkom okviru, procijeniti više od jedne diskriminacijske funkcije. Statistički promatrano, LDA testira nultu hipotezu jednakosti grupnih prosjeka (centroida) za skup nezavisnih varijabli gdje je mjera statističke signifikantnosti izračunata na osnovi generalizirane mjere udaljenosti između grupnih centroida. Zbog toga je primjena i interpretacija LDA vrlo slična linearnom regresijskom modelu uz bitnu razliku da LDA dozvoljava nemetričku zavisnu varijablu. LDA dijeli i određene sličnosti sa (M)ANOVA modelima uz razliku što (M)ANOVA modeli imaju metričku zavisnu i nemetričke nezavisne varijable dok je kod LDA obratno.
Primjer 1
Tvrtka želi ispitati mogućnosti plasmana novog proizvoda na tržište. Identificirane su dvije skupine potrošača, jedna koja je spremna kupiti novi proizvod i druga koja nije. Potencijalnim kupcima su postavljena pitanja vezana uz tri karakteristike proizvoda u cilju otkrivanja preferencija spram svake karakteristike na skali 1-10. Tri ponuđene karakteristike se odnose na: izdržljivost, performanse i stil proizvoda. Takav nacrt istraživanja omogućuje tvrtki da procjeni koje karakteristike proizvoda najbolje diskriminiraju između novih potencijalnih ne/kupaca. Rezultati provedenog upitnika su prikazani u sljedećoj tablici.
Rezultati provedenog upitnika.
Kako bi se identificirale varijable koje najbolje diskriminiraju potencijalne kupce, naglasak LDA je na procjeni grupnih razlike (ne procjeni korelacije kao kod regresijskog modela). Grupne razlike se u ovom primjeru mogu vizualizirati na sljedeći način:
Vizualni pregled rezultata upitnika po grupama
Nakon vizualne inspekcije varijabli, sljedeći korak u analizi je procijeniti diskriminacijsku funkciju sa ciljem identifikacije važnosti varijabli (karakteristika proizvoda) i njihovog utjecaja na odluku o kupnji.
Rezultati LDA i klasifikacisjke matrice.
Diskriminantna analiza je identificirala varijable koje imaju najveću udaljenost među grupama i dala procjenu diskriminacijskih koeficijenata koji najbolje odražavaju te razlike. Rezultat analize je diskriminacijska funkcija koja opisuje separaciju među grupama. Ta se separacija može prikazati na sljedećem grafikonu:
Prikaz diskriminacijske funkcije.
U cilju objašnjenja separacije između dvije grupe potencijalnih kupaca, procijenjena je linearna kombinacija nezavisnih varijabli i pripadajući diskriminacijski koeficijenti za svakog potencijalnog kupca. Diskriminacijski koeficijenti su izračunati maksimizacijom varijance između grupa i minimizacijom varijance unutar grupa. Što je varijanca među grupama veća u odnosu sa varijancom unutar grupa, to bolje diskriminacijska funkcija objašnjava separaciju među grupama.
Primjer 2
Prethodni primjer je dao prikaz LDA sa dvije grupe i tri kategorije. U ovom primjeru imamo tri grupe i dvije kategorije. Prednost LDA pred logističkom regresijom je upravo to što omogućava diskriminaciju između više od dvije grupe. Diskriminacija u ovom slučaju omogućavaprocjenjenu više diskriminacijskih funkcija što dozvoljava dodatne uvide u kombinaciju karakteristika (nezavisnih varijabli) koje separiraju analizirane grupe. U ovom primjeru je tvrtka provela istraživanje o prelasku kupaca kod konkurentskih tvrtki kroz 15 organiziranih intervju-a. Ispitanici su na osnovi otkrivenih preferencija svrstani u tri grupe: sigurno prelazi, ne zna hoće li prijeći, sigurno prelazi, te su se odredili spram dvije kategorije konkurentske tvrtke: cjenovna konkurentnost i razina uslužnostii. Cilj analize je odrediti stavove kupaca prema karateristikama konkurentske tvrtke te analizirati može li se predvidjeti vjerojatnost prelaska kupaca kod konkurentske tvrtke. LDA je primjereni model u ovom slučaju jer je zavisna varijabla nemetrička (kategorička), a zavisne varijable konkurentnosti i uslužnosti su metričke varijable. Rezultati intervju su prikazani u sljedećoj tablici:
Rezultati intervjua.
Grafički prikaz ispitanika po karakteristikama konkurenata i dvodimenzionalni diskriminacijski prostor su prikazani na sljedećem grafikonu:
Viuzalni prikaz rezultata intervjua i 2d LDA prostora
U donjem djelu grafikona je su prikazani ispitanici u dvodimenzionalnom diskriminacijskom prostoru. Separacija među grupama je vrlo izražena. Vidljivo je da prva diskriminacijska funkcija jasno separira kupce koji nisu sigurni u prelazak od kupaca koji će sigurno preći konkurenciji. Cjenovna konkurentnost (df1) ipak ne separira dobro kupace koji hoće ili neće prijeći konkurenciji, pa je zbog toga uputno pogledati i drugu diskriminacijsku funkciju (df2) koja se odnosi na razinu usluge. Analiza u ovom slučaju omogućuje prikaz odvojenih efekata cjenovne konkurentnosti i razine usluge na mogućnost prelaska kupaca kod konkurencije.
LOGISTIČKA REGRESIJA
Logistička regresija je primijerena metoda u slučaju kada je zavisna varijabla nemetrička, a nezavisne varijable su metričke i/ili nemetričke. Ova metoda omogućava identifikaciju utjecaja nazavisnih varijabli na pripadnost grupi i klasifikaciju grupne pripadnosti. U usporedbi sa LDA, logistička regresija je ograničena na primjene gdje je zavisna varijabla binarna, omogućava procjenu uz manje restriktivne pretpostavke i dozvoljava nemetričke (dummy) regresore. Logistička regresija je češća u praktičkim primjenama jer omogućava procjenu varijabli koje nisu normalno distribuirane i nemaju jednake kovarijančne matrice između grupa te ju prati dostupnost i implementacija većeg broja dijagnostičkih testova. Procedura logističke regresije uključuje: 1. transformaciju binarne zavisne varijable u vjerojatnost ishoda pri čemu takva, logit varijabla postaje predmet interesa analize, 2. modelsku dijagnostiku kao kod LDA gdje se provjerava statistička signifikantnost cjelokupnog modela i preciznost predviđanja kroz klasifikacijsku matricu, 3. interpretaciju transformiranog logaritamskog odnosa varijabli koja je slična kao kod linearnog regresijskog modela, 4. validaciju modela na testnom uzorku.
Primjer
Tvrtka želi procijeniti da li postoje razlike u percepciji između kupaca u SAD i ostatku svijeta pa je u cilju analize prikupljen uzorak uzorak od 100 ispitanika koji su podijeljeni na 60 ispitanika u trening uzorku i 40 ispitanika u testnom uzorku. U prvom koraku valja pogledati razlike u varijablama između dvije grupe koje su prikazane u sljedećoj tablici. Vidljivo je da su neke razlike signifikantne te da potencijalno postoji problem multikolinearnosti varijabli (zajednički faktori!?).
Razlike u varijablama po grupama
Potom je procijenjen osnovni model sa svim varijablama:
Razlike u varijablama po grupama
U sljedećem koraku je provedena stepwise procedura za procjenu modela na način da je prvo proveden model sa jednom signifikantnom varijablom te je u svakom sljedećem koraku dodana još jedna nezavisna i signifikantna varijabla. Rezultati stepwise modela su prikazani u sljedeće dvije tablice :
- korak stepwise metode.
S obzirom da u modelu postoji još signifikantnih varijabli, provedena je i druga stepwise iteracija:
- korak stepwise metode.
Vidljivo je dodatno smanjenjenje -2LL mjere u drugom modelu te da Hosmer&Lemeshow test nije signifikantan što znači da ne postoji signifikantna razlika između stvarnih i očekivanih vrijednosti pa se može zaključiti da je model dobar. Preciznost procjene je prikazana u donjoj tablici za trening i testni uzorak te pokazuje zadovoljavajuće visoke stope točno svrstanih grupa. Finalni model uključuje dvije varijable sa pozitivnim i statistički značajnim koeficijentima što rezultate logističke regresije čini vrlo sličnima kao u 2. primjeru LDA analize. Moguće je zaključiti da povećanje kod jedne i druge varijable povećava vjerojatnost da će kupac biti izvan SAD-a. Na kraju je prikazana i tablica predviđanja vjerojatnosti za dva grupna projeka:
Validacija rezultata.
PRIMJENA DISKRIMINANTNE ANALIZE U R
## PRVI PRIMJER ##
# UČITAJ PAKETE
library(car)
library(rattle)
# UČITAJ PODATKE
data(wine)
attach(wine)
names(wine)## [1] "Type" "Alcohol" "Malic" "Ash"
## [5] "Alcalinity" "Magnesium" "Phenols" "Flavanoids"
## [9] "Nonflavanoids" "Proanthocyanins" "Color" "Hue"
## [13] "Dilution" "Proline"head(wine,10)## Type Alcohol Malic Ash Alcalinity Magnesium Phenols Flavanoids
## 1 1 14.23 1.71 2.43 15.6 127 2.80 3.06
## 2 1 13.20 1.78 2.14 11.2 100 2.65 2.76
## 3 1 13.16 2.36 2.67 18.6 101 2.80 3.24
## 4 1 14.37 1.95 2.50 16.8 113 3.85 3.49
## 5 1 13.24 2.59 2.87 21.0 118 2.80 2.69
## 6 1 14.20 1.76 2.45 15.2 112 3.27 3.39
## 7 1 14.39 1.87 2.45 14.6 96 2.50 2.52
## 8 1 14.06 2.15 2.61 17.6 121 2.60 2.51
## 9 1 14.83 1.64 2.17 14.0 97 2.80 2.98
## 10 1 13.86 1.35 2.27 16.0 98 2.98 3.15
## Nonflavanoids Proanthocyanins Color Hue Dilution Proline
## 1 0.28 2.29 5.64 1.04 3.92 1065
## 2 0.26 1.28 4.38 1.05 3.40 1050
## 3 0.30 2.81 5.68 1.03 3.17 1185
## 4 0.24 2.18 7.80 0.86 3.45 1480
## 5 0.39 1.82 4.32 1.04 2.93 735
## 6 0.34 1.97 6.75 1.05 2.85 1450
## 7 0.30 1.98 5.25 1.02 3.58 1290
## 8 0.31 1.25 5.05 1.06 3.58 1295
## 9 0.29 1.98 5.20 1.08 2.85 1045
## 10 0.22 1.85 7.22 1.01 3.55 1045# PREGLED PODATAKA
scatterplotMatrix(wine[2:6])
# PROVEDI LDA
wine.lda <- MASS::lda(Type ~., data = wine)
wine.lda## Call:
## lda(Type ~ ., data = wine)
##
## Prior probabilities of groups:
## 1 2 3
## 0.3314607 0.3988764 0.2696629
##
## Group means:
## Alcohol Malic Ash Alcalinity Magnesium Phenols Flavanoids
## 1 13.74475 2.010678 2.455593 17.03729 106.3390 2.840169 2.9823729
## 2 12.27873 1.932676 2.244789 20.23803 94.5493 2.258873 2.0808451
## 3 13.15375 3.333750 2.437083 21.41667 99.3125 1.678750 0.7814583
## Nonflavanoids Proanthocyanins Color Hue Dilution Proline
## 1 0.290000 1.899322 5.528305 1.0620339 3.157797 1115.7119
## 2 0.363662 1.630282 3.086620 1.0562817 2.785352 519.5070
## 3 0.447500 1.153542 7.396250 0.6827083 1.683542 629.8958
##
## Coefficients of linear discriminants:
## LD1 LD2
## Alcohol -0.403399781 0.8717930699
## Malic 0.165254596 0.3053797325
## Ash -0.369075256 2.3458497486
## Alcalinity 0.154797889 -0.1463807654
## Magnesium -0.002163496 -0.0004627565
## Phenols 0.618052068 -0.0322128171
## Flavanoids -1.661191235 -0.4919980543
## Nonflavanoids -1.495818440 -1.6309537953
## Proanthocyanins 0.134092628 -0.3070875776
## Color 0.355055710 0.2532306865
## Hue -0.818036073 -1.5156344987
## Dilution -1.157559376 0.0511839665
## Proline -0.002691206 0.0028529846
##
## Proportion of trace:
## LD1 LD2
## 0.6875 0.3125# HISTOGRAM LDA VRIJEDNOSTI
wine.lda.pred <- predict(wine.lda)
head(wine.lda.pred)## $class
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [38] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [149] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## Levels: 1 2 3
##
## $posterior
## 1 2 3
## 1 1.000000e+00 3.261633e-09 3.641123e-18
## 2 9.999996e-01 3.583115e-07 8.733373e-17
## 3 9.999977e-01 2.321357e-06 7.823824e-14
## 4 1.000000e+00 3.726442e-12 1.334086e-16
## 5 9.251179e-01 7.488190e-02 2.171038e-07
## 6 1.000000e+00 3.509635e-11 1.291915e-17
## 7 1.000000e+00 2.700215e-11 1.200162e-17
## 8 1.000000e+00 1.905769e-10 2.304906e-16
## 9 9.999999e-01 6.006630e-08 2.436593e-15
## 10 9.999990e-01 9.839361e-07 1.156433e-13
## 11 1.000000e+00 7.882912e-10 1.560206e-18
## 12 9.999999e-01 1.013615e-07 6.790111e-14
## 13 1.000000e+00 3.178992e-08 1.063435e-14
## 14 1.000000e+00 1.223118e-10 3.713231e-21
## 15 1.000000e+00 2.485909e-13 6.100898e-21
## 16 1.000000e+00 1.166982e-08 4.124099e-13
## 17 1.000000e+00 1.376802e-08 1.859659e-13
## 18 9.999903e-01 9.693950e-06 2.068110e-12
## 19 1.000000e+00 3.895138e-13 4.347985e-20
## 20 9.999994e-01 6.131886e-07 6.646280e-13
## 21 9.999492e-01 5.075849e-05 2.562782e-14
## 22 9.935875e-01 6.412399e-03 5.452579e-08
## 23 9.999998e-01 1.748064e-07 1.444852e-18
## 24 9.997980e-01 2.019753e-04 1.062379e-12
## 25 9.996417e-01 3.582615e-04 1.915839e-13
## 26 9.688940e-01 3.110601e-02 1.717736e-09
## 27 1.000000e+00 1.588585e-08 9.262203e-16
## 28 9.999349e-01 6.506220e-05 2.377313e-11
## 29 9.999927e-01 7.346039e-06 2.714336e-14
## 30 9.999934e-01 6.575811e-06 5.362422e-13
## 31 9.999852e-01 1.484746e-05 2.121715e-12
## 32 1.000000e+00 3.179670e-08 2.242335e-14
## 33 9.995655e-01 4.344811e-04 1.185090e-13
## 34 9.999995e-01 4.919632e-07 3.310376e-14
## 35 9.999869e-01 1.306947e-05 6.385151e-12
## 36 9.973176e-01 2.682405e-03 1.146146e-11
## 37 9.999882e-01 1.184203e-05 1.306068e-11
## 38 9.991533e-01 8.467217e-04 1.250642e-09
## 39 9.912901e-01 8.709907e-03 1.944354e-12
## 40 1.000000e+00 2.871314e-08 2.182948e-13
## 41 9.983632e-01 1.636779e-03 4.296391e-12
## 42 9.989880e-01 1.011957e-03 7.945497e-10
## 43 1.000000e+00 2.899414e-10 3.422129e-18
## 44 8.115443e-01 1.884540e-01 1.667243e-06
## 45 9.404681e-01 5.953191e-02 5.974783e-11
## 46 9.999999e-01 9.191235e-08 4.367056e-11
## 47 1.000000e+00 3.633049e-08 1.938931e-15
## 48 9.999846e-01 1.537223e-05 6.595729e-14
## 49 9.999158e-01 8.415562e-05 3.325537e-10
## 50 9.999999e-01 1.098285e-07 3.350431e-14
## 51 9.999549e-01 4.508965e-05 3.992197e-13
## 52 1.000000e+00 4.361162e-09 4.191204e-17
## 53 1.000000e+00 2.975169e-09 4.798328e-17
## 54 1.000000e+00 2.335804e-09 3.050225e-14
## 55 9.999968e-01 3.168385e-06 7.722646e-13
## 56 9.992167e-01 7.832445e-04 2.202455e-08
## 57 9.999959e-01 4.127994e-06 5.233342e-12
## 58 1.000000e+00 3.325554e-08 1.551762e-14
## 59 1.000000e+00 1.095210e-08 5.925886e-15
## 60 2.496185e-09 9.999788e-01 2.122437e-05
## 61 2.520506e-06 9.999544e-01 4.304963e-05
## 62 9.708421e-09 9.653154e-01 3.468461e-02
## 63 3.954589e-04 9.996042e-01 3.837475e-07
## 64 1.239069e-07 9.999999e-01 1.036785e-10
## 65 3.049453e-08 9.999999e-01 2.630717e-08
## 66 8.148179e-04 9.991852e-01 2.231901e-08
## 67 1.124532e-04 9.998875e-01 1.195564e-12
## 68 7.916083e-07 9.999992e-01 2.142607e-09
## 69 6.608591e-03 9.924414e-01 9.499911e-04
## 70 2.880586e-07 9.999997e-01 1.710365e-09
## 71 5.517252e-06 9.982998e-01 1.694708e-03
## 72 2.206427e-04 9.997794e-01 1.917175e-09
## 73 3.460675e-06 9.999791e-01 1.739046e-05
## 74 2.460929e-03 9.975391e-01 1.188193e-10
## 75 7.877233e-05 9.999210e-01 1.882415e-07
## 76 6.880809e-10 9.999998e-01 2.032388e-07
## 77 9.508745e-08 9.999999e-01 1.626127e-08
## 78 3.060615e-07 9.999877e-01 1.198380e-05
## 79 1.864429e-05 9.999814e-01 2.946738e-09
## 80 2.790988e-06 9.999972e-01 1.090616e-09
## 81 3.005681e-10 1.000000e+00 2.015746e-13
## 82 1.020957e-02 9.897904e-01 3.053515e-10
## 83 4.047302e-08 9.999999e-01 9.930801e-09
## 84 4.499907e-07 8.972724e-01 1.027272e-01
## 85 8.249501e-05 9.999175e-01 2.417933e-08
## 86 1.475382e-05 9.999852e-01 1.924970e-10
## 87 5.478239e-10 1.000000e+00 9.099192e-09
## 88 5.426103e-09 1.000000e+00 3.515237e-09
## 89 1.096344e-06 9.999988e-01 1.358075e-07
## 90 7.759467e-08 9.999999e-01 1.016527e-09
## 91 6.193200e-08 9.999998e-01 1.018648e-07
## 92 2.887574e-09 9.999943e-01 5.740564e-06
## 93 4.805769e-08 9.999977e-01 2.292493e-06
## 94 4.239848e-07 9.999996e-01 1.806643e-10
## 95 1.137306e-08 1.000000e+00 2.169411e-08
## 96 6.165573e-04 9.993834e-01 7.789350e-11
## 97 9.084754e-07 8.438891e-01 1.561100e-01
## 98 3.301184e-07 9.999997e-01 5.936754e-12
## 99 1.517906e-04 9.998482e-01 6.599749e-13
## 100 2.814446e-07 9.999997e-01 4.000107e-14
## 101 1.568781e-06 9.999984e-01 1.793826e-11
## 102 6.144220e-07 9.999994e-01 2.917636e-08
## 103 2.692405e-05 9.999729e-01 1.769766e-07
## 104 1.580737e-11 1.000000e+00 2.823873e-08
## 105 3.269330e-05 9.999673e-01 2.012488e-10
## 106 9.387183e-08 9.999999e-01 7.552388e-10
## 107 5.534996e-06 9.999945e-01 5.195827e-10
## 108 1.781183e-07 9.999990e-01 7.981622e-07
## 109 7.737830e-10 1.000000e+00 2.031331e-10
## 110 1.231762e-03 9.987682e-01 6.488025e-12
## 111 2.044858e-10 1.000000e+00 4.282228e-09
## 112 3.885179e-08 9.999999e-01 1.650185e-08
## 113 6.886971e-04 9.993108e-01 4.576745e-07
## 114 2.523764e-10 1.000000e+00 2.536709e-08
## 115 2.201920e-07 9.999998e-01 1.641537e-09
## 116 5.771512e-13 1.000000e+00 1.911248e-15
## 117 5.154331e-09 1.000000e+00 3.495310e-10
## 118 4.675000e-09 1.000000e+00 1.032802e-10
## 119 8.376742e-07 9.693670e-01 3.063215e-02
## 120 3.765197e-07 9.999996e-01 3.918935e-09
## 121 6.406351e-05 9.999359e-01 2.646662e-10
## 122 3.081851e-03 9.969181e-01 2.009740e-15
## 123 3.676696e-07 9.999979e-01 1.751668e-06
## 124 3.396939e-05 9.999645e-01 1.533926e-06
## 125 4.475589e-06 9.999955e-01 7.806592e-10
## 126 1.811570e-07 9.999998e-01 2.929478e-11
## 127 4.442480e-07 9.999996e-01 3.273236e-10
## 128 2.405754e-10 9.999999e-01 9.030136e-08
## 129 1.138345e-09 1.000000e+00 1.205023e-10
## 130 1.329868e-06 9.997235e-01 2.751561e-04
## 131 8.923808e-07 6.153941e-02 9.384597e-01
## 132 3.217713e-10 8.597404e-05 9.999140e-01
## 133 6.794305e-13 2.509693e-05 9.999749e-01
## 134 3.488842e-12 1.273963e-05 9.999873e-01
## 135 8.028169e-11 1.674312e-03 9.983257e-01
## 136 1.128387e-11 2.193992e-05 9.999781e-01
## 137 2.367710e-12 2.337355e-06 9.999977e-01
## 138 1.654617e-15 4.076869e-07 9.999996e-01
## 139 4.245868e-11 1.099872e-05 9.999890e-01
## 140 7.197671e-12 6.872235e-05 9.999313e-01
## 141 3.995118e-08 2.135381e-04 9.997864e-01
## 142 6.317509e-07 3.699549e-05 9.999624e-01
## 143 7.751488e-10 3.171845e-05 9.999683e-01
## 144 7.268153e-09 7.589190e-05 9.999241e-01
## 145 7.884375e-12 4.731136e-08 1.000000e+00
## 146 2.152927e-09 7.834667e-05 9.999217e-01
## 147 6.018765e-15 1.744298e-09 1.000000e+00
## 148 2.073985e-15 1.909049e-10 1.000000e+00
## 149 7.236065e-16 2.140096e-10 1.000000e+00
## 150 1.704439e-15 8.851366e-10 1.000000e+00
## 151 1.401212e-14 2.253888e-09 1.000000e+00
## 152 3.346918e-18 2.381377e-11 1.000000e+00
## 153 4.195729e-17 1.674300e-08 1.000000e+00
## 154 5.032898e-16 6.421173e-11 1.000000e+00
## 155 2.069701e-14 6.419086e-06 9.999936e-01
## 156 2.974894e-16 1.480965e-10 1.000000e+00
## 157 4.795601e-16 2.379184e-11 1.000000e+00
## 158 1.569685e-15 1.613223e-08 1.000000e+00
## 159 6.138686e-18 2.856824e-13 1.000000e+00
## 160 3.632449e-18 3.959640e-12 1.000000e+00
## 161 3.039034e-17 6.637100e-09 1.000000e+00
## 162 1.560237e-09 1.256253e-06 9.999987e-01
## 163 1.789043e-10 1.129453e-04 9.998871e-01
## 164 2.344863e-09 1.161007e-05 9.999884e-01
## 165 9.656814e-16 1.332647e-10 1.000000e+00
## 166 1.971666e-14 4.010267e-08 1.000000e+00
## 167 8.333929e-17 3.794619e-12 1.000000e+00
## 168 2.393434e-16 3.966000e-11 1.000000e+00
## 169 1.449826e-13 1.005755e-09 1.000000e+00
## 170 3.794601e-16 1.460398e-12 1.000000e+00
## 171 7.200244e-13 1.264093e-05 9.999874e-01
## 172 1.902559e-18 7.559555e-11 1.000000e+00
## 173 4.071087e-14 1.126758e-11 1.000000e+00
## 174 1.798520e-13 1.861473e-11 1.000000e+00
## 175 3.005318e-14 1.457729e-09 1.000000e+00
## 176 5.033243e-16 1.463164e-12 1.000000e+00
## 177 1.816681e-13 9.687823e-10 1.000000e+00
## 178 1.105427e-17 3.148141e-13 1.000000e+00
##
## $x
## LD1 LD2
## 1 -4.70024401 1.979138347
## 2 -4.30195811 1.170412858
## 3 -3.42071952 1.429101388
## 4 -4.20575366 4.002871483
## 5 -1.50998168 0.451223898
## 6 -4.51868934 3.213137563
## 7 -4.52737794 3.269121791
## 8 -4.14834781 3.104117653
## 9 -3.86082876 1.953382629
## 10 -3.36662444 1.678643269
## 11 -4.80587907 2.235362714
## 12 -3.42807646 2.175109393
## 13 -3.66610246 2.262489607
## 14 -5.58824635 2.054787732
## 15 -5.50131449 3.613048652
## 16 -3.18475189 2.889525284
## 17 -3.28936988 2.765842660
## 18 -2.99809262 1.425111322
## 19 -5.24640372 3.709826553
## 20 -3.13653106 1.976899222
## 21 -3.57747791 0.562459905
## 22 -1.69077135 0.913421363
## 23 -4.83515033 0.914762801
## 24 -3.09588961 0.617358884
## 25 -3.32164716 0.298477344
## 26 -2.14482223 0.163692467
## 27 -3.98242850 2.175156795
## 28 -2.68591432 1.218509238
## 29 -3.56309464 1.038176511
## 30 -3.17301573 1.377896245
## 31 -2.99626797 1.324198961
## 32 -3.56866244 2.340654779
## 33 -3.38506383 0.201234260
## 34 -3.52753750 1.715927389
## 35 -2.85190852 1.470707713
## 36 -2.79411996 0.237930930
## 37 -2.75808511 1.569704208
## 38 -2.17734477 1.010364553
## 39 -3.02926382 -0.235095828
## 40 -3.27105228 2.604045903
## 41 -2.92065533 0.255233429
## 42 -2.23721062 0.919461164
## 43 -4.69972568 2.560753392
## 44 -1.23036133 0.422595151
## 45 -2.58203904 -0.350291948
## 46 -2.58312049 2.876865723
## 47 -3.88887889 2.051604078
## 48 -3.44975356 0.951839171
## 49 -2.34223331 1.432589499
## 50 -3.52062596 2.081553565
## 51 -3.21840912 0.879128696
## 52 -4.38214896 2.164715728
## 53 -4.36311727 2.271829285
## 54 -3.51917293 3.007373725
## 55 -3.12277475 1.593566695
## 56 -1.80240540 1.330061557
## 57 -2.87378754 1.729899425
## 58 -3.61690518 2.291157529
## 59 -3.73868551 2.460118029
## 60 1.58618749 -2.423844156
## 61 0.79967216 -1.394064606
## 62 2.38015446 -1.451886585
## 63 -0.45917726 -1.190453649
## 64 -0.50726885 -3.166624034
## 65 0.39398359 -2.779841704
## 66 -0.92256616 -1.388723683
## 67 -1.95549377 -2.693606293
## 68 -0.34732815 -2.592899030
## 69 0.20371212 0.019621350
## 70 -0.24831914 -2.756176101
## 71 1.17987999 -0.900342766
## 72 -1.07718925 -1.826701180
## 73 0.64100179 -1.445313675
## 74 -1.74684421 -1.784558589
## 75 -0.34721117 -1.488106819
## 76 1.14274222 -3.089248998
## 77 0.18665882 -2.673170958
## 78 0.90052500 -1.819423568
## 79 -0.70709551 -2.123044489
## 80 -0.59562833 -2.489622452
## 81 -0.55761818 -4.653037777
## 82 -1.80430417 -1.487149451
## 83 0.23077079 -2.842875470
## 84 2.03482711 -0.790320030
## 85 -0.62113021 -1.696895883
## 86 -1.03372742 -2.441437623
## 87 0.76598781 -3.446414023
## 88 0.35042568 -3.229356981
## 89 0.15324508 -2.112877671
## 90 -0.14962842 -2.991932096
## 91 0.48079504 -2.540024080
## 92 1.39689016 -2.540822912
## 93 0.91972331 -2.248596651
## 94 -0.59102937 -2.938453935
## 95 0.49411386 -2.936310763
## 96 -1.62614426 -2.020495450
## 97 2.00044562 -0.634484640
## 98 -1.00534818 -3.331125861
## 99 -2.07121314 -2.714454204
## 100 -1.63815890 -3.877396541
## 101 -1.05894340 -2.999872629
## 102 0.02594549 -2.354113884
## 103 -0.21887407 -1.642896008
## 104 1.36437640 -3.817471743
## 105 -1.12901245 -2.326852449
## 106 -0.21263094 -2.996775815
## 107 -0.77946884 -2.472773916
## 108 0.61546732 -2.178239872
## 109 0.22550192 -3.797341593
## 110 -2.03869851 -2.185325224
## 111 0.79274716 -3.661575980
## 112 0.30229545 -2.795278730
## 113 -0.50664882 -1.095273408
## 114 0.99837397 -3.445986749
## 115 -0.21954922 -2.797597691
## 116 -0.37131517 -6.005610308
## 117 0.05545894 -3.478469699
## 118 -0.09137874 -3.619777332
## 119 1.79755252 -0.850121765
## 120 -0.17405009 -2.632249713
## 121 -1.17870281 -2.205192262
## 122 -3.21054390 -2.905311694
## 123 0.62605202 -1.995708659
## 124 0.03366613 -1.384359759
## 125 -0.69930080 -2.459439566
## 126 -0.72061079 -3.246665203
## 127 -0.51933512 -2.869693250
## 128 1.17030045 -3.319478636
## 129 0.10824791 -3.798761426
## 130 1.12319783 -1.287848151
## 131 2.24632419 0.187347873
## 132 3.28527755 0.696086249
## 133 4.07236441 0.144257515
## 134 3.86691235 0.535033573
## 135 3.45088333 -0.217345358
## 136 3.71583899 0.565101301
## 137 3.92220510 0.893526217
## 138 4.85161020 0.314068518
## 139 3.54993389 0.915963299
## 140 3.76889174 0.225541129
## 141 2.66942250 1.141090760
## 142 2.32491492 1.948483302
## 143 3.17712883 1.059853166
## 144 2.88964418 1.157059225
## 145 3.78325562 2.007393044
## 146 3.04411324 0.981243704
## 147 4.70697017 1.817782774
## 148 4.85021393 2.208182127
## 149 4.98359184 2.034955195
## 150 4.86968293 1.808328611
## 151 4.59869190 1.872242276
## 152 5.67447884 1.825802705
## 153 5.32986123 0.582185152
## 154 5.03401031 2.277320759
## 155 4.52080087 -0.006734202
## 156 5.09783710 2.001620301
## 157 5.04368277 2.511903302
## 158 4.86980829 1.091580738
## 159 5.61316558 2.984393323
## 160 5.67046737 2.273069964
## 161 5.37413513 0.762472235
## 162 3.09975377 1.941064843
## 163 3.35888137 0.548689610
## 164 3.04007194 1.456988981
## 165 4.94861303 2.189924581
## 166 4.54504458 1.219898447
## 167 5.27255844 2.716230611
## 168 5.13016117 2.291725363
## 169 4.30468082 2.391125305
## 170 5.08336782 3.157666652
## 171 4.06743571 0.318921921
## 172 5.74212961 1.467081651
## 173 4.48205140 3.307083817
## 174 4.29150758 3.390331907
## 175 4.50329623 2.083545915
## 176 5.04747033 3.196231361
## 177 4.27615505 2.431387976
## 178 5.53808610 3.042057095MASS::ldahist(data = wine.lda.pred$x[,1], g = Type) # 1.LDA
MASS::ldahist(data = wine.lda.pred$x[,2], g = Type) # 2.LDA
# SCATTER
plot(wine.lda.pred$x[,1],wine.lda.pred$x[,2],
xlab = "2.DF", ylab = "1.DF", main = "2D diksriminantni prostor") # make a scatterplot
text(wine.lda.pred$x[,1],wine.lda.pred$x[,2],Type,cex=0.7,pos=4,col="red")
# END
detach(wine)## DRUGI PRIMJER ##
# UČITAJ PODATKE
url <- 'http://www.biz.uiowa.edu/faculty/jledolter/DataMining/admission.csv'
pristupnici <- read.csv(url)
# PREGLED PODATAKA
names(pristupnici)## [1] "GPA" "GMAT" "De"str(pristupnici)## 'data.frame': 85 obs. of 3 variables:
## $ GPA : num 2.96 3.14 3.22 3.29 3.69 3.46 3.03 3.19 3.63 3.59 ...
## $ GMAT: int 596 473 482 527 505 693 626 663 447 588 ...
## $ De : Factor w/ 3 levels "admit","border",..: 1 1 1 1 1 1 1 1 1 1 ...head(pristupnici,10)## GPA GMAT De
## 1 2.96 596 admit
## 2 3.14 473 admit
## 3 3.22 482 admit
## 4 3.29 527 admit
## 5 3.69 505 admit
## 6 3.46 693 admit
## 7 3.03 626 admit
## 8 3.19 663 admit
## 9 3.63 447 admit
## 10 3.59 588 admit# VIZUALIZACIJA
prPlot <- data.frame(pristupnici)
plot(prPlot$GPA, prPlot$GMAT, col=prPlot$De)
# PROCJENA
model1 <- MASS::lda(De ~ ., prPlot)
model1## Call:
## lda(De ~ ., data = prPlot)
##
## Prior probabilities of groups:
## admit border notadmit
## 0.3647059 0.3058824 0.3294118
##
## Group means:
## GPA GMAT
## admit 3.403871 561.2258
## border 2.992692 446.2308
## notadmit 2.482500 447.0714
##
## Coefficients of linear discriminants:
## LD1 LD2
## GPA 5.008766354 1.87668220
## GMAT 0.008568593 -0.01445106
##
## Proportion of trace:
## LD1 LD2
## 0.9673 0.0327# PREDVIĐANJE MODELA
p1 <- predict(model1, forecast = data.frame(GPA = 3.20, GMAT = 497))
lapply(p1,head,10)## $class
## [1] admit border border admit admit admit admit admit admit admit
## Levels: admit border notadmit
##
## $posterior
## admit border notadmit
## 1 0.6274441 3.677500e-01 4.805886e-03
## 2 0.1400290 8.578453e-01 2.125682e-03
## 3 0.4070245 5.925494e-01 4.261541e-04
## 4 0.9111531 8.883071e-02 1.618774e-05
## 5 0.9989964 1.003605e-03 6.361722e-10
## 6 0.9999849 1.506768e-05 6.281005e-11
## 7 0.9339968 6.575834e-02 2.448575e-04
## 8 0.9981064 1.893124e-03 5.117961e-07
## 9 0.9787312 2.126871e-02 5.091012e-08
## 10 0.9998460 1.540215e-04 2.192548e-10
##
## $x
## LD1 LD2
## 1 0.8485083 -1.58163149
## 2 0.6961493 0.53365169
## 3 1.1739680 0.55372673
## 4 1.9101683 0.03479678
## 5 3.7251658 1.10339298
## 6 4.1840450 -2.04504321
## 7 1.4561797 -1.88379553
## 8 2.5746203 -2.11821560
## 9 2.9276614 1.82895353
## 10 3.9354824 -0.28371322# PROCJENI KVADRATNI MODEL (QDA)
model2 <- MASS::qda(De ~., prPlot)
model2## Call:
## qda(De ~ ., data = prPlot)
##
## Prior probabilities of groups:
## admit border notadmit
## 0.3647059 0.3058824 0.3294118
##
## Group means:
## GPA GMAT
## admit 3.403871 561.2258
## border 2.992692 446.2308
## notadmit 2.482500 447.0714p2 <- predict(model2, forecast = data.frame(GPA = 3.20, GMAT = 497))
lapply(p2, head,10)## $class
## [1] admit border admit admit admit admit admit admit admit admit
## Levels: admit border notadmit
##
## $posterior
## admit border notadmit
## 1 0.9827310 5.740445e-03 1.152851e-02
## 2 0.3098756 6.880045e-01 2.119862e-03
## 3 0.8168026 1.826903e-01 5.070901e-04
## 4 0.9995494 4.307666e-04 1.985923e-05
## 5 1.0000000 2.322074e-09 4.254151e-10
## 6 1.0000000 3.974095e-20 1.887372e-10
## 7 0.9993608 1.560192e-05 6.235838e-04
## 8 0.9999982 5.599096e-11 1.830087e-06
## 9 0.9999297 7.025325e-05 2.151403e-08
## 10 1.0000000 1.265027e-13 3.241084e-10# GRAFIČKI PRIKAZ
library(klaR)
partimat(De ~ ., data = prPlot, method = "lda")
## TREĆI PRIMJER ##
# UČITAJ PODATKE
credit <- read.csv("http://www.biz.uiowa.edu/faculty/jledolter/DataMining/germancredit.csv")
head(credit,10) ## Default checkingstatus1 duration history purpose amount savings employ
## 1 0 A11 6 A34 A43 1169 A65 A75
## 2 1 A12 48 A32 A43 5951 A61 A73
## 3 0 A14 12 A34 A46 2096 A61 A74
## 4 0 A11 42 A32 A42 7882 A61 A74
## 5 1 A11 24 A33 A40 4870 A61 A73
## 6 0 A14 36 A32 A46 9055 A65 A73
## 7 0 A14 24 A32 A42 2835 A63 A75
## 8 0 A12 36 A32 A41 6948 A61 A73
## 9 0 A14 12 A32 A43 3059 A64 A74
## 10 1 A12 30 A34 A40 5234 A61 A71
## installment status others residence property age otherplans housing cards
## 1 4 A93 A101 4 A121 67 A143 A152 2
## 2 2 A92 A101 2 A121 22 A143 A152 1
## 3 2 A93 A101 3 A121 49 A143 A152 1
## 4 2 A93 A103 4 A122 45 A143 A153 1
## 5 3 A93 A101 4 A124 53 A143 A153 2
## 6 2 A93 A101 4 A124 35 A143 A153 1
## 7 3 A93 A101 4 A122 53 A143 A152 1
## 8 2 A93 A101 2 A123 35 A143 A151 1
## 9 2 A91 A101 4 A121 61 A143 A152 1
## 10 4 A94 A101 2 A123 28 A143 A152 2
## job liable tele foreign
## 1 A173 1 A192 A201
## 2 A173 1 A191 A201
## 3 A172 2 A191 A201
## 4 A173 2 A191 A201
## 5 A173 2 A191 A201
## 6 A172 2 A192 A201
## 7 A173 1 A191 A201
## 8 A174 1 A192 A201
## 9 A172 1 A191 A201
## 10 A174 1 A191 A201names(credit)## [1] "Default" "checkingstatus1" "duration" "history"
## [5] "purpose" "amount" "savings" "employ"
## [9] "installment" "status" "others" "residence"
## [13] "property" "age" "otherplans" "housing"
## [17] "cards" "job" "liable" "tele"
## [21] "foreign"str(credit)## 'data.frame': 1000 obs. of 21 variables:
## $ Default : int 0 1 0 0 1 0 0 0 0 1 ...
## $ checkingstatus1: Factor w/ 4 levels "A11","A12","A13",..: 1 2 4 1 1 4 4 2 4 2 ...
## $ duration : int 6 48 12 42 24 36 24 36 12 30 ...
## $ history : Factor w/ 5 levels "A30","A31","A32",..: 5 3 5 3 4 3 3 3 3 5 ...
## $ purpose : Factor w/ 10 levels "A40","A41","A410",..: 5 5 8 4 1 8 4 2 5 1 ...
## $ amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ savings : Factor w/ 5 levels "A61","A62","A63",..: 5 1 1 1 1 5 3 1 4 1 ...
## $ employ : Factor w/ 5 levels "A71","A72","A73",..: 5 3 4 4 3 3 5 3 4 1 ...
## $ installment : int 4 2 2 2 3 2 3 2 2 4 ...
## $ status : Factor w/ 4 levels "A91","A92","A93",..: 3 2 3 3 3 3 3 3 1 4 ...
## $ others : Factor w/ 3 levels "A101","A102",..: 1 1 1 3 1 1 1 1 1 1 ...
## $ residence : int 4 2 3 4 4 4 4 2 4 2 ...
## $ property : Factor w/ 4 levels "A121","A122",..: 1 1 1 2 4 4 2 3 1 3 ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ otherplans : Factor w/ 3 levels "A141","A142",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ housing : Factor w/ 3 levels "A151","A152",..: 2 2 2 3 3 3 2 1 2 2 ...
## $ cards : int 2 1 1 1 2 1 1 1 1 2 ...
## $ job : Factor w/ 4 levels "A171","A172",..: 3 3 2 3 3 2 3 4 2 4 ...
## $ liable : int 1 1 2 2 2 2 1 1 1 1 ...
## $ tele : Factor w/ 2 levels "A191","A192": 2 1 1 1 1 2 1 2 1 1 ...
## $ foreign : Factor w/ 2 levels "A201","A202": 1 1 1 1 1 1 1 1 1 1 ...# Izaberi (numeričke) varijable
cred1 <- credit[, c("Default","duration","amount","installment","age")]
head(cred1, 10)## Default duration amount installment age
## 1 0 6 1169 4 67
## 2 1 48 5951 2 22
## 3 0 12 2096 2 49
## 4 0 42 7882 2 45
## 5 1 24 4870 3 53
## 6 0 36 9055 2 35
## 7 0 24 2835 3 53
## 8 0 36 6948 2 35
## 9 0 12 3059 2 61
## 10 1 30 5234 4 28summary(cred1)## Default duration amount installment age
## Min. :0.0 Min. : 4.0 Min. : 250 Min. :1.000 Min. :19.00
## 1st Qu.:0.0 1st Qu.:12.0 1st Qu.: 1366 1st Qu.:2.000 1st Qu.:27.00
## Median :0.0 Median :18.0 Median : 2320 Median :3.000 Median :33.00
## Mean :0.3 Mean :20.9 Mean : 3271 Mean :2.973 Mean :35.55
## 3rd Qu.:1.0 3rd Qu.:24.0 3rd Qu.: 3972 3rd Qu.:4.000 3rd Qu.:42.00
## Max. :1.0 Max. :72.0 Max. :18424 Max. :4.000 Max. :75.00# Vizualiziraj (nije normalna distribucja?)
cred1[,-1] %>%
# as_tibble(.) %>%
# select(- Default) %>%
gather(., Varijable, Vrijednosti) %>%
ggplot(.) +
geom_histogram( aes(x = Vrijednosti), colour = "black", fill = "white") +
facet_wrap(~Varijable, scales = "free")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# PROCJENI MODEL
lin <- lda(Default ~ ., cred1)
table(predict(lin)$class, cred1$Default) # Confusion matrica##
## 0 1
## 0 669 256
## 1 31 44# Predvidi vjerojatnost za određene vrijednsoti parametara
predict(lin, newdata = data.frame(duration = 6,
amount = 1100,
installment = 4,
age = 67))## $class
## [1] 0
## Levels: 0 1
##
## $posterior
## 0 1
## 1 0.8704023 0.1295977
##
## $x
## LD1
## 1 -1.791853qua <- qda(Default ~ . , cred1)
qua## Call:
## qda(Default ~ ., data = cred1)
##
## Prior probabilities of groups:
## 0 1
## 0.7 0.3
##
## Group means:
## duration amount installment age
## 0 19.20714 2985.457 2.920000 36.22429
## 1 24.86000 3938.127 3.096667 33.96333table(predict(qua)$class, cred1$Default)##
## 0 1
## 0 628 221
## 1 72 79predict(qua,newdata=data.frame(duration = 6,
amount = 1100,
installment = 4,
age = 67))## $class
## [1] 0
## Levels: 0 1
##
## $posterior
## 0 1
## 1 0.9375556 0.06244441## ČETVRTI PRIMJER ##
# Podatci
sample_n(iris,12)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 4.6 3.6 1.0 0.2 setosa
## 2 5.1 3.8 1.6 0.2 setosa
## 3 6.4 3.2 4.5 1.5 versicolor
## 4 5.0 2.0 3.5 1.0 versicolor
## 5 6.8 3.0 5.5 2.1 virginica
## 6 6.5 3.0 5.8 2.2 virginica
## 7 6.3 2.5 4.9 1.5 versicolor
## 8 5.0 3.5 1.6 0.6 setosa
## 9 6.3 2.3 4.4 1.3 versicolor
## 10 6.0 3.4 4.5 1.6 versicolor
## 11 4.7 3.2 1.6 0.2 setosa
## 12 5.7 2.8 4.5 1.3 versicolor# Podjela na trening i test
traning <- sample(c(TRUE,FALSE),nrow(iris),replace = T, prob = c(0.6,0.4))
train <- iris[traning,]
test <- iris[!traning,]
# Procjeni LDA model
lda.iris <- lda(Species ~ . , train)
lda.iris## Call:
## lda(Species ~ ., data = train)
##
## Prior probabilities of groups:
## setosa versicolor virginica
## 0.3614458 0.3132530 0.3253012
##
## Group means:
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa 5.090000 3.470000 1.456667 0.2433333
## versicolor 5.884615 2.684615 4.230769 1.3230769
## virginica 6.637037 3.018519 5.640741 2.0592593
##
## Coefficients of linear discriminants:
## LD1 LD2
## Sepal.Length 1.012361 -0.08040085
## Sepal.Width 1.031302 -2.08171038
## Petal.Length -1.925059 0.87394361
## Petal.Width -2.854816 -2.66015469
##
## Proportion of trace:
## LD1 LD2
## 0.9859 0.0141# Vizualizacija
plot(lda.iris, col = as.integer(train$Species))
partimat(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data=train, method="lda")
# Predikcija na trening uzorku
lda.train <- predict(lda.iris)
train$lda <- lda.train$class
table(train$lda, train$Species)##
## setosa versicolor virginica
## setosa 30 0 0
## versicolor 0 24 1
## virginica 0 2 26# Predikcija na testnom uzorku
lda.test <- predict(lda.iris, test)
test$lda <- lda.test$class
table(test$lda, test$Species)##
## setosa versicolor virginica
## setosa 20 0 0
## versicolor 0 24 1
## virginica 0 0 22## Nelinearna diskriminantna analiza
qda.iris <- qda(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, train)
qda.iris## Call:
## qda(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,
## data = train)
##
## Prior probabilities of groups:
## setosa versicolor virginica
## 0.3614458 0.3132530 0.3253012
##
## Group means:
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa 5.090000 3.470000 1.456667 0.2433333
## versicolor 5.884615 2.684615 4.230769 1.3230769
## virginica 6.637037 3.018519 5.640741 2.0592593# Vizualizacija
partimat(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data=train, method="qda")
# Predikcija na trening uzorku
qda.train <- predict(qda.iris)
train$qda <- qda.train$class
table(train$qda,train$Species)##
## setosa versicolor virginica
## setosa 30 0 0
## versicolor 0 24 0
## virginica 0 2 27# Predikcija na test uzorku
qda.test <- predict(qda.iris,test)
test$qda <- qda.test$class
table(test$qda,test$Species)##
## setosa versicolor virginica
## setosa 20 0 0
## versicolor 0 24 1
## virginica 0 0 22## PETI PRIMJER ##
# Podatci
bankrot <- as_tibble(ISLR::Default)
names(bankrot)## [1] "default" "student" "balance" "income"glimpse(bankrot)## Observations: 10,000
## Variables: 4
## $ default <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, No, No,...
## $ student <fct> No, Yes, No, No, No, Yes, No, Yes, No, No, Yes, Yes, No, No...
## $ balance <dbl> 729.5265, 817.1804, 1073.5492, 529.2506, 785.6559, 919.5885...
## $ income <dbl> 44361.625, 12106.135, 31767.139, 35704.494, 38463.496, 7491...summary(bankrot)## default student balance income
## No :9667 No :7056 Min. : 0.0 Min. : 772
## Yes: 333 Yes:2944 1st Qu.: 481.7 1st Qu.:21340
## Median : 823.6 Median :34553
## Mean : 835.4 Mean :33517
## 3rd Qu.:1166.3 3rd Qu.:43808
## Max. :2654.3 Max. :73554head(bankrot,10)## # A tibble: 10 x 4
## default student balance income
## <fct> <fct> <dbl> <dbl>
## 1 No No 730. 44362.
## 2 No Yes 817. 12106.
## 3 No No 1074. 31767.
## 4 No No 529. 35704.
## 5 No No 786. 38463.
## 6 No Yes 920. 7492.
## 7 No No 826. 24905.
## 8 No Yes 809. 17600.
## 9 No No 1161. 37469.
## 10 No No 0 29275.# Podjela na trening i test
uzorak <- sample(c(TRUE, FALSE), nrow(bankrot), replace = T, prob = (c(0.6, 0.4)))
train <- bankrot[uzorak,]
test <- bankrot[!uzorak, ]
# Provedi test
mod1.lda <- lda(default ~ balance + student, data = train)
plot(mod1.lda)
# Predikcija
preDf <- tibble(balance = rep(c(1000,2000),2),
student = c("No", "No", "Yes", "Yes"))
mod1.lda.pred <- predict(mod1.lda, preDf)
mod1.lda.pred## $class
## [1] No Yes No No
## Levels: No Yes
##
## $posterior
## No Yes
## 1 0.9887742 0.011225826
## 2 0.4480317 0.551968260
## 3 0.9939798 0.006020167
## 4 0.6034178 0.396582179
##
## $x
## LD1
## 1 0.4558416
## 2 2.7126825
## 3 0.1532748
## 4 2.4101157sum(mod1.lda.pred$posterior[,1] >= .5) # ne-bankrotirani## [1] 3sum(mod1.lda.pred$posterior[,2] > .5) # bankrotirani## [1] 1# Nelinearna diskriminantna analiza
mod1.qda <- qda(default ~ balance + student, data = train)
mod1.qda## Call:
## qda(default ~ balance + student, data = train)
##
## Prior probabilities of groups:
## No Yes
## 0.96791798 0.03208202
##
## Group means:
## balance studentYes
## No 807.9166 0.2940372
## Yes 1736.3779 0.3556701predict(mod1.qda, preDf) # Predikcija QDA## $class
## [1] No Yes No No
## Levels: No Yes
##
## $posterior
## No Yes
## 1 0.9943319 0.005668146
## 2 0.4684804 0.531519630
## 3 0.9989962 0.001003806
## 4 0.5160590 0.483940998# Usporedi modele
test.predikcija.lda <- predict(mod1.lda, newdata = test)
test.predikcija.qda <- predict(mod1.qda, newdata = test)
table.lda <- table(test$default, test.predikcija.lda$class)
table.qda <- table(test$default, test.predikcija.qda$class)
# 1
list(LDA.model = table.lda %>% prop.table() %>% round(3),
QDA.model = table.qda %>% prop.table() %>% round(3))## $LDA.model
##
## No Yes
## No 0.962 0.003
## Yes 0.026 0.010
##
## $QDA.model
##
## No Yes
## No 0.961 0.004
## Yes 0.025 0.011list(LDA.model.num = table.lda,
QDA.model.num = table.qda)## $LDA.model.num
##
## No Yes
## No 3802 12
## Yes 101 38
##
## $QDA.model.num
##
## No Yes
## No 3800 14
## Yes 97 42# 2
test %>%
mutate(lda.pred = test.predikcija.lda$class,
qda.pred = test.predikcija.qda$class) %>%
summarise(lda.error = mean(default != lda.pred),
qda.error = mean(default != qda.pred))## # A tibble: 1 x 2
## lda.error qda.error
## <dbl> <dbl>
## 1 0.0286 0.0281# 3
lda.pred.adj <- ifelse(test.predikcija.lda$posterior[,2] > .2, "Da", "Ne")
qda.pred.adj <- ifelse(test.predikcija.qda$posterior[,2] > .2, "Da", "Ne")
list(LDA.mod = table(test$default, lda.pred.adj), # Confusion matrica
qDA.mod = table(test$default, qda.pred.adj))## $LDA.mod
## lda.pred.adj
## Da Ne
## No 82 3732
## Yes 79 60
##
## $qDA.mod
## qda.pred.adj
## Da Ne
## No 124 3690
## Yes 88 51# ROC krivulja
par(mfrow=c(1,2))
prediction(test.predikcija.lda$posterior[,2], test$default) %>%
performance(measure = "tpr", x.measure = "fpr") %>%
plot(main = "LDA")
prediction(test.predikcija.qda$posterior[,2], test$default) %>%
performance(measure = "tpr", x.measure = "fpr") %>%
plot(main= "QDA")
## ŠESTI PRIMJER ##
# Podatci
head(ISLR::Smarket)## Year Lag1 Lag2 Lag3 Lag4 Lag5 Volume Today Direction
## 1 2001 0.381 -0.192 -2.624 -1.055 5.010 1.1913 0.959 Up
## 2 2001 0.959 0.381 -0.192 -2.624 -1.055 1.2965 1.032 Up
## 3 2001 1.032 0.959 0.381 -0.192 -2.624 1.4112 -0.623 Down
## 4 2001 -0.623 1.032 0.959 0.381 -0.192 1.2760 0.614 Up
## 5 2001 0.614 -0.623 1.032 0.959 0.381 1.2057 0.213 Up
## 6 2001 0.213 0.614 -0.623 1.032 0.959 1.3491 1.392 Upstr(ISLR::Smarket)## 'data.frame': 1250 obs. of 9 variables:
## $ Year : num 2001 2001 2001 2001 2001 ...
## $ Lag1 : num 0.381 0.959 1.032 -0.623 0.614 ...
## $ Lag2 : num -0.192 0.381 0.959 1.032 -0.623 ...
## $ Lag3 : num -2.624 -0.192 0.381 0.959 1.032 ...
## $ Lag4 : num -1.055 -2.624 -0.192 0.381 0.959 ...
## $ Lag5 : num 5.01 -1.055 -2.624 -0.192 0.381 ...
## $ Volume : num 1.19 1.3 1.41 1.28 1.21 ...
## $ Today : num 0.959 1.032 -0.623 0.614 0.213 ...
## $ Direction: Factor w/ 2 levels "Down","Up": 2 2 1 2 2 2 1 2 2 2 ...# Train/test
train <- subset(ISLR::Smarket, Year < 2005)
test <- subset(ISLR::Smarket, Year == 2005)
# Logistička regresija
logit.fit <- glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume,
family = binomial,
data = train)
summary(logit.fit)##
## Call:
## glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 +
## Volume, family = binomial, data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.302 -1.190 1.079 1.160 1.350
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.191213 0.333690 0.573 0.567
## Lag1 -0.054178 0.051785 -1.046 0.295
## Lag2 -0.045805 0.051797 -0.884 0.377
## Lag3 0.007200 0.051644 0.139 0.889
## Lag4 0.006441 0.051706 0.125 0.901
## Lag5 -0.004223 0.051138 -0.083 0.934
## Volume -0.116257 0.239618 -0.485 0.628
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1383.3 on 997 degrees of freedom
## Residual deviance: 1381.1 on 991 degrees of freedom
## AIC: 1395.1
##
## Number of Fisher Scoring iterations: 3# Predikcija
logit.pred <- predict(logit.fit, test, type = "response")
table(test$Direction, ifelse((logit.pred > .5), "Up", "Down")) # Confusion matrica##
## Down Up
## Down 77 34
## Up 97 44mean(ifelse(logit.pred >.5, "Up", "Down") == test$Direction) # Preciznost## [1] 0.4801587mean(ifelse(logit.pred >.5, "Up", "Down") != test$Direction) # Error## [1] 0.5198413# Utjecaj varijabli i novi logit model
caret::varImp(logit.fit)## Overall
## Lag1 1.04620896
## Lag2 0.88432632
## Lag3 0.13941784
## Lag4 0.12456821
## Lag5 0.08257344
## Volume 0.48517564logit.fit.novi <- glm( Direction ~ Lag1 + Lag2, data = train, family = binomial)
summary(logit.fit.novi)##
## Call:
## glm(formula = Direction ~ Lag1 + Lag2, family = binomial, data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.345 -1.188 1.074 1.164 1.326
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.03222 0.06338 0.508 0.611
## Lag1 -0.05562 0.05171 -1.076 0.282
## Lag2 -0.04449 0.05166 -0.861 0.389
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1383.3 on 997 degrees of freedom
## Residual deviance: 1381.4 on 995 degrees of freedom
## AIC: 1387.4
##
## Number of Fisher Scoring iterations: 3logit.pred.novi <- predict(logit.fit.novi, test, type = "response") # Predikcija
table(test$Direction, ifelse(logit.pred.novi > .5, "Up", "Down")) # Confusion matrica##
## Down Up
## Down 35 76
## Up 35 106mean(ifelse(logit.pred.novi >.5, "Up", "Down") == test$Direction) # Preciznost## [1] 0.5595238mean(ifelse(logit.pred.novi >.5, "Up", "Down") != test$Direction) # Error## [1] 0.4404762# Linearna diskriminantna anliza
lda.fit <- lda(Direction ~ Lag1 + Lag2, data = train)
print(lda.fit)## Call:
## lda(Direction ~ Lag1 + Lag2, data = train)
##
## Prior probabilities of groups:
## Down Up
## 0.491984 0.508016
##
## Group means:
## Lag1 Lag2
## Down 0.04279022 0.03389409
## Up -0.03954635 -0.03132544
##
## Coefficients of linear discriminants:
## LD1
## Lag1 -0.6420190
## Lag2 -0.5135293lda.predict <- predict(lda.fit, newdata = test) # Predikcija
table(test$Direction, lda.predict$class) # Confusion matrica##
## Down Up
## Down 35 76
## Up 35 106mean(lda.predict$class == test$Direction) # Točnost## [1] 0.5595238mean(lda.predict$class != test$Direction) # Error## [1] 0.4404762# Nelinearna diskriminantna analiza
qda.fit <- qda(Direction ~ Lag1 + Lag2, data = train )
print(qda.fit)## Call:
## qda(Direction ~ Lag1 + Lag2, data = train)
##
## Prior probabilities of groups:
## Down Up
## 0.491984 0.508016
##
## Group means:
## Lag1 Lag2
## Down 0.04279022 0.03389409
## Up -0.03954635 -0.03132544qda.predict <- predict(qda.fit, newdata = test) # Predikcija
table(test$Direction, qda.predict$class) # Confusion matrica##
## Down Up
## Down 30 81
## Up 20 121mean(qda.predict$class == test$Direction) # Točnost## [1] 0.5992063mean(qda.predict$class != test$Direction) # Error## [1] 0.4007937# Vizualizacija ROC za različite modela
p1 <- prediction(logit.pred.novi, test$Direction) %>%
performance(measure = "tpr", x.measure = "fpr")
p2 <- prediction(lda.predict$posterior[,2], test$Direction) %>%
performance(measure = "tpr", x.measure = "fpr")
p3 <- prediction(qda.predict$posterior[,2], test$Direction) %>%
performance(measure = "tpr", x.measure = "fpr")
plot(p1, col = "red")
plot(p2, add = TRUE, col = "blue")
plot(p3, add = TRUE, col = "green")