Загружаем данные
Загрузим данные и посмотрим общую информацию по переменным:
## Date_entry Region District_ad Address
## Length:3000 Length:3000 Length:3000 Length:3000
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Metro Dist_metro_ad Rooms Price
## Length:3000 Min. : 0 Length:3000 Min. : 10
## Class :character 1st Qu.: 355 Class :character 1st Qu.: 22000
## Mode :character Median : 790 Mode :character Median : 30000
## Mean : 1495 Mean : 45505
## 3rd Qu.: 1570 3rd Qu.: 50000
## Max. :31700 Max. :690000
## NA's :77
## Minimum_duration No_agents Building Area_total
## Length:3000 Length:3000 Length:3000 Min. : 15.00
## Class :character Class :character Class :character 1st Qu.: 39.00
## Mode :character Mode :character Mode :character Median : 50.00
## Mean : 63.09
## 3rd Qu.: 74.00
## Max. :514.00
## NA's :138
## Area_living Area_kitchen Floor NFloor
## Min. : 10.00 Min. : 1.00 Min. : 1.000 Length:3000
## 1st Qu.: 19.00 1st Qu.: 8.00 1st Qu.: 3.000 Class :character
## Median : 30.00 Median : 10.00 Median : 5.000 Mode :character
## Mean : 37.69 Mean : 13.36 Mean : 6.718
## 3rd Qu.: 46.00 3rd Qu.: 15.00 3rd Qu.: 9.000
## Max. :300.00 Max. :165.00 Max. :27.000
## NA's :54 NA's :364 NA's :121
## Lift Furnished Bath Refurbished
## Length:3000 Length:3000 Length:3000 Length:3000
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Balcony Latitude Longitude Year_construction
## Length:3000 Min. :59.57 Min. :28.77 Min. :1838
## Class :character 1st Qu.:59.88 1st Qu.:30.28 1st Qu.:2002
## Mode :character Median :59.94 Median :30.32 Median :2012
## Mean :59.94 Mean :30.33 Mean :2001
## 3rd Qu.:59.99 3rd Qu.:30.37 3rd Qu.:2015
## Max. :60.70 Max. :30.63 Max. :2017
## NA's :538 NA's :538 NA's :2668
Приводим переменные к нужным типам:
data$Region = data$Region %>% as.factor()
data$District_ad = data$District_ad %>% as.factor()
data$Metro = data$Metro %>% as.factor()
data$No_agents= data$No_agents %>% as.factor()
data$Building = data$Building %>% as.factor()
data$Lift = data$Lift %>% as.factor()
data$Furnished = data$Furnished %>% as.factor()
data$Bath = data$Bath %>% as.factor()
data$Refurbished = data$Refurbished %>% as.factor()
data$Balcony = data$Balcony %>% as.factor()
Первая переменная - дата размещения объявления. Посмотрим, как распределены объявления по дням недели:
library(lubridate)
data$Date_entry = ymd(data$Date_entry)
ggplot(data) + geom_bar(aes(x = wday(Date_entry, label = T)), fill = 10,color = "black")+
xlab("Дни недели")+
ylab("Количеств объявлений")+
ggtitle("Распределение объявлений по дням недели")
Отметим, что чаще всего объявления подаются во вторник, а реже всего - по выходным (что, пожалуй, логично)
Dist_metro_ad - Расстояние до метро
Здесь и далее:
mean - среднее
median - медиана (2ой квартиль)
min/max/range - минимум, максимум, размах
assimetria - коэффициент ассиметрии
kurtosis - куртозис
firstQu/thirdQu - первый/третий квартиль
sko - среднее квадратичное отклонение
moda - мода
#загрузим библиотеку psych и с ее помощью проанализируем описательные статистики (попутно добавляя те, которые не предусмотрены функцией describe и удаляя лишние)
library(psych)
library(knitr)
library(DT) #для построения таблиц
dist_ = data$Dist_metro_ad %>% na.omit() #сразу уберем все пропущенные значения
dista_= describe(dist_) %>% select(-vars, -n, -sd, -trimmed, -mad, -se)%>% rename(assimetria = skew) %>% mutate(firstQu = quantile(dist_,0.25)) %>% mutate(thirdQu = quantile(dist_,0.75)) %>% mutate(sko = sd(dist_)) %>% mutate(moda = mode(dist_)) %>% mutate_all(round, 2)
kable(dista_,row.names = F, caption = "Описательные характеристики расстояния до метро в выборке")
| mean | median | min | max | range | assimetria | kurtosis | firstQu | thirdQu | sko | moda |
|---|---|---|---|---|---|---|---|---|---|---|
| 1495.11 | 790 | 0 | 31700 | 31700 | 5.59 | 40.6 | 355 | 1570 | 2680.76 | 591.4 |
31 километр до метро кажется каким-то очень большим значением. Посмотрим на таблицу для всех значений которые превышают 5 км
data_dist = data %>% select(Dist_metro_ad,Metro,Address, Region) %>% filter(Dist_metro_ad>=5000)
datatable(data_dist)
Всего лишь 135 наблюдений. Большая часть наблюдений после такого фильтра - квартиры, сдаваемые в пригородах Петербурга (и большая дистанция до метро объяснима). Есть наблюдения, где указана станция метро никак не относящаяся к адресу или станция метро от которой ходит наземный транспорт до адреса. Более того, есть наблюдения в Лен.Области, для которых расстояяние до метро вообще не имеет смысла указывать - уберем их (и заодно уберем пропущенные значения)
data_dist = data %>% select(Dist_metro_ad,Metro,Address, Region) %>% filter(Region != "Leningradskaya oblast'") %>% filter(!is.na(Dist_metro_ad))
dist_= describe(data_dist$Dist_metro_ad) %>% select(-vars, -n, -sd, -trimmed, -mad, -se) %>% rename(assimetria = skew) %>% mutate(firstQu = quantile(data_dist$Dist_metro_ad,0.25)) %>% mutate(thirdQu = quantile(data_dist$Dist_metro_ad,0.75)) %>% mutate(sko = sqrt(var(data_dist$Dist_metro_ad)))%>% mutate(moda = mode(data_dist$Dist_metro_ad)) %>% mutate_all(round,2)
kable(dist_, row.names = F, caption = "Описательные характеристики расстояния до метро в выборке после преобразований")
| mean | median | min | max | range | assimetria | kurtosis | firstQu | thirdQu | sko | moda |
|---|---|---|---|---|---|---|---|---|---|---|
| 1473.8 | 780 | 0 | 31700 | 31700 | 5.73 | 42.58 | 340 | 1550 | 2667.71 | 589.65 |
Значения почти не поменялись. Любопытно, что и значение 31700 никуда не ушло. Посмотрим на него:
От Черной речки до Кронштадта и от Комендантского до Комарово. Аназлиз усложняется тем, что пригороды формально являются частью Петербурга (Курортный, Пушкинский районы, Кронштадт и т.д.), но метро пока туда не ходит. Будем считать, что квартира находится в пешей доступности от метро, если расстояние до метро <1500м. Посмотрим, какая доля квартир находится в пешей доступности.
ggplot(data_dist %>% mutate(peshaya = Dist_metro_ad<1500) %>% mutate(Tr = T)) + geom_bar(aes(x = Tr, , fill = peshaya),position = 'fill')+
xlab("")+
ylab("")+
scale_x_discrete(labels = c(""))+
scale_fill_discrete(name = "", labels = c("Вне пешей доступности", "В пешей доступности"))+
ggtitle("Доля квартир в пешей доступности от метро в выборке")
Почти 75%
И наконец, допустим, что расстояние до метро имеет смысл указывать только, если оно меньше 4 км (с учетом возможности использования дополнительно назменого транспорта).
С помощью ящика с усами убедимся, что верхняя граница “статистически значимых значений” действительно находится на уровне 4 км.
ggplot(data) +
geom_boxplot(aes(y = Dist_metro_ad/1000))+
geom_hline(yintercept = 4, color = "red", linetype = "dashed")+
scale_x_discrete("")+
scale_y_continuous(breaks = seq(0, 32, by = 2))+
ggtitle("Распределение расстояния до метро в выборке (в км)")+
ylab("")
## Warning: Removed 77 rows containing non-finite values (stat_boxplot).
Рассчитаем описательные статистики именно для значений меньше 4 км
data_dist = data %>% select(Dist_metro_ad,Metro,Address, Region) %>% filter(Region != "Leningradskaya oblast'") %>% filter(!is.na(Dist_metro_ad)) %>% filter(Dist_metro_ad<4000)
summary(data_dist$Metro)
## A.Hevskogo pl. Admiralteiskaya
## 0 30 38
## Akademicheskaya Antropshino Avtovo
## 69 0 17
## Baltiiskaya Bol'shevikov pr. Buharestskaya
## 16 70 4
## Carskoe selo Chernaya rechka Chernyshevskaya
## 2 35 104
## Chkalovskaya Devyatkino Dostoevskaya
## 47 0 11
## Dybenko ul. Elektrosila Elizarovskaya
## 50 34 2
## Frunzenskaya Gor'kovskaya Gostinyi Dvor
## 63 52 29
## Grajdanskii pr. Kirovskii zavod Komendantskii pr.
## 71 7 124
## Krestovskii ostrov Kupchino Ladojskaya
## 51 64 59
## Lenina pl. Leninskii pr. Lesnaya
## 26 63 27
## Ligovskii pr. Lomonosovskaya Mayakovskaya
## 10 29 19
## Mejdunarodnaya Moskovskaya Moskovskie vorota
## 56 102 11
## Mujestva pl. Narvskaya Nevskii pr.
## 32 6 36
## Novocherkasskaya Novyi Petergof Obuhovo
## 33 1 4
## Obvodnyi Kanal Ozerki Park Pobedy
## 4 59 45
## Parnas Pavlovsk Pesochnaya
## 55 2 1
## Petrogradskaya Pionerskaya Politehnicheskaya
## 93 36 13
## Primorskaya Proletarskaya Prosveshcheniya pr.
## 121 24 82
## Pushkinskaya Repino Roshchino
## 2 1 0
## Rybackoe Sadovaya Sennaya pl.
## 26 28 18
## Sestroreck Shushary Siverskaya
## 1 1 0
## Spasskaya Sportivnaya Staraya Derevnya
## 2 26 69
## Staryi Petergof Tarhovka Tat'yanino
## 1 1 0
## Tehnologicheskii i-t Udel'naya Vasileostrovskaya
## 14 46 62
## Verevo Veteranov pr. Vladimirskaya
## 0 68 23
## Vosstaniya pl. Vyborg Vyborgskaya
## 104 0 9
## Zelenogorsk Zvenigorodskaya Zvezdnaya
## 1 3 94
Замечание: Среди станций метро попадаются ж/д станции. Будем считать, что для пригородов ж/д станции своеобразный аналог метро - их можно не исключать из выборки.
dist_ = data_dist$Dist_metro_ad %>% na.omit() #сразу уберем все пропущенные значения
dista_= describe(dist_) %>% select(-vars, -n, -sd, -trimmed, -mad)%>% rename(assimetria = skew) %>% mutate(firstQu = quantile(dist_,0.25)) %>% mutate(thirdQu = quantile(dist_,0.75)) %>% mutate(sko = sd(dist_)) %>% mutate(moda = mode(dist_)) %>% mutate_all(round, 2)
kable(dista_, row.names = F, caption = "Описательные характеристики расстояния до метро в выборке после преобразований")
| mean | median | min | max | range | assimetria | kurtosis | se | firstQu | thirdQu | sko | moda |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 965.37 | 720 | 0 | 3980 | 3980 | 1.28 | 1.15 | 17.25 | 300 | 1310 | 886.35 | 116.87 |
Заметно, как раньше большие значения сильно влияли на среднее. Также сильно снизилось модальное значение. Распределение стало более симметричым (коэффициент ассиметрии снизился), куртозис также снизился значительно - острота пика распределения теперь не такая явная.
Коэффициент ассиметрии положительный - распределение скошено вправо
Посмотрим это на графиках:
Гистограмма
ggplot(data_dist) +geom_histogram(aes(x = Dist_metro_ad), fill = 19)+
ylab("Абсолютная частота")+
xlab("Расстояние до метро (в метрах)")+
ggtitle("Гистограмма распределения расстояния до метро")
Нетрудно заметить, что сдаваемые квартиры (исходя из информации из объявлений) чаще всего находятся совсем рядом с метро (в пределах 100 метров)
График плотности распределения
ggplot(data_dist)+geom_density(aes(x= Dist_metro_ad))+
ggtitle("График эмпирической плотности распределения")+
ylab("")+
xlab("расстояние до метро (в метрах)")+
geom_vline(xintercept = mean(data_dist$Dist_metro_ad), color = 2, linetype = "dashed")+
annotate("text", x = 990, y = 0.0002, label = " Среднее", color = 2)+
geom_vline(xintercept = mode(data_dist$Dist_metro_ad), color = 3, linetype = "dashed")+
annotate("text", x = 110, y = 0.0002, label = "Мода", color = 3)+
geom_vline(xintercept = median(data_dist$Dist_metro_ad), color = 7, linetype = "dashed")+
annotate("text", x = median(data_dist$Dist_metro_ad), y = 0.0004, label = "Медиана", color = 7)
Price - цена аренды (руб/мес)
Проведем предварительный анализ с помощью summary(), гистограммы и функции плотности:
ggplot(data) +geom_histogram(aes(x = Price/1000), binwidth = 25)+
ggtitle("Гистограмма")+
xlab("Цена аренды в тыс. руб")+
ylab("Абсолютная частота")
ggplot(data)+geom_density(aes(x= Price/1000))+
ggtitle("График эмпирической плотности распределения цены")+
ylab("")+
xlab("Цена аренды в тыс. руб")
Сразу отметим, что квартир с ценой аренды больше 200 тыс. руб. очень мало в выборке, а основная доля приходится на квартиры с ценой аренды меньше 100 тыс. руб.
summary(data$Price)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10 22000 30000 45505 50000 690000
Отметим, что цена указана во всех объявлениях (нет пропущенных значений). Меры центральности и квартили кажутся вполне корректными, Обратим внимание на минимальное значение - 10 руб/месяц - скорее всего ошибка в данных. Посмотрим, какие квартиры сдаются меньше чем за 10000 руб/мес.
datatable(data %>% select(Address, Rooms, Price, Area_total) %>% filter(Price <10000))
Таких квартир всего 16. При этом, если значение меньше 100, то вполне очевидно, что цена просто указана в тысячах рублей - преобразуем ее в стандартный для выборки вид.
Что касается остальных наблюдений, квартира в деревне Жабино вполне может сдаваться за 8000 рублей, а вот 3-комнатная квартира на Мойке вряд ли будет стоить 5500 руб/мес. То же самое можно сказать и об остальных подозрительно дешевых квартирах в черте города. Трудно точно утверждать, какого именно типа эти ошибка - не хватает ли нулей в цене или, возможно, в выборке оказались данные о посуточной аренде, поэтому в последующем лучше просто удалим их из выборки (оставив данные по квартирам в Жабино и Репино, которым, кажется, можно доверять).
data$Price = ifelse(data$Price<100,data$Price*1000, data$Price)
data = data %>% filter(data$Price>=8000)
Наконец, посмотрим на распределение переменной с помощью barplot:
ggplot(data) +
geom_boxplot(aes(y = Price/1000))+
scale_x_discrete("")+
ylab("Цена в тысячах рублей")+
ggtitle("Распределение цены аренды в выборке")
Видно, что верхняя граница статистически значимых данных ~ 100 тыс. руб./мес. Посмотрим на большие значения и поймем, есть ли в них возможные ошибки:
datatable(data %>% select(Address, Rooms, Price, Area_total) %>% filter(Price >400000))
В выборке всего восемь наблюдений с ценой больше 400000 руб/месяц - квартиры, в элитных жилых комплексах, площадью не меньше 160 кв.м. Это нормальные для рынка элитного жилья цены - потенциальных ошибок не обнаружено.
Выше, исходя из данных boxplot мы назвали наблюдения, у которых указана цена более 100 тыс.руб. статистически незначимыми.Их доля в выборке составляет ‘r a’
Построим таблицу с описательными статистиками и графики без учета этих значений. И для удобства укажем цены в тысячах рублей.
data_price = data %>% filter(Price<100000)
data_price$Price = data_price$Price/1000
price_stat= describe(data_price$Price) %>% select(-vars, -n, -sd, -trimmed, -mad, -se)%>% rename(assimetria = skew) %>% mutate(firstQu = quantile(data_price$Price,0.25)) %>% mutate(thirdQu = quantile(data_price$Price,0.75)) %>% mutate(moda = mode(data_price$Price))%>% mutate(sko = sd(data_price$Price)) %>% mutate_all(round,3)
kable(price_stat, row.names = F, caption = "Описательные статистики для цены аренды в выборке")
| mean | median | min | max | range | assimetria | kurtosis | firstQu | thirdQu | moda | sko |
|---|---|---|---|---|---|---|---|---|---|---|
| 34.894 | 28 | 8 | 99 | 91 | 1.238 | 0.807 | 21 | 45 | 21.502 | 18.501 |
Среднее и медианное значения теперь отличаются в меньшей степени. Распределение все еще скошено вправо, “острота пика” не так сильно выражена.
Гистограмма
ggplot(data_price) +geom_histogram(aes(x = Price), binwidth = 5, fill = 19)+
ylab("Абсолютная частота")+
xlab("Цена аренды (тыс. руб/мес)")+
ggtitle("Гистограмма распределения цены аренды")
График эмпирической плотности распределения
ggplot(data_price)+geom_density(aes(x = Price))+
ggtitle("График эмпирической плотности распределения")+
ylab("")+
xlab("Цена аренды (тыс. руб/мес)")+
geom_vline(xintercept = mean(data_price$Price), color = 2, linetype = "dashed")+
annotate("text", x = mean(data_price$Price), y = 0.02, label = " Среднее", color = 2)+
geom_vline(xintercept = mode(data_price$Price), color = 3, linetype = "dashed")+
annotate("text", x = mode(data_price$Price), y = 0.02, label = "Мода", color = 3)+
geom_vline(xintercept = median(data_price$Price), color = 7, linetype = "dashed")+
annotate("text", x = median(data_price$Price), y = 0.03, label = "Медиана", color = 7)