Importare le librerie
library(dplyr)
library(knitr)
library(moments)
library(ggplot2)
dati_texas <- read.csv("realestate_texas.csv",sep=",")
attach(dati_texas)
kable(sapply(dati_texas, class))
x | |
---|---|
city | character |
year | integer |
month | integer |
sales | integer |
volume | numeric |
median_price | numeric |
listings | integer |
months_inventory | numeric |
Il dataset contiene le seguenti variabili:
1. city (categorica): città in Texas
2. year (discreta ordinale): anno di riferimento
3. month (categorica ordinale): mese di riferimento
4. sales (discreta): numero totale di vendite
5. volume (continua): valore totale delle vendite in milioni di
dollari
6. median_price (continua): prezzo mediano di vendita in dollari
7. listings (discreta): numero totale di annunci attivi
8. months_inventory (continua): tempo necessario per vendere tutte le
inserzioni al ritmo attuale, in mesi
Il dataset contiene le seguenti variabili temporali “city”, “year” e
“month” di cui non ha senso valutare indici statistici, per questo
motivo in questa prima fase sono stati rimossi dal data frame attraverso
il comando:
dati_filtered <- dati_texas[,!names(dati_texas) %in% c("city", "year", "month")]
kable(summary(dati_filtered))
sales | volume | median_price | listings | months_inventory | |
---|---|---|---|---|---|
Min. : 79.0 | Min. : 8.166 | Min. : 73800 | Min. : 743 | Min. : 3.400 | |
1st Qu.:127.0 | 1st Qu.:17.660 | 1st Qu.:117300 | 1st Qu.:1026 | 1st Qu.: 7.800 | |
Median :175.5 | Median :27.062 | Median :134500 | Median :1618 | Median : 8.950 | |
Mean :192.3 | Mean :31.005 | Mean :132665 | Mean :1738 | Mean : 9.193 | |
3rd Qu.:247.0 | 3rd Qu.:40.893 | 3rd Qu.:150050 | 3rd Qu.:2056 | 3rd Qu.:10.950 | |
Max. :423.0 | Max. :83.547 | Max. :180000 | Max. :3296 | Max. :14.900 |
Dalla tabella è possibile osservare che per:
1. Sales (Vendite):
* La distribuzione è asimmetrica positivamente, con media (192.3) >
mediana (175.5)
* C’è una notevole variabilità, con vendite che vanno da un minimo di 79
a un massimo di 423
* Il 50% centrale dei dati si trova tra 127 (Q1) e 247 (Q3), indicando
una discreta dispersione
* La deviazione standard di 79.7 suggerisce una significativa
variabilità nelle vendite
2. Volume (in milioni di dollari):
* Anche questa variabile mostra asimmetria positiva (media 31.005 >
mediana 27.062)
* Il range è molto ampio, da 8.166 a 83.547 milioni
* La deviazione standard di 16.652 indica una forte variabilità nei
volumi di vendita
3. Median_Price (Prezzo mediano):
* La distribuzione appare più simmetrica, con media (132665) e mediana
(134500) molto vicine
* I prezzi variano da 73800 a 180000 dollari
* Il 50% centrale dei prezzi si trova tra 117300 e 150050 dollari
4. Listings (Annunci):
* Mostra asimmetria positiva (media 1738 > mediana 1618)
* Il numero di annunci varia notevolmente, da 743 a 3296
* La deviazione standard di 753 indica una significativa variabilità nel
numero di annunci
5. Month_inventory (Mesi di inventario):
* Leggera asimmetria positiva (media 9.193 > mediana 8.950)
* Varia da 3.4 a 14.9 mesi
* La deviazione standard relativamente bassa (2.305) suggerisce una
minore variabilità rispetto alle altre misure
Per valutare la variazione tra i diversi parametri e l’asimmetricità degli stessi è stata applicata la funzione per il calcolo del coefficiente di variazione e attraverso la libreria moments il calcolo dello skeweness.
var_sales <- var(sales)
var_volume <- var(volume)
var_median_price <- var(median_price)
var_listings <- var(listings)
var_months_inventory <- var(months_inventory)
sd_sales <- sd(sales)
sd_volume <- sd(volume)
sd_median_price <- sd(median_price)
sd_listings <- sd(listings)
sd_months_inventory <- sd(months_inventory)
CV <- function(x) {
return(sd(x) / mean(x) * 100)
}
cv_sales <- CV(sales)
cv_volume <- CV(volume)
cv_median_price <- CV(median_price)
cv_listings <- CV(listings)
cv_months_inventory <- CV(months_inventory)
skew_sales <- skewness(sales)
skew_volume <- skewness(volume)
skew_median_price <- skewness(median_price)
skew_listings <- skewness(listings)
skew_months_inventory <- skewness(months_inventory)
stats_df <- data.frame(
Variabile = c("Sales", "Volume", "Median_Price", "Listings", "Months_Inventory"),
Varianza = round(c(var_sales, var_volume, var_median_price, var_listings, var_months_inventory), 2),
Deviazione_Standard = round(c(sd_sales, sd_volume, sd_median_price, sd_listings, sd_months_inventory), 2),
Coefficiente_Variabilità = round(c(cv_sales, cv_volume, cv_median_price, cv_listings, cv_months_inventory), 2),
Asimmetria = round(c(skew_sales, skew_volume, skew_median_price, skew_listings, skew_months_inventory), 2)
)
kable(stats_df, caption = "Statistiche di Varianza, Deviazione Standard, Coefficiente di Variazione e Asimmetria")
Variabile | Varianza | Deviazione_Standard | Coefficiente_Variabilità | Asimmetria |
---|---|---|---|---|
Sales | 6.34430e+03 | 79.65 | 41.42 | 0.72 |
Volume | 2.77270e+02 | 16.65 | 53.71 | 0.88 |
Median_Price | 5.13573e+08 | 22662.15 | 17.08 | -0.36 |
Listings | 5.66569e+05 | 752.71 | 43.31 | 0.65 |
Months_Inventory | 5.31000e+00 | 2.30 | 25.06 | 0.04 |
La tabella mostra per:
1. Coefficiente di Variazione (CV):
* Il Volume ha il CV più alto (53.71%), indicando la maggiore
variabilità relativa
* Median_Price ha il CV più basso (17.08%), suggerendo la minore
dispersione relativa
* Sales, Listings e Month_inventory mostrano una variabilità relativa
intermedia
2. Skewness (Asimmetria):
* Median_Price è l’unica variabile con asimmetria negativa (-0.36),
indicando una coda più lunga verso i valori bassi
* Volume ha la maggiore asimmetria positiva (0.88), suggerendo una
significativa coda verso i valori alti
* Month_inventory è quasi simmetrica (0.04), molto vicina allo
zero
* Sales e Listings mostrano asimmetria positiva moderata
N <- nrow(dati_texas)
freq_ass_city <- table(dati_texas$city)
freq_rel_city <- round(freq_ass_city / N, 2)
distr_freq_city <- cbind(Frequenza_Assoluta = freq_ass_city, Frequenza_Relativa = freq_rel_city)
kable(distr_freq_city, caption = "Distribuzione di Frequenza per Città")
Frequenza_Assoluta | Frequenza_Relativa | |
---|---|---|
Beaumont | 60 | 0.25 |
Bryan-College Station | 60 | 0.25 |
Tyler | 60 | 0.25 |
Wichita Falls | 60 | 0.25 |
freq_ass_year <- table(dati_texas$year)
freq_rel_year <- round(freq_ass_year / N, 2)
distr_freq_year <- cbind(Frequenza_Assoluta = freq_ass_year, Frequenza_Relativa = freq_rel_year)
kable(distr_freq_year, caption = "Distribuzione di Frequenza per Anno")
Frequenza_Assoluta | Frequenza_Relativa | |
---|---|---|
2010 | 48 | 0.2 |
2011 | 48 | 0.2 |
2012 | 48 | 0.2 |
2013 | 48 | 0.2 |
2014 | 48 | 0.2 |
freq_ass_month <- table(dati_texas$month)
freq_rel_month <- round(freq_ass_month / N, 2)
distr_freq_month <- cbind(Frequenza_Assoluta = freq_ass_month, Frequenza_Relativa = freq_rel_month)
kable(distr_freq_month, caption = "Distribuzione di Frequenza per Mese")
Frequenza_Assoluta | Frequenza_Relativa |
---|---|
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
20 | 0.08 |
volume_cl <- cut(dati_texas$volume, breaks = c(20, 40, 60, 80, 100))
ni<-table(volume_cl)
fi<-ni/N
Ni<-cumsum(ni)
Fi<-Ni/N
distr_freq<-as.data.frame(cbind(ni,fi,Ni,Fi))
distr_freq$classe <- factor(rownames(distr_freq), levels = rownames(distr_freq), ordered = TRUE)
fig1 = ggplot(data = distr_freq) +
geom_col(
aes(x = classe,
y = ni),
col = "red",
fill = "darkblue") +
labs(x = "valore totale delle vendite in milioni di dollari",
y = "Frequenze assolute",
title = "Distribuzione del valore delle vendite") +
theme_bw()
ggsave("diatribuzione_volume_in_clase.png",
width = 10,
height = 6,
units = "in",
dpi = 600)
fig1
Dall’analisi del seguente grafico emerge che il valore delle vendite
totali con maggiore frequenza è nella classe 20-40 milioni di $.
gini.index <- function(x){
ni = table(x)
fi = ni/length(x)
fi2 = fi^2
J = length(table(x))
gini = 1-sum(fi2)
gini.norm = gini/((J-1)/J)
return(gini.norm)
}
sales_cl <- cut(dati_texas$sales, breaks = 5)
GI_sales = round(gini.index(sales_cl), 2)
GI_sales
## [1] 0.91
Ottengo il valore di 0.91 che indica un alto grado di disuguaglianza nella distribuzione delle vendite totali.
GI_city = gini.index(dati_texas$city)
GI_city
## [1] 1
Applicando invece l’indice di Gini alla variabile categorica città, si ottiene un valore pari a 1 che indica massima disuguaglianza
prob_beaumont <- (sum(dati_texas$city=="Beaumont"))/nrow(dati_texas)
prob_beaumont
## [1] 0.25
La probabilità è pari a 1/4 = 0.25, dato che sono presenti 4 città equamente presenti nel dataset.
prob_july <- round((sum(dati_texas$month=="7"))/nrow(dati_texas), 3)
prob_july
## [1] 0.083
La probabilità è pari a 1/12 = 0.083, dato che sono presenti 12 mesi equamente presenti nel dataset
prob_dec_2012 <- round(sum((dati_texas$year == "2012") & (dati_texas$month == "12")) / nrow(dati_texas),3)
prob_dec_2012
## [1] 0.017
La probabilità è pari a 1/(12*5) = 0.016, dato che sono presenti 12 mesi e 5 anni equamente presenti nel dataset.
Usiamo la variabile volume
e sales
per
creare una nuova colonna con il prezzo medio di vendita. Dividendo il
valore totale delle vendite (opportunamente convertito da milioni di
dollari in dollari) e diviso per il numero totale di vendite) otteniamo
la variabile prize
prize <- volume * 10^6/ sales
mean_prize = mean(prize)
mean_prize
## [1] 154320.4
Facendo la media (mean(prize)) si ottiene il valore di circa 154320 dollari che confrontato con il valore medio relativa alla colonna del prezzo mediano di vendita di 132665 dollari.
dati_texas$efficacia <- (dati_texas$sales / dati_texas$listings * dati_texas$months_inventory)
head(dati_texas)
## 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
## efficacia
## 1 0.5143509
## 2 0.6809584
## 3 1.1422143
## 4 1.2412178
## 5 1.2432524
## 6 1.1635607
dati_texas_eff_city <- dati_texas %>%
group_by(city) %>%
summarize(efficacia_media = round(mean(sales / (listings * months_inventory), na.rm = TRUE), 3))
dati_texas_eff_city
## # A tibble: 4 × 2
## city efficacia_media
## <chr> <dbl>
## 1 Beaumont 0.011
## 2 Bryan-College Station 0.024
## 3 Tyler 0.009
## 4 Wichita Falls 0.017
Raggruppando questo indice per città, calcolandone la media delle efficacie si ottiene mediamente che l’efficacia di vendita è maggiore a Tyler con un valore di efficacia di 1.03, che indica poco più di una vendita ogni inserzione.
dati_texas_eff_year <- dati_texas %>%
group_by(year) %>%
summarize(efficacia_media = round(mean(sales / (listings * months_inventory), na.rm = TRUE), 3))
dati_texas_eff_year
## # A tibble: 5 × 2
## year efficacia_media
## <int> <dbl>
## 1 2010 0.011
## 2 2011 0.009
## 3 2012 0.012
## 4 2013 0.018
## 5 2014 0.026
In maniera analoga ma per anno, si individua che l’anno in cui mediamente c’è una maggiore efficacia degli annunci di vendita è stato il 2012, con un valore di efficacia pari a 1.06.
L’indice di efficacia ci permette di valutare quanto velocemente vengono vendute le proprietà in relazione al numero di annunci attivi. Un valore più alto indica una maggiore efficienza del mercato immobiliare in quella città.
summary_by_city_year <- dati_texas %>%
group_by(city, year) %>%
summarise(
media_sales = round(mean(sales),2),
sd_sales = round(sd(sales),2)
)
kable(summary_by_city_year, caption = "Riassunto delle vendite per città e anno")
city | year | media_sales | sd_sales |
---|---|---|---|
Beaumont | 2010 | 156.17 | 36.92 |
Beaumont | 2011 | 144.00 | 22.66 |
Beaumont | 2012 | 171.92 | 28.39 |
Beaumont | 2013 | 201.17 | 37.73 |
Beaumont | 2014 | 213.67 | 36.49 |
Bryan-College Station | 2010 | 167.58 | 70.75 |
Bryan-College Station | 2011 | 167.42 | 62.19 |
Bryan-College Station | 2012 | 196.75 | 74.28 |
Bryan-College Station | 2013 | 237.83 | 95.85 |
Bryan-College Station | 2014 | 260.25 | 86.69 |
Tyler | 2010 | 227.50 | 48.98 |
Tyler | 2011 | 238.83 | 49.62 |
Tyler | 2012 | 263.50 | 46.40 |
Tyler | 2013 | 287.42 | 53.05 |
Tyler | 2014 | 331.50 | 56.85 |
Wichita Falls | 2010 | 123.42 | 26.62 |
Wichita Falls | 2011 | 106.25 | 19.76 |
Wichita Falls | 2012 | 112.42 | 14.25 |
Wichita Falls | 2013 | 121.25 | 26.00 |
Wichita Falls | 2014 | 117.00 | 21.09 |
La tabella mostra le vendite medie e la deviazione standard per quattro città (Beaumont, Bryan-College Station, Tyler e Wichita Falls) nel periodo dal 2010 al 2014. Per Beaumont, si osserva un aumento delle vendite medie, passando da 156.17 nel 2010 a 213.67 nel 2014. La deviazione standard varia, con un picco nel 2013, indicando una certa variabilità nelle vendite annuali. Bryan-College Station presenta un trend simile, con le vendite medie che aumentano da 167.58 nel 2010 a 260.25 nel 2014. Tuttavia, la deviazione standard è piuttosto alta, specialmente nel 2013, suggerendo una maggiore variabilità nelle vendite rispetto a Beaumont. Tyler mostra un significativo aumento delle vendite medie, da 227.5 nel 2010 a 331.5 nel 2014. La deviazione standard è relativamente stabile, con un leggero aumento nel 2014, indicando una variabilità moderata. Infine, Wichita Falls ha vendite medie più basse rispetto alle altre città e mostra una leggera diminuzione dal 2010 al 2014. La deviazione standard è più bassa rispetto alle altre città, suggerendo una minore variabilità nelle vendite.
fig2 = ggplot(data = dati_texas) +
geom_boxplot(aes(
x = city,
y = months_inventory)) +
labs(x = "Città",
y = "Tempo necessario di vendita") +
theme_bw()
ggsave("Distribuzione_mediana_vendite_per_citta.png",
width = 10,
height = 6,
units = "in",
dpi = 600)
fig2
Il grafico mostra che per la città di Tyler vi sono tempi di vendita generalmente più lunghi (valore mediano più alto) a differenza di Wichita Falls che ha la mediana più bassa, suggerendo tempi di vendita più rapidi. Inoltre la distribuzione per Tyler appare leggermente asimmetrica verso l’alto, con un baffo superiore più lungo mentre le altre città mostrano distribuzioni più simmetriche
fig3 = ggplot(data = dati_texas,
aes(x = city, y = volume, fill = factor(year))) +
geom_boxplot() +
labs(title = "Distribuzione del Volume delle Vendite tra Città e Anni",
x = "Città",
y = "Volume delle Vendite (Milioni di $)") +
theme_minimal()
ggsave("Distribuzione_vendite_per_citta_e_anno.png" ,
width = 10,
height = 6,
units = "in",
dpi = 600)
fig3
dati_aggregati <- dati_texas %>%
group_by(city, year, month) %>%
summarize(total_sales = sum(sales))
fig4 = ggplot(data = dati_aggregati, aes(x = factor(month), y = total_sales, fill = city)) +
geom_col(position = "stack") +
facet_wrap(~year) +
labs(x = "Mese",
y = "Vendite totali",
title = "Totale delle vendite per mese e città") +
theme_minimal()
ggsave("Distribuzione_mediana_vendite_per_mese_e_anno.png" ,
width = 10,
height = 6,
units = "in",
dpi = 600)
fig4
fig5= ggplot(data = dati_aggregati, aes(x = factor(month), y = total_sales, fill = city)) +
geom_col(position = "fill") +
facet_wrap(~year) +
labs(x = "Mese",
y = "Proporzione delle vendite",
title = "Proporzione delle vendite per mese e città") +
theme_minimal()
ggsave("Distribuzione_normalizzata_mediana_vendite_per_mese_e_anno.png" ,
width = 10,
height = 6,
units = "in",
dpi = 600)
fig5
Il grafico mostra delle variazioni stagionali, infatti sono evidenti picchi di vendita nei mesi estivi (maggio, giugno, luglio) per la maggior parte delle città e degli anni. Inoltre vi sono delle differenze tra le città. Tyler (in verde) mostra costantemente il volume di vendite più alto, Wichita Falls (in viola) ha generalmente il volume di vendite più basso, infine, Beaumont e Bryan-College Station mostrano volumi di vendita intermedi. Il 2014 mostra il maggior numero di vendite, particolarmente evidente per Tyler e Bryan-College Station. Cioè possibile visualizzarlo anche nel grafico normalizzato successivo, in cui la normalizzazione permette di confrontare più facilmente le proporzioni di vendita tra le città, indipendentemente dai valori assoluti.
dati_texas <- dati_texas %>%
mutate(data = as.Date(paste(year, month, "01", sep = "-")))
dati_aggregati <- dati_texas %>%
group_by(city, data) %>%
summarize(median_price = mean(median_price, na.rm = TRUE))
fig6= ggplot(dati_aggregati, aes(x = data, y = median_price, color = city, group = city)) +
geom_line(size = 1) +
labs(x = "Data",
y = "Prezzo Mediano ($)",
title = "Confronto del Prezzo Mediano tra Città nel Tempo") +
theme_minimal() +
theme(legend.position = "bottom")
ggsave("line_chart_mediana_vendite_nel_tempo.png" ,
width = 10,
height = 6,
units = "in",
dpi = 600)
fig6
Da cui si può vedere chiaramente come il prezzo mediano delle vendite sia stato maggiore per la città di Bryan-College Station mentre Wichita Falls ha i prezzi mediani più bassi per tutto il periodo, invece Beaumont e Tyler si posizionano nel mezzo, con Tyler generalmente superiore a Beaumont. Tutte le città mostrano una tendenza generale all’aumento dei prezzi dal 2010 al 2014. Il periodo 2010-2011 mostra prezzi relativamente stabili per tutte le città. Dal 2012 al 2014 si osserva un incremento più marcato, specialmente per Bryan-College Station e Tyler. Per quanto riguarda invece la variabilità temporale Bryan-College Station mostra la maggiore variabilità nei prezzi, con fluttuazioni più ampie. Wichita Falls invece presenta la minore variabilità, con un trend più lineare. Volendo avere anche un’analisi di dettaglio per i diversi mesi si riporta il seguente grafico.
dati_texas <- dati_texas %>%
mutate(data = as.Date(paste(year, month, "01", sep = "-")))
dati_aggregati <- dati_texas %>%
group_by(city, data) %>%
summarize(median_price = mean(median_price, na.rm = TRUE))
fig7= ggplot(dati_aggregati, aes(x = data, y = median_price, color = city, group = city)) +
geom_line(size = 1) +
labs(x = "Anno e Mese",
y = "Prezzo Mediano ($)",
title = "Confronto del Prezzo Mediano tra Città nel Tempo") +
scale_x_date(date_labels = "%Y-%b", # Mostra anno e mese (abbreviato)
date_breaks = "3 month") + # Imposta intervalli di 1 mese
theme_minimal() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) # Ruota i mesi per leggibilità
ggsave("line_chart_mediana_vendite_nel_tempo_v1.png" ,
width = 10,
height = 6,
units = "in",
dpi = 600)
fig7
Il grafico riporta sull’asse delle ascisse anche i mesi. Rispetto al grafico precedente si possono osservare delle variazioni stagionali, alcune città mostrano pattern stagionali più evidenti di altre.