Poverty

Чтение данных

library(dplyr)
library(matrixStats)
library(ggplot2)
library(GGally)
library(ppcor)
library(Hmisc)
library(corrplot)
library(nortest)
library(stats)


df <- read.csv(file = "poverty.csv", header = TRUE, fileEncoding = "UTF-8", dec = ",")
df <- df[-1]
head(df)

summary(df)

##      BIRTH           DEATH          INF_DEAH         LIFE_M     
##  Min.   : 9.70   Min.   : 2.20   Min.   :  4.5   Min.   :38.10  
##  1st Qu.:14.50   1st Qu.: 7.80   1st Qu.: 13.1   1st Qu.:55.80  
##  Median :29.00   Median : 9.50   Median : 43.0   Median :63.70  
##  Mean   :29.23   Mean   :10.84   Mean   : 54.9   Mean   :61.49  
##  3rd Qu.:42.20   3rd Qu.:12.50   3rd Qu.: 83.0   3rd Qu.:68.60  
##  Max.   :52.20   Max.   :25.00   Max.   :181.6   Max.   :75.90  
##                                                                 
##      LIFE_F           GNP           GROUP             COUNTRY         
##  Min.   :41.20   Min.   :    0   Length:97          Length:97         
##  1st Qu.:57.50   1st Qu.:  445   Class :character   Class :character  
##  Median :67.80   Median : 1640   Mode  :character   Mode  :character  
##  Mean   :66.15   Mean   : 5367                                        
##  3rd Qu.:75.40   3rd Qu.: 6695                                        
##  Max.   :81.80   Max.   :26040                                        
##                  NA's   :6

Удаляем выброс

df <- df %>% slice(-c(37))

Смотрим на pairs

num_col <- c(1, 2, 3, 4, 5, 6)
ggpairs(df, columns = num_col,
        diag=list(continuous=wrap("barDiag",binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3)))),
        upper = list(continuous = "points"))

Логарифмируем

df$INF_DEAH <- log(df$INF_DEAH)
df$GNP <- log(df$GNP)
df$DEATH <- log(df$DEATH)
#df$LIFE_M <- log(df$LIFE_M)
#df$LIFE_F <- log(df$LIFE_F)
#df$BIRTH <- log(df$BIRTH)

ggpairs(df, columns = num_col,
        diag=list(continuous=wrap("barDiag",binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3)))),
        upper = list(continuous = "points"))

Удаляем выбросы и na

df <- na.omit(df)

Получаем новые признаки из старых

df <- df %>% mutate(LIFE = (LIFE_M + LIFE_F) / 2, LIFE_D = LIFE_F - LIFE_M, LIFE_M = NULL, LIFE_F = NULL) %>% relocate(c(LIFE, LIFE_D), .after = INF_DEAH)

Раскрашенные по стране pairs

df$GROUP <- as.factor(df$GROUP)

ggpairs(df, columns = num_col, aes(color = GROUP, alpha = 0.5),
        diag = list(continuous=wrap("barDiag",binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3)))),
        upper = list(continuous = wrap("cor", size = 3)))

Смотрим на boxplot

ggplot(df, aes(x = GROUP, y = BIRTH, fill = GROUP)) + geom_boxplot()

ggplot(df, aes(x = GROUP, y = DEATH, fill = GROUP)) + geom_boxplot()

ggplot(df, aes(x = GROUP, y = INF_DEAH, fill = GROUP)) + geom_boxplot()

ggplot(df, aes(x = GROUP, y = LIFE, fill = GROUP)) + geom_boxplot()

ggplot(df, aes(x = GROUP, y = LIFE_D, fill = GROUP)) + geom_boxplot()

ggplot(df, aes(x = GROUP, y = GNP, fill = GROUP)) + geom_boxplot()

t.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "ASIA", "GNP"])

## 
##  Welch Two Sample t-test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "ASIA", "GNP"]
## t = -0.67923, df = 19.794, p-value = 0.5049
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.2359961  0.6290938
## sample estimates:
## mean of x mean of y 
##  6.198446  6.501898

t.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "EAST_E", "GNP"])

## 
##  Welch Two Sample t-test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "EAST_E", "GNP"]
## t = -4.9822, df = 30.021, p-value = 2.445e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.8068595 -0.7562415
## sample estimates:
## mean of x mean of y 
##  6.198446  7.479997

t.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "MID_EAST", "GNP"])

## 
##  Welch Two Sample t-test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "MID_EAST", "GNP"]
## t = -6.5165, df = 17.767, p-value = 4.246e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -3.09882 -1.58677
## sample estimates:
## mean of x mean of y 
##  6.198446  8.541241

t.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "SOU_A", "GNP"])

## 
##  Welch Two Sample t-test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "SOU_A", "GNP"]
## t = -3.8197, df = 32.155, p-value = 0.0005763
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.6236709 -0.4943938
## sample estimates:
## mean of x mean of y 
##  6.198446  7.257479

#t.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "WEST_E_A", "GNP"])

wilcox.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "ASIA", "GNP"])

## Warning in wilcox.test.default(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == :
## cannot compute exact p-value with ties

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "ASIA", "GNP"]
## W = 184.5, p-value = 0.9124
## alternative hypothesis: true location shift is not equal to 0

wilcox.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "EAST_E", "GNP"])

## Warning in wilcox.test.default(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == :
## cannot compute exact p-value with ties

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "EAST_E", "GNP"]
## W = 34.5, p-value = 0.001573
## alternative hypothesis: true location shift is not equal to 0

wilcox.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "MID_EAST", "GNP"])

## Warning in wilcox.test.default(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == :
## cannot compute exact p-value with ties

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "MID_EAST", "GNP"]
## W = 13, p-value = 3.239e-05
## alternative hypothesis: true location shift is not equal to 0

wilcox.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == 'SOU_A', "GNP"])

## Warning in wilcox.test.default(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == :
## cannot compute exact p-value with ties

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "SOU_A", "GNP"]
## W = 61, p-value = 0.002223
## alternative hypothesis: true location shift is not equal to 0

wilcox.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "WEST_E_A", "GNP"])

## Warning in wilcox.test.default(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == :
## cannot compute exact p-value with ties

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "WEST_E_A", "GNP"]
## W = 0, p-value = 1.922e-08
## alternative hypothesis: true location shift is not equal to 0

ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "ASIA", "GNP"])

## Warning in ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "ASIA", :
## cannot compute exact p-value with ties

## 
##  Two-sample Kolmogorov-Smirnov test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "ASIA", "GNP"]
## D = 0.14286, p-value = 0.9918
## alternative hypothesis: two-sided

ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "EAST_E", "GNP"])

## Warning in ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "EAST_E", :
## cannot compute exact p-value with ties

## 
##  Two-sample Kolmogorov-Smirnov test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "EAST_E", "GNP"]
## D = 0.7037, p-value = 0.002499
## alternative hypothesis: two-sided

ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "MID_EAST", "GNP"])

## Warning in ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "MID_EAST", :
## cannot compute exact p-value with ties

## 
##  Two-sample Kolmogorov-Smirnov test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "MID_EAST", "GNP"]
## D = 0.81481, p-value = 0.0001238
## alternative hypothesis: two-sided

ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "SOU_A", "GNP"])

## Warning in ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "SOU_A", :
## cannot compute exact p-value with ties

## 
##  Two-sample Kolmogorov-Smirnov test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "SOU_A", "GNP"]
## D = 0.57407, p-value = 0.008374
## alternative hypothesis: two-sided

ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "WEST_E_A", "GNP"])

## Warning in ks.test(df[df$GROUP == "AFRICA", "GNP"], df[df$GROUP == "WEST_E_A", :
## cannot compute exact p-value with ties

## 
##  Two-sample Kolmogorov-Smirnov test
## 
## data:  df[df$GROUP == "AFRICA", "GNP"] and df[df$GROUP == "WEST_E_A", "GNP"]
## D = 1, p-value = 8.323e-10
## alternative hypothesis: two-sided

Распределения

df_africa <- df %>% filter(GROUP == "AFRICA")

QQplot <- function(data, column) ggplot(data, aes(sample = data[, column])) + stat_qq() + stat_qq_line(colour = "red")

lapply(names(df_africa[, num_col]), function(x) QQplot(df_africa, x))

## [[1]]

## 
## [[2]]

## 
## [[3]]

## 
## [[4]]

## 
## [[5]]

## 
## [[6]]

lapply(names(df_africa[, num_col]), function(x) shapiro.test(df_africa[,x]))

## [[1]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.89247, p-value = 0.009034
## 
## 
## [[2]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.97821, p-value = 0.8198
## 
## 
## [[3]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.94565, p-value = 0.1679
## 
## 
## [[4]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.97205, p-value = 0.6568
## 
## 
## [[5]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.82661, p-value = 0.0004103
## 
## 
## [[6]]
## 
##  Shapiro-Wilk normality test
## 
## data:  df_africa[, x]
## W = 0.98005, p-value = 0.8634

Корреляции

m = cor(df_africa[num_col])
corrplot(m, method = 'color')

rcorr(as.matrix(df_africa[num_col]))

##          BIRTH DEATH INF_DEAH  LIFE LIFE_D   GNP
## BIRTH     1.00  0.68     0.56 -0.69   0.12 -0.58
## DEATH     0.68  1.00     0.84 -0.96  -0.03 -0.73
## INF_DEAH  0.56  0.84     1.00 -0.84  -0.07 -0.58
## LIFE     -0.69 -0.96    -0.84  1.00  -0.05  0.69
## LIFE_D    0.12 -0.03    -0.07 -0.05   1.00  0.26
## GNP      -0.58 -0.73    -0.58  0.69   0.26  1.00
## 
## n= 27 
## 
## 
## P
##          BIRTH  DEATH  INF_DEAH LIFE   LIFE_D GNP   
## BIRTH           0.0000 0.0026   0.0000 0.5637 0.0017
## DEATH    0.0000        0.0000   0.0000 0.8793 0.0000
## INF_DEAH 0.0026 0.0000          0.0000 0.7120 0.0017
## LIFE     0.0000 0.0000 0.0000          0.8206 0.0000
## LIFE_D   0.5637 0.8793 0.7120   0.8206        0.1866
## GNP      0.0017 0.0000 0.0017   0.0000 0.1866

ggpairs(df_africa, columns = num_col,
        diag=list(continuous=wrap("barDiag",binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3)))),
        upper = list(continuous = "points"))