JCO_col = c("#0073C2FF", "#EFC000FF", "#868686FF", "#CD534CFF", "#7AA6DCFF", 
            "#003C67FF", "#8F7700FF", "#3B3B3BFF", "#A73030FF", "#4A6990FF")

dane <- as_tibble(read_excel("dane.xlsx"))
source('Funkcje dodatkowe.R', encoding = 'UTF-8')
source('StepWiseLogit.R', encoding = 'UTF-8')

Punkt 1 - Przyjęcie poziomów istotności

alpha_f = 0.3
alpha_b = 0.35

Punkt 2 - Uruchomienie algorytmu krokowego doboru predyktorów

Wszystkie punkty zadania od (a) do (d) zostały przedstawione w poniższej tabeli.

StepForward = StepWiseLogit(dane, y="remission", selection = "forward", sle = alpha_f, sls = alpha_b, digits = 2,
                            color = "black", colorP = "red", colorNA = "white", 
                            background = "#FFFF33", backgroundm = "#99FF33")

StepForward$StepsTableHTML
(Intercept)
cell
smear
infil
li
blast
temp
model \(\widehat\beta_1\) \(SE_{\beta_1}\) \(z_1\) \(p_1\) \(\widehat\beta_2\) \(SE_{\beta_2}\) \(z_2\) \(p_2\) \(\widehat\beta_3\) \(SE_{\beta_3}\) \(z_3\) \(p_3\) \(\widehat\beta_4\) \(SE_{\beta_4}\) \(z_4\) \(p_4\) \(\widehat\beta_5\) \(SE_{\beta_5}\) \(z_5\) \(p_5\) \(\widehat\beta_6\) \(SE_{\beta_6}\) \(z_6\) \(p_6\) \(\widehat\beta_7\) \(SE_{\beta_7}\) \(z_7\) \(p_7\) AIC Chisq Pr(>Chisq)
Krok 0
\(M_0\) -0.69 0.41 -1.7 0.09 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 36.37 NA NA
\(M_2\) -5.64 4.1 -1.38 0.17 5.41 4.34 1.25 0.21 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 35.79 2.58 0.11
\(M_3\) -2.05 1.42 -1.44 0.15 NA NA NA NA 2.08 2.03 1.02 0.31 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 37.28 1.09 0.3
\(M_4\) -2.25 1.29 -1.75 0.08 NA NA NA NA NA NA NA NA 2.61 1.96 1.33 0.18 NA NA NA NA NA NA NA NA NA NA NA NA 36.4 1.97 0.16
\(M_5\) -3.78 1.38 -2.74 0.01 NA NA NA NA NA NA NA NA NA NA NA NA 2.9 1.19 2.44 0.01 NA NA NA NA NA NA NA NA 30.07 8.3 0
\(M_6\) -1.83 0.81 -2.27 0.02 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 1.53 0.87 1.76 0.08 NA NA NA NA 34.82 3.55 0.06
\(M_7\) 24.2 31.13 0.78 0.44 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -24.99 31.28 -0.8 0.42 37.67 0.7 0.4
Krok 1
\(M_0\) -3.78 1.38 -2.74 0.01 NA NA NA NA NA NA NA NA NA NA NA NA 2.9 1.19 2.44 0.01 NA NA NA NA NA NA NA NA 30.07 NA NA
\(M_2\) -9.59 6.27 -1.53 0.13 6.29 6.15 1.02 0.31 NA NA NA NA NA NA NA NA 2.88 1.25 2.3 0.02 NA NA NA NA NA NA NA NA 30.34 1.73 0.19
\(M_3\) -4.31 2.06 -2.09 0.04 NA NA NA NA 0.88 2.39 0.37 0.71 NA NA NA NA 2.85 1.21 2.35 0.02 NA NA NA NA NA NA NA NA 31.94 0.14 0.71
\(M_4\) -4.73 2.04 -2.33 0.02 NA NA NA NA NA NA NA NA 1.72 2.3 0.75 0.46 2.82 1.24 2.27 0.02 NA NA NA NA NA NA NA NA 31.49 0.58 0.45
\(M_6\) -3.81 1.4 -2.72 0.01 NA NA NA NA NA NA NA NA NA NA NA NA 2.69 1.36 1.98 0.05 0.35 1.15 0.3 0.76 NA NA NA NA 31.98 0.09 0.76
\(M_7\) 47.86 46.44 1.03 0.3 NA NA NA NA NA NA NA NA NA NA NA NA 3.3 1.36 2.43 0.02 NA NA NA NA -52.43 47.49 -1.1 0.27 30.65 1.43 0.23
Krok 2
\(M_0\) -9.59 6.27 -1.53 0.13 6.29 6.15 1.02 0.31 NA NA NA NA NA NA NA NA 2.88 1.25 2.3 0.02 NA NA NA NA NA NA NA NA 30.34 NA NA
\(M_3\) -9.96 6.6 -1.51 0.13 6.31 6.21 1.02 0.31 0.55 2.52 0.22 0.83 NA NA NA NA 2.86 1.27 2.26 0.02 NA NA NA NA NA NA NA NA 32.29 0.05 0.83
\(M_4\) -9.58 6.3 -1.52 0.13 5.95 6.41 0.93 0.35 NA NA NA NA 0.53 2.68 0.2 0.84 2.87 1.27 2.26 0.02 NA NA NA NA NA NA NA NA 32.3 0.04 0.84
\(M_6\) -10.67 7.13 -1.5 0.13 7.46 7.06 1.06 0.29 NA NA NA NA NA NA NA NA 3.26 1.65 1.98 0.05 -0.57 1.49 -0.38 0.7 NA NA NA NA 32.19 0.15 0.69
\(M_7\) 67.63 56.89 1.19 0.23 9.65 7.75 1.25 0.21 NA NA NA NA NA NA NA NA 3.87 1.78 2.17 0.03 NA NA NA NA -82.07 61.71 -1.33 0.18 29.95 2.39 0.12
Krok 3
\(M_0\) 67.63 56.89 1.19 0.23 9.65 7.75 1.25 0.21 NA NA NA NA NA NA NA NA 3.87 1.78 2.17 0.03 NA NA NA NA -82.07 61.71 -1.33 0.18 29.95 NA NA
\(M_3\) 70.1 58.76 1.19 0.23 9.85 7.83 1.26 0.21 0.91 2.96 0.31 0.76 NA NA NA NA 3.91 1.82 2.15 0.03 NA NA NA NA -85.44 64.21 -1.33 0.18 31.86 0.1 0.76
\(M_4\) 70.62 59.11 1.19 0.23 9.14 7.91 1.16 0.25 NA NA NA NA 0.91 3.14 0.29 0.77 3.9 1.81 2.15 0.03 NA NA NA NA -85.25 64.09 -1.33 0.18 31.87 0.08 0.77
\(M_6\) 71.25 62.46 1.14 0.25 9.06 8.71 1.04 0.3 NA NA NA NA NA NA NA NA 3.71 2.05 1.81 0.07 0.26 1.81 0.14 0.89 -85.2 65.6 -1.3 0.19 31.93 0.02 0.89

Analizując powyższą tabelę można zauważyć, że wartość kryterium informacyjnego AIC jest najmniejsza w przypadku modeli, które zawierały zmienną dodawaną przez algorytm krokowy do właściwego modelu. Ostatecznie wartość kryterium AIC jest najmniejsza dla ostatecznego modelu wyznaczonego przez algorytm krokowego doboru predyktorów. Warto także zwrócić uwagę, że do modelu czasami były dodawane zmienne w przypadku których p-wartość testu \(H_0:\beta_i=0\) vs \(H_1:\beta_i\neq0\) była większa od założonego przez nas poziomu istotności \(\alpha\). Było tak w przypadku kroku 1 dla predyktora cell dla której p-wartość wyniosła 0.31, co oczywiście powinno prowadzić do przyjęcia hipotezy zerowej. Jednakże ostatecznie p-wartość w końcowym modelu dla tej zmiennej wyniosła 0.21.

Punkt 3 - Konstrukcja tabeli z prawdopodobieństwem oraz jego przedziałem ufności

Do wyznaczenia prawdopodobieństwa zwracanego przez model wraz z jego przedziałem ufności została wykorzystana funkcja add_resp_glm, która rozszerza dane o dodatkowe kolumny takie jak prawdopodobieństwo, logarytm szansy, odchylenie standardowe logarytmu szansy, przedział ufności dla logarytmu szansy, a także przedział ufności dla prawdopodobieństwa. Z kolei funkcja add_tresh_test dodaje oznaczenia dla poszczególnych punktów tak jak dla macierzy konfuzji. W poniższej tabeli zawarto jednak wyłącznie takie informacje jak wartości zmiennych \((y,\boldsymbol{x})= (remiss,cell,smear,infil,li,blast,temp)\), prawdopodobieństwo \(\pi(\boldsymbol{x})\) (kolumna resp) oraz lewy i prawy koniec przedziału ufności Walda (resp.up, resp.down).

dane2 = dane %>% 
    add_resp_glm(StepForward$model, alpha = 0.05) %>% 
    add_tresh_test(remission, resp)

kable(dane2 %>% select(remission:temp, resp, resp.up, resp.down, Test)) %>% kable_styling()
remission cell smear infil li blast temp resp resp.up resp.down Test
1 0.80 0.83 0.66 1.9 1.100 0.996 0.7226489 0.9709308 0.1689203 TP
1 0.90 0.36 0.32 1.4 0.740 0.992 0.5787391 0.8376193 0.2678769 TP
0 0.80 0.88 0.70 0.8 0.176 0.982 0.1045990 0.6341884 0.0078100 TN
0 1.00 0.87 0.87 0.7 1.053 0.986 0.2825773 0.6568252 0.0749793 TN
1 0.90 0.75 0.68 1.3 0.519 0.980 0.7141804 0.9487569 0.2521795 TP
0 1.00 0.65 0.65 0.6 0.519 0.982 0.2708868 0.6895121 0.0585194 TN
1 0.95 0.97 0.92 1.0 1.230 0.992 0.3215554 0.5951615 0.1325485 FN
0 0.95 0.87 0.83 1.9 1.354 1.020 0.6072319 0.9528731 0.1057171 FP
0 1.00 0.45 0.45 0.8 0.322 0.999 0.1663164 0.5612346 0.0301751 TN
0 0.95 0.36 0.34 0.5 0.000 1.038 0.0015693 0.6896189 0.0000011 TN
0 0.85 0.39 0.33 0.7 0.279 0.988 0.0728520 0.4998246 0.0061407 TN
0 0.70 0.76 0.53 1.2 0.146 0.982 0.1728570 0.8720619 0.0063664 TN
0 0.80 0.46 0.37 0.4 0.380 1.006 0.0034575 0.4652987 0.0000138 TN
0 0.20 0.39 0.08 0.8 0.114 0.990 0.0001850 0.9648173 0.0000000 TN
0 1.00 0.90 0.90 1.1 1.037 0.990 0.5712204 0.8397279 0.2530256 FP
1 1.00 0.84 0.84 1.9 2.064 1.020 0.7146954 0.9718896 0.1536176 TP
0 0.65 0.42 0.27 0.5 0.114 1.014 0.0006223 0.6266526 0.0000002 TN
0 1.00 0.75 0.75 1.0 1.322 1.004 0.2228888 0.6367021 0.0448348 TN
0 0.50 0.44 0.22 0.6 0.114 0.990 0.0015425 0.7964415 0.0000006 TN
1 1.00 0.63 0.63 1.1 1.072 0.986 0.6491095 0.9055470 0.2630488 TP
0 1.00 0.33 0.33 0.4 0.176 1.010 0.0169297 0.5047489 0.0002909 TN
0 0.90 0.93 0.84 0.6 1.591 1.020 0.0062175 0.5606165 0.0000307 TN
1 1.00 0.58 0.58 1.0 0.531 1.002 0.2526057 0.6359717 0.0613730 FN
0 0.95 0.32 0.30 1.6 0.886 0.988 0.8701089 0.9848055 0.4091050 FP
1 1.00 0.60 0.60 1.7 0.964 0.990 0.9313166 0.9957251 0.4411429 TP
1 1.00 0.69 0.69 0.9 0.398 0.986 0.4605092 0.7852916 0.1661227 FN
0 1.00 0.73 0.73 0.7 0.398 0.986 0.2825773 0.6568252 0.0749793 TN
wykres = ggprobglm(dane2, test.filter = c('FN', 'FP', 'TP', 'TN'))
wykres = 
  ggpar(wykres,
        title = paste0("Prawdopodobieństwo sukcesu w funkcji logarytmu szansy"),
        caption = "A. Fiolka",
        palette = "jco")
wykres

Dodatkowo, watro jest przedstawić tego typu dane w postaci wykresu, który lepiej uzmysławia nam, jak bardzo szeroki przedział ufności został uzyskany dla praktycznie każdego punktu danych. Szczególnie widać to w przypadku danych dla których logarytm szansy był mniejszy od -6. Tak duża szerokość przedziału ufności wynika z bardzo małej ilości obserwacji. Dla regresji logistycznej przyjmuje się minimalną ilość obserwacji równą 30 na każdą zmienną wprowadzaną do modelu.

Punkt 4 - Powtórzenie obliczeń, przy wykorzystaniu eliminacji wstecznej

StepBackward = StepWiseLogit(dane, y="remission", selection = "backward", sle = alpha_f, sls = alpha_b, digits = 2,
                            color = "black", colorP = "red", colorNA = "white", 
                            background = "#FFFF33", backgroundm = "#99FF33")

StepBackward$StepsTableHTML
(Intercept)
cell
smear
infil
li
blast
temp
model \(\widehat\beta_1\) \(SE_{\beta_1}\) \(z_1\) \(p_1\) \(\widehat\beta_2\) \(SE_{\beta_2}\) \(z_2\) \(p_2\) \(\widehat\beta_3\) \(SE_{\beta_3}\) \(z_3\) \(p_3\) \(\widehat\beta_4\) \(SE_{\beta_4}\) \(z_4\) \(p_4\) \(\widehat\beta_5\) \(SE_{\beta_5}\) \(z_5\) \(p_5\) \(\widehat\beta_6\) \(SE_{\beta_6}\) \(z_6\) \(p_6\) \(\widehat\beta_7\) \(SE_{\beta_7}\) \(z_7\) \(p_7\) AIC Chisq Pr(>Chisq)
Krok 0
\(M_0\) 58.04 71.24 0.81 0.42 24.66 47.84 0.52 0.61 19.29 57.95 0.33 0.74 -19.6 61.68 -0.32 0.75 3.9 2.34 1.67 0.1 0.15 2.28 0.07 0.95 -87.43 67.57 -1.29 0.2 35.75 NA NA
\(M_1\) NA NA NA NA 43.74 44.34 0.99 0.32 43.35 52.8 0.82 0.41 -44.64 56.15 -0.79 0.43 3.72 2.17 1.72 0.09 -0.28 2.16 -0.13 0.9 -46.92 43.66 -1.07 0.28 34.48 0.73 0.39
\(M_2\) 77.94 64.89 1.2 0.23 NA NA NA NA -10.81 10.36 -1.04 0.3 12.56 11.82 1.06 0.29 3.91 2.18 1.79 0.07 -0.09 2.23 -0.04 0.97 -83.99 66.71 -1.26 0.21 34.07 0.32 0.57
\(M_3\) 70.09 63.8 1.1 0.27 9.23 8.81 1.05 0.29 NA NA NA NA 0.96 3.78 0.25 0.8 3.93 2.27 1.73 0.08 -0.05 2.2 -0.02 0.98 -84.82 66.98 -1.27 0.21 33.87 0.12 0.73
\(M_4\) 69.36 64.01 1.08 0.28 10.01 9.55 1.05 0.29 0.97 3.53 0.27 0.78 NA NA NA NA 3.94 2.27 1.74 0.08 -0.06 2.18 -0.03 0.98 -84.89 67.08 -1.27 0.21 33.86 0.11 0.74
\(M_5\) 56.99 56.23 1.01 0.31 23.45 31.12 0.75 0.45 27.62 38.65 0.71 0.47 -31.69 41.53 -0.76 0.45 NA NA NA NA 2.94 1.62 1.81 0.07 -80.91 53.67 -1.51 0.13 38.1 4.34 0.04
\(M_6\) 57.13 69.98 0.82 0.41 24.18 47.26 0.51 0.61 18.37 56.22 0.33 0.74 -18.48 59.26 -0.31 0.76 3.99 1.9 2.1 0.04 NA NA NA NA -86.14 64.79 -1.33 0.18 33.76 0 0.95
\(M_7\) -16.7 33.35 -0.5 0.62 12.73 35.01 0.36 0.72 6.71 44.45 0.15 0.88 -5.37 47.41 -0.11 0.91 3.55 1.91 1.86 0.06 -1.07 1.95 -0.55 0.58 NA NA NA NA 35.88 2.13 0.14
Krok 1
\(M_0\) 57.13 69.98 0.82 0.41 24.18 47.26 0.51 0.61 18.37 56.22 0.33 0.74 -18.48 59.26 -0.31 0.76 3.99 1.9 2.1 0.04 NA NA NA NA -86.14 64.79 -1.33 0.18 33.76 NA NA
\(M_1\) NA NA NA NA 45.56 42.15 1.08 0.28 46.21 48.22 0.96 0.34 -47.94 50.36 -0.95 0.34 3.55 1.69 2.1 0.04 NA NA NA NA -48.51 41.96 -1.16 0.25 32.5 0.75 0.39
\(M_2\) 78.83 60.94 1.29 0.2 NA NA NA NA -10.62 9.19 -1.16 0.25 12.27 9.46 1.3 0.19 3.86 1.74 2.22 0.03 NA NA NA NA -84.85 63.14 -1.34 0.18 32.07 0.32 0.57
\(M_3\) 70.62 59.11 1.19 0.23 9.14 7.91 1.16 0.25 NA NA NA NA 0.91 3.14 0.29 0.77 3.9 1.81 2.15 0.03 NA NA NA NA -85.25 64.09 -1.33 0.18 31.87 0.11 0.74
\(M_4\) 70.1 58.76 1.19 0.23 9.85 7.83 1.26 0.21 0.91 2.96 0.31 0.76 NA NA NA NA 3.91 1.82 2.15 0.03 NA NA NA NA -85.44 64.21 -1.33 0.18 31.86 0.1 0.75
\(M_5\) 12.71 38.21 0.33 0.74 13.76 20.64 0.67 0.51 12.96 26.94 0.48 0.63 -12.43 28.62 -0.43 0.66 NA NA NA NA NA NA NA NA -27.14 32.44 -0.84 0.4 40.22 8.46 0
\(M_7\) -18.62 32.11 -0.58 0.56 15.48 33.57 0.46 0.64 12.55 42.02 0.3 0.77 -12.71 44.3 -0.29 0.77 2.84 1.28 2.21 0.03 NA NA NA NA NA NA NA NA 34.2 2.44 0.12
Krok 2
\(M_0\) 70.1 58.76 1.19 0.23 9.85 7.83 1.26 0.21 0.91 2.96 0.31 0.76 NA NA NA NA 3.91 1.82 2.15 0.03 NA NA NA NA -85.44 64.21 -1.33 0.18 31.86 NA NA
\(M_1\) NA NA NA NA 7.76 6.91 1.12 0.26 0.66 2.6 0.25 0.8 NA NA NA NA 3 1.33 2.26 0.02 NA NA NA NA -11.64 7.5 -1.55 0.12 31.63 1.77 0.18
\(M_2\) 49.2 47.59 1.03 0.3 NA NA NA NA 1.06 2.55 0.41 0.68 NA NA NA NA 3.27 1.39 2.36 0.02 NA NA NA NA -54.48 48.89 -1.11 0.27 32.48 2.62 0.11
\(M_3\) 67.63 56.89 1.19 0.23 9.65 7.75 1.25 0.21 NA NA NA NA NA NA NA NA 3.87 1.78 2.17 0.03 NA NA NA NA -82.07 61.71 -1.33 0.18 29.95 0.1 0.76
\(M_5\) 21.72 32.27 0.67 0.5 5.49 4.54 1.21 0.23 1.36 2.19 0.62 0.53 NA NA NA NA NA NA NA NA NA NA NA NA -28.44 32.47 -0.88 0.38 38.43 8.58 0
\(M_7\) -9.96 6.6 -1.51 0.13 6.31 6.21 1.02 0.31 0.55 2.52 0.22 0.83 NA NA NA NA 2.86 1.27 2.26 0.02 NA NA NA NA NA NA NA NA 32.29 2.43 0.12
Krok 3
\(M_0\) 67.63 56.89 1.19 0.23 9.65 7.75 1.25 0.21 NA NA NA NA NA NA NA NA 3.87 1.78 2.17 0.03 NA NA NA NA -82.07 61.71 -1.33 0.18 29.95 NA NA
\(M_1\) NA NA NA NA 7.72 6.86 1.12 0.26 NA NA NA NA NA NA NA NA 3.01 1.31 2.3 0.02 NA NA NA NA -11.16 7.15 -1.56 0.12 29.69 1.74 0.19
\(M_2\) 47.86 46.44 1.03 0.3 NA NA NA NA NA NA NA NA NA NA NA NA 3.3 1.36 2.43 0.02 NA NA NA NA -52.43 47.49 -1.1 0.27 30.65 2.69 0.1
\(M_5\) 24 31.98 0.75 0.45 5.66 4.38 1.29 0.2 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA -29.97 32.21 -0.93 0.35 36.83 8.88 0
\(M_7\) -9.59 6.27 -1.53 0.13 6.29 6.15 1.02 0.31 NA NA NA NA NA NA NA NA 2.88 1.25 2.3 0.02 NA NA NA NA NA NA NA NA 30.34 2.39 0.12

Na początku należy zwrócić uwagę na to, że algorytm eliminacji wstecznej doprowadził do uzyskania dokładnie takiego samego modelu. Podobnie jak w przypadku poprzednim, dla modeli których pozbawiono zmiennej usuwanej z właściwego modelu, możemy zauważyć najniższą wartość kryterium informacyjnego AIC. W ostatecznym modelu wartość tego kryterium jest najniższa.