-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathhw2.Rmd
157 lines (118 loc) · 8.67 KB
/
hw2.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
---
title: ""
output: html_notebook
---
#### Практическая работа №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 - программа сорвана)
```{r}
library(readxl)
addicts <- read_excel("addicts.xlsx")
# View(addicts)
```
Исследуем переменные на наличие пропусков.
```{r}
c(summary(as.factor(addicts$intpla)), summary(as.factor(addicts$curwor)), summary(as.factor(addicts$se)), summary(as.factor(addicts$end)))
```
Исключаем данные с пропусками и выделяем нужные столбцы [удалены 3 записи]
```{r}
data <- na.omit(addicts[ , c("intpla", "curwor", "se", "end")])
summary(data)
```
### Гипотезы о независимости по критерию $\chi^2$ и точному критерию Фишера
> intpla - место лечения
```{r}
tab_intpla <- table(X=data$intpla, Y=data$end); tab_intpla
```
```{r}
tab_intpla[,2]/rowSums(tab_intpla)
```
Для 30.9% лечившихся амбулаторно и для 23.2% лечившихся в диспансере программа лечения была выполнена.
```{r}
c(fisher.test(tab_intpla)$p.value, chisq.test(tab_intpla, correct=FALSE)$p.value, chisq.test(tab_intpla)$p.value)
```
Итоговые p.value критериев Фишера и $\chi^2$ без поправки и с поправкой на непрерывность превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, **не отвергается**. Проценты людей, лечившихся амбулаторно и в диспансере, отличаются **незначимо**. Данные признаки независимы. Различия в частотах можно объяснить случайностью.
> curwor - занятость
```{r}
tab_curwor <- table(X=data$curwor, Y=data$end); tab_curwor
```
```{r}
tab_curwor[,2]/rowSums(tab_curwor)
```
Для 23.9% лечившихся, занятых на работе, и для 35.5% пациентов, кто не работал, программа лечения была выполнена.
```{r}
c(fisher.test(tab_curwor)$p.value, chisq.test(tab_curwor, correct=FALSE)$p.value, chisq.test(tab_curwor)$p.value)
```
Итоговые p.value критериев Фишера и $\chi^2$ без поправки и с поправкой на непрерывность лишь немного превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, **не отвергается**. Проценты людей, имеющих работу и не имеющих, отличаются **незначимо**, однако к данным результатам стоит отнестись с осторожностью ввиду достаточно близкого к уровню значимости 0.05 p-значения критериев.
> se - использование успокоительных средств
```{r}
tab_se <- table(X=data$se, Y=data$end); tab_se
```
```{r}
tab_se[,2]/rowSums(tab_se)
```
Для 29.7% лечившихся, не употреблявших успокоительные средства, и для 18.5% пациентов, кто употреблял успокоительные, программа лечения была выполнена.
```{r}
c(fisher.test(tab_se)$p.value, chisq.test(tab_se, correct=FALSE)$p.value, chisq.test(tab_se)$p.value)
```
Итоговые p.value критериев Фишера и $\chi^2$ без поправки и с поправкой на непрерывность немного превышают уровень значимости 0.05. Гипотеза о том, что условные вероятности одинаковы, **не отвергается**. Проценты людей, принимавших и не принимавших успокоительные, отличаются **незначимо**, однако к данным результатам стоит отнестись с некоторой осторожностью.
### Коэффициенты неопределенности
```{r}
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. Независимые переменные по отдельности
```{r}
Uncertainty_coefficient(tab_intpla)
Uncertainty_coefficient(tab_curwor)
Uncertainty_coefficient(tab_se)
```
Для признака intpla коэффициент неопределенности едва превышает 0.5%, для curwor и se -- чуть больше 1%. Таким образом, знание любого из этих признаков по отдельности не вносит ясности в вопрос, было ли лечение успешным, так как зависимости между этими признаками с end практически нет, только за счет объема выборки есть некоторое отличие от нуля.
2. Пары независимых переменных
```{r}
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),]
}
```
```{r}
Uncertainty_coefficients_multiple(x, X., k=2)
```
3. Все три независимые переменные одновременно
```{r}
Uncertainty_coefficients_multiple(x, X., k=3)
```
Сочетание пары переменных "занятость - использование успокоительных" даёт нам лишь 2.1% информации о том, насколько программа лечения была выполнена. Другие две пары объясняют зависимую переменную end лишь на 1.24% и 1.5%. Аналогично можно сказать и о комбинации сразу всех трех признаков: 2.47%, что фактически говорит о независимости успешности лечения от места лечения, занятости, приема успокоительных или комбинации этих признаков в паре или даже тройке.