title: ‘Analiza danych’ subtitle: ‘Analiza opisowa’ author:
“Aleksandra Kucińska” date: “2023-01-07”
Twoja kolej!
Na podstawie danych dot. rynku nieruchomości z pewnego regionu USA,
dokonaj podobnej analizy opisowej.
#Zobaczmy, jakie mamy zmienne: #DATA WRANGLING
glimpse(houses)
## Rows: 506
## Columns: 14
## $ crim <dbl> 0.00632, 0.02731, 0.02729, 0.03237, 0.06905, 0.02985, 0.08829,…
## $ zn <dbl> 18.0, 0.0, 0.0, 0.0, 0.0, 0.0, 12.5, 12.5, 12.5, 12.5, 12.5, 1…
## $ indus <dbl> 2.31, 7.07, 7.07, 2.18, 2.18, 2.18, 7.87, 7.87, 7.87, 7.87, 7.…
## $ chas <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ nox <dbl> 0.538, 0.469, 0.469, 0.458, 0.458, 0.458, 0.524, 0.524, 0.524,…
## $ rm <dbl> 6.575, 6.421, 7.185, 6.998, 7.147, 6.430, 6.012, 6.172, 5.631,…
## $ age <dbl> 65.2, 78.9, 61.1, 45.8, 54.2, 58.7, 66.6, 96.1, 100.0, 85.9, 9…
## $ dis <dbl> 4.0900, 4.9671, 4.9671, 6.0622, 6.0622, 6.0622, 5.5605, 5.9505…
## $ rad <int> 1, 2, 2, 3, 3, 3, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4,…
## $ tax <int> 296, 242, 242, 222, 222, 222, 311, 311, 311, 311, 311, 311, 31…
## $ ptratio <dbl> 15.3, 17.8, 17.8, 18.7, 18.7, 18.7, 15.2, 15.2, 15.2, 15.2, 15…
## $ black <dbl> 396.90, 396.90, 392.83, 394.63, 396.90, 394.12, 395.60, 396.90…
## $ lstat <dbl> 4.98, 9.14, 4.03, 2.94, 5.33, 5.21, 12.43, 19.15, 29.93, 17.10…
## $ medv <dbl> 24.0, 21.6, 34.7, 33.4, 36.2, 28.7, 22.9, 27.1, 16.5, 18.9, 15…
Nasz zbiór danych zawiera informacje o losowej próbie nieruchomości i
różnych cechach dla ich sąsiedztwa.
Ta ramka danych ma 506 wierszy i 14 kolumn (predyktorów). Mamy opisy
i podsumowania predyktorów jak poniżej: - crim: wskaźnik przestępczości
na mieszkańca według miasta. - zn: proporcja gruntów mieszkalnych
przeznaczonych na działki powyżej 25 000 stóp kwadratowych. - indus:
proporcja akrów biznesu niedetalicznego na miasto. - chas: zmienna dummy
river (= 1, jeśli działka graniczy z rzeką; 0 w przeciwnym razie). -
nox: stężenie tlenków azotu (cząsteczek na 10 milionów). - rm: średnia
liczba pokoi na mieszkanie. - age: odsetek mieszkań zamieszkanych przez
właścicieli zbudowanych przed 1940 rokiem. - dis: średnia ważona
odległości do miejskich centrów zatrudnienia. - rad: indeks dostępności
do autostrad radialnych. - tax: stawka podatku od nieruchomości o pełnej
wartości za 10 000 USD. - ptratio: współczynnik uczeń-nauczyciel według
miasta. - black: 1000(Bk - 0.63)^2 gdzie Bk jest odsetkiem czarnoskórych
w danym mieście. - lstat: status populacji poniżej progu ubóstwa
(procent). - medv: mediana wartości domów zamieszkałych przez
właścicieli w 1000$.
#DATA WRANGLING
houses$chas<-as.factor(houses$chas)
houses$rad<-as.factor(houses$rad)
houses$rm<-factor(houses$rm,ordered=TRUE)
attach(houses)
etykiety<-c("5-10","10-15 k$","15-20k$","20-25k$","25-30k$","30-35k$","35-40k$","40-45k$","45-50k$")
limits<-cut(houses$medv,seq(5, 50,by=5), labels=etykiety)
tabela1<-freq(limits,type="html")
##
|
| | 0%
|
|======================================================================| 100%
kbl(tabela1,caption = "Nieruchomości w USA - ceny w 1000$") %>%
kable_material(c("striped", "hover"))
Nieruchomości w USA - ceny w 1000$
|
|
x
|
label
|
Freq
|
Percent
|
Valid Percent
|
Cumulative Percent
|
|
Valid
|
5-10
|
|
22
|
4.3
|
4.4
|
4.4
|
|
|
10-15 k$
|
|
73
|
14.4
|
14.5
|
18.8
|
|
|
15-20k$
|
|
118
|
23.3
|
23.4
|
42.3
|
|
|
20-25k$
|
|
167
|
33.0
|
33.1
|
75.4
|
|
|
25-30k$
|
|
40
|
7.9
|
7.9
|
83.3
|
|
|
30-35k$
|
|
36
|
7.1
|
7.1
|
90.5
|
|
|
35-40k$
|
|
17
|
3.4
|
3.4
|
93.8
|
|
|
40-45k$
|
|
9
|
1.8
|
1.8
|
95.6
|
|
|
45-50k$
|
|
22
|
4.3
|
4.4
|
100.0
|
|
|
Total
|
|
504
|
99.6
|
100.0
|
|
|
Missing
|
<blank>
|
|
0
|
0.0
|
|
|
|
|
<NA>
|
|
2
|
0.4
|
|
|
|
|
Total
|
|
506
|
100.0
|
|
|
tab1<-classIntervals(houses$medv,n=8,style="fixed",fixedBreaks=seq(5, 50,by=5))
jenks.tests(tab1)
## # classes Goodness of fit Tabular accuracy
## 9.0000000 0.9760087 0.8179821
Jak widzimy - wskaźnik TAI jest dość wysoki. 0,82 oznacza, że możemy
zaakceptować zaproponowaną konstrukcję tablicy częstości.
##Podstawowe wykresy
hist(medv, breaks="FD", col="green", probability = TRUE,
main="Ceny domów w USA według kryterium dostępu do rzeki")
lines(density(medv[chas=="0"]),col=2)
lines(density(medv[chas=="1"]),col=3)
legend("topright", legend=c("brak dostepu do rzeki", "dostep do rzeki"),
col=c(2,3), lty=1:2, horiz=FALSE, box.lty=0, cex=0.8)
# Density plot of "medv $"
#::::::::::::::::::::::::::::::::::::::
density.p <- ggdensity(houses, x = "medv",
fill = "chas", palette = "jco")+
stat_overlay_normal_density(color = "red", linetype = "dashed")
# Liczymy statystyki wg dostepu:
stable <- desc_statby(houses, measure.var = "medv",
grps = "chas")
stable <- stable[, c("chas", "length", "mean", "sd")]
# Wykres, szablon "medium orange":
stable.p <- ggtexttable(stable, rows = NULL,
theme = ttheme("mOrange"))
# Podpisujemy wykres:
#::::::::::::::::::::::::::::::::::::::
text <- paste("mediana wartości domów zamieszkałych przez właścicieli w 1000$ wedlug dostepu do rzeki",
"Losowa próba 506 domow.",
sep = " ")
text.p <- ggparagraph(text = text, face = "italic", size = 11, color = "black")
# Aranżujemy wykresy na tym samym panelu:
ggarrange(density.p, stable.p, text.p,
ncol = 1, nrow = 3,
heights = c(1, 0.5, 0.3))
plot1 <- ggplot(houses, aes(crim, lstat)) +
geom_abline() +
geom_jitter(width = 0.2, height = 0.2) +
ggtitle("Wskaźnik przestępczości w zależności od status populacji poniżej \nprogu ubóstwa dla obszarów \ngranicznych z rzeka - 1, w przeciwnym wypadku 0") +
theme(plot.title = element_text(hjust = 0.5))
plot1 + facet_wrap(~chas)
ggplot(houses, aes(x=rad, y=medv)) +
geom_boxplot(alpha=0.7) +
stat_summary(fun="mean", geom="point", shape=20, size=5, color="red", fill="red") +
geom_jitter() +
facet_grid(~chas) +
scale_fill_brewer(palette="Set1")
plot1 <- ggplot(houses, aes(medv, chas)) +
geom_abline() +
geom_jitter(width = 0.1, height = 0.1)
plot1 + facet_wrap(~rad)
library(psych)
raport <-
list("mediana wartości domów" =
list("Min" = ~ min(medv),
"Max" = ~ max(medv),
"Q1" = ~ quantile(medv,0.25),
"Mediana" = ~ round(median(medv),2),
"Q3" = ~ quantile(medv,0.75),
"Mean" = ~ round(mean(medv),2),
"Odch. std." = ~ round(sd(medv),2),
"IQR" = ~ round(iqr(medv),2),
"Sx" = ~ round(iqr(medv)/2,2),
"Var %" = ~ round((sd(medv)/mean(medv)),2),
"IQR Var %" = ~ round((iqr(medv)/median(medv)),2),
"Skośność" = ~ round(skew(medv),2),
"Kurtoza" = ~ round(kurtosi(medv),2)
))
tabela<-summary_table(houses, summaries = raport, by = c("rad"))
kbl(tabela,
digits = 2,
caption="Tabela 1. Mediana wartości domów zamieszkałych przez właścicieli w 1000$ przy grupowaniu według indeksu dostępności do autostrad radialnych",
col.names = c('1', '2', '3', '4','5','6','7','8','24'))%>%
kable_classic(full_width = F, html_font = "Cambria")%>%
kable_styling(bootstrap_options = c("striped", "hover"))
Tabela 1. Mediana wartości domów zamieszkałych przez właścicieli w 1000$
przy grupowaniu według indeksu dostępności do autostrad radialnych
|
|
1
|
2
|
3
|
4
|
5
|
6
|
7
|
8
|
24
|
|
Min
|
11.90
|
15.70
|
14.40
|
7.00
|
11.80
|
16.80
|
17.60
|
16.00
|
5.00
|
|
Max
|
50.00
|
43.80
|
50.00
|
50.00
|
50.00
|
24.80
|
42.80
|
50.00
|
50.00
|
|
Q1
|
20.48
|
21.40
|
21.12
|
17.58
|
19.50
|
18.90
|
24.30
|
23.82
|
11.23
|
|
Mediana
|
22.20
|
23.85
|
26.50
|
20.45
|
23.00
|
21.20
|
26.20
|
28.25
|
14.40
|
|
Q3
|
27.23
|
33.23
|
34.52
|
23.65
|
30.00
|
23.03
|
29.60
|
33.17
|
19.90
|
|
Mean
|
24.37
|
26.83
|
27.93
|
21.39
|
25.71
|
20.98
|
27.11
|
30.36
|
16.40
|
|
Odch. std.
|
8.02
|
7.87
|
8.32
|
6.96
|
9.33
|
2.31
|
6.49
|
9.73
|
8.54
|
|
IQR
|
6.75
|
11.83
|
13.40
|
6.07
|
10.50
|
4.12
|
5.30
|
9.35
|
8.67
|
|
Sx
|
3.38
|
5.91
|
6.70
|
3.04
|
5.25
|
2.06
|
2.65
|
4.67
|
4.34
|
|
Var %
|
0.33
|
0.29
|
0.30
|
0.33
|
0.36
|
0.11
|
0.24
|
0.32
|
0.52
|
|
IQR Var %
|
0.30
|
0.50
|
0.51
|
0.30
|
0.46
|
0.19
|
0.20
|
0.33
|
0.60
|
|
Skośność
|
1.47
|
0.65
|
0.49
|
1.77
|
1.21
|
-0.06
|
0.66
|
0.65
|
2.22
|
|
Kurtoza
|
2.73
|
-0.76
|
-0.44
|
5.38
|
0.79
|
-1.35
|
-0.14
|
-0.77
|
6.46
|
|