Analisi del mercato immobiliare in Texas
Gabriele Petronzi
1. Analisi delle variabili
# Caricamento dataset
data <- read.csv("realestate_texas.csv")
# Creazione nuova colonna per facilitare analisi temporali
data <- data %>%
mutate(date = as.Date(sprintf("%d-%02d-01", year, month)))
# Raggruppa per year e month e calcola la somma totale vendite per ogni mese/anno
andamento_anni <- data %>%
group_by(year, month) %>%
summarise(sales = sum(sales, na.rm = TRUE)) %>%
ungroup() %>%
mutate(sales = round(sales, 2))
variables <- data.frame(
name = c("city",
"year",
"month",
"sales",
"volume",
"median_price",
"listings",
"months_inventory",
"average_price_per_sale",
"listings_effectiveness"),
type = c("Qualitativa Nominale",
"Quantitativa Continua (trattata come Qualitativa Ordinale)",
"Qualitativa Nominale Ciclica (codificata numericamente)",
"Quantitativa Discreta",
"Quantitativa Continua (Scala di rapporti)",
"Quantitativa Continua (Scala di rapporti)",
"Quantitativa Discreta",
"Quantitativa Continua (Scala di rapporti)",
"Quantitativa Continua (Scala di rapporti)",
"Quantitativa Continua (Scala di rapporti)"),
description = c("Città del Texas in cui sono stati raccolti i dati",
"Anno in cui sono stati raccolti i dati (2010-2014)",
"Mese (espresso numericamente 1-12) in cui sono stati raccolti i dati",
"Numero totale di vendite immobiliari concluse nel mese",
"Valore complessivo delle vendite immobiliari concluse (in milioni di dollari)",
"Prezzo mediano degli immobili venduti (in dollari)",
"Numero totale di annunci immobiliari attivi nel mese",
"Numero medio di mesi necessari per vendere tutti gli immobili disponibili sul mercato",
"Prezzo medio per singola transazione",
"Efficacia annunci (rapporto tra vendite ed annunci)")
)
kable(variables, caption = "Analisi Variabili")| name | type | description |
|---|---|---|
| city | Qualitativa Nominale | Città del Texas in cui sono stati raccolti i dati |
| year | Quantitativa Continua (trattata come Qualitativa Ordinale) | Anno in cui sono stati raccolti i dati (2010-2014) |
| month | Qualitativa Nominale Ciclica (codificata numericamente) | Mese (espresso numericamente 1-12) in cui sono stati raccolti i dati |
| sales | Quantitativa Discreta | Numero totale di vendite immobiliari concluse nel mese |
| volume | Quantitativa Continua (Scala di rapporti) | Valore complessivo delle vendite immobiliari concluse (in milioni di dollari) |
| median_price | Quantitativa Continua (Scala di rapporti) | Prezzo mediano degli immobili venduti (in dollari) |
| listings | Quantitativa Discreta | Numero totale di annunci immobiliari attivi nel mese |
| months_inventory | Quantitativa Continua (Scala di rapporti) | Numero medio di mesi necessari per vendere tutti gli immobili disponibili sul mercato |
| average_price_per_sale | Quantitativa Continua (Scala di rapporti) | Prezzo medio per singola transazione |
| listings_effectiveness | Quantitativa Continua (Scala di rapporti) | Efficacia annunci (rapporto tra vendite ed annunci) |
2. Indici di posizione, variabilità e forma
Distribuzioni di frequenza per city, month e year
table_freq <- function(x) {
freq_abs <- table(x)
table_res <- data.frame(
Categoria = names(freq_abs), # Categoria nome temporaneo
Frequenza_Assoluta = as.integer(freq_abs),
Frequenza_Relativa_In_Percentuale = as.numeric(prop.table(freq_abs)) * 100
)
return(table_res)
}
# colonne da analizzare
columns <- c("city", "month", "year")
for (column in columns) {
caption_table <- paste("Distribuzione di Frequenza per", column)
table_frame <- table_freq(data[[column]])
names(table_frame)[1] <- column # nome relativa colonna (city, month, year)
# stampa tabelle
print(
kable(
table_frame,
caption = caption_table,
digits = 2
)
)
cat("\n\n") # per separare tabelle
}| city | Frequenza_Assoluta | Frequenza_Relativa_In_Percentuale |
|---|---|---|
| Beaumont | 60 | 25 |
| Bryan-College Station | 60 | 25 |
| Tyler | 60 | 25 |
| Wichita Falls | 60 | 25 |
| month | Frequenza_Assoluta | Frequenza_Relativa_In_Percentuale |
|---|---|---|
| 1 | 20 | 8.33 |
| 2 | 20 | 8.33 |
| 3 | 20 | 8.33 |
| 4 | 20 | 8.33 |
| 5 | 20 | 8.33 |
| 6 | 20 | 8.33 |
| 7 | 20 | 8.33 |
| 8 | 20 | 8.33 |
| 9 | 20 | 8.33 |
| 10 | 20 | 8.33 |
| 11 | 20 | 8.33 |
| 12 | 20 | 8.33 |
| year | Frequenza_Assoluta | Frequenza_Relativa_In_Percentuale |
|---|---|---|
| 2010 | 48 | 20 |
| 2011 | 48 | 20 |
| 2012 | 48 | 20 |
| 2013 | 48 | 20 |
| 2014 | 48 | 20 |
Commenti
- Ogni città, mese ed anno presentano lo stesso numero di osservazioni
Calcolo indici per restanti variabili
vars_index_selected <- data %>% select(sales, volume, median_price, listings, months_inventory)
summary_vars_index <- data.frame(
Mean = sapply(vars_index_selected, mean),
Median = sapply(vars_index_selected, median),
Dev.Std = sapply(vars_index_selected, sd),
Var = sapply(vars_index_selected, var),
Min = sapply(vars_index_selected, min),
Max = sapply(vars_index_selected, max),
Q1_25_percentile = sapply(vars_index_selected, quantile, probs = 0.25),
Q3_75_percentile = sapply(vars_index_selected, quantile, probs = 0.75),
Range_Interquartile_IQR = sapply(vars_index_selected, IQR),
Skewness = sapply(vars_index_selected, skewness),
Kurtosis = sapply(vars_index_selected, kurtosis)
)
kable(round(summary_vars_index, 2), caption = "Indici di posizione, variabilità e forma")| Mean | Median | Dev.Std | Var | Min | Max | Q1_25_percentile | Q3_75_percentile | Range_Interquartile_IQR | Skewness | Kurtosis | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| sales | 192.29 | 175.50 | 79.65 | 6.34430e+03 | 79.00 | 423.00 | 127.00 | 247.00 | 120.00 | 0.72 | 2.69 |
| volume | 31.01 | 27.06 | 16.65 | 2.77270e+02 | 8.17 | 83.55 | 17.66 | 40.89 | 23.23 | 0.88 | 3.18 |
| median_price | 132665.42 | 134500.00 | 22662.15 | 5.13573e+08 | 73800.00 | 180000.00 | 117300.00 | 150050.00 | 32750.00 | -0.36 | 2.38 |
| listings | 1738.02 | 1618.50 | 752.71 | 5.66569e+05 | 743.00 | 3296.00 | 1026.50 | 2056.00 | 1029.50 | 0.65 | 2.21 |
| months_inventory | 9.19 | 8.95 | 2.30 | 5.31000e+00 | 3.40 | 14.90 | 7.80 | 10.95 | 3.15 | 0.04 | 2.83 |
Commenti:
sales:
La media è più alta della mediana e l’asimmetria (skewness) è positiva > 0 (coda a destra) e questo indica che nella maggior parte dei mesi si hanno circa 175 vendite di media (quindi inferiore a 192 di Mean), ma ci sono alcuni mesi con un numero di vendite eccezionalmente alto.
La deviazione standard è molto alta e quindi indica grande variabilità (possibile incertezza).
Il range tra minimo e massimo è grande, il mese migliore ha registrato circa 5 volte le vendite del mese peggiore.
Kurtosi vicino a 3 indica una curtosi normale (mesocurtica), quindi la probabilità di valori estremi (le code) non è né esageratamente alta né bassa.
volume:
La media è più alta della mediana e l’assimetria è positiva ed anche più elevata rispetto a sales quindi nei mesi di picco, non solo si vende di più, ma si vendono anche case di valore mediamente più alto.
Kurtosis a 3.18 leggermente leptocurtica (maggiore di 3). A differenza delle sales, qui c’è una probabilità leggermente più alta di osservare valori estremi.
median_price:
La media è inferiore alla mediana e l’assimetria è negativa < 0 (-0.36) e questo indica che ci sono dei casi con prezzi mediani insolitamente bassi che abbassano la media, suggerisce che una o più città fanno scendere la media.
La variabilità è meno elevata e quindi si ha una maggiore stabiltà dei prezzi.
Kurtosis a 2.38 platicurtica (minore di 3), quindi più piatta di una normale e con code più sottili che indica che shock di prezzo estremi sono poco probabili.
listings:
Offerta tende a seguire la domanda, ecco perché è simile a sales.
months_inventory:
Media e mediana quasi identiche e la distribuzione è praticamente simmetrica (skewness = 0.04), quindi è l’indicatore più stabile e suggerisce che in media c’è più offerta che domanda.
3. Identificazione delle variabili con maggiore variabilità e asimmetria
summary_vars_index$CV <- (summary_vars_index$Dev.Std / summary_vars_index$Mean) * 100
kable(round(summary_vars_index, 2) %>% select(CV, Skewness) %>% arrange(desc(CV)))| CV | Skewness | |
|---|---|---|
| volume | 53.71 | 0.88 |
| listings | 43.31 | 0.65 |
| sales | 41.42 | 0.72 |
| months_inventory | 25.06 | 0.04 |
| median_price | 17.08 | -0.36 |
Commenti: 1. volume è la variabile con
il coefficiente di variazione (CV) più alto indicando quindi una forte
variabilità nel volume totale di vendite. 2. volume è la
variabile con la distribuzione più asimmetrica (Skewness) (verso destra)
e quindi indica una forte probabilità di outliers.
4. Creazione di classi per una variabile quantitativa
data$sales_class <- cut(data$sales, breaks = pretty(data$sales, n = 8), right = FALSE)
freq_sales_class <- data %>%
count(sales_class, name = "Frequenza") %>%
mutate(Percentuale = round(Frequenza / sum(Frequenza) * 100, 2))
kable(freq_sales_class, caption = "Distribuzione delle vendite mensili per classi")| sales_class | Frequenza | Percentuale |
|---|---|---|
| [50,100) | 20 | 8.33 |
| [100,150) | 69 | 28.75 |
| [150,200) | 58 | 24.17 |
| [200,250) | 33 | 13.75 |
| [250,300) | 34 | 14.17 |
| [300,350) | 14 | 5.83 |
| [350,400) | 9 | 3.75 |
| [400,450) | 3 | 1.25 |
# Aggiunta del grafico per visualizzare la distribuzione delle classi create
ggplot(freq_sales_class, aes(x = sales_class, y = Frequenza)) +
geom_col(fill = "steelblue", color = "black") +
geom_text(aes(label = Frequenza), vjust = -0.5, size = 3.5) +
labs(title = "Distribuzione delle classi di vendita", x = "Classe di vendita", y = "Frequenza assoluta") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Commenti:
- Nello scenario più frequente si registrano tra le 100 e le 150 vendite al mese.
gini.index <- function(x) {
ni = table(x)
fi = ni / length(x)
fi2 = fi^2
J = length(table(x))
gini = 1 - sum(fi2)
gini.normalizzato = gini / ((J - 1) / J)
return(gini.normalizzato)
}
kable(data.frame(round(gini.index(data$sales_class), 2)), col.names = "Indice di Gini per le Classi di Vendite")| Indice di Gini per le Classi di Vendite |
|---|
| 0.92 |
Commenti:
- L’indice di Gini pari a 0.92, un valore molto vicino a 1, indica un’elevata eterogeneità. Le vendite sono distribuite in modo molto disperso su un range ampio di valori, anziché essere concentrate in poche classi dominanti.
5. Calcolo della probabilità
total_rows <- nrow(data)
prob_beaumont <- (sum(data$city == "Beaumont") / total_rows) * 100
prob_july <- (sum(data$month == 7) / total_rows) * 100
prob_december_2012 <- (nrow(filter(data, month == 12 & year == "2012")) / total_rows) * 100
prob_df <- data.frame(
"Evento" = c("Una riga riporta la città Beaumont",
"Una riga riporta il mese di luglio",
"Una riga riporta il mese di Dicembre 2012"),
"Probabilità" = c(prob_beaumont,
prob_july,
prob_december_2012)
)
kable(prob_df, digits = 2, caption = "Riepilogo Probabilità")| Evento | Probabilità |
|---|---|
| Una riga riporta la città Beaumont | 25.00 |
| Una riga riporta il mese di luglio | 8.33 |
| Una riga riporta il mese di Dicembre 2012 | 1.67 |
6. Creazione di nuove variabili (prezzo medio immobili ed efficacia annunci attivi)
data <- data %>%
mutate(
average_price_per_sale = (volume * 1e6) / sales,
listings_effectiveness = sales / listings
)
ggplot(data, aes(x = average_price_per_sale)) +
geom_histogram(binwidth = 10000, fill = "cyan", color = "black") +
scale_x_continuous(labels = dollar_format()) +
labs(title = "Prezzo medio per vendita", x = "Prezzo medio", y = "Frequenza") +
theme_minimal()
Commenti: * Il prezzo medio per vendita si concentra tra 110.000$ e 190.000$, fuori da questo range sono poco rappresentati.
- La fascia più frequente è 120.000$ e 150.000\(–180.000\).
ggplot(data, aes(x = listings_effectiveness)) +
geom_histogram(binwidth = 0.05, fill = "lightgreen", color = "black") +
scale_x_continuous(
labels = percent_format(accuracy = 1),
breaks = seq(0, 1, by = 0.05)
) +
labs(
title = "Efficacia annunci (vendite/listings)",
x = "Efficacia",
y = "Frequenza"
) +
theme_minimal()
Commenti: * L’efficacia degli annunci è generalmente bassa e si concetra tra 5%-30%.
- La fascia più frequente è del 10%.
- Valori superiori al 20% sono molto rari
7. Analisi condizionata
# Il dataset originale è già a livello (city, year, month), quindi non c'è bisogno di una summarizzazione preliminare.
# Passiamo direttamente i dati al formato long per i plot.
summary_long <- data %>%
select(city, year, month, date, sales, volume, median_price, listings, months_inventory, average_price_per_sale, listings_effectiveness) %>%
pivot_longer(
cols = c(sales, volume, median_price, listings, months_inventory, average_price_per_sale, listings_effectiveness),
names_to = "variabile",
values_to = "valore"
)
variabili <- unique(summary_long$variabile)
for (v in variabili) {
p <- ggplot(
summary_long %>% filter(variabile == v),
aes(x = date, y = valore, color = city)
) +
geom_line(size = 1.2) +
labs(
x = "Data (Anno-Mese)",
y = v,
color = "Città"
) +
scale_x_date(date_labels = "%Y-%b", date_breaks = "3 months") +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.title = element_text(size = 13),
axis.text = element_text(size = 11),
legend.title = element_text(size = 12),
legend.text = element_text(size = 12),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom"
)
print(p)
}
8. Creazione di visualizzazioni con ggplot2
# boxplot prezzo mediano per città ed anno
ggplot(data, aes(x = factor(year), y = median_price, fill = city)) +
geom_boxplot(outlier.size = 1) +
labs(
title = "Distribuzione del prezzo mediano per città ed anno",
x = "Anno", y = "Prezzo mediano", fill = "Città"
) +
theme_minimal()
Commenti: * Bryan-College Station presenta prezzi mediani più alti in ogni anno.
- Wichita Falls è sempre quella più economica.
- Bryan-College e Station hanno un trend positivo negli anni.
- Wichita Falls ha la maggiore variabilità suggerendo forti fluttuazioni nel prezzo.
- Bryan-College ha la variabilità più contenuta di tutte suggerendo un mercato più stabile.
- Tra il 2013 e 2014 forte presenza di outliers soprattutto per Tyler indicando forte potenziale di guadagno e crescita.
# boxplot valore totale vendite per città ed anno
ggplot(data, aes(x = city, y = sales, fill = factor(year))) +
geom_boxplot(outlier.size = 1) +
labs(
title = "Distribuzione del valore totale delle vendite per città ed anno",
x = "Città", y = "Totale vendite", fill = "Anno"
) +
theme_minimal()
Commenti: * Bryan-College Station e Tyler hanno il valore totale di vendite più alto presentando una crescita esponenziale dal 2011 al 2012.
- Bryan-College presenta una fortissima variabilità suggerendo forti fluttuazioni.
- Beaumont a parte per il 2011 presenta una crescita lineare con variabilità contenuta.
- Tyler presenta una crescita lineare e performa particolarmente bene nel 2013 e 2014.
- Wichita Falls non ha una tendenza di crescita rimanendo praticamente costante negli anni e pochissima variabilità.
# grafico a barre sovrapposte vendite medie per mese e città
ggplot(data, aes(x = factor(month), y = sales, fill = city)) +
geom_col(position = "stack") +
labs(title = "Totale vendite per mese e città", x = "Mese", y = "Totale vendite") +
theme_minimal()
Commenti: * Forte stagionalità con un picco di vendite tra giugno ed agosto ed un brusco calo successivo.
- Gennaio e Febbraio presentano il minor numero di vendite, ma da inizio marzo si ha una forte crescita.
- Tyler e Bryan-College sono i leader di vendite ed interessante Bryan-College raddopia le sue vendite medie tra giugno e luglio.
- Wichita Falls e Beaumont non presentano aumenti di rilievo.
# line chart andamento vendite in periodi storici differenti
ggplot(andamento_anni, aes(x = month, y = sales, color = factor(year))) +
geom_line(size = 1.2) +
geom_point(size = 2) +
scale_x_continuous(breaks = 1:12, labels = month.abb) +
labs(
title = "Confronto andamento mensile delle vendite nei vari anni",
x = "Mese",
y = "Totale vendite",
color = "Anno"
) +
theme_minimal()
Commenti: * Forte stagionalità anno dopo anno e soprattutto nei mesi estivi come riportato anche nei grafici precedenti
- Trend di crescita nel numero di vendite ed in particolare nel 2013 e 2014
- La stagionalità negli anni è cambiata, nel 2013 e 2014 il picco di vendite avviene prima ed è molto più importante
- Il 2014 presenta un’irregolarità, mostra una caduta brusca a settembre prevedibile, ma è seguita poi da un recupero
# plot normalizzato
ggplot(data, aes(x = month, y = sales, fill = city)) +
geom_col(position = "fill") +
facet_wrap(~ year) +
scale_x_continuous(breaks = seq(1, 12, by = 1)) +
scale_y_continuous(labels = percent_format()) +
labs(
title = "Valore totale delle vendite (Normalizzato) per Città",
x = "Mese",
y = "Quota Percentuale sul Totale Vendite",
fill = "Città"
) +
theme_minimal()
9. Conclusioni
Commenti: * Il mercato mostra un trend di crescita importante anno dopo anno con una stagionalità consistente dove negli ultimi anni non solo si è intensificata ma anche anticipata
- Tyler è il leader ed ha una volatilità contenuta rendendelo il più affidabile per futuri investimenti
- Bryan-College ha un estrema volatilità incrementando di molto i guadagni nei mesi estivi, ma richiede una maggiore attenzione per la gestione del rischio
- Beaumont ha una crescita moderata e stabile
- Wichita Falls ha un mercato stabile, ma ha una crescita praticamente irrilevante rispetto alle altre città rendendo poco utile investire troppo
- Le campagne di marketing per gli annunci dovrebbero essere concentrate nei primissimi mesi per massimizzare il picco stagionale
```