Практическая работа №2

Статистический анализ качественных (категориальных) признаков

Глушков Егор Александрович, гр. 20.М04-мм
Вариант № 7. Категориальные переменные: intpla, curwor, se.

---

Данные (addicts.xls), варианты в Табл.1. Для каждой из трех независимых категориальных переменных исследовать таблицы сопряженности с зависимой переменной end.

• Проверить гипотезы о независимости по критерию хи-квадрат (без поправки и с поправкой) и точному критерию Фишера. Представить условные вероятности и значимости их отличия.
• Вычислить коэффициенты неопределенности для зависимой переменной end и 1) для каждой из независимых переменных по отдельности, 2) для трех пар независимых переменных, 3) для всех трех независимых переменных одновременно.

Переменные:

• intpla – место лечения (1 - амбулаторно, 2 - в диспансере)
• curwor – занятость (1 - работает, 2 - не работает)
• se – использование успокоительных средств (1 - да, 0 - нет)
• end – итог лечения (1 - программа лечения выполнена, 0 - программа сорвана)

Исследуем переменные на наличие пропусков.

c(summary(as.factor(addicts$intpla)), summary(as.factor(addicts$curwor)), summary(as.factor(addicts$se)), summary(as.factor(addicts$end)))

   1    2    0    1    0    1 NA's    0    1 NA's 
 141  139  204   76  213   65    2  202   77    1 

Исключаем данные с пропусками и выделяем нужные столбцы [удалены 3 записи]

data <- na.omit(addicts[ , c("intpla", "curwor", "se", "end")])
summary(data)

     intpla          curwor             se              end        
 Min.   :1.000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :1.000   Median :0.0000   Median :0.0000   Median :0.0000  
 Mean   :1.498   Mean   :0.2744   Mean   :0.2347   Mean   :0.2708  
 3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:1.0000  
 Max.   :2.000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  

Гипотезы о независимости по критерию \(\chi^2\) и точному критерию Фишера

intpla - место лечения

tab_intpla <- table(X=data$intpla, Y=data$end); tab_intpla

   Y
X     0   1
  1  96  43
  2 106  32

tab_intpla[,2]/rowSums(tab_intpla)

        1         2 
0.3093525 0.2318841 

Для 30.9% лечившихся амбулаторно и для 23.2% лечившихся в диспансере программа лечения была выполнена.

c(fisher.test(tab_intpla)$p.value, chisq.test(tab_intpla, correct=FALSE)$p.value, chisq.test(tab_intpla)$p.value)

[1] 0.1763913 0.1468375 0.1883169

Итоговые p.value критериев Фишера и \(\chi^2\) без поправки и с поправкой на непрерывность превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, не отвергается. Проценты людей, лечившихся амбулаторно и в диспансере, отличаются незначимо. Данные признаки независимы. Различия в частотах можно объяснить случайностью.

curwor - занятость

tab_curwor <- table(X=data$curwor, Y=data$end); tab_curwor

   Y
X     0   1
  0 153  48
  1  49  27

tab_curwor[,2]/rowSums(tab_curwor)

        0         1 
0.2388060 0.3552632 

Для 23.9% лечившихся, занятых на работе, и для 35.5% пациентов, кто не работал, программа лечения была выполнена.

c(fisher.test(tab_curwor)$p.value, chisq.test(tab_curwor, correct=FALSE)$p.value, chisq.test(tab_curwor)$p.value)

[1] 0.06837940 0.05162145 0.07269287

Итоговые p.value критериев Фишера и \(\chi^2\) без поправки и с поправкой на непрерывность лишь немного превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, не отвергается. Проценты людей, имеющих работу и не имеющих, отличаются незначимо, однако к данным результатам стоит отнестись с осторожностью ввиду достаточно близкого к уровню значимости 0.05 p-значения критериев.

se - использование успокоительных средств

tab_se <- table(X=data$se, Y=data$end); tab_se

   Y
X     0   1
  0 149  63
  1  53  12

tab_se[,2]/rowSums(tab_se)

        0         1 
0.2971698 0.1846154 

Для 29.7% лечившихся, не употреблявших успокоительные средства, и для 18.5% пациентов, кто употреблял успокоительные, программа лечения была выполнена.

c(fisher.test(tab_se)$p.value, chisq.test(tab_se, correct=FALSE)$p.value, chisq.test(tab_se)$p.value)

[1] 0.08081371 0.07400653 0.10372925

Итоговые p.value критериев Фишера и \(\chi^2\) без поправки и с поправкой на непрерывность немного превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, не отвергается. Проценты людей, принимавших и не принимавших успокоительные, отличаются незначимо, однако к данным результатам стоит отнестись с некоторой осторожностью.

Коэффициенты неопределенности

Entropy <- function(x)
{
  p <- x / sum(x)
  p <- p[p!=0]
  -sum(p*log(p, 2))
}

Uncertainty_coefficient <- function(tab)
{
  Hxy <- Entropy(as.vector(tab))
  Hx<-Entropy(rowSums(tab))
  Hy<-Entropy(colSums(tab))
  I <- Hx + Hy - Hxy
  c(I/Hx, I/Hy, 2*I/(Hx+Hy)) * 100
}

1. Независимые переменные по отдельности

Uncertainty_coefficient(tab_intpla)

[1] 0.5496901 0.6524060 0.5966596

Uncertainty_coefficient(tab_curwor)

[1] 1.125993 1.132826 1.129399

Uncertainty_coefficient(tab_se)

[1] 1.119485 1.044402 1.080641

Для признака intpla коэффициент неопределенности едва превышает 0.5%, для curwor и se – чуть больше 1%. Таким образом, знание любого из этих признаков по отдельности не вносит ясности в вопрос, было ли лечение успешным, так как зависимости между этими признаками с end практически нет, только за счет объема выборки есть некоторое отличие от нуля.

2. Пары независимых переменных

x <- data$end
X. <- data[, -which(colnames(data)=="end")]

Bin_encoding <- function(X_)
{
  rowSums(apply(rbind(2^(seq(ncol(X_))-1), X_), 2, function(x) x[-1] * x[1]))
}

Uncertainty_coefficients_multiple <- function(x, X., k)
{
  C <- combn(ncol(X.), k)
  L <- apply(C, 2, function(z) {
    Uncertainty_coefficient(table(x, Bin_encoding(X.[, z])))[1]
  })
  df <- data.frame(t(apply(C, 2, function(z)colnames(X.)[z])), L=L)
  df[order(df$L, decreasing=TRUE),]
}

Uncertainty_coefficients_multiple(x, X., k=2)

3. Все три независимые переменные одновременно

Uncertainty_coefficients_multiple(x, X., k=3)

Сочетание пары переменных “занятость - использование успокоительных” даёт нам лишь 2.1% информации о том, насколько программа лечения была выполнена. Другие две пары объясняют зависимую переменную end лишь на 1.24% и 1.5%. Аналогично можно сказать и о комбинации сразу всех трех признаков: 2.47%, что фактически говорит о независимости успешности лечения от места лечения, занятости, приема успокоительных или комбинации этих признаков в паре или даже тройке.