Importiamo le librerie utili per lo svolgimento del progetto
#Importiamo le librerie
library(ggplot2)
library(dplyr)
library(moments)
library(stringr)
Procediamo, dunque, con l’importare il dataset e osserviamo le prime righe
texas <- read.csv("Real Estate Texas.csv")
head(texas, 5)
## city year month sales volume median_price listings months_inventory
## 1 Beaumont 2010 1 83 14.162 163800 1533 9.5
## 2 Beaumont 2010 2 108 17.690 138200 1586 10.0
## 3 Beaumont 2010 3 182 28.701 122400 1689 10.6
## 4 Beaumont 2010 4 200 26.819 123200 1708 10.6
## 5 Beaumont 2010 5 202 28.833 123100 1771 10.9
Tipologia delle variabili - Qualitativa nominale: city - Quantitative discrete: sales, listings - Quantitative continue: volume, median_price, months_inventory - Variabili temporali: year, month
Implicazione statistica: - analisi di confronto delle variabili (prezzi, volume ecc..) delle diverse città nel medesimo periodo - analisi temporale delle varibili (year/month)
v.coeff <- function(x){return(sd(x)/mean(x)*100)}
Creiamo una tabella per raccogliere gli indici statistici:
attach(texas)
texas.colnames <- colnames(texas)[4:8]
indexes <- c("min", "1st quartile", "mediana", "3rd quartile", "max", "range",
"IQR", "media", "deviazione standard", "coeff. variazione",
"asimmetria", "curtosi")
indexes.df <- data.frame(matrix(nrow = 0, ncol = length(indexes)))
colnames(indexes.df) <- indexes
for (obj.name in texas.colnames) {
obj <- pull(texas, obj.name)
quartili <- as.numeric(quantile(obj))
df <- texas %>%
summarise(range = max(obj) - min(obj),
IQR = IQR(obj),
mean = mean(obj),
sd = sd(obj),
var.coeff = v.coeff(obj),
skewness = skewness(obj),
kurtosis = kurtosis(obj) - 3)
row <- c(quartili, as.numeric(df))
indexes.df <- rbind(indexes.df, row)}
indexes.df <- cbind(texas.colnames, indexes.df)
colnames(indexes.df)[1] <- "variabile"
indexes.df
## variabile X79 X127 X175.5 X247 X423
## 1 sales 79.000 127.0000 175.5000 247.000 423.000
## 2 volume 8.166 17.6595 27.0625 40.893 83.547
## 3 median_price 73800.000 117300.0000 134500.0000 150050.000 180000.000
## 4 listings 743.000 1026.5000 1618.5000 2056.000 3296.000
## 5 months_inventory 3.400 7.8000 8.9500 10.950 14.900
## X344 X120 X192.291666666667 X79.6511111777793 X41.4220296482492
## 1 344.000 120.0000 192.29167 79.651111 41.42203
## 2 75.381 23.2335 31.00519 16.651447 53.70536
## 3 106200.000 32750.0000 132665.41667 22662.148687 17.08218
## 4 2553.000 1029.5000 1738.02083 752.707756 43.30833
## 5 11.500 3.1500 9.19250 2.303669 25.06031
## X0.718104024884959 X.0.313176409071494
## 1 0.71810402 -0.3131764
## 2 0.88474203 0.1769870
## 3 -0.36455288 -0.6229618
## 4 0.64949823 -0.7917900
## 5 0.04097527 -0.1744475
Considerazioni preliminari: - volume: massima variabilità (CV elevato): forte eterogeneità tra osservazioni - volume: kurtosi positiva (leptocurtica): presenza di code pesanti e outlier - altre variabili: kurtosi negativa (platicurtiche):distribuzioni più piatte della normale - median_price: asimmetria negativa: presenza di valori bassi influenti - altre variabili: asimmetria positiva:presenza di valori estremi elevati - volume: skewness massima:distribuzione fortemente sbilanciata
N <- nrow(texas)
ni <- table(texas$city)
fi <- ni / N
city_freq_distr <- cbind(ni, fi)
city_freq_distr
## ni fi
## Beaumont 60 0.25
## Bryan-College Station 60 0.25
## Tyler 60 0.25
## Wichita Falls 60 0.25
La tabella mostra che la distribuzione è uniforme tra le città.Poichè le osservazioni sono distribuite uniformemente sulle 4 categorie, ci si aspetta che l’indice di Gini per ‘city’ sia 1.
Calcoliamo l’indice di Gini:
gini.index <- function(x){
J <- length(table(x))
fi2 <- (table(x) / length(x))^2
G <- 1 - sum(fi2)
gini <- G / ((J - 1) / J)
print("L'indice di Gini è:")
return(gini)}
gini.index(texas$city)
## [1] "L'indice di Gini è:"
## [1] 1
Difatti l’indice GINI è 1
volume_classes <- cut(texas$volume,
breaks = seq(min(texas$volume),
max(texas$volume),
length.out = 16))
ni <- table(volume_classes)
fi <- ni / N
Ni <- cumsum(ni)
Fi <- Ni / N
volume_freq_distr <- as.data.frame(cbind(ni, fi, Ni, Fi))
volume_freq_distr
## ni fi Ni Fi
## (8.17,13.2] 24 0.100000000 24 0.1000000
## (13.2,18.2] 42 0.175000000 66 0.2750000
## (18.2,23.2] 26 0.108333333 92 0.3833333
## (23.2,28.3] 30 0.125000000 122 0.5083333
## (28.3,33.3] 27 0.112500000 149 0.6208333
## (33.3,38.3] 22 0.091666667 171 0.7125000
## (38.3,43.3] 17 0.070833333 188 0.7833333
## (43.3,48.4] 9 0.037500000 197 0.8208333
## (48.4,53.4] 17 0.070833333 214 0.8916667
## (53.4,58.4] 5 0.020833333 219 0.9125000
## (58.4,63.4] 7 0.029166667 226 0.9416667
## (63.4,68.5] 5 0.020833333 231 0.9625000
## (68.5,73.5] 4 0.016666667 235 0.9791667
## (73.5,78.5] 2 0.008333333 237 0.9875000
## (78.5,83.5] 2 0.008333333 239 0.9958333
gini.index(volume_classes)
## [1] "L'indice di Gini è:"
## [1] 0.9614769
Plottiamo la distribuzione delle freuenze di Volume_class con un istogramma
barplot(ni,
xlab = "",
ylab = "",
ylim = c(0,50),
main = "Volume classes frequencies",
col = "blue",
space = 0.1,
names.arg = names(ni),
las = 2)
Beaumont_ext = filter(texas, city == "Beaumont")
Beaumont_N = dim(Beaumont_ext)[1]
Beaumont_prob = Beaumont_N/N*100
cat("Probabilità per città di Beaumont: ", round(Beaumont_prob,2),"%\n")
## Probabilità per città di Beaumont: 25 %
July_ext = filter(texas, month == 7)
July_N = dim(July_ext)[1]
July_prob = July_N/N*100
cat("Probabilità per mese luglio tutti gli anni: ", round(July_prob,2),"%\n")
## Probabilità per mese luglio tutti gli anni: 8.33 %
Dec12_ext = filter(texas, year == 2012, month == 12)
Dec12_N = dim(Dec12_ext)[1]
Dec12_prob = Dec12_N/N
cat("Probabilità per mese di dicembre 2012: ", round(Dec12_prob,2),"%\n")
## Probabilità per mese di dicembre 2012: 0.02 %
avg_price <- (texas$volume * 1000000) / texas$sales
sales_eff <- texas$sales / texas$listings
texas_complete <- cbind(texas, avg_price, sales_eff)
head(texas_complete)
## city year month sales volume median_price listings months_inventory
## 1 Beaumont 2010 1 83 14.162 163800 1533 9.5
## 2 Beaumont 2010 2 108 17.690 138200 1586 10.0
## 3 Beaumont 2010 3 182 28.701 122400 1689 10.6
## 4 Beaumont 2010 4 200 26.819 123200 1708 10.6
## 5 Beaumont 2010 5 202 28.833 123100 1771 10.9
## 6 Beaumont 2010 6 189 27.219 122800 1803 11.1
## avg_price sales_eff
## 1 170626.5 0.05414220
## 2 163796.3 0.06809584
## 3 157697.8 0.10775607
## 4 134095.0 0.11709602
## 5 142737.6 0.11405985
## 6 144015.9 0.10482529
Per sales_eff pari a 1 l’efficienca è massima. I valori maggiori (0.29,0.33 e 0.39) si ottengono per: -2014 -Bryan-College Station -Summer (June,July;August)
texas_complete[order(-texas_complete$sales_eff), ][1:3, ]
## city year month sales volume median_price listings
## 115 Bryan-College Station 2014 7 403 83.547 172600 1041
## 114 Bryan-College Station 2014 6 377 77.983 169600 1152
## 116 Bryan-College Station 2014 8 298 60.639 172200 1016
## months_inventory avg_price sales_eff
## 115 4.1 207312.7 0.3871278
## 114 4.5 206851.5 0.3272569
## 116 4.0 203486.6 0.2933071
city_stats_sales_eff <-texas_complete %>%
group_by(city) %>%
summarise(year = 2014, avg_sales_eff = mean(sales_eff),
std_sales_eff = sd(sales_eff))
print(city_stats_sales_eff)
## # A tibble: 4 × 4
## city year avg_sales_eff std_sales_eff
## <chr> <dbl> <dbl> <dbl>
## 1 Beaumont 2014 0.106 0.0267
## 2 Bryan-College Station 2014 0.147 0.0729
## 3 Tyler 2014 0.0935 0.0235
## 4 Wichita Falls 2014 0.128 0.0247
ggplot(city_stats_sales_eff, aes(x = reorder(city, avg_sales_eff), y = avg_sales_eff)) +
geom_pointrange(aes(ymin = avg_sales_eff - std_sales_eff,ymax = avg_sales_eff + std_sales_eff)) +
coord_flip() +
labs(x = "City",y = "Average sales_eff",title = "Mean sales_eff ± standard deviation by city") +
theme_minimal()
- Analisi condizionata per sales: “Tyler” è la città con più vendite in
assoluto.
city_stats_sales <- texas_complete %>%
group_by(city) %>%
summarise(avg_sales = mean(sales),
std_sales = sd(sales))
print(city_stats_sales)
## # A tibble: 4 × 3
## city avg_sales std_sales
## <chr> <dbl> <dbl>
## 1 Beaumont 177. 41.5
## 2 Bryan-College Station 206. 85.0
## 3 Tyler 270. 62.0
## 4 Wichita Falls 116. 22.2
ggplot(city_stats_sales, aes(x = reorder(city, avg_sales), y = avg_sales)) +
geom_pointrange(aes(ymin = avg_sales - std_sales,ymax = avg_sales + std_sales)) +
coord_flip() +
labs(x = "City",y = "Average sales",title = "Mean sales ± standard deviation by city") +
theme_minimal()
BoxPlot di Median_price per città: “Tyler” e “Bryan College Station” presentano la mediana più elevata. “Wichita Falls” presenta la mediana più bassa del valore totale delle vendite. Inoltre, mostra una variabilità molto ridotta, risultando pressoché costante rispetto alle altre città.
ggplot(texas_complete) +
geom_boxplot(aes(x = median_price / 1000, y = city)) +
labs(x = "Median Price (k$)", y = "City")
BoxPlot di sales per città e divisi per i diversi anni
ggplot(texas_complete, aes(x = volume, y = city, fill = factor(year))) +
geom_boxplot() +
scale_fill_manual(values = c("lightblue", "lightblue1", "lightblue2", "lightblue3", "lightblue4")) +
labs(
x = "Total value of sales (M$)",
y = "City",
title = "Total value of sales per year"
) +
theme_minimal()
Applicazione di un istogramma delle vendite totali suddivise per mese
(in ascissa) e per città, in valore assoluto prima e normalizzato
dopo.
cities = unique(city)
ggplot(texas_complete, aes(x = month.abb[month], y = volume, fill = city)) +
geom_col() +
facet_wrap(~year, nrow = 1) +
scale_x_discrete(guide = guide_axis(angle = 90)) +
scale_fill_discrete(name = "City", labels = cities) +
labs(x = "Month",
y = "Total value of sales (M$)",
title = "Total value of sales per month") +
theme_minimal() +
theme(legend.position = "bottom",
plot.title = element_text(hjust = 0.5),
axis.text.x = element_text(size = 6))
ggplot(texas_complete, aes(x = month.abb[month], y = volume, fill = city)) +
geom_col(position = "fill") +
facet_wrap(~year, nrow = 1) +
scale_x_discrete(guide = guide_axis(angle = 90)) +
scale_fill_discrete(name = "City", labels = cities) +
labs(x = "Month",
y = "Total value of sales (M$)",
title = "Total value of sales per month") +
theme_minimal() +
theme(legend.position = "bottom")
Il valore totale delle vendite negli anni è in aumento negli
principalmente grazie al contributo delle vendite totali di “Tyler” e
del “median_price” di “Bryan-College Station”
Mostriamo i prezzi con un grafico a linee suddivise per città per mostrare lo stesso risultato. Si mostra come “median_price” rimane pressochè costante in “Beaumont” negli anni, mentre aumenta in “Bryan-College Station” e “Tyler” (e lievemente in “Wichita Falls”), come visto prima.
ggplot(texas_complete, aes(x = factor(month.abb[month], levels = month.abb),y = median_price / 1000, group = city,color = city)) +
geom_line(linewidth = 1) +
facet_wrap(~year, nrow = 1) +
scale_x_discrete(guide = guide_axis(angle = 90)) +
scale_color_discrete(name = "City") +
labs(x = "Month",y = "Median sale price (k$)", title = "Median sale price per month") +
theme_minimal() +
theme(legend.position = "bottom")
ggplot(texas_complete, aes(x = factor(month.abb[month], levels = month.abb),y = sales,group = city,color = city)) +
geom_line(linewidth = 1) +
facet_wrap(~year, nrow = 1) +
scale_x_discrete(guide = guide_axis(angle = 90)) +
scale_color_discrete(name = "City") +
labs(x = "Month",y = "Sales",title = "Sales per month") +
theme_minimal() +
theme(legend.position = "bottom")
Conclusioni
L’analisi del mercato immobiliare del Texas evidenzia forti differenze tra le città. Il volume delle vendite è molto variabile, mentre il prezzo mediano è più stabile ma differisce chiaramente tra le zone, con Bryan-College Station ai livelli più alti e Wichita Falls ai più bassi. L’efficienza del mercato varia nel tempo e tra città: Bryan-College Station e Tyler risultano le più dinamiche, soprattutto nel 2014, mentre Wichita Falls è la meno attiva e più stabile. Nel tempo, sia vendite sia prezzi mostrano un trend crescente, guidato soprattutto da Tyler e Bryan-College Station. Inoltre, emerge una stagionalità, con maggiore attività nei mesi estivi. In generale, il mercato immobiliare texano è eterogeneo e diseguale, con crescita concentrata in poche città e forte variabilità tra aree.