tidyr— title: “Task1” output: html_document: df_print: paged —
1. Выбор данных
https://vincentarelbundock.github.io/Rdatasets/datasets.html - здесь есть множество разных датасетов с описанием. При этом можно предварительно посмотреть на количество наблюдений, количество признаков, сколько из них являются факторами и т.д.
2. Считывание и просмотр
df <- read.csv(file = "Angell.csv", header = TRUE, as.is = FALSE) #Скачиваем csv, сохраняем в папку, где лежит r markdown и считываем данные.
head(df) #Head() Показывает первые шесть строк данных.## X moral hetero mobility region
## 1 Rochester 19.0 20.6 15.0 E
## 2 Syracuse 17.0 15.6 20.2 E
## 3 Worcester 16.4 22.1 13.6 E
## 4 Erie 16.2 14.0 14.8 E
## 5 Milwaukee 15.8 17.4 17.6 MW
## 6 Bridgeport 15.3 27.9 17.5 E3. Описание данных
Рассматриваемые данные содержат различную информацию о 43 городах в Америке около 1950г.
moral - Moral integration - Composite of crime rate and welfare expenditures
hetero - Ethnic Heterogenity - From percentages of nonwhite and foreign-born white residents
mobility - Geographic Mobility - From percentages of residents moving into and out of the city
region - A factor with levels: E Northeast; MW Midwest; S Southeast; W West.
4. Типы признаков
moral - количественный hetero - количественный mobility - количественный region - качественный
library(dplyr)## Registered S3 methods overwritten by 'tibble':
## method from
## format.tbl pillar
## print.tbl pillar##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionsummarize(df, across(moral:region, function(x) max(table(x)))) #считает сколько раз встречается мода у каждого признака## moral hetero mobility region
## 1 2 1 2 14#df %>% summarize(across(moral:region, function(x) max(table(x)))) #считает сколько раз встречается мода у каждого признакаИз таблицы выше можем заключить, что hetero - абсолютно непрерывный признак. Кроме того, можем считать, что moral и mobility ближе к непрерывным признакам.
5. Порядковые признаки
Здесь необходимо проверить соответствие текстовых меток порядкового признака (если такие использованы) их естественному порядку.
В данном датасете таких признаков нет.
6. Matrix plot, outliers, etc.
panel.hist <- function(x, ...) #функция рисующая гистограмму, предлагаемая в help'е функции pairs
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5) )
h <- hist(x, plot = FALSE)
breaks <- h$breaks; nB <- length(breaks)
y <- h$counts; y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...)
}
pairs(df[,2:4], diag.panel = panel.hist)
Для категоризованной картинки используйте функцию ggpairs
7. Симметричность распределений.
Из матрикс плота видно, что распределение hetero - сильно несимметричное с хвостом вправо, поэтому прологарифмируем его и построим заново матрикс плот.
dfl <- transform(df, hetero=log(hetero))
pairs(df[,2:4], diag.panel = panel.hist)
8. Аутлаеры
В данном случае на одном скаттерплоте (hetero & moral) видна линейная зависимость, не имеющая аутлаеров относительно нее. На скаттерплоте (mobility & hetero) отсутствует зависимость и, соответственно, аутлаеры. На (moral & mobility) также линейная зависимость, но вместо аутлаеров наблюдается скорее неоднородность.
10. Матрикс плот и аутлаеры для отдельной группы.
pairs(df[df$region == "S",2:4], diag.panel = panel.hist)
dflo <- dfl #сохраняем датасет
dflo[38,] <- NA #удаляем аутлаер относительно линейной зависимости между hetero и mobility
pairs(df[df$region == "S",2:4], diag.panel = panel.hist)
11. Descriptive statistics
summary(df)## X moral hetero mobility region
## Akron : 1 Min. : 4.20 Min. :10.60 Min. :12.10 E : 9
## Atlanta : 1 1st Qu.: 8.70 1st Qu.:16.90 1st Qu.:19.45 MW:14
## Baltimore : 1 Median :11.10 Median :23.70 Median :25.90 S :14
## Birmingham: 1 Mean :11.20 Mean :31.37 Mean :27.60 W : 6
## Bridgeport: 1 3rd Qu.:13.95 3rd Qu.:39.00 3rd Qu.:34.80
## Buffalo : 1 Max. :19.00 Max. :84.50 Max. :49.80
## (Other) :37summary(dfl)## X moral hetero mobility region
## Akron : 1 Min. : 4.20 Min. :2.361 Min. :12.10 E : 9
## Atlanta : 1 1st Qu.: 8.70 1st Qu.:2.827 1st Qu.:19.45 MW:14
## Baltimore : 1 Median :11.10 Median :3.165 Median :25.90 S :14
## Birmingham: 1 Mean :11.20 Mean :3.267 Mean :27.60 W : 6
## Bridgeport: 1 3rd Qu.:13.95 3rd Qu.:3.663 3rd Qu.:34.80
## Buffalo : 1 Max. :19.00 Max. :4.437 Max. :49.80
## (Other) :37library(moments)
summarize(dfl, across(moral:mobility, list(kurtosis = kurtosis, skewness = skewness)))## moral_kurtosis moral_skewness hetero_kurtosis hetero_skewness
## 1 2.295829 -0.01912821 2.158586 0.4273672
## mobility_kurtosis mobility_skewness
## 1 2.303007 0.41203192.1 Выбор категоризующей переменной
В качестве категоризующего признака возьмем region. Сравнивать будем центральные штаты и юго-восточный регион, как имеющие наибольшее количество наблюдений (14 и 13, соответственно).
2.2 Boxplot
dfcomp <- dflo %>% filter(region == "S" | region == "MW") #Выбираем из дата фрейма только наблюдения из юго-восточного и центрального регионов. Filter - вытаскивает подвыборку дата фрейма. %>% - передает dflo как первый параметр функции, идущей после этого знака.
dfcomp$region <- droplevels(dfcomp$region) #Изменяет параметр-фактор, отвечающий за принадлежность городу региона, оставляя только присутствующие регионы (в нашем случае юго-восточный и центральный)
library(lattice)
bwplot(moral ~ region, data = dfcomp, col = c("forestgreen", "gold"), main = "Moral Integration", xlab = "Region") #строим боксплоты моральной интеграции по региону. moral ~ region - моральная интеграция как главный параметр, ~ region - разбивает боксплоты на группы в зависимости от региона. data - передаем наш дата фрейм. col - раскрашивает боксплоты в зависимости от группы. main - название над картинкой. xlab - подпись оси х.
#Далее, аналогичные картинки относительно двух других признаков.
bwplot(hetero ~ region, data = dfcomp, col = c("forestgreen", "gold"), main = "Ethnic Heterogenity", xlab = "Region")
bwplot(mobility ~ region, data = dfcomp, col = c("forestgreen", "gold"), main = "Geographic Mobility", xlab = "Region")
#boxplot(mobility ~ region, dfcomp, col = c("forestgreen", "gold"), main = "Geographic Mobility, mean and median", xlab = "Region")
rb<- boxplot(mobility ~ region, dfcomp, col = c("forestgreen", "gold"), main = "Geographic Mobility, mean and median", xlab = "Region")
#title("Comparing boxplot()s and non-robust mean +/- SD")
mn.t <- tapply(dfcomp$mobility, dfcomp$region, mean)
sd.t <- tapply(dfcomp$mobility, dfcomp$region,sd)
xi <- 0.3 + seq(rb$n)
points(xi, mn.t, col = "red", pch = 18)
arrows(xi, mn.t - sd.t, xi, mn.t + sd.t,
code = 3, col = "red", angle = 75, length = .1)
#две гистограммы рядом
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.0.5ggplot(dfcomp, aes(x=mobility, fill=region)) +
geom_histogram( color='#e9ecef', alpha=0.6, position='identity')## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.