Analiza wzorców chodu z wykorzystaniem algorytmów uczenia maszynowego

Autorzy: Kamil Kałużny, Szymon Soszka, Tomasz Gudyka

W projekcie został wykorzystany kod źródłowy z następującego źródła: Walking-Pattern-Recognition.

Przygotowanie danych

Ładowanie wszystkich plików CSV jako oddzielne ramki danych

## Biblioteki
suppressMessages(require(randomForest, quietly = T))
suppressMessages(require(caret, quietly = T))
suppressMessages(require(MASS, quietly = T))
suppressMessages(require(e1071, quietly = T))
suppressMessages(require(doParallel, quietly = T))
suppressMessages(require(corrplot, quietly = T))
suppressMessages(require(glmnet, quietly = T))
suppressMessages(require(plotly, quietly = T))
suppressMessages(require(tinytex, quietly = T))


Wiktoria.df <- read.csv('gotowyWiktoria.csv')
Tomek.df <- read.csv('gotowyTomek.csv')
Konrad.df <- read.csv('gotowyKonrad.csv')
Kamil.df <- read.csv('gotowyKamil.csv')
Szymon.df <- read.csv('gotowySzymon.csv')
Michal.df <- read.csv('gotowyMichal.csv')
Julita.df <- read.csv('gotowyJulita.csv')
Krzysiek.df <- read.csv('gotowyKrzysiek.csv')

Wizualizacja danych

Funkcja acc.type.plots odpowiada za tworzenie wykresów każdej mierzonej wielkości w zależności od czasu w sekundach.

acc.type.plots <- function(column="AccX", ylim.min = 0, ylim.max = 28){
  par(mfrow=c(3,2))
  
  plot(Wiktoria.df$relative_time/1000, Wiktoria.df[[column]], type = "l", col="red", 
       main = paste0(column, " - Wiktoria"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Tomek.df$relative_time/1000, Tomek.df[[column]], type = "l", col="blue", 
       main = paste0(column, " - Tomek"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Konrad.df$relative_time/1000, Konrad.df[[column]], type = "l", col="green", 
       main = paste0(column, " - Konrad"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Kamil.df$relative_time/1000, Kamil.df[[column]], type = "l", col="orchid", 
       main = paste0(column, " - Kamil"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Szymon.df$relative_time/1000, Szymon.df[[column]], type = "l", col="orange", 
       main = paste0(column, " - Szymon"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Michal.df$relative_time/1000, Michal.df[[column]], type = "l", col="yellow", 
       main = paste0(column, " - Michał"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Julita.df$relative_time/1000, Julita.df[[column]], type = "l", col="brown", 
       main = paste0(column, " - Julita"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
  plot(Krzysiek.df$relative_time/1000, Krzysiek.df[[column]], type = "l", col="gray", 
       main = paste0(column, " - Krzysiek"), ylim = c(ylim.min, ylim.max),
       ylab = "m/s2", xlab = "sekund")
}

acc.type.plots(column="AccX", ylim.min = -25, ylim.max = 25)

acc.type.plots(column="AccY", ylim.min = -45, ylim.max = 15)

acc.type.plots(column="AccZ", ylim.min = -30, ylim.max = 25)

acc.type.plots(column="LinearAccelerometerSensor", ylim.min = -5, ylim.max = 50)

Okienkowanie danych

Slicer to funkcja do tworzenia przedziałów (binów) dla każdego zestawu danych na podstawie podanych parametrów. Musimy określić wielkość okna (window.size) oraz wielkość nakładającego się fragmentu (overlap size) w celu podziału danych. Funkcja zwraca listę wszystkich przedziałów, np. bins = [(1, 2, 3), (3, 4), (5, 6, 7, 8, 9), (10, 11, 12, 13), …], gdzie każda liczba odpowiada indeksowi wiersza w ramce danych.

### Jest to funkcja, która uzyskuje możliwe przedziały (biny) dla każdego zestawu danych.

slicer <- function(df, window.size=500, overlap = 200){
  # wartość non-overlap
  non_overlap <- window.size - overlap
  
  # indeks początkowy
  from <- 1
  
  # początek czasu relatywnego
  start <- df[["relative_time"]][1]
  
  # wektor dla utworzonych przedziałów (binów)
  bins <- list()
  counter <- 1
  
  done <- FALSE
  while (done != TRUE) {
    # uzyskaj możliwe indeksy przedziałów (binów) = [start, end)
    bin.idx <- c(from, from + window.size)
    
    # uzyskaj odpowiednie indeksy czasu względnego dla danego przedziału (bina) i zapisz je do wektora bins.
    bin <- c()
    for(i in start:nrow(df)) ifelse(df$relative_time[i] < bin.idx[2], bin <- c(bin, i), break)
    
    if(is.null(bin) == FALSE) {
      bins[[counter]] <- bin
      counter = counter + 1
    }
    
    # Zmień indeks początkowy dla kolejnego przedziału (bina).
    from <- from + non_overlap
    # start <- i
    start <- which(df$relative_time >= from)[1]

    # warunek zakończenia:
    if(from > df[["relative_time"]][nrow(df)]) done <- TRUE
  }
  return(bins)
  }

Teraz sprawdzamy możliwą liczbę binów generowanych przy określonych parametrach.

## Liczba możliwych binów przy określonych wartościach window.size i overlap.
window.size = 1500
overlap = 1000

Wiktoria.bins <- slicer(Wiktoria.df, window.size=window.size, overlap = overlap)
paste("Wiktoria", length(Wiktoria.bins))
## [1] "Wiktoria 4122"
Tomek.bins <- slicer(Tomek.df, window.size=window.size, overlap = overlap)
paste("Tomek",length(Tomek.bins))
## [1] "Tomek 3032"
Konrad.bins <- slicer(Konrad.df, window.size=window.size, overlap = overlap)
paste("Konrad", length(Konrad.bins))
## [1] "Konrad 4119"
Kamil.bins <- slicer(Kamil.df, window.size=window.size, overlap = overlap)
paste("Kamil", length(Kamil.bins))
## [1] "Kamil 4102"
Szymon.bins <- slicer(Szymon.df, window.size=window.size, overlap = overlap)
paste("Szymon", length(Szymon.bins))
## [1] "Szymon 4110"
Michal.bins <- slicer(Michal.df, window.size=window.size, overlap = overlap)
paste("Michał", length(Michal.bins))
## [1] "Michał 3940"
Julita.bins <- slicer(Julita.df, window.size=window.size, overlap = overlap)
paste("Julita", length(Julita.bins))
## [1] "Julita 3050"
Krzysiek.bins <- slicer(Krzysiek.df, window.size=window.size, overlap = overlap)
paste("Krzysiek", length(Krzysiek.bins))
## [1] "Krzysiek 2994"

To jest przykład binów dla każdego zestawu danych z window.size=1500 i overlap=1000.

Wiktoria.df[Wiktoria.bins[[1]], ]
##    relative_time LinearAccelerometerSensor      AccX       AccY      AccZ
## 8            533                  2.743641  0.307050  2.5860002  8.943001
## 9            573                  3.407571 -0.262050  3.3670502  9.352950
## 10           613                  2.817585  1.150050  2.3509500  8.763000
## 11           653                  3.212532  1.296000  2.7700500  8.823000
## 12           693                  3.687852  0.904950  3.4600501  8.907001
## 13           732                  3.709182  1.207050  3.4000502  8.946000
## 14           772                  3.734187  1.794000  3.2610002  9.504001
## 15           812                  3.607000  1.444050  3.3019502  9.955951
## 16           852                  3.068892  1.035000  2.8330503 10.372951
## 17           892                  3.616643  1.762950  2.9790001  8.758950
## 18           932                  3.072265  1.513950  2.6479502  9.439051
## 19           971                  3.411500  1.492050  3.0460501  9.441000
## 20          1011                  3.273465  1.369950  2.8950002  9.130051
## 21          1051                  2.991398  0.831000  2.7540002  8.986051
## 22          1091                  3.874557  1.947000  3.1680002  8.718000
## 23          1131                  3.466898  2.140950  2.6790001  9.298051
## 24          1171                  3.584441  2.259000  2.6629500  8.998051
## 25          1210                  3.832229  2.557950  2.5960500  8.622001
## 26          1250                  5.297134  4.630050  2.5309501 10.272000
## 27          1290                  3.054569  2.659050  1.4719501 10.111951
## 28          1330                  6.091438  3.420000  2.1450002  5.245050
## 29          1370                  8.503842  6.373050  2.4900000  4.756950
## 30          1410                 10.086307  5.691000  3.1080000  2.080950
## 31          1450                 11.603537  7.996950  1.6230000  1.557000
## 32          1489                 12.842574  7.353000  2.5980000 -0.397050
## 33          1529                  8.207419  2.709000  1.0080000  2.125050
## 34          1569                 11.941901  8.160001  1.3960501  1.200000
## 35          1609                 11.097050  8.785050 -0.4830000  3.043950
## 36          1649                 11.789112  9.559051 -0.3349500  2.914950
## 37          1689                 12.764453 10.477950 -0.8380501  2.565000
## 38          1728                 15.083529 11.283001 -2.0760002  0.013950
## 39          1768                 20.219974 18.993000 -2.1409502  3.208950
## 40          1808                 18.943340 18.103951 -2.9430001  5.070000
## 41          1848                 17.181447 12.828001 -2.0880001 -1.431000
## 42          1888                 17.605705 10.452001 -0.4069500 -4.354950
## 43          1928                 15.636536  7.887001  0.1660500 -3.694050
## 44          1967                 12.880198  8.229000 -1.1680501 -0.033000
Tomek.df[Tomek.bins[[1]], ]
##    relative_time LinearAccelerometerSensor         AccX        AccY       AccZ
## 11           526                 3.9599590   1.97700012  -1.4970001 12.8940010
## 12           566                 4.0183841   1.03095007   0.4060500  5.9440503
## 13           606                 1.4348909  -1.27500010   0.6259500  9.6030006
## 14           645                 1.2745346   0.35505003  -0.9679500 10.5559502
## 15           685                 0.5663341  -0.03195000   0.0060000 10.3720503
## 16           725                 0.8669617  -0.07695001   0.7000501  9.3010502
## 17           765                 1.4442004   0.47805002   0.5640000  8.5660505
## 18           804                 1.3418241  -0.35505003   1.1820000  9.2800503
## 19           844                 1.4788322  -0.52005005   0.8920500  8.7480001
## 20           884                 2.5117943  -1.38705003   1.2769500  8.1469507
## 21           923                 2.1114573  -0.93195003   1.2409501  8.3749504
## 22           963                 1.5057543  -1.24305010   0.5370000  9.1480503
## 23          1003                 2.5469017  -2.29005003   0.6000000 10.7460003
## 24          1043                 2.0062514  -1.76805007   0.2569500  8.8939505
## 25          1082                 5.8748045  -5.67405033   0.6400501  8.4250507
## 26          1122                 4.9990247  -3.99300027  -2.9419501 10.4320507
## 27          1162                 7.3952810  -2.94600010  -3.8179502  4.2000003
## 28          1202                13.1267034  -7.02705050  -2.5180502 -0.9910501
## 29          1241                13.4919282  -5.90205050  -5.1810002 -1.1640000
## 30          1281                13.7798510  -4.22504997  -8.9149504  0.1860000
## 31          1321                13.6399305  -4.88595009 -11.9830503  5.4960003
## 32          1360                15.0919928  -9.69105053 -11.4780006  8.3550005
## 33          1400                20.0593412 -18.21495056  -8.3640003  9.0090008
## 34          1440                24.0367533 -23.26995087  -5.9500504  8.8729506
## 35          1480                34.1999325 -30.06495094   1.4950501 -6.4260001
## 36          1519                20.1218441 -13.62105083  -6.4120502 -3.5440502
## 37          1559                15.4326142 -12.57405090  -7.7460003  5.3280001
## 38          1599                16.0629706 -12.86205101  -6.6319504  2.8350000
## 39          1638                21.6625129  -3.69105029 -12.5719509 -7.4440503
## 40          1678                17.2567909  -6.37395048 -12.2149506 -0.5839500
## 41          1718                12.3058151  -5.28405046 -11.0920506  9.1150503
## 42          1758                 9.1553911  -2.84595013  -6.2130003  3.7140002
## 43          1797                12.6978054 -10.61295033  -6.4860005  7.2510004
## 44          1837                 6.7591773  -4.59600019  -4.9560003  9.8430004
## 45          1877                 5.9789691  -2.24895000   0.0559500  4.2670503
## 46          1917                 8.1957571  -1.93800008  -3.3060002  2.5620000
## 47          1956                10.3797321  -4.32600021  -4.0819502  1.3000500
## 48          1996                10.2085017  -2.11304998  -1.3729501 -0.0859500
Konrad.df[Konrad.bins[[1]], ]
##    relative_time LinearAccelerometerSensor        AccX       AccY      AccZ
## 8            509                  6.390229  4.11774874  1.2592229  5.085047
## 9            566                  2.998420  2.02791715  2.2025933  9.643374
## 10           623                  2.354250  0.01674976  2.2444677  9.096315
## 11           680                  2.451629 -0.74327052  2.2516460  9.183653
## 12           737                  3.121124 -1.36570358  2.7520452  9.256635
## 13           794                  2.674053 -1.70697987  1.9115661 10.569995
## 14           851                  2.671429 -1.17188489  2.3138595  9.166903
## 15           908                  3.042302 -1.75722909  2.4215364 10.357931
## 16           965                  2.715317 -1.35613227  2.3521447  9.842278
## 17          1022                  2.873092 -1.11924279  2.6443682  9.710373
## 18          1079                  3.172734 -1.15274227  2.9087751  9.280862
## 19          1136                  3.392436 -1.18983102  3.0379875  8.877372
## 20          1193                  2.862835 -0.57338011  2.8046873  9.778569
## 21          1250                  3.161517 -0.87038922  2.6814568  8.375776
## 22          1307                  3.373143 -1.01994061  2.3796620  7.644470
## 23          1364                  4.166892 -2.08534503  3.3314073  8.422437
## 24          1421                  4.474551 -1.69621217  1.5741782  5.976972
## 25          1478                  7.735403 -3.95144749 -0.3352943  3.165106
## 26          1535                  5.460646 -2.40000105 -2.3018954  5.475377
## 27          1592                  8.722709 -7.78205729 -3.1363924  7.421638
## 28          1649                  9.581940 -6.54556656 -5.7469616  5.813961
## 29          1705                  9.342506 -6.74536705 -6.3418775  8.556435
## 30          1762                 12.871788 -9.50817966 -8.2489567 12.495918
## 31          1819                 13.914884 -8.85703278 -4.3561335 19.614864
## 32          1876                  9.569728 -5.05992270 -7.0543404 13.833207
## 33          1933                 12.026696 -7.11296463 -5.2106705 17.985651
## 34          1990                 10.888623  6.48095989 -8.6042910 11.395818
Kamil.df[Kamil.bins[[1]], ]
##    relative_time LinearAccelerometerSensor     AccX    AccY      AccZ
## 9            520                  2.694114 -2.23905 1.33995 10.477051
## 10           577                  3.052898 -1.87800 2.10195  8.634001
## 11           633                  3.000631 -2.46000 1.33605 10.887000
## 12           690                  2.875786 -1.29795 2.56605  9.835951
## 13           746                  3.102601 -2.56995 1.51995 10.650001
## 14           803                  3.236097 -0.90600 3.02100  9.082050
## 15           859                  2.238212 -1.03005 1.96095 10.128000
## 16           916                  2.800478 -0.52800 2.49195  8.643001
## 17           972                  3.074165  1.22895 2.68605  8.955001
## 18          1029                  3.675983 -1.68600 0.47100 13.039051
## 19          1085                  4.228112  0.85800 2.50200  6.508050
## 20          1142                  2.404827  0.46995 2.32905 10.177951
## 21          1198                  2.294373  0.90600 1.77600 10.942051
## 22          1255                  2.768098  0.51795 2.04900  8.019000
## 23          1311                  2.677400  0.50295 2.40105  8.734051
## 24          1368                  3.837171  0.87705 2.18295 12.838051
## 25          1424                  1.969687  0.11595 1.93695 10.144951
## 26          1481                  2.261606  1.14300 1.93200 10.081950
## 27          1537                  2.212518  0.47700 2.02995  9.067050
## 28          1594                  2.377305  0.75195 2.23605  9.513000
## 29          1650                  2.419393  0.43395 2.21400  8.932950
## 30          1707                  3.146686  1.86795 2.43195  9.100950
## 31          1763                  2.805792  0.91500 2.64495  9.607950
## 32          1820                  4.047421  1.68105 3.33000  8.236051
## 33          1876                  3.360943 -0.57795 1.05795 12.943951
## 34          1933                  6.975547  2.91000 4.09605  4.968000
## 35          1989                  3.296155 -1.36800 2.72895 11.050051
Szymon.df[Szymon.bins[[1]], ]
##    relative_time LinearAccelerometerSensor        AccX     AccY      AccZ
## 9            529                  3.961033  0.15792629 3.754040  8.552845
## 10           586                  3.447991  0.42382872 3.212963  8.629416
## 11           642                  3.252873  0.47766721 3.102893  8.955139
## 12           699                  2.907961  0.21056840 2.899204  9.725926
## 13           756                  3.582410 -0.25244278 3.561118  9.509377
## 14           813                  2.694071  0.33649069 2.251646  8.366205
## 15           869                  3.688259 -0.08733802 3.661916  9.375379
## 16           926                  3.213800 -0.59611195 3.094518  9.176475
## 17           983                  2.864436 -0.05144569 2.620440  8.650951
## 18          1040                  2.976657 -0.80668032 2.863311  9.700802
## 19          1096                  2.975608 -0.40229329 2.851347  9.056833
## 20          1153                  2.891900 -0.77318084 2.781955  9.967901
## 21          1210                  2.692588 -0.64396840 2.591726  9.462716
## 22          1267                  2.582701 -0.51355958 2.481357  9.307182
## 23          1323                  2.798265 -0.91465646 2.578566  9.219545
## 24          1380                  1.940758 -0.66430742 1.496411 10.848759
## 25          1437                  3.798918 -0.95054877 3.435495  8.493025
## 26          1494                  2.958840 -1.37886405 2.603690 10.079167
## 27          1550                  2.512827 -0.75403821 2.358127  9.376575
## 28          1607                  3.006609 -0.96610212 2.816651  9.390931
## 29          1664                  2.847153 -0.75523466 2.742474  9.685248
## 30          1721                  2.847702 -0.66311097 2.760420  9.583553
## 31          1778                  2.963100 -0.71694946 2.810669  9.201599
## 32          1834                  2.715340 -0.39272201 2.665904  9.472287
## 33          1891                  2.727804 -0.72293156 2.626422  9.948758
## 34          1948                  2.908273 -0.49561340 2.768795  9.067601
Michal.df[Michal.bins[[1]], ]
##    relative_time LinearAccelerometerSensor         AccX        AccY      AccZ
## 12           540                 6.0325685  -0.81495005  -2.3089502 15.319951
## 13           580                 2.7786667  -1.83495009   2.0839500  9.912001
## 14           620                 1.4308621   0.09000000   1.2559501  9.127050
## 15           659                 3.8809061  -1.57905006   1.3420501 13.087951
## 16           699                 3.1130065  -0.08700000   2.6310000  8.145000
## 17           739                 2.0883499   0.40995002   1.9429501  9.160050
## 18           778                 0.9525744   0.66900003   0.6709501  9.904950
## 19           818                 2.1011323   1.11000001   0.6670500  8.152050
## 20           858                 1.9535419   1.86705005  -0.2400000 10.329000
## 21           898                 3.9544126  -3.24105024   1.3710001  8.002951
## 22           937                 3.1201781   0.34605002  -1.2600001 12.640051
## 23           977                 2.7283486   0.09900001   2.4960001 10.903951
## 24          1017                 3.1022294  -0.42705002   2.9920502 10.506001
## 25          1057                 2.6624737  -0.10800000   2.2660501  8.413051
## 26          1096                 2.2352775   1.02105010   0.0580500  7.819050
## 27          1136                 5.3330272  -3.19305015   0.5040000  5.565000
## 28          1176                 3.3068734  -2.55600023   0.0439500  7.708951
## 29          1215                 2.4088674  -0.26595002  -0.2809500  7.429050
## 30          1255                 3.3813899  -1.14300001  -1.7010001  7.117050
## 31          1295                 9.4775098  -2.50800014  -3.6649501  1.434000
## 32          1335                15.0997315 -13.90605068  -0.1489500 15.688951
## 33          1374                11.3219454  -7.27905035  -7.3720503  5.239950
## 34          1414                11.5346523  -9.22395039  -6.5100002  7.443000
## 35          1454                11.8456514 -10.73295021  -4.9320002  8.913000
## 36          1493                16.2565245 -10.24200058  -8.1719999  0.184050
## 37          1533                11.2191595  -5.18805027  -9.7290001  7.732950
## 38          1573                 9.9760190  -5.61900043  -5.5279503  3.691950
## 39          1613                 9.2792872  -6.13605022  -3.5550001  3.822000
## 40          1652                10.2533452  -5.43705034  -6.8700004  4.480050
## 41          1692                 5.7442866  -4.38795042  -3.6360002  9.084001
## 42          1732                 7.1115570  -5.57100010  -3.3730502  6.949950
## 43          1771                 9.4984052  -4.11000013  -6.0070505  3.703950
## 44          1811                10.6032473  -6.28005028  -7.8610506  6.460950
## 45          1851                10.8947781  -3.54300022  -9.4660501  5.740050
## 46          1891                13.7701958  -3.82995009 -11.2210503  2.803950
## 47          1930                13.1915951  -5.91405010 -11.4490509  6.985050
## 48          1970                10.9198103  -7.75605059  -6.2059503  5.271000
Julita.df[Julita.bins[[1]], ]
##    relative_time LinearAccelerometerSensor       AccX      AccY      AccZ
## 11           527                  2.402734   1.318050  0.324000  7.824000
## 12           567                  1.658795  -0.280950  1.216950  8.715000
## 13           607                  2.228877  -0.613950  1.723050  8.533051
## 14           646                  4.385724  -3.580950  2.532000  9.787951
## 15           686                  1.480424  -0.487050  0.468000 11.124001
## 16           726                  3.357338  -3.342000  0.075000  9.495001
## 17           766                  4.612935  -4.084050  1.984050 10.621051
## 18           805                  6.495516  -4.315950  1.584000  5.218050
## 19           845                  5.084741  -4.831050  0.628050 11.263050
## 20           885                  7.212779  -6.544050  2.437050  8.001000
## 21           924                  6.709180  -5.377050 -1.228950  5.986950
## 22           964                  4.127065  -1.630950 -3.138000 11.934001
## 23          1004                  9.974198  -7.032001 -2.359950 16.474951
## 24          1044                  7.310123  -6.642000 -1.773000  7.321050
## 25          1083                 11.336851  -8.299050 -3.724950  3.040950
## 26          1123                  8.225612  -5.964000 -5.310000  7.833000
## 27          1163                  9.434041  -3.649950 -7.636050  5.638950
## 28          1202                  8.168453  -1.533000 -6.961051  5.817000
## 29          1242                  5.683404  -0.891000 -4.455000  6.391950
## 30          1282                  5.419376  -1.653000 -2.866950  5.515050
## 31          1322                  4.373186  -2.743050 -3.114000  8.427000
## 32          1361                  6.371449  -4.837950 -3.961950  8.584950
## 33          1401                  6.725673  -3.696000 -5.308050  7.963050
## 34          1441                  6.576377  -3.816000 -5.173950  8.422050
## 35          1481                  7.802300  -6.061950 -4.474950  7.780951
## 36          1520                  7.481242  -5.052000 -5.466000 10.561050
## 37          1560                  7.271326  -4.105950 -5.332050  7.053000
## 38          1600                  6.511213  -3.616950 -4.915050  7.536000
## 39          1639                  5.943296  -3.382050 -4.840950  9.136050
## 40          1679                  7.128347  -5.916000 -3.972000  9.613050
## 41          1719                  6.760125  -6.013950 -2.953950  8.908951
## 42          1759                  7.023688  -6.079050 -2.659050  7.503000
## 43          1798                  6.639734  -5.550000 -2.281050  6.964050
## 44          1838                  5.242353  -3.550050 -3.430050  8.041950
## 45          1878                  8.557803  -6.726000 -3.223950  5.611050
## 46          1917                  7.136912  -4.948950 -3.586050  6.121050
## 47          1957                  6.820938  -3.729000 -4.684950  6.540000
## 48          1997                 10.599848 -10.383000 -2.047950  9.210000
Krzysiek.df[Krzysiek.bins[[1]], ]
##    relative_time LinearAccelerometerSensor        AccX       AccY        AccZ
## 10           536                  1.741019   0.1399500   1.711050   9.5170507
## 11           576                  2.887926  -0.4510500   2.046000   7.8190503
## 12           615                  3.968074  -3.0130501   1.962000   8.1280508
## 13           655                  2.532003  -1.6390501   0.613950   7.9770002
## 14           695                  4.634608  -1.3800001   0.183000   5.3860502
## 15           735                  4.857002  -2.1130500   0.694950   5.4889503
## 16           774                  7.214240  -3.0280502  -1.504950   3.4339502
## 17           814                  7.785584  -7.4509501  -1.585950  11.4139509
## 18           854                  7.860803  -3.2530501  -5.382000  14.5230007
## 19           894                  6.915015  -2.3160002  -5.832000  12.7120504
## 20           933                  9.987648  -5.0490003  -8.556001  10.8340502
## 21           973                  5.731556  -2.2540500  -1.099950   4.6530004
## 22          1013                  7.969662  -2.0749500  -4.258950   3.3979502
## 23          1052                  6.758390  -5.0419502  -3.969000   7.6849504
## 24          1092                  9.438030  -9.0630007  -0.444000  12.4030504
## 25          1132                  7.280357   0.3480000  -7.225950  10.6240501
## 26          1172                  9.666157  -3.2530501  -8.398050   6.2959504
## 27          1211                 10.120230  -0.8700001  -7.855950  16.1269512
## 28          1251                  8.667530  -2.9920502  -6.652050  14.4889507
## 29          1291                  8.959645  -0.7549500  -8.829000  11.1310501
## 30          1331                  7.555749   2.6809502  -6.304050   6.6190505
## 31          1370                  7.283336  -2.5890002  -4.530000   4.7250004
## 32          1410                  9.438668  -2.7979500  -8.235001   6.1399503
## 33          1450                  7.833730  -2.9149501  -7.255050  10.2910509
## 34          1489                  9.759252  -3.1279502  -6.205950   2.9550002
## 35          1529                 12.740976  -5.7199502  -5.344050  -0.2460000
## 36          1569                 17.279192  -8.8480501 -11.818050   0.8280001
## 37          1609                 10.174406  -3.6769502  -9.382051   8.4010506
## 38          1648                 11.799389  -3.2269502 -10.213051  14.7570009
## 39          1688                 11.539317  -5.1640501 -10.275001  10.7620506
## 40          1728                 28.814141 -12.6270008  -0.271050 -16.0920010
## 41          1768                 20.397168  -6.9960003 -10.383000  -6.2959504
## 42          1807                 14.947962  -7.6960502 -12.201000   5.8890004
## 43          1847                 11.761271  -7.3840504  -8.341950  13.5769510
## 44          1887                 12.121435  -8.3830500  -6.541050   3.9870002
## 45          1927                 12.601701  -4.3930502  -7.935000   1.0579500
## 46          1966                 11.354480  -4.3350000  -6.790051   1.8049501

Generowanie cech

W następnym kroku wygenerowano następujące cechy:

# Funkcja obliczająca różnicę bezwzględną
absolute_diff <- function(xx){
  ## Obliczane tylko dla wierszy bez NANów.
  xx <- na.omit(xx)
  return((1/length(xx)) * sum(abs(xx - mean(xx))))}

Funkcja build.features przyjmuje jako wejście ramkę danych oraz jej biny, a następnie generuje ramkę danych z cechami.

build.features <- function(df, bins, person_name){
  # inicjalizacja cech ramki
  feature.df <- data.frame()
  
  # Iteruj przez biny, generuj cechy i dodawaj je do ramki danych z cechami.
  for(bin.ids in bins){
    bin <- df[bin.ids, ]
    created_obs <- data.frame(mean(bin$AccX, na.rm = TRUE), 
                              sd(bin$AccX, na.rm = TRUE), 
                              absolute_diff(bin$AccX), 
                              mean(bin$AccY, na.rm = TRUE),
                              sd(bin$AccY, na.rm = TRUE),
                              absolute_diff(bin$AccY), 
                              mean(bin$AccZ, na.rm = TRUE), 
                              sd(bin$AccZ, na.rm = TRUE),
                              absolute_diff(bin$AccZ), 
                              mean(bin$LinearAccelerometerSensor, na.rm = TRUE), 
                              person_name)
    feature.df <- rbind(feature.df, created_obs)
  }
  
  names(feature.df) <- c('meanAccX', 'sdAccX', 'absdiff_AccX', 
                         'meanAccY', 'sdAccY', 'absdiff_AccY',
                         'meanAccZ', 'sdAccZ', 'absdiff_AccZ', 
                         'meanAccLin', 'person_name')
  return(feature.df)
}

summary(Wiktoria.df)
##  relative_time     LinearAccelerometerSensor      AccX         
##  Min.   :     50   Min.   : 2.51             Min.   :-14.6090  
##  1st Qu.: 515531   1st Qu.:12.87             1st Qu.: -1.8019  
##  Median :1030781   Median :15.46             Median : -0.3510  
##  Mean   :1030778   Mean   :15.66             Mean   : -0.6209  
##  3rd Qu.:1546026   3rd Qu.:17.61             3rd Qu.:  1.0300  
##  Max.   :2061259   Max.   :33.22             Max.   : 18.9930  
##                    NA's   :1                 NA's   :1         
##       AccY              AccZ        
##  Min.   :-32.293   Min.   :-20.141  
##  1st Qu.:-11.905   1st Qu.: -3.067  
##  Median : -9.529   Median : -1.474  
##  Mean   : -9.654   Mean   : -1.735  
##  3rd Qu.: -7.008   3rd Qu.:  0.264  
##  Max.   :  7.687   Max.   : 19.275  
##  NA's   :1         NA's   :1
summary(Tomek.df)
##  relative_time       LinearAccelerometerSensor      AccX         
##  Min.   :      0.8   Min.   : 0.5663           Min.   :  -34.35  
##  1st Qu.: 379139.0   1st Qu.:13.0878           1st Qu.:   -3.97  
##  Median : 758216.0   Median :14.2992           Median :   -1.77  
##  Mean   : 758219.2   Mean   :15.3248           Mean   :    0.31  
##  3rd Qu.:1137306.0   3rd Qu.:16.9071           3rd Qu.:   -0.03  
##  Max.   :1516383.0   Max.   :54.0208           Max.   :45689.00  
##                      NA's   :2                 NA's   :2         
##       AccY              AccZ         
##  Min.   :-51.271   Min.   :-28.6010  
##  1st Qu.:-11.163   1st Qu.: -1.8491  
##  Median : -9.619   Median : -0.4189  
##  Mean   : -9.668   Mean   : -0.8041  
##  3rd Qu.: -7.689   3rd Qu.:  0.5740  
##  Max.   : 11.868   Max.   : 19.7820  
##  NA's   :2         NA's   :2
summary(Konrad.df)
##  relative_time     LinearAccelerometerSensor      AccX         
##  Min.   :    110   Min.   : 0.9028           Min.   :-21.8749  
##  1st Qu.: 539124   1st Qu.:10.9150           1st Qu.: -2.1619  
##  Median :1042267   Median :13.0133           Median : -0.3855  
##  Mean   :1036232   Mean   :13.8956           Mean   : -0.6985  
##  3rd Qu.:1541009   3rd Qu.:16.3790           3rd Qu.:  1.1103  
##  Max.   :2059629   Max.   :46.4332           Max.   : 20.0399  
##       AccY              AccZ         
##  Min.   :-37.153   Min.   :-20.4000  
##  1st Qu.:-13.043   1st Qu.: -0.7493  
##  Median : -9.588   Median :  1.1133  
##  Mean   : -9.734   Mean   :  1.6511  
##  3rd Qu.: -6.545   3rd Qu.:  3.8311  
##  Max.   :  6.261   Max.   : 24.2785
summary(Kamil.df)
##  relative_time     LinearAccelerometerSensor      AccX          
##  Min.   :     68   Min.   : 0.8205           Min.   :-18.97995  
##  1st Qu.: 543651   1st Qu.:13.1024           1st Qu.: -1.44705  
##  Median :1025812   Median :15.5081           Median : -0.02205  
##  Mean   :1026149   Mean   :15.7286           Mean   : -0.08493  
##  3rd Qu.:1507941   3rd Qu.:17.5214           3rd Qu.:  1.43700  
##  Max.   :2051422   Max.   :48.5807           Max.   : 23.37105  
##       AccY              AccZ         
##  Min.   :-31.037   Min.   :-27.8160  
##  1st Qu.:-12.227   1st Qu.: -2.7670  
##  Median :-10.108   Median : -0.8179  
##  Mean   :-10.043   Mean   : -1.2876  
##  3rd Qu.: -7.855   3rd Qu.:  0.7540  
##  Max.   :  6.802   Max.   : 25.8270
summary(Szymon.df)
##  relative_time     LinearAccelerometerSensor      AccX         
##  Min.   :     84   Min.   : 1.15             Min.   :-23.0181  
##  1st Qu.: 510912   1st Qu.:12.65             1st Qu.: -0.8433  
##  Median :1044702   Median :15.19             Median :  0.8692  
##  Mean   :1037261   Mean   :15.85             Mean   :  0.9923  
##  3rd Qu.:1564871   3rd Qu.:18.01             3rd Qu.:  2.4854  
##  Max.   :2055276   Max.   :56.81             Max.   : 28.9089  
##       AccY              AccZ         
##  Min.   :-47.887   Min.   :-36.2181  
##  1st Qu.:-13.019   1st Qu.: -2.3539  
##  Median : -9.582   Median : -0.8318  
##  Mean   : -9.878   Mean   : -1.4966  
##  3rd Qu.: -6.867   3rd Qu.:  0.4340  
##  Max.   : 15.453   Max.   : 21.5970
summary(Michal.df)
##  relative_time       LinearAccelerometerSensor      AccX         
##  Min.   :     -4.7   Min.   :  0.7453          Min.   :  -26.69  
##  1st Qu.: 492332.0   1st Qu.: 12.6753          1st Qu.:   -1.93  
##  Median : 984995.0   Median : 14.9980          Median :    0.09  
##  Mean   : 984984.1   Mean   : 16.2312          Mean   :    8.46  
##  3rd Qu.:1477639.0   3rd Qu.: 18.4623          3rd Qu.:    1.95  
##  Max.   :1970264.0   Max.   :104.8251          Max.   :45689.00  
##                      NA's   :11                NA's   :11        
##       AccY              AccZ         
##  Min.   :-73.604   Min.   :  -78.43  
##  1st Qu.:-13.099   1st Qu.:   -3.01  
##  Median : -9.581   Median :   -0.58  
##  Mean   :-10.325   Mean   :    0.75  
##  3rd Qu.: -7.097   3rd Qu.:    2.11  
##  Max.   : 15.499   Max.   :45870.00  
##  NA's   :11        NA's   :11
summary(Julita.df)
##  relative_time       LinearAccelerometerSensor      AccX        
##  Min.   :      0.5   Min.   : 0.9326           Min.   :-20.126  
##  1st Qu.: 381351.0   1st Qu.:13.5341           1st Qu.: -3.454  
##  Median : 762641.0   Median :14.2399           Median : -2.338  
##  Mean   : 762658.7   Mean   :14.5312           Mean   : -2.296  
##  3rd Qu.:1143959.0   3rd Qu.:15.1316           3rd Qu.: -1.061  
##  Max.   :1525303.0   Max.   :40.2285           Max.   :  9.543  
##                      NA's   :1                 NA's   :1        
##       AccY               AccZ         
##  Min.   :  -13.54   Min.   :-13.2371  
##  1st Qu.:    8.07   1st Qu.: -1.6000  
##  Median :    8.98   Median : -0.6851  
##  Mean   :   10.56   Mean   : -0.4906  
##  3rd Qu.:   10.00   3rd Qu.:  0.3540  
##  Max.   :45793.00   Max.   : 16.6160  
##  NA's   :1          NA's   :1
summary(Krzysiek.df)
##  relative_time       LinearAccelerometerSensor      AccX         
##  Min.   :     -1.6   Min.   : 1.023            Min.   :  -22.78  
##  1st Qu.: 374373.0   1st Qu.:11.742            1st Qu.:   -0.89  
##  Median : 748720.0   Median :14.141            Median :    0.44  
##  Mean   : 748705.6   Mean   :14.759            Mean   :    5.33  
##  3rd Qu.:1123046.0   3rd Qu.:17.350            3rd Qu.:    1.96  
##  Max.   :1497363.0   Max.   :60.369            Max.   :45689.00  
##                      NA's   :5                 NA's   :5         
##       AccY              AccZ         
##  Min.   :-43.420   Min.   :  -32.30  
##  1st Qu.:-12.368   1st Qu.:   -2.27  
##  Median : -9.629   Median :    0.17  
##  Mean   :-10.012   Mean   :    1.04  
##  3rd Qu.: -7.452   3rd Qu.:    2.04  
##  Max.   : 10.831   Max.   :45870.00  
##  NA's   :5         NA's   :5
anyNA(Wiktoria.df)
## [1] TRUE
anyNA(Tomek.df)
## [1] TRUE
anyNA(Konrad.df)
## [1] FALSE
anyNA(Kamil.df)
## [1] FALSE
anyNA(Szymon.df)
## [1] FALSE
anyNA(Michal.df)
## [1] TRUE
anyNA(Julita.df)
## [1] TRUE
anyNA(Krzysiek.df)
## [1] TRUE
Wiktoria.feature.df <- build.features(Wiktoria.df, Wiktoria.bins, person_name = 'Wiktoria')
Tomek.feature.df <- build.features(Tomek.df, Tomek.bins, person_name = 'Tomek')
Konrad.feature.df <- build.features(Konrad.df, Konrad.bins, person_name = 'Konrad')
Kamil.feature.df <- build.features(Kamil.df, Kamil.bins, person_name = 'Kamil')
Szymon.feature.df <- build.features(Szymon.df, Szymon.bins, person_name = 'Szymon')
Michal.feature.df <- build.features(Michal.df, Michal.bins, person_name = 'Michał')
Julita.feature.df <- build.features(Julita.df, Julita.bins, person_name = 'Julita')
Krzysiek.feature.df <- build.features(Krzysiek.df, Krzysiek.bins, person_name = 'Krzysiek')

Funkcja plot.features odpowiada za rysowanie czterech głównych cech: avg(AccX), avg(AccY), avg(AccZ) i avg(LinAcc).

# Funkcja, która rysuje główne cechy (AccX, AccY, AccZ, LinAcc).
plot.features <- function(feature.df, person){
  plot(feature.df$meanAccX, col = "blue", ylim = c(-13,18), type = "l",
       ylab = "",  xlab = "bin")
  points(x=1:nrow(feature.df), y = feature.df$meanAccY, 
         type = "l", col = "red")
  points(x=1:nrow(feature.df), y = feature.df$meanAccZ,
         type = "l", col = "green")
  points(x=1:nrow(feature.df), y = feature.df$meanAccLin,
         type = "l", col = "orange")
  title(paste0("Główne cechy wzoru chodu ", person))
  legend("bottomleft", legend=c("avg(AccX)", 'avg(AccY)', 'avg(AccZ)', 'avg(AccLin)'),
         col = c("blue", 'red', "green", 'orange'), lwd = c(1,1,1,1), bty = "n")
}


plot.features(Wiktoria.feature.df, "Wiktoria")

Wykresy 2d

plot.features(Tomek.feature.df, "Tomek")

plot.features(Konrad.feature.df, "Konrad")

plot.features(Kamil.feature.df, "Kamil")

plot.features(Szymon.feature.df, "Szymon")

plot.features(Michal.feature.df, "Michał")

plot.features(Julita.feature.df, "Julita")

plot.features(Krzysiek.feature.df, "Krzysiek")

Łączenie wszystkich ramek danych

Wszystkie indywidualne zestawy danych są łączone w jedną ramkę danych i ponownie indeksowane. Następnie usuwane są wszystkie wiersze zawierające przynajmniej jedną wartość NULL.

walks.df <- rbind(Tomek.feature.df, 
                  Kamil.feature.df,
                  Wiktoria.feature.df, 
                  Szymon.feature.df, 
                  Konrad.feature.df,
                  Michal.feature.df,
                  Julita.feature.df,
                  Krzysiek.feature.df)
# usuwanie NANów
walks.df <- na.omit(walks.df)
# reindexowanie
rownames(walks.df) <- NULL
# pokazanie pierwszego wiersza 
head(walks.df)
##    meanAccX   sdAccX absdiff_AccX   meanAccY   sdAccY absdiff_AccY   meanAccZ
## 1 -5.395244 6.843574     4.797115  -3.584732 4.507186     3.850235  5.5664805
## 2 -6.128586 6.499176     4.497680  -7.243070 4.961336     4.083662  3.3117712
## 3 -4.184530 4.406747     3.381086  -9.001410 6.343215     4.793041  1.0164316
## 4 -2.686212 3.744160     2.857035 -10.627448 5.918886     4.056787  0.0738973
## 5 -2.487237 4.983720     3.807467  -9.954810 7.488348     5.119749 -0.9463737
## 6 -1.892155 4.332229     3.143008 -10.228497 5.677172     3.705754 -0.3617487
##     sdAccZ absdiff_AccZ meanAccLin person_name
## 1 5.070406     4.179718   9.446882       Tomek
## 2 4.541648     3.670398  13.392706       Tomek
## 3 4.251337     3.267251  14.981667       Tomek
## 4 3.188189     2.370214  15.929335       Tomek
## 5 3.472660     2.466303  16.697481       Tomek
## 6 2.894313     2.050696  15.687604       Tomek
# Konwersja person_name na factor (dla bezpieczeństwa)
walks.df$person_name <- as.factor(walks.df$person_name)

# Podział na dwie grupy
levels_person <- levels(walks.df$person_name) # Pobierz poziomy
group1 <- levels_person[1:4]               # Pierwsze 4 osoby
group2 <- levels_person[5:8]               # Kolejne 4 osoby

# Dane dla grup
walks_group1 <- walks.df[walks.df$person_name %in% group1, ]
walks_group2 <- walks.df[walks.df$person_name %in% group2, ]

# Sortowanie danych po person_name w porządku alfabetycznym
walks_group1 <- walks_group1[order(walks_group1$person_name), ]
walks_group2 <- walks_group2[order(walks_group2$person_name), ]

# Przypisanie person_name jako factor w każdej grupie, jeżeli nie jest (OBOWIĄZKOWO)
walks_group1$person_name <- factor(walks_group1$person_name, levels = unique(walks_group1$person_name))
walks_group2$person_name <- factor(walks_group2$person_name, levels = unique(walks_group2$person_name))


# Tworzenie wykresu dla grupy 1
fig1 <- plot_ly(
  data = walks_group1,
  x = ~meanAccX, 
  y = ~meanAccY, 
  z = ~meanAccZ,
  type = "scatter3d",
  mode = "markers",
  marker = list(
    size = 2, 
    color = ~as.numeric(person_name), 
    colorscale = "Rainbow", 
    showscale = TRUE,
    cmin = 1,
    cmax = 4,
    colorbar = list(
      tickvals = 1:4, 
      ticktext = group1
    )
  )
) %>%
  layout(
    title = "Grupa 1: Średnia(AccX) vs. Średnia(AccY) vs. Średnia(AccZ)",
    scene = list(
      xaxis = list(title = "średnia(AccX)", range = c(-10, 10)),
      yaxis = list(title = "średnia(AccY)", range = c(-15, 15)),
      zaxis = list(title = "średnia(AccZ)", range = c(-15, 15))
    )
  )

# Tworzenie wykresu dla grupy 2
fig2 <- plot_ly(
  data = walks_group2,
  x = ~meanAccX, 
  y = ~meanAccY, 
  z = ~meanAccZ,
  type = "scatter3d",
  mode = "markers",
  marker = list(
    size = 2, 
    color = ~as.numeric(person_name), 
    colorscale = "Rainbow", 
    showscale = TRUE,
    cmin = 1,
    cmax = 4,
    colorbar = list(
      tickvals = 1:4, 
      ticktext = group2
    )
  )
) %>%
  layout(
    title = "Grupa 2: Średnia(AccX) vs. Średnia(AccY) vs. Średnia(AccZ)",
    scene = list(
      xaxis = list(title = "średnia(AccX)", range = c(-5, 5)),
      yaxis = list(title = "średnia(AccY)", range = c(-15, -5)),
      zaxis = list(title = "średnia(AccZ)", range = c(-10, 10))
    )
  )

# Wyświetlenie wykresów
fig1

Wykresy 3d

fig2

Obliczanie (informacyjnie) jaki procent wszystkich danych stanowią rekordy od konkretnych osób

prop.table(table(walks.df$person_name))
## 
##    Julita     Kamil    Konrad  Krzysiek    Michał    Szymon     Tomek  Wiktoria 
## 0.1034986 0.1391971 0.1397740 0.1015983 0.1336998 0.1394686 0.1028878 0.1398758

Podział danych

Podział danych na zbiór treningowy i testowy za pomocą funkcji createDataPartition. Umieszczamy 80% danych w zbiorze treningowym.

# Początkowy punkt dla generatora liczb pseudolosowych
# Dzięki temu uzyskane losowe podziały danych będą zawsze takie same, co pozwala na odtworzenie wyników w przyszłości
set.seed(2137)

# Funkcja createDataPartition zapewnia proporcjonalny podział danych na klasy
idx.train <- caret::createDataPartition(walks.df$person_name, p = 0.8, list = FALSE)

# Tworzenie zbioru treningowego
X_train <- walks.df[idx.train, ]
y_train <- as.factor(X_train$person_name)
X_train$person_name <- NULL

# Tworzenie zbioru testowego
X_test <- walks.df[-idx.train, ]
y_test <- as.factor(X_test$person_name)
X_test$person_name <- NULL

Modelowanie

Pracujemy nad klasyfikacją wieloklasową. Użyte algorytmy:

Random Forest (Las losowy)

Linear Discriminant Analysis (LDA, analiza dyskryminacyjna)

Naive Bayes (parametryczny)

k-Nearest Neighbours (k-najbliższych sąsiadów)

SVM (Maszyna wektorów nośnych)

Stacking Model z najlepszych 3 modeli

Random Forest

Random Forest to technika uczenia maszynowego oparta na metodzie ensemble, która łączy wyniki wielu drzew decyzyjnych w celu uzyskania bardziej stabilnych i dokładnych prognoz. Kluczowe cechy tego podejścia to: Uniknięcie przeuczenia (overfitting): Random Forest jest mniej podatny na przeuczenie niż pojedyncze drzewa decyzyjne, ponieważ agreguje wyniki wielu drzew. Losowość: Każde drzewo jest budowane na losowej próbce danych oraz losowym podzbiorze cech, co zwiększa różnorodność i stabilność modelu.

Wybór liczby drzew na podstawie błędów OOB (Out Of Bag). W Random Forest każde drzewo w lesie jest trenowane na losowej podgrupie danych (z wyjątkiem niektórych danych, które są “na zewnątrz” tej podgrupy). Te dane, które nie zostały użyte do trenowania danego drzewa, nazywają się danymi OOB dla tego drzewa.

Błąd OOB to błąd klasyfikacji obliczany na tych danych, które zostały “na zewnątrz” danego drzewa, a więc nie były użyte do jego trenowania. Następnie, dla całego lasu drzew, średnia wartość błędów OOB dla każdego drzewa jest obliczana.

Innymi słowy, błędy OOB pokazują, jak dobrze model generalizuje na danych, których nigdy nie widział podczas trenowania.

# Wybór liczby drzew
RF.model <- randomForest(x = X_train, y = y_train, ntree=300, proximity=T)

# Wyświetlanie pierwszych kilku wierszy błędów OOB dla modelu
head(RF.model$err.rate)
##             OOB     Julita     Kamil      Konrad   Krzysiek    Michał
## [1,] 0.08665350 0.01945080 0.2255700 0.009377664 0.09427208 0.1649485
## [2,] 0.09014824 0.02310924 0.2038442 0.011861784 0.09851169 0.1741189
## [3,] 0.08701099 0.01896263 0.1892333 0.011088296 0.09513274 0.1702945
## [4,] 0.08255444 0.01478561 0.1867295 0.011611030 0.08415842 0.1669801
## [5,] 0.08144412 0.01241379 0.1765893 0.013495277 0.08069030 0.1684840
## [6,] 0.07710407 0.01146384 0.1629341 0.013238618 0.07826476 0.1629081
##          Szymon      Tomek   Wiktoria
## [1,] 0.06055646 0.02895323 0.05775578
## [2,] 0.06794162 0.04536222 0.07074280
## [3,] 0.06933116 0.04769737 0.07131214
## [4,] 0.06292948 0.04062653 0.06731813
## [5,] 0.06420168 0.04018265 0.06942093
## [6,] 0.05517689 0.03783546 0.07112835
# Tworzenie ramki danych do wizualizacji błędu OOB
oob.error <- data.frame(
  nTrees = rep(1:nrow(RF.model$err.rate), times = 9),
  Error.Type = rep(c('OOB', "Julita", "Kamil", "Konrad", "Krzysiek", "Michał", "Szymon", "Tomek", "Wiktoria"), each =nrow(RF.model$err.rate)), # Typ błędu (ogólny błąd OOB lub dla poszczególnych osób)
  Error = c(RF.model$err.rate[, "OOB"], 
            RF.model$err.rate[, "Julita"],
            RF.model$err.rate[, "Kamil"],
            RF.model$err.rate[, "Konrad"],
            RF.model$err.rate[, "Krzysiek"],
            RF.model$err.rate[, "Michał"],
            RF.model$err.rate[, "Szymon"],
            RF.model$err.rate[, "Tomek"],
            RF.model$err.rate[, "Wiktoria"])
)
# Tworzenie wykresu liniowego pokazującego, jak zmienia się błąd OOB w zależności od liczby drzew (nTrees).
require(ggplot2)

ggplot(data = oob.error, aes(x=nTrees, y = Error)) + 
  geom_line(aes(color = Error.Type)) + ggtitle("Odsetek błędów vs. nTrees") + theme(plot.title = element_text(hjust = 0.5))

Z analizy błędu OOB wynika, że stabilny błąd OOB osiąga się przy około 50 drzewach.

randomForest.fit.predict <- function(RF.model, X_test, y_test, full.stats = TRUE){ 
  cat("\n\n\t\t\t Algorytm RANDOM FOREST\n\n")
  
  # Tworzenie macierzy błędu bazując na OOB
  if(full.stats==TRUE) {
  cat("\nMacierz błędu (bazująca na OOB) : \n")
  print(RF.model$confusion)
  }
  
  # Obliczanie odsetku błędnych klasyfikacji na danych treningowych
  err.train <- mean(as.vector(RF.model$predicted) != as.vector(y_train))*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze treningowym: %f", round(err.train,2)))
  
  if(full.stats==TRUE) cat("\n\n       Przewidywania na zbiorze testowym\n ------------------------------------ \n")
  
  # Przewidywanie etykiet dla danych testowych
  predictions <- predict(RF.model, newdata = X_test)
  
  # Obliczanie odseteku błędnych klasyfikacji na zbiorze testowym
  err.test <- mean(predictions != y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(err.test,2)))
  
  # Wyświetlanie szczegółowej macierzy błędu dla zbioru testowego
  statistics <- confusionMatrix(predictions, y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
  
  return(predictions)
}  

RF.pred <- randomForest.fit.predict(RF.model, X_test, y_test)
## 
## 
##           Algorytm RANDOM FOREST
## 
## 
## Macierz błędu (bazująca na OOB) : 
##          Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria class.error
## Julita     2431     0      0        0      2      2     4        1 0.003688525
## Kamil         0  2991      2       41    118     19     2      109 0.088665448
## Konrad        1     3   3273        6      9      2     2        0 0.006978155
## Krzysiek      2    48      5     2296     33      6     2        4 0.041736227
## Michał        1   321      4       41   2717     33    24       11 0.138007614
## Szymon        0    17      2        5     32   3213     9       10 0.022810219
## Tomek         1     0      3        3     14      3  2402        0 0.009892828
## Wiktoria      0    64      1        2      6      4     4     3217 0.024560340
## 
## Wskaźnik błędnej klasyfikacji na zbiorze treningowym: 4.400000
## 
##        Przewidywania na zbiorze testowym
##  ------------------------------------ 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 4.310000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      608     0      0        1      1      0     0        0
##   Kamil         0   760      0       17     78      3     0       20
##   Konrad        0     0    822        2      3      0     0        0
##   Krzysiek      0    13      0      563     11      1     0        2
##   Michał        1    12      0       12    675      7     4        1
##   Szymon        0     3      0        2     11    808     2        0
##   Tomek         1     2      1        0      3      3   600        0
##   Wiktoria      0    30      0        1      6      0     0      801
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9569          
##                  95% CI : (0.9514, 0.9619)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9506          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9967       0.9268        0.9988         0.94147
## Specificity                 0.9996       0.9767        0.9990         0.99490
## Pos Pred Value              0.9967       0.8656        0.9940         0.95424
## Neg Pred Value              0.9996       0.9880        0.9998         0.99340
## Prevalence                  0.1035       0.1392        0.1397         0.10151
## Detection Rate              0.1032       0.1290        0.1395         0.09557
## Detection Prevalence        0.1035       0.1490        0.1404         0.10015
## Balanced Accuracy           0.9982       0.9518        0.9989         0.96819
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                 0.8566        0.9830       0.9901          0.9721
## Specificity                 0.9927        0.9964       0.9981          0.9927
## Pos Pred Value              0.9480        0.9782       0.9836          0.9558
## Neg Pred Value              0.9782        0.9972       0.9989          0.9954
## Prevalence                  0.1338        0.1395       0.1029          0.1399
## Detection Rate              0.1146        0.1372       0.1019          0.1360
## Detection Prevalence        0.1209        0.1402       0.1035          0.1423
## Balanced Accuracy           0.9247        0.9897       0.9941          0.9824

LDA - Linear Discriminant Analysis

LDA (Linear Discriminant Analysis) to technika klasyfikacji, która ma na celu znalezienie najlepszej kombinacji cech, które rozróżniają różne osoby. Działa to na zasadzie obliczania “granic” (linii) między klasami(osobami), bazując na średnich i wariancjach cech w każdej klasie. LDA zakłada, że dane w różnych klasach są rozkładane zgodnie z rozkładem normalnym i mają tę samą macierz kowariancji.

Jak działa LDA? Cel: LDA stara się znaleźć linię lub przestrzeń, która maksymalizuje różnice między klasami, minimalizując jednocześnie zmienność wewnątrz każdej klasy. Działanie: Używa analiz statystycznych, aby wyznaczyć linię (lub przestrzeń w przypadku wielu cech), która najlepiej “separuje” klasy danych. Używa średnich, wariancji i kowariancji, aby stworzyć model, który jest w stanie przypisać nowe dane do odpowiedniej klasy.

Podsumowanie działania LDA: Trenuje model LDA na danych treningowych. Przewiduje klasy zarówno dla danych treningowych, jak i testowych. Oblicza błędy klasyfikacji (na danych treningowych i testowych). Generuje macierz błędu do oceny skuteczności modelu. Zwraca wyniki predykcji na zbiorze testowym.

lda.fit.predict <- function(X_train, y_train, X_test, y_test, full.stats=TRUE){
  cat("\n\n\t\t\t Algorytm LDA - LINEAR DISCRIMINANT ANALYSIS \n\n")
  # Trenowanie modelu LDA
  mod_LDA = lda(y_train ~ ., data = X_train)
  
  # Wykonywnie przewidywania klasyfikacji na zbiorze treningowym (X_train) przy użyciu wytrenowanego modelu LDA
  tr_pred_LDA = predict(mod_LDA, X_train)
  
  # Obliczanie błędu klasyfikacji na zbiorze treningowym
  ETr_LDA = mean(as.vector(tr_pred_LDA$class) != as.vector(y_train))*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze treningowym: %f", round(ETr_LDA,2)))
  
  if(full.stats==TRUE) cat("\n\n       Przewidywania na zbiorze testowym\n ------------------------------------ \n")
  
  # Dokonywanie prewidywania na danych testowych
  pred_LDA = predict(mod_LDA, X_test)
  
  # Obliczanie błędu klasyfikacji na zbiorze testowym
  ETe_LDA <- mean(pred_LDA$class != y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(ETe_LDA,2)))
  
  # Generoewanie macierzy błędu i innych statystyk
  statistics <- confusionMatrix(pred_LDA$class, y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
  
  return(pred_LDA)
}

lda.pred <- lda.fit.predict(X_train, y_train, X_test, y_test)
## 
## 
##           Algorytm LDA - LINEAR DISCRIMINANT ANALYSIS 
## 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze treningowym: 11.000000
## 
##        Przewidywania na zbiorze testowym
##  ------------------------------------ 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 11.150000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      606     0      0        0      0      0     0        0
##   Kamil         0   620      0       22    152     24    17       24
##   Konrad        3     1    814        7      5      6     0        1
##   Krzysiek      0     9      4      545     46      2    20        0
##   Michał        0    38      0       20    524      9     0        2
##   Szymon        0     2      2        2     20    769     0        4
##   Tomek         1     0      2        1      1      2   564        1
##   Wiktoria      0   150      1        1     40     10     5      792
## 
## Overall Statistics
##                                           
##                Accuracy : 0.8885          
##                  95% CI : (0.8802, 0.8964)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.8721          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9934       0.7561        0.9891         0.91137
## Specificity                 1.0000       0.9529        0.9955         0.98470
## Pos Pred Value              1.0000       0.7218        0.9725         0.87061
## Neg Pred Value              0.9992       0.9603        0.9982         0.98993
## Prevalence                  0.1035       0.1392        0.1397         0.10151
## Detection Rate              0.1029       0.1052        0.1382         0.09251
## Detection Prevalence        0.1029       0.1458        0.1421         0.10626
## Balanced Accuracy           0.9967       0.8545        0.9923         0.94803
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                0.66497        0.9355      0.93069          0.9612
## Specificity                0.98648        0.9941      0.99849          0.9591
## Pos Pred Value             0.88364        0.9625      0.98601          0.7928
## Neg Pred Value             0.95017        0.9896      0.99210          0.9935
## Prevalence                 0.13376        0.1395      0.10287          0.1399
## Detection Rate             0.08895        0.1305      0.09574          0.1344
## Detection Prevalence       0.10066        0.1356      0.09710          0.1696
## Balanced Accuracy          0.82573        0.9648      0.96459          0.9602

Naive Bayes (parametric)

Naive Bayes to prosty algorytm klasyfikacyjny oparty na zastosowaniu twierdzenia Bayesa i założeniu warunkowej niezależności cech (tzw. “naiwność”). Jest to model parametryczny, który przyjmuje pewne założenia dotyczące rozkładu danych (np. rozkład normalny dla cech ciągłych).

Jak działa algorytm?

Twierdzenie Bayesa: Twierdzenie Bayesa wyznacza prawdopodobieństwo przynależności próbki do danej klasy na podstawie:
P(C∣X)=(P(X∣C)⋅P(C))/P(X)
    P(C∣X)P(C∣X): Prawdopodobieństwo, że próbka XX należy do klasy CC.
    P(X∣C)P(X∣C): Prawdopodobieństwo wystąpienia danych XX przy założeniu klasy CC.
    P(C)P(C): A priori prawdopodobieństwo wystąpienia klasy CC.
    P(X)P(X): Prawdopodobieństwo danych XX (stała w przypadku porównywania klas).
    
naivebayes.fit.predict <- function(X_train, y_train, X_test, y_test, full.stats=TRUE){
  cat("\n\n\t\t\t Algorytm NAIVE BAYES \n\n")
  
  # Trenowanie modelu Naive Bayes
  mod_NB = naiveBayes(y_train ~ ., data = X_train, type = "raw")
  
  # Wykonywnie przewidywania klasyfikacji na zbiorze treningowym (X_train) przy użyciu wytrenowanego modelu LDA
  tr_pred = predict(mod_NB, X_train)

  
  # Obliczanie błędu klasyfikacji na zbiorze testowym
  tr.error = mean(as.vector(tr_pred) != as.vector(y_train))*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze treningowym: %f", round(tr.error,2)))
  
  if(full.stats==TRUE) cat("\n\n       Przewidywania na zbiorze testowym\n ------------------------------------ \n")
  
  # Dokonywanie przewidywania na danych testowych
  pred_NB = predict(mod_NB, X_test)   
  
  # Obliczanie błędu klasyfikacji na zbiorze testowym
  MCE_NB = mean(pred_NB !=  y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(MCE_NB,2)))
  
  # Generoewanie macierzy błędu i innych statystyk
  statistics <- confusionMatrix(pred_NB, y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
  
  return(pred_NB)
}

naivebayes.pred <- naivebayes.fit.predict(X_train, y_train, X_test, y_test)
## 
## 
##           Algorytm NAIVE BAYES 
## 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze treningowym: 36.830000
## 
##        Przewidywania na zbiorze testowym
##  ------------------------------------ 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 36.800000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      606     1      2        2      9      4    36        1
##   Kamil         0   550      1      506    196      9     0       58
##   Konrad        0     1    817       13     25      0   177        0
##   Krzysiek      0     0      0        0      0      0     0        0
##   Michał        1     0      1        3    131      1     0        0
##   Szymon        1    19      0       55    352    692     0        2
##   Tomek         1     1      2        3     54      4   168        4
##   Wiktoria      1   248      0       16     21    112   225      759
## 
## Overall Statistics
##                                           
##                Accuracy : 0.632           
##                  95% CI : (0.6195, 0.6443)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.5751          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9934      0.67073        0.9927          0.0000
## Specificity                 0.9896      0.84816        0.9574          1.0000
## Pos Pred Value              0.9168      0.41667        0.7909             NaN
## Neg Pred Value              0.9992      0.94093        0.9988          0.8985
## Prevalence                  0.1035      0.13920        0.1397          0.1015
## Detection Rate              0.1029      0.09336        0.1387          0.0000
## Detection Prevalence        0.1122      0.22407        0.1754          0.0000
## Balanced Accuracy           0.9915      0.75944        0.9750          0.5000
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                0.16624        0.8418      0.27723          0.9211
## Specificity                0.99882        0.9154      0.98694          0.8770
## Pos Pred Value             0.95620        0.6173      0.70886          0.5492
## Neg Pred Value             0.88582        0.9727      0.92253          0.9856
## Prevalence                 0.13376        0.1395      0.10287          0.1399
## Detection Rate             0.02224        0.1175      0.02852          0.1288
## Detection Prevalence       0.02326        0.1903      0.04023          0.2346
## Balanced Accuracy          0.58253        0.8786      0.63209          0.8991

k-Nearest Neighbor

k-Nearest Neighbors (k-NN) to algorytm klasyfikacji, który przypisuje nowy punkt do klasy, która jest najczęściej występującą klasą wśród jego k najbliższych sąsiadów. Aby znaleźć sąsiadów, algorytm oblicza odległości między punktami w przestrzeni cech. Zwykle używa się odległości euklidesowej. Parametr k określa, ilu sąsiadów należy brać pod uwagę przy podejmowaniu decyzji o klasyfikacji.

Jak działa k-NN? Przewidywanie: Dla nowego punktu (np. nieznanego przykładu) algorytm oblicza odległość między tym punktem a wszystkimi innymi punktami w zbiorze danych. Wybór sąsiadów: Wybiera k najbliższych punktów (sąsiadów). Klasyfikacja: Przypisuje nowy punkt do tej klasy, która występuje najczęściej wśród k najbliższych sąsiadów.

Algorytm jest prosty, ale kosztowny obliczeniowo przy dużych zbiorach danych, ponieważ musi obliczyć odległość do każdego punktu.

set.seed(2137)
registerDoParallel(cores=1)
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 2) #trenuje model k-NN, używając walidacji krzyżowej (10-krotna walidacja krzyżowa, powtórzona 2 razy).

knn_fit <- train(y = y_train ,
                 x = X_train, method = "knn",
                 trControl  = trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
# Informacyjnie
print(paste("Najlepszy parametr:", as.character(knn_fit$bestTune)))
## [1] "Najlepszy parametr: 5"
plot(knn_fit, main="Dokładność vs. k", xlab="k", ylab="Accuracy")

Etykiety klas to po prostu kategorie, do których przypisuje się dane w problemie klasyfikacyjnym. W kontekście algorytmu k-NN (i innych algorytmów klasyfikacyjnych), celem jest przypisanie każdemu przykładowi (danej) jednej z określonych klas. Przykład:

Załóżmy, że masz zbiór danych dotyczący kwiatów i chcesz sklasyfikować, do jakiego gatunku należy dany kwiat. Możliwe klasy (etykiety klas) to:

Setosa
Versicolor
Virginica

W tym przypadku, dla każdego przykładu (np. konkretnego kwiatu) algorytm klasyfikacyjny przypisuje mu jedną z tych etykiet, czyli decyduje, do której klasy należy dany punkt. Jak działają etykiety klas w kontekście k-NN?

Sąsiadów: Algorytm k-NN bierze k najbliższych sąsiadów dla danego punktu.
Przewidywanie etykiety: Na podstawie klas tych sąsiadów (ich etykiet), algorytm przypisuje etykietę nowemu punktowi. Jeśli np. 3 z 5 sąsiadów należy do klasy Setosa, to nowy punkt również zostanie przypisany do tej klasy.

Co to jest “najwyższe prawdopodobieństwo”?

Niektóre algorytmy, w tym k-NN, mogą zwracać prawdopodobieństwo przynależności do różnych klas. Na przykład, dla danego kwiatu k-NN może zwrócić:

70% prawdopodobieństwa, że to Setosa
20% prawdopodobieństwa, że to Versicolor
10% prawdopodobieństwa, że to Virginica

Wówczas “najwyższe prawdopodobieństwo” oznacza, że algorytm przypisuje etykietę klasy Setosa, bo ta ma najwyższy procent prawdopodobieństwa (70%).

#Funkcja, która zwraca etykiety klas dla przewidywań na podstawie najwyższego prawdopodobieństwa (w przypadku, gdy są dostępne prawdopodobieństwa dla różnych klas).
get_label <- function(predictions){
  n = nrow(predictions)
  pred_labels = rep(NA,n)
  for(i in 1:n){
    max.id <- which.max(predictions[i, ])
    pred_labels[i] <- names(predictions[i, max.id])
  }
  return(as.factor(pred_labels))
}
knn.fit.predict <- function(X_train, y_train, X_test, y_test, k=knn_fit$bestTune, full.stats=TRUE){
  cat("\n\n\t\t\t k-NEAREST NEIGHBOR algorithm \n\n")
  
  # Tworzenie modelu k-NN przy użyciu najlepszej wartości k
  mod_KNN = knn3(y=y_train, x = X_train, k)
  
  # Wykonywnie przewidywania klasyfikacji na zbiorze treningowym
  tr_pred = predict(mod_KNN, X_train)
  main_tr_pred = get_label(tr_pred)
  
  # Obliczanie błędu klasyfikacji na zbiorze testowym
  tr.error = mean(as.vector(main_tr_pred) != as.vector(y_train))*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze treningowym: %f", round(tr.error,2)))
  
  if(full.stats==TRUE) cat("\n\n       Przewidywania na zbiorze testowym\n ------------------------------------ \n")
  
  # Dokonywanie prewidywania na danych testowych
  pred_KNN = predict(mod_KNN, X_test)
  main_pred_KNN = get_label(pred_KNN)

  # Obliczanie błędu klasyfikacji na zbiorze testowym
  te.error = mean(main_pred_KNN !=  y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(te.error,2)))

  # Generowanie macierzy błędu i innych statystyk
  statistics <- confusionMatrix(main_pred_KNN, y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
    
  return(main_pred_KNN)
}

knn.pred <- knn.fit.predict(X_train, y_train, X_test, y_test, k = 7) # Zmienna k dobrana na podstawie wcześniej obliczonej najlepszej wartości
## 
## 
##           k-NEAREST NEIGHBOR algorithm 
## 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze treningowym: 3.680000
## 
##        Przewidywania na zbiorze testowym
##  ------------------------------------ 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 4.330000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      608     0      0        1      1      0     0        0
##   Kamil         0   745      0       13     77      6     0       16
##   Konrad        0     0    820        3      4      0     0        0
##   Krzysiek      0    10      1      568      8      3     0        0
##   Michał        1    16      1        9    680      6     2        1
##   Szymon        0     3      0        1      7    804     0        0
##   Tomek         1     0      1        1      2      1   604        0
##   Wiktoria      0    46      0        2      9      2     0      807
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9567          
##                  95% CI : (0.9512, 0.9618)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9504          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9967       0.9085        0.9964         0.94983
## Specificity                 0.9996       0.9779        0.9986         0.99584
## Pos Pred Value              0.9967       0.8693        0.9915         0.96271
## Neg Pred Value              0.9996       0.9851        0.9994         0.99434
## Prevalence                  0.1035       0.1392        0.1397         0.10151
## Detection Rate              0.1032       0.1265        0.1392         0.09642
## Detection Prevalence        0.1035       0.1455        0.1404         0.10015
## Balanced Accuracy           0.9982       0.9432        0.9975         0.97284
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                 0.8629        0.9781       0.9967          0.9794
## Specificity                 0.9929        0.9978       0.9989          0.9884
## Pos Pred Value              0.9497        0.9865       0.9902          0.9319
## Neg Pred Value              0.9791        0.9965       0.9996          0.9966
## Prevalence                  0.1338        0.1395       0.1029          0.1399
## Detection Rate              0.1154        0.1365       0.1025          0.1370
## Detection Prevalence        0.1215        0.1383       0.1035          0.1470
## Balanced Accuracy           0.9279        0.9880       0.9978          0.9839

SVM

Support Vector Machine (SVM) to popularny algorytm klasyfikacyjny, który szuka hiperplanu w przestrzeni cech, który najlepiej oddziela różne klasy. SVM stara się maksymalizować margines, czyli odległość między punktami należącymi do różnych klas a tym hiperplanem. Hiperplan to granica decyzyjna. W 2D jest to linia, w 3D płaszczyzna, a w wyższych wymiarach — n-wymiarowy obiekt. Gdy klasy nie są liniowo separowalne, SVM korzysta z tzw. jąder (kernels), aby przekształcić dane do wyższej wymiarowości, w której stają się liniowo separowalne.

Popularne funkcje jądrowe: Linear: Bez przekształcenia, działa jak zwykły SVM. RBF (Radial Basis Function): Wykorzystuje funkcję Gaussa, aby oddzielić dane nieliniowe. Polynomial: Stosuje wielomianowe przekształcenia. Sigmoid: Przekształcenia podobne do tych w sieciach neuronowych.

svm.fit.predict <- function(X_train, y_train, X_test, y_test, full.stats=TRUE){
  cat("\n\n\t\t\t Algorytm SVM \n\n")
  
  # Trenowanie modelu SVM
  mod.svm <-svm(x = X_train, y = y_train)
  
  # Wykonywnie przewidywania klasyfikacji na zbiorze treningowym (X_train) przy użyciu wytrenowanego modelu SVM
  train.pred <- predict(mod.svm, X_train)
  
  # Obliczanie błędu klasyfikacji na zbiorze testowym
  tr.error = mean(as.vector(train.pred) != as.vector(y_train))*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze treningowym: %f", round(tr.error,2)))
  
  if(full.stats==TRUE) cat("\n\n       Przewidywania na zbiorze testowym\n ------------------------------------ \n")
  
  # Dokonywanie prewidywania na danych testowych
  pred_svm = predict(mod.svm, X_test)

  # Obliczanie błędu klasyfikacji na zbiorze testowym
  te.error = mean(pred_svm !=  y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(te.error,2)))

  # Generowanie macierzy błędu i innych statystyk
  statistics <- confusionMatrix(pred_svm, y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
    
  return(pred_svm)
}

svm.pred <- svm.fit.predict(X_train, y_train, X_test, y_test)
## 
## 
##           Algorytm SVM 
## 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze treningowym: 20.430000
## 
##        Przewidywania na zbiorze testowym
##  ------------------------------------ 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 20.960000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      606     0      0        0      0      0     0        0
##   Kamil         0   545      0       47    152     76     5       48
##   Konrad        1     1    780       20      3      1     2        2
##   Krzysiek      0    60     38      517     29     46    16        2
##   Michał        0    42      2        5    488      8    16        0
##   Szymon        3     9      1        3     16    507     0        3
##   Tomek         0     1      2        3     23      1   448        4
##   Wiktoria      0   162      0        3     77    183   119      765
## 
## Overall Statistics
##                                           
##                Accuracy : 0.7904          
##                  95% CI : (0.7797, 0.8007)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.7597          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9934      0.66463        0.9478         0.86455
## Specificity                 1.0000      0.93532        0.9941         0.96391
## Pos Pred Value              1.0000      0.62428        0.9630         0.73023
## Neg Pred Value              0.9992      0.94520        0.9915         0.98437
## Prevalence                  0.1035      0.13920        0.1397         0.10151
## Detection Rate              0.1029      0.09251        0.1324         0.08776
## Detection Prevalence        0.1029      0.14819        0.1375         0.12018
## Balanced Accuracy           0.9967      0.79998        0.9709         0.91423
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                0.61929       0.61679      0.73927          0.9284
## Specificity                0.98569       0.99310      0.99357          0.8926
## Pos Pred Value             0.86988       0.93542      0.92946          0.5844
## Neg Pred Value             0.94371       0.94111      0.97079          0.9871
## Prevalence                 0.13376       0.13953      0.10287          0.1399
## Detection Rate             0.08284       0.08606      0.07605          0.1299
## Detection Prevalence       0.09523       0.09200      0.08182          0.2222
## Balanced Accuracy          0.80249       0.80494      0.86642          0.9105

Stacking Model

Stacking (ang. stacked generalization) to technika ensembling, w której wykorzystuje się wiele różnych modeli klasyfikacyjnych do uzyskania bardziej trafnych prognoz. Zamiast polegać na jednym modelu, stackowanie łączy wyniki kilku różnych algorytmów, aby poprawić ogólną dokładność klasyfikacji. W tym przypadku, model stackingowy jest oparty na trzech różnych algorytmach: k-NN, Random Forest i SVM. W przypadku, gdyby każdy klasyfikator zwrócił inną klasę (lub był remis) decydujący głos ma SVM.

stacking.model <- function(knn.pred, RF.pred, lda.pred){

  stacking.pred.all <- cbind(
                          RF = as.character(RF.pred),
                          LDA   = as.character(lda.pred$class),
                          #NaivB = as.character(naivebayes.pred),
                           knn   = as.character(knn.pred)
                          #SVM   = as.character(svm.pred),
                           )

  stacking.pred.all <- as.factor( apply(stacking.pred.all, 1, function(x) names(which.max(table(x))) ) )
                  
  return(stacking.pred.all)
}

stacking.pred <- stacking.model(knn.pred, RF.pred, lda.pred)
stacking.statistics <- function(stacking.pred, y_test, full.stats=TRUE){
  cat("\n\n\t\t\t STACKING MODEL \n\n")
  
  te.error = mean(stacking.pred !=  y_test)*100
  cat(sprintf("\nWskaźnik błędnej klasyfikacji na zbiorze testowym: %f \n\n", round(te.error,2)))

  # Statystyki
  statistics <- confusionMatrix(as.factor(stacking.pred), y_test)
  if(full.stats==TRUE) print(statistics)
  else print(statistics$overall["Accuracy"])
}

stacking.statistics(stacking.pred, y_test)
## 
## 
##           STACKING MODEL 
## 
## 
## Wskaźnik błędnej klasyfikacji na zbiorze testowym: 4.330000 
## 
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Julita Kamil Konrad Krzysiek Michał Szymon Tomek Wiktoria
##   Julita      609     0      0        1      1      0     0        0
##   Kamil         0   753      0       16     87      5     0       16
##   Konrad        0     0    821        4      4      2     0        0
##   Krzysiek      0    11      1      565      9      1     0        0
##   Michał        0    14      0        9    671      6     3        1
##   Szymon        0     3      0        1      5    807     0        0
##   Tomek         1     0      1        0      2      1   603        0
##   Wiktoria      0    39      0        2      9      0     0      807
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9567          
##                  95% CI : (0.9512, 0.9618)
##     No Information Rate : 0.1399          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9504          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Julita Class: Kamil Class: Konrad Class: Krzysiek
## Sensitivity                 0.9984       0.9183        0.9976         0.94482
## Specificity                 0.9996       0.9755        0.9980         0.99584
## Pos Pred Value              0.9967       0.8586        0.9880         0.96252
## Neg Pred Value              0.9998       0.9866        0.9996         0.99378
## Prevalence                  0.1035       0.1392        0.1397         0.10151
## Detection Rate              0.1034       0.1278        0.1394         0.09591
## Detection Prevalence        0.1037       0.1489        0.1411         0.09964
## Balanced Accuracy           0.9990       0.9469        0.9978         0.97033
##                      Class: Michał Class: Szymon Class: Tomek Class: Wiktoria
## Sensitivity                 0.8515        0.9818       0.9950          0.9794
## Specificity                 0.9935        0.9982       0.9991          0.9901
## Pos Pred Value              0.9531        0.9890       0.9918          0.9417
## Neg Pred Value              0.9774        0.9970       0.9994          0.9966
## Prevalence                  0.1338        0.1395       0.1029          0.1399
## Detection Rate              0.1139        0.1370       0.1024          0.1370
## Detection Prevalence        0.1195        0.1385       0.1032          0.1455
## Balanced Accuracy           0.9225        0.9900       0.9971          0.9848

Podsumowanie wyników

Algorytm W/O RNF LDA NaiveBayes k-NN SVM Stacking
500/200 0.8887 0.6281 0.5008 0.8854 0.5816 0.8845
Dokładność 1000/500 0.9418 0.8596 0.6221 0.9396 0.6649 0.9307
1500/1000 0.9506 0.8885 0.6320 0.9567 0.7904 0.9567
2000/1200 0.9674 0.9052 0.6696 0.9598 0.7766 0.9614
.
MENU