Analisi Esplorativa del Mercato Immobiliare del Texas
Gabriele Panico
Analisi preliminare
In questa fase ci concentreremo sullo studio del datset a disposizione fornendo una visione d’insieme dei dati e delle prospettive operative. Laddove necessario le variabili del dataset saranno convertite in un formato più utile oppure più facile da interpretare.
Il primo passaggio consiste nell’importare il dataset e nel fornire una veloce descrizione di tutte le variabili mostrando i principali indici statistici.
dati <- read.csv("realestate_texas.csv", stringsAsFactors = FALSE)
str(dati)## 'data.frame': 240 obs. of 8 variables:
## $ city : chr "Beaumont" "Beaumont" "Beaumont" "Beaumont" ...
## $ year : int 2010 2010 2010 2010 2010 2010 2010 2010 2010 2010 ...
## $ month : int 1 2 3 4 5 6 7 8 9 10 ...
## $ sales : int 83 108 182 200 202 189 164 174 124 150 ...
## $ volume : num 14.2 17.7 28.7 26.8 28.8 ...
## $ median_price : num 163800 138200 122400 123200 123100 ...
## $ listings : int 1533 1586 1689 1708 1771 1803 1857 1830 1829 1779 ...
## $ months_inventory: num 9.5 10 10.6 10.6 10.9 11.1 11.7 11.6 11.7 11.5 ...summary(dati)## city year month sales
## Length:240 Min. :2010 Min. : 1.00 Min. : 79.0
## Class :character 1st Qu.:2011 1st Qu.: 3.75 1st Qu.:127.0
## Mode :character Median :2012 Median : 6.50 Median :175.5
## Mean :2012 Mean : 6.50 Mean :192.3
## 3rd Qu.:2013 3rd Qu.: 9.25 3rd Qu.:247.0
## Max. :2014 Max. :12.00 Max. :423.0
## volume median_price listings months_inventory
## Min. : 8.166 Min. : 73800 Min. : 743 Min. : 3.400
## 1st Qu.:17.660 1st Qu.:117300 1st Qu.:1026 1st Qu.: 7.800
## Median :27.062 Median :134500 Median :1618 Median : 8.950
## Mean :31.005 Mean :132665 Mean :1738 Mean : 9.193
## 3rd Qu.:40.893 3rd Qu.:150050 3rd Qu.:2056 3rd Qu.:10.950
## Max. :83.547 Max. :180000 Max. :3296 Max. :14.900Per una questione di robustezza ed analisi future controlliamo e convertiamo ciascuna variabile nella forma più idonea.
if(!is.factor(dati$city)) dati$city <- as.factor(dati$city)
if(is.character(dati$year)) dati$year <- as.integer(dati$year)
if(is.character(dati$sales)) dati$sales <- as.numeric(dati$sales)
if(is.character(dati$volume)) dati$volume <- as.numeric(dati$volume)
if(is.character(dati$median_price)) dati$median_price <- as.numeric(dati$median_price)
if(is.character(dati$listings)) dati$listings <- as.numeric(dati$listings)
if(is.character(dati$months_inventory)) dati$months_inventory <- as.numeric(dati$months_inventory)Per una maggiore leggibilità trasformiamo i mesi da numeri (1,2,…,12) a parole (January, February,…, December)
dati$month <- as.integer(dati$month)
stopifnot(all(dati$month %in% 1:12))
dati$month <- factor(dati$month, levels = 1:12,
labels = month.name, ordered = TRUE)Di seguito viene fornita una lista di come potrebbe essere studiata e utilizzata ciascuna variabile.
- city: variabile qualitativa nominale; si potrebbero generare tabelle di frequenza; permette confronti di determinati aspetti tra città in funzione di come viene combinata con altre variabili.
- month: variabile qualitativa ordinale; ordinata da January a December. Permette analisi di stagionalità, osservare trend e lo sviluppo di serie storiche.
- year: variabile temporale discreta; analogamente a month consente l’analisi di stagionalità, osservare trend e lo sviluppo di serie storiche.
- sales/listings: variabili quantitative discrete; i relativi indici statistici possono essere utilizzati come stimatori di alcune caratteristiche; Lo studio combinato con altre variabili può restituire grafici interessanti per la previsione dei trend.
- volume/median_price/months_inventory: variabili quantitative continue; analogamente a sales/listings, i relativi indici statistici possono essere utilizzati come stimatori e ,in combinazione con altre variabili, possono fornire prospettive degne di nota per la previsione dei trend.
Indici statistici e principali distribuzioni di frequenza
Questa sezione è dedicata a identificare quali sono le variabili che più si prestano ad un’analisi statistica basata su indici di posizione, varaibilità e forma. Per le restanti ci limiteremo a creare una distribuzione di frequenza.
num_vars <- c("sales","volume","median_price","listings","months_inventory") #variabili di cui andremo a calcolare gli indici statistici
qual_vars <- c("city","month","year") #variabili di cui calcoleremo la distribuzione di frequenzaPrima di procedere con il calcolo degli indici istanziamo la funzione che consente di calcolare il coefficiente di variazione:
\[ CV\% = \frac{SD}{\bar{x}} \times 100 \]
CV <- function(x) { sd(x, na.rm=TRUE) / mean(x, na.rm=TRUE) * 100 }e importiamo la libreria che agevola il calcolo degli indici di forma:
library(moments)Per generalizzare il processo istanziamo la funzione da applicare alle variabili per determinarne i vari indici:
descr_var <- function(x){
x <- x[!is.na(x)] #rimuove eventuali valori nulli
out <- c(
Min = suppressWarnings(min(x, na.rm=TRUE)),
Q1 = as.numeric(quantile(x, 0.25, na.rm=TRUE)),
Median = median(x, na.rm=TRUE),
Mean = mean(x, na.rm=TRUE),
Q3 = as.numeric(quantile(x, 0.75, na.rm=TRUE)),
Max = suppressWarnings(max(x, na.rm=TRUE)),
Var = var(x, na.rm=TRUE),
SD = sd(x, na.rm=TRUE),
IQR = IQR(x, na.rm=TRUE),
CV_perc = CV(x),
Asimmetria = moments::skewness(x, na.rm=TRUE),
Curtosi = moments::kurtosis(x, na.rm=TRUE) - 3
# na.rm=TRUE consente di ignorare eventuali valori nulli
)
return(out)
}Procediamo creando un dataframe con i risultati dell’analisi statistica di cui discusso
tab_descr <- do.call(rbind, lapply(num_vars, function(v) descr_var(dati[[v]])))
rownames(tab_descr) <- num_vars
tab_descr <- round(as.data.frame(tab_descr), 3)
library(knitr)
kable(tab_descr)| Min | Q1 | Median | Mean | Q3 | Max | Var | SD | IQR | CV_perc | Asimmetria | Curtosi | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| sales | 79.000 | 127.00 | 175.500 | 192.292 | 247.000 | 423.000 | 6.34430e+03 | 79.651 | 120.000 | 41.422 | 0.718 | -0.313 |
| volume | 8.166 | 17.66 | 27.062 | 31.005 | 40.893 | 83.547 | 2.77271e+02 | 16.651 | 23.233 | 53.705 | 0.885 | 0.177 |
| median_price | 73800.000 | 117300.00 | 134500.000 | 132665.417 | 150050.000 | 180000.000 | 5.13573e+08 | 22662.149 | 32750.000 | 17.082 | -0.365 | -0.623 |
| listings | 743.000 | 1026.50 | 1618.500 | 1738.021 | 2056.000 | 3296.000 | 5.66569e+05 | 752.708 | 1029.500 | 43.308 | 0.649 | -0.792 |
| months_inventory | 3.400 | 7.80 | 8.950 | 9.193 | 10.950 | 14.900 | 5.30700e+00 | 2.304 | 3.150 | 25.060 | 0.041 | -0.174 |
Come possiamo interpretare questi riusltati?
La tabella descrive bene “ampiezza” e “forma” delle variabili: volume è la più instabile in termini relativi (CV≈54%, Asimmetria ≈ +0,89), con media (31,0) > mediana (27,1): pochi mesi/città molto alti “tirano” la distribuzione a destra. sales e listings mostrano variabilità ancora elevata (CV≈41–43%) e asimmetria positiva (Asimmetria ≈ +0,72 e +0,65): anche qui prevalgono mesi “forti” che alzano le medie rispetto alle mediane. Al contrario, median_price ha la dispersione relativa più contenuta (CV≈17%) e una leggera coda a sinistra (Asimmetria = −0,37) con mediana (134,5k) > media (132,7k): i livelli di prezzo sono quindi più stabili e possono essere sintetizzati con mediana/IQR (32,8k). months_inventory è la metrica più regolare (CV≈25%, Asimmetria ≈ 0). Le Curtosi lievemente negative (tranne per volume) indicano code non particolarmente pesanti; per volume (Curtosi≈+0,18) la coda a destra è più marcata.
Passiamo alla creazione delle distribuzioni di frequenza per le restanti variabili
N <- nrow(dati)
# city
if ("city" %in% qual_vars){
freq_city_abs <- table(dati$city)
freq_city_rel <- freq_city_abs / N
distr_city <- cbind(FreqAss = as.vector(freq_city_abs),
FreqRel = round(as.vector(freq_city_rel), 3))
rownames(distr_city) <- names(freq_city_abs)
kable(distr_city)
}| FreqAss | FreqRel | |
|---|---|---|
| Beaumont | 60 | 0.25 |
| Bryan-College Station | 60 | 0.25 |
| Tyler | 60 | 0.25 |
| Wichita Falls | 60 | 0.25 |
# month
if ("month" %in% qual_vars){
freq_mon_abs <- table(dati$month)
freq_mon_rel <- freq_mon_abs / N
distr_month <- cbind(FreqAss = as.vector(freq_mon_abs),
FreqRel = round(as.vector(freq_mon_rel), 3))
rownames(distr_month) <- names(freq_mon_abs)
kable(distr_month)
}| FreqAss | FreqRel | |
|---|---|---|
| January | 20 | 0.083 |
| February | 20 | 0.083 |
| March | 20 | 0.083 |
| April | 20 | 0.083 |
| May | 20 | 0.083 |
| June | 20 | 0.083 |
| July | 20 | 0.083 |
| August | 20 | 0.083 |
| September | 20 | 0.083 |
| October | 20 | 0.083 |
| November | 20 | 0.083 |
| December | 20 | 0.083 |
# year
if ("year" %in% qual_vars){
freq_year_abs <- table(dati$year)
freq_year_rel <- freq_year_abs / N
distr_year <- cbind(FreqAss = as.vector(freq_year_abs),
FreqRel = round(as.vector(freq_year_rel), 3))
rownames(distr_year) <- names(freq_year_abs)
kable(distr_year)
}| FreqAss | FreqRel | |
|---|---|---|
| 2010 | 48 | 0.2 |
| 2011 | 48 | 0.2 |
| 2012 | 48 | 0.2 |
| 2013 | 48 | 0.2 |
| 2014 | 48 | 0.2 |
Osservando le distribuzioni di frequenze possiamo concludere che la raccolta delle osservazioni è stata equamente distribuita sia temporalmente che spazialmente e ciò ci consentirà di combinare le variabili per condurre sia analisi temporali che spaziali.
Maggiore variabilità e asimmettria
Le variabili con la maggiore variabilità e asimmetria sono state già identificate nella fase precedente. Tuttavia, si è ritenuto opportuno aggiungere una sezione dedicata alla loro ricerca in quanto, in caso di analisi future con molte più variabili, il codice risulterebbe ancora valido ed efficiente.
var_abs_name <- rownames(tab_descr)[ which.max(tab_descr$SD) ]
var_abs_val <- tab_descr$SD[ which.max(tab_descr$SD) ]
var_rel_name <- rownames(tab_descr)[ which.max(tab_descr$CV_percent) ]
var_rel_val <- tab_descr$CV_percent[ which.max(tab_descr$CV_percent) ]Per ottenere la variabilità assoluta è sufficiente confrontare le deviazioni standard, tuttavia sarebbe poco utile in quanto non è un indice scale-free
A scopo esemplificativo, la variabile con deviazione standard maggiore è median_price con valore 2.2662149^{4}
L’indice che mi consente di effettuare confronti tra variabili con scale diverse è il coefficiente di variazione (nel nostro caso scritto in forma percentuale)
Pertanto la variabile con il maggiore coefficiente di variazione è ** con valore **
Procediamo in maniera analoga per identificare la variabile con l’indice di asimmetria maggiore.
idx_skew_abs <- which.max(abs(tab_descr$Asimmetria))
skew_name <- rownames(tab_descr)[ idx_skew_abs ]
skew_val <- tab_descr$Asimmetria[ idx_skew_abs ]La variabile con il più alto indice di asimmettria è volume con valore 0.885
Considerazioni:
Come potevamo aspettarci il prezzo_mediano è la variabile con variabilità assoluta maggiore per il semplici motivo che, all’interno del dataset, è quella che viene registrati con valori numerici maggiori.
Un valore alto per il coefficiente di variazione associato al volume di vendite suggerisce che c’è una forte variabilità nel tempo e/o nello spazio, cioè il volume potrebbe essere fortemente associato a quando e dove è avvenuta l’osservazione e pertanto richiede analisi più approfondite.
Una asimmetria positiva per il volume di vendite suggerisce che l’azienda registra più osservazioni con volumi di vendita inferiori alla media. In altre parole, la raccolta delle osservazione registra più mesi in cui il volume delle vendite è inferiore alla media e sono pochi mesi in cui si registrano volumi molto alti che “trascinano” la distribuzione verso destra.
A scopo esemplificativo procederemo alla rappresentazione della frequenza della variabile volume
var_sel <- "volume" # cambiando il nome della variabile si può scegliere di condurre la stessa analisi su altre variabili
K <- 12 # il numero di classi è stato scelto utilizzando la regola di Rice
x <- as.numeric(dati[[var_sel]])
#Costruiamo delle classi di uguale ampiezza
brks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = K + 1)
x_cl <- cut(x, breaks = brks, include.lowest = TRUE, right = FALSE)
#Calcoliamo la distribuzione di frequenze assolute e relative
N <- sum(!is.na(x))
ni <- table(x_cl)
fi <- ni / N
Ni <- cumsum(ni)
Fi <- Ni / N
distr_freq <- data.frame(
classe = names(ni),
ni = as.vector(ni),
fi = as.numeric(fi),
Ni = as.vector(Ni),
Fi = as.numeric(Fi),
row.names = NULL
)
kable(distr_freq)| classe | ni | fi | Ni | Fi |
|---|---|---|---|---|
| [8.17,14.4) | 38 | 0.1583333 | 38 | 0.1583333 |
| [14.4,20.7) | 44 | 0.1833333 | 82 | 0.3416667 |
| [20.7,27) | 38 | 0.1583333 | 120 | 0.5000000 |
| [27,33.3) | 30 | 0.1250000 | 150 | 0.6250000 |
| [33.3,39.6) | 25 | 0.1041667 | 175 | 0.7291667 |
| [39.6,45.9) | 18 | 0.0750000 | 193 | 0.8041667 |
| [45.9,52.1) | 18 | 0.0750000 | 211 | 0.8791667 |
| [52.1,58.4) | 9 | 0.0375000 | 220 | 0.9166667 |
| [58.4,64.7) | 8 | 0.0333333 | 228 | 0.9500000 |
| [64.7,71) | 7 | 0.0291667 | 235 | 0.9791667 |
| [71,77.3) | 2 | 0.0083333 | 237 | 0.9875000 |
| [77.3,83.5] | 3 | 0.0125000 | 240 | 1.0000000 |
Rappresentiamo i risultati ottenuti in un grafico a barre
library(ggplot2)
distr_freq$classe <- factor(distr_freq$classe, levels = levels(x_cl), ordered = TRUE)
ggplot(distr_freq, aes(x = classe, y = ni, fill = ni)) +
geom_col() +
scale_fill_gradient(low = "darkorange", high = "darkred") +
labs(title = paste("Distribuzione in classi di", var_sel),
x = "Classe", y = "Frequenza") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.3))
Calcoliamo l’iIndice di Gini per verificare l’eterogeneità delle classi.
gini.index <- function(x_factor){
ni <- table(x_factor)
fi <- ni / sum(ni)
J <- length(ni)
g <- 1 - sum(fi^2)
g_norm <- g / ((J - 1) / J)
return(g_norm)
}
gini_classi <- gini.index(x_cl)Indice di Gini = 0.9544697
Nonostante il grafico a barre mostri una concentrazione maggiore nelle prime classi, nel complesso i dati occupano molte classi, e nessuna singola classe domina in modo schiacciante. L’alto valore dell’indice di Gini conferma che le osservazioni registrate sono fortemente diversificate in termini di volumi di vendite. In altre parole: la variabilità è elevata, e c’è una buona dispersione tra le diverse classi.
Esercizio probabilità
Nel seguente esercizio si è adottato il criterio della frequenza
relativa per stimare la probabilità di alcuni eventi.
La probabilità di un evento \(E\) viene
calcolata come:
\[ P(E) = \frac{\text{numero di casi favorevoli}}{\text{numero totale di osservazioni}} \]
N <- nrow(dati)
p_city_beaumont <- sum(dati$city == "Beaumont", na.rm = TRUE) / N
p_month_july <- sum(dati$month == "July", na.rm = TRUE) / N
p_dec_2012 <- sum(dati$month == "December" & dati$year == 2012, na.rm = TRUE) / N #evento congiunto
prob_ex <- data.frame(
Evento = c('Beaumont',
'July',
'December & 2012'),
Prob = c(p_city_beaumont, p_month_july, p_dec_2012),
Perc = round(c(p_city_beaumont, p_month_july, p_dec_2012) * 100, 3)
)
kable(prob_ex)| Evento | Prob | Perc |
|---|---|---|
| Beaumont | 0.2500000 | 25.000 |
| July | 0.0833333 | 8.333 |
| December & 2012 | 0.0166667 | 1.667 |
(Nel caso dell’evento congiunto si contano le osservazioni che soddisfano entrambe le condizioni contemporaneamente, divise per il numero totale di osservazioni)
Le probabilità degli eventi sono state calcolate in modo empirico, come frequenza relativa delle occorrenze osservate nel dataset rispetto al numero totale di osservazioni.
Nuove variabili: prezzo medio ed efficacia degli annunci
In questa sezione utilizzeremo le variabili di partenza del dataset per ricavarne altre grazie alle quali condurremo un’analisi più approfondita.
Per determinare il prezzo medio degli annunci utilizziamo le variabili volume e sales così combinate
\[ \textit{avg_price} = \frac{\textit{volume} \times 10^6}{\textit{sales}} \]
dati$avg_price <- with(dati,
ifelse(!is.na(volume) & !is.na(sales) & sales > 0, volume * 1e6 / sales, NA_real_)
)
summary(dati$avg_price)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 97010 132939 156588 154320 173915 213234Per determinare l’efficacia degli annunci di vendita possiamo combinare altre varaiabili per ottenere i seguenti indici:
- Tasso di conversione: quante vendite sono state effettuate per ciascun annuncio in un determinato periodo
\[ \textit{eff_conv} = \frac{\textit{sales}}{\textit{listings}} \]
dati$eff_conv <- with(dati,
ifelse(!is.na(listings) & listings > 0, sales / listings, NA_real_)
)
summary(dati$eff_conv)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.05014 0.08980 0.10963 0.11874 0.13492 0.38713- Velocità di assorbimento: aumenta all’aumentare della velocità con cui vengono vendute le inserzioni correnti
\[ \textit{eff_speed} = \frac{1}{\textit{months_inventory}} \]
dati$eff_speed <- with(dati,
ifelse(!is.na(months_inventory) & months_inventory > 0, 1 / months_inventory, NA_real_)
)
summary(dati$eff_speed)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.06711 0.09133 0.11174 0.11719 0.12821 0.29412- Indice combinato: tiene conto delle vendite per annuncio e della velocità con cui vengono vendute le inserzioni
\[ \textit{eff_adj} = \frac{\textit{sales}}{\textit{listings}} \, \frac{1}{\textit{months_inventory}} \]
dati$eff_adj <- with(dati,
ifelse(!is.na(listings) & listings > 0 & !is.na(months_inventory) & months_inventory > 0, (sales / listings) * (1 / months_inventory), NA_real_)
)
summary(dati$eff_adj)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.003802 0.008521 0.012286 0.015146 0.016671 0.094421Organizziamo i risultati ottenuti per città.
library(dplyr)##
## Caricamento pacchetto: 'dplyr'## I seguenti oggetti sono mascherati da 'package:stats':
##
## filter, lag## I seguenti oggetti sono mascherati da 'package:base':
##
## intersect, setdiff, setequal, unioncity_summary <- dati %>%
group_by(city) %>%
summarise(
avg_price_mean = mean(avg_price, na.rm = TRUE),
eff_conv_mean = mean(eff_conv, na.rm = TRUE),
eff_adj_mean = mean(eff_adj, na.rm = TRUE)
) %>%
arrange(desc(eff_adj_mean))
kable(city_summary)| city | avg_price_mean | eff_conv_mean | eff_adj_mean |
|---|---|---|---|
| Bryan-College Station | 183534.3 | 0.1473431 | 0.0238966 |
| Wichita Falls | 119430.0 | 0.1280140 | 0.0166419 |
| Beaumont | 146640.4 | 0.1061332 | 0.0112856 |
| Tyler | 167676.8 | 0.0934894 | 0.0087613 |
library(ggplot2)
ggplot(city_summary, aes(x = reorder(city, eff_adj_mean), y = eff_adj_mean)) +
geom_col(fill = "steelblue") +
coord_flip() +
labs(title = "Efficacia annunci (indice eff_adj) per città",
x = "Città", y = "eff_adj") +
theme_minimal()
Il grafico a barre fornisce una visione d’insieme dell’efficienza degli annunci in termini di velocità di assorbimento e tasso di conversione.
Dal grafico appare evidente che le zone meno efficienti sono quelle di Tyler e Beaumont pertanto, in prima analisi, si può suggerire di rivedere la disposzione degli investimenti, sia umani sia economici, nelle suddette zone.
Confronti tra città, mesi e anni - indice di efficienza
Organizziamo i risultati ottenuti finora dividendoli per
- Città
by_city <- dati %>%
group_by(city) %>%
summarise(
sales_mean = mean(sales, na.rm = TRUE),
sales_sd = sd(sales, na.rm = TRUE),
median_price_mean = mean(median_price, na.rm = TRUE),
median_price_sd = sd(median_price, na.rm = TRUE),
avg_price_mean = mean(avg_price, na.rm = TRUE),
avg_price_sd = sd(avg_price, na.rm = TRUE),
eff_adj_mean = mean(eff_adj, na.rm = TRUE),
eff_adj_sd = sd(eff_adj, na.rm = TRUE),
)
kable(by_city)| city | sales_mean | sales_sd | median_price_mean | median_price_sd | avg_price_mean | avg_price_sd | eff_adj_mean | eff_adj_sd |
|---|---|---|---|---|---|---|---|---|
| Beaumont | 177.3833 | 41.48395 | 129988.3 | 10104.993 | 146640.4 | 11232.13 | 0.0112856 | 0.0045374 |
| Bryan-College Station | 205.9667 | 84.98374 | 157488.3 | 8852.235 | 183534.3 | 15149.35 | 0.0238966 | 0.0199245 |
| Tyler | 269.7500 | 61.96380 | 141441.7 | 9336.538 | 167676.8 | 12350.51 | 0.0087613 | 0.0036514 |
| Wichita Falls | 116.0667 | 22.15192 | 101743.3 | 11320.034 | 119430.0 | 11398.48 | 0.0166419 | 0.0041415 |
df_long <- bind_rows(
data.frame(city = by_city$city, metric = "sales", mean = by_city$sales_mean, sd = by_city$sales_sd),
data.frame(city = by_city$city, metric = "median_price", mean = by_city$median_price_mean, sd = by_city$median_price_sd),
data.frame(city = by_city$city, metric = "avg_price", mean = by_city$avg_price_mean, sd = by_city$avg_price_sd),
data.frame(city = by_city$city, metric = "eff_adj", mean = by_city$eff_adj_mean, sd = by_city$eff_adj_sd)
)
df_long$metric <- factor(df_long$metric, levels = c("sales","median_price","avg_price","eff_adj"))
pos <- position_dodge(width = 0.8)
ggplot(df_long, aes(x = city, y = mean, fill = city)) +
geom_col(position = pos, width = 0.8) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd),
position = pos, width = 0.2, color = "black") +
facet_wrap(~ metric, scales = "free_y") +
labs(title = "Confronto per città: medie con deviazione standard",
x = NULL, y = NULL, fill = "Città") +
theme_minimal() +
theme(
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
legend.position = "bottom"
) +
guides(fill = guide_legend(title = NULL, nrow = 1, byrow = TRUE)) +
scale_fill_brewer(palette = "Pastel2")
La variabile da tenere sott’occhio per disporre al meglio i futuri investimenti è l’indice combinato eff_adj_mean che riflette quanto evidenziato in precedenza. Tuttavia emerge una deviazione standard elevata che potrebbe essere legata al periodo, mese o anno, in cui è avvenuta l’osservazione che pertanto indagheremo nei prossimi passaggi.
- Città e anno
by_year_city <- dati %>%
group_by(year, city) %>%
summarise(
sales_mean = mean(sales, na.rm = TRUE),
sales_sd = sd(sales, na.rm = TRUE),
median_price_mean = mean(median_price, na.rm = TRUE),
median_price_sd = sd(median_price, na.rm = TRUE),
avg_price_mean = mean(avg_price, na.rm = TRUE),
avg_price_sd = sd(avg_price, na.rm = TRUE),
eff_adj_mean = mean(eff_adj, na.rm = TRUE),
eff_adj_sd = sd(eff_adj, na.rm = TRUE),
.groups = "drop"
)
kable(by_year_city)| year | city | sales_mean | sales_sd | median_price_mean | median_price_sd | avg_price_mean | avg_price_sd | eff_adj_mean | eff_adj_sd |
|---|---|---|---|---|---|---|---|---|---|
| 2010 | Beaumont | 156.1667 | 36.92457 | 133116.67 | 13353.572 | 146582.5 | 13960.173 | 0.0082293 | 0.0017627 |
| 2010 | Bryan-College Station | 167.5833 | 70.75368 | 153533.33 | 5474.126 | 174601.8 | 11964.068 | 0.0122085 | 0.0046253 |
| 2010 | Tyler | 227.5000 | 48.97959 | 135175.00 | 4782.188 | 159537.5 | 8554.899 | 0.0059507 | 0.0014205 |
| 2010 | Wichita Falls | 123.4167 | 26.61667 | 98941.67 | 10360.718 | 120032.5 | 12351.214 | 0.0169636 | 0.0047396 |
| 2011 | Beaumont | 144.0000 | 22.65552 | 125641.67 | 9603.168 | 145921.9 | 12655.337 | 0.0070074 | 0.0009014 |
| 2011 | Bryan-College Station | 167.4167 | 62.19246 | 151416.67 | 3709.407 | 173689.0 | 11645.001 | 0.0103944 | 0.0026003 |
| 2011 | Tyler | 238.8333 | 49.62007 | 136216.67 | 8505.168 | 160248.0 | 8949.978 | 0.0057318 | 0.0007619 |
| 2011 | Wichita Falls | 106.2500 | 19.76280 | 98141.67 | 10631.724 | 113143.6 | 8247.222 | 0.0125675 | 0.0014654 |
| 2012 | Beaumont | 171.9167 | 28.38840 | 126533.33 | 7973.289 | 141475.9 | 10345.771 | 0.0095060 | 0.0018432 |
| 2012 | Bryan-College Station | 196.7500 | 74.28217 | 153566.67 | 7095.752 | 179360.6 | 9072.876 | 0.0137989 | 0.0049038 |
| 2012 | Tyler | 263.5000 | 46.40239 | 139250.00 | 7983.221 | 165533.0 | 12271.146 | 0.0077967 | 0.0011269 |
| 2012 | Wichita Falls | 112.4167 | 14.24754 | 100958.33 | 12347.282 | 117225.3 | 13981.539 | 0.0153704 | 0.0023443 |
| 2013 | Beaumont | 201.1667 | 37.73070 | 132400.00 | 7784.834 | 150079.0 | 6245.121 | 0.0140233 | 0.0027728 |
| 2013 | Bryan-College Station | 237.8333 | 95.84726 | 159391.67 | 5429.123 | 187315.8 | 12931.505 | 0.0279944 | 0.0122290 |
| 2013 | Tyler | 287.4167 | 53.04965 | 146100.00 | 6725.528 | 174501.8 | 8939.224 | 0.0099389 | 0.0012142 |
| 2013 | Wichita Falls | 121.2500 | 26.00393 | 105000.00 | 10383.028 | 122924.3 | 8760.490 | 0.0203310 | 0.0042539 |
| 2014 | Beaumont | 213.6667 | 36.48993 | 132250.00 | 9835.418 | 149142.7 | 11234.169 | 0.0176617 | 0.0030468 |
| 2014 | Bryan-College Station | 260.2500 | 86.69185 | 169533.33 | 7776.460 | 202704.3 | 8625.369 | 0.0550869 | 0.0197176 |
| 2014 | Tyler | 331.5000 | 56.85308 | 150466.67 | 8543.401 | 178563.5 | 10805.818 | 0.0143881 | 0.0032364 |
| 2014 | Wichita Falls | 117.0000 | 21.09287 | 105675.00 | 12443.993 | 123824.3 | 10994.396 | 0.0179769 | 0.0026485 |
pos <- position_dodge(width = 0.85)
ggplot(by_year_city, aes(x = year, y = eff_adj_mean, fill = city)) +
geom_col(position = pos, width = 0.8) +
geom_errorbar(
aes(ymin = pmax(eff_adj_mean - eff_adj_sd, 0),
ymax = eff_adj_mean + eff_adj_sd),
position = pos, width = 0.2, color = "black"
) +
labs(title = "Efficacia annunci (eff_adj): media ± sd per anno e città",
x = "Anno", y = "eff_adj (media)", fill = "Città") +
theme_minimal() +
theme(legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2")
Come volevasi dimostrare eff_adj_mean ha subito una forte variazione a Bryan-College Station nel corso degli anni con un valore che dal 2012 al 2014 è quasi triplicato. Questo dato suggerisce 2 scenari:
Il mercato immobiliare della zona ha subito un generale aumento dovuto a migliorie della città stessa; in questo caso una buona strategia potrebbe essere acquisire nuovi immobili o investire in risorse umane che operino in zona.
Le strategia di marketing adottate in queste zona si sono rilevate particolarmente efficaci. Una volta escluso il primo scenario si potrebbe valutare di applicare le stesse stratagie ad altre zone qualore le variabili socio demografiche e/o culturali lo consentano.
Città e mese
by_month_city <- dati %>%
group_by(city, month) %>%
summarise(
sales_mean = mean(sales, na.rm = TRUE),
sales_sd = sd(sales, na.rm = TRUE),
median_price_mean = mean(median_price, na.rm = TRUE),
median_price_sd = sd(median_price, na.rm = TRUE),
avg_price_mean = mean(avg_price, na.rm = TRUE),
avg_price_sd = sd(avg_price, na.rm = TRUE),
eff_adj_mean = mean(eff_adj, na.rm = TRUE),
eff_adj_sd = sd(eff_adj, na.rm = TRUE),
.groups = "drop"
)
kable(by_month_city)| city | month | sales_mean | sales_sd | median_price_mean | median_price_sd | avg_price_mean | avg_price_sd | eff_adj_mean | eff_adj_sd |
|---|---|---|---|---|---|---|---|---|---|
| Beaumont | January | 121.6 | 31.245800 | 127460 | 22741.878 | 142059.2 | 20363.512 | 0.0081405 | 0.0031117 |
| Beaumont | February | 135.4 | 31.949961 | 126980 | 9500.368 | 146503.0 | 12974.719 | 0.0086983 | 0.0033326 |
| Beaumont | March | 171.0 | 14.866069 | 124460 | 4547.307 | 149918.4 | 5398.706 | 0.0108352 | 0.0032921 |
| Beaumont | April | 189.6 | 17.742604 | 129820 | 5730.794 | 142949.1 | 5511.596 | 0.0113609 | 0.0033970 |
| Beaumont | May | 206.8 | 42.611031 | 129320 | 6828.030 | 146873.9 | 6495.480 | 0.0124133 | 0.0052329 |
| Beaumont | June | 205.0 | 36.034706 | 130680 | 4708.184 | 148591.7 | 4913.971 | 0.0120792 | 0.0048817 |
| Beaumont | July | 185.4 | 22.930329 | 130900 | 7024.244 | 153993.7 | 15215.577 | 0.0106731 | 0.0038604 |
| Beaumont | August | 217.4 | 50.643855 | 138480 | 4784.558 | 150966.9 | 6549.042 | 0.0134622 | 0.0060942 |
| Beaumont | September | 174.0 | 46.888165 | 127760 | 11298.363 | 144663.8 | 13874.571 | 0.0114819 | 0.0063657 |
| Beaumont | October | 189.2 | 43.973856 | 130820 | 9111.915 | 148133.6 | 9899.859 | 0.0124598 | 0.0060843 |
| Beaumont | November | 158.6 | 22.799123 | 132180 | 15191.840 | 134896.1 | 11773.634 | 0.0106806 | 0.0040312 |
| Beaumont | December | 174.6 | 30.113120 | 131000 | 9921.945 | 150135.5 | 10028.542 | 0.0131417 | 0.0052119 |
| Bryan-College Station | January | 118.2 | 27.887273 | 150220 | 6194.514 | 179365.7 | 13494.091 | 0.0127350 | 0.0073264 |
| Bryan-College Station | February | 125.6 | 27.455418 | 156240 | 9968.851 | 169985.7 | 18446.113 | 0.0124482 | 0.0088150 |
| Bryan-College Station | March | 189.8 | 49.736305 | 154200 | 4655.105 | 174920.3 | 8552.149 | 0.0171705 | 0.0149483 |
| Bryan-College Station | April | 236.4 | 49.515654 | 157300 | 7533.923 | 182128.2 | 14123.928 | 0.0194417 | 0.0163482 |
| Bryan-College Station | May | 301.6 | 46.586479 | 155720 | 7137.016 | 181804.4 | 18412.798 | 0.0275728 | 0.0196596 |
| Bryan-College Station | June | 319.4 | 44.150878 | 156740 | 9333.435 | 181582.2 | 18298.850 | 0.0324464 | 0.0240626 |
| Bryan-College Station | July | 306.0 | 95.333625 | 157780 | 9420.828 | 183344.8 | 16508.899 | 0.0375655 | 0.0347992 |
| Bryan-College Station | August | 262.8 | 62.283224 | 158640 | 11023.067 | 184104.9 | 16633.849 | 0.0326242 | 0.0251860 |
| Bryan-College Station | September | 158.4 | 35.373719 | 162440 | 12348.401 | 191815.7 | 9544.628 | 0.0220597 | 0.0177836 |
| Bryan-College Station | October | 151.8 | 46.820935 | 163460 | 8439.964 | 193938.3 | 13905.882 | 0.0223999 | 0.0189751 |
| Bryan-College Station | November | 143.8 | 29.928248 | 158780 | 8694.654 | 192760.5 | 11943.247 | 0.0216070 | 0.0160561 |
| Bryan-College Station | December | 157.8 | 34.193567 | 158340 | 11220.651 | 186660.8 | 15651.209 | 0.0286885 | 0.0246631 |
| Tyler | January | 181.4 | 37.192741 | 129360 | 7166.101 | 154935.3 | 6400.878 | 0.0063715 | 0.0024436 |
| Tyler | February | 211.6 | 28.892906 | 137760 | 8955.054 | 164516.8 | 8645.045 | 0.0072018 | 0.0022389 |
| Tyler | March | 268.4 | 23.222834 | 137660 | 6339.401 | 161441.0 | 11066.124 | 0.0086246 | 0.0021003 |
| Tyler | April | 286.8 | 33.364652 | 136980 | 6558.353 | 162962.8 | 10856.908 | 0.0085662 | 0.0025155 |
| Tyler | May | 311.2 | 47.641369 | 143080 | 6774.732 | 178711.5 | 6087.930 | 0.0093044 | 0.0038047 |
| Tyler | June | 327.0 | 59.845635 | 148920 | 6921.488 | 180028.9 | 11050.260 | 0.0094192 | 0.0040028 |
| Tyler | July | 319.0 | 52.416600 | 146320 | 8211.090 | 170866.7 | 8333.915 | 0.0091116 | 0.0034766 |
| Tyler | August | 310.8 | 47.520522 | 147140 | 4830.424 | 173738.0 | 11343.693 | 0.0091911 | 0.0034371 |
| Tyler | September | 281.4 | 51.684621 | 142860 | 10005.149 | 169106.3 | 17250.045 | 0.0089051 | 0.0041521 |
| Tyler | October | 271.8 | 64.464719 | 141040 | 9092.469 | 167987.0 | 15113.128 | 0.0092786 | 0.0050282 |
| Tyler | November | 225.2 | 54.366350 | 145280 | 11389.996 | 166102.4 | 7061.601 | 0.0085296 | 0.0047469 |
| Tyler | December | 242.4 | 52.908411 | 140900 | 12911.235 | 161724.3 | 14740.546 | 0.0106314 | 0.0062563 |
| Wichita Falls | January | 88.4 | 10.430724 | 89960 | 6288.323 | 106201.5 | 9788.224 | 0.0143179 | 0.0034339 |
| Wichita Falls | February | 90.8 | 7.886698 | 99320 | 8967.274 | 114356.4 | 7397.539 | 0.0143851 | 0.0030250 |
| Wichita Falls | March | 128.6 | 23.564804 | 93340 | 6118.251 | 118266.5 | 12167.279 | 0.0186098 | 0.0037209 |
| Wichita Falls | April | 134.0 | 21.679483 | 101860 | 9127.322 | 117805.3 | 7684.451 | 0.0194162 | 0.0054083 |
| Wichita Falls | May | 135.8 | 23.134390 | 109820 | 9215.042 | 125550.3 | 5015.104 | 0.0186085 | 0.0054338 |
| Wichita Falls | June | 122.8 | 7.628892 | 114140 | 15283.750 | 135980.5 | 13412.726 | 0.0154942 | 0.0023104 |
| Wichita Falls | July | 132.6 | 19.073542 | 104000 | 7153.321 | 119318.8 | 7206.987 | 0.0175228 | 0.0050396 |
| Wichita Falls | August | 134.8 | 9.602083 | 102440 | 5038.154 | 117012.4 | 5664.009 | 0.0177123 | 0.0047061 |
| Wichita Falls | September | 115.6 | 14.876155 | 103100 | 9134.276 | 120503.5 | 6905.672 | 0.0155773 | 0.0048857 |
| Wichita Falls | October | 106.8 | 8.526430 | 98600 | 18400.136 | 113530.6 | 13971.741 | 0.0152842 | 0.0042713 |
| Wichita Falls | November | 99.8 | 10.848963 | 100980 | 12908.214 | 123173.0 | 12234.014 | 0.0151650 | 0.0029251 |
| Wichita Falls | December | 102.8 | 15.658863 | 103360 | 9863.468 | 121461.4 | 12532.343 | 0.0176094 | 0.0034334 |
pos <- position_dodge(width = 0.85)
ggplot(by_month_city, aes(x = month, y = eff_adj_mean, fill = city)) +
geom_col(position = pos, width = 0.8) +
geom_errorbar(
aes(ymin = pmax(eff_adj_mean - eff_adj_sd, 0),
ymax = eff_adj_mean + eff_adj_sd),
position = pos, width = 0.2, color = "black"
) +
labs(title = "Efficacia annunci (eff_adj): media ± sd per mese e città",
x = "Mese", y = "eff_adj (media)", fill = "Città") +
theme_minimal() +
theme(
legend.position = "bottom",
axis.text.x = element_text(angle = 30, hjust = 1)
) +
scale_fill_brewer(palette = "Pastel2")
Dal grafico appare evidente una dipendenza dalla stagionalità, più accentuata in alcune città rispetto ad altre. È palese, per esempio, come il mercato immobiliare risenta dei benefici del periodo estivo e lievemente anche di quello natalizio.
- Città, mese e anno
by_year_month_city <- dati %>%
group_by(year, month, city) %>%
summarise(
eff_adj_mean = mean(eff_adj, na.rm = TRUE),
eff_adj_sd = sd(eff_adj, na.rm = TRUE),
.groups = "drop"
)
by_year_month_city$month <- factor(by_year_month_city$month,
levels = month.name, ordered = TRUE)
pos <- position_dodge(width = 0.85)
ggplot(by_year_month_city, aes(x = month, y = eff_adj_mean, fill = city)) +
geom_col(position = pos, width = 0.8) +
geom_errorbar(aes(ymin = pmax(eff_adj_mean - eff_adj_sd, 0),
ymax = eff_adj_mean + eff_adj_sd),
position = pos, width = 0.2, color = "black") +
facet_wrap(~ year, ncol = 1, scales = "free_y") +
labs(title = "Efficacia annunci (eff_adj): media ± sd per mese e città",
x = "Mese", y = "eff_adj (media)", fill = "Città") +
theme_minimal() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 30, hjust = 1)) +
scale_fill_brewer(palette = "Pastel2")
Da quest’ultimo grafico emerge un’interessante cambiamento di tendenza: l’azienda nel 2010 traeva i maggiori profitti (considerando anche il rapporto spesa/impresa) nella zona di Wichita Falls nel periodo primaverile, invece nel 2014 il fatturato è stato perlopiù guidato dal mercato immobiliare della zona di Bryan-College Station nel periodo estivo.
Confronti tra città e anni - prezzo mediano
Confrontiamo la distribuzione di median_price tra le città
ggplot(dati, aes(x = reorder(city, median_price, FUN = median, na.rm = TRUE),
y = median_price)) +
geom_boxplot(aes(fill=city), outlier.alpha = 0.35) +
geom_jitter(width = 0.2, alpha = 0.3) +
labs(title = "Prezzo mediano per città",
x = "Città (ordinate per mediana)", y = "Prezzo mediano ($)") +
theme_minimal() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels = scales::dollar_format()) +
scale_fill_brewer(palette = "Pastel2")
Il boxplot del prezzo mediano per città mostra quattro mercati nettamente distinti per livello: Wichita Falls è il più accessibile (mediana ≈ 95–105k$), Beaumont si colloca nel medio-basso (≈ 125–135k$), Tyler nel medio-alto (≈ 145–155k$) e Bryan–College Station è il più caro (≈ 155–165k$).
Le implicazioni operative suggerite per l’agenzia sono le seguenti:
Usare la mediana locale come ancora di prezzo nelle stime e per comunicare al venditore un range realistico
Spingere prodotti entry-level e piani di finanziamento a Wichita Falls; mid-market a Beaumont/Tyler; premium (servizi foto/video professionali, home staging,…) a Bryan–College Station.
Allocare agenti senior nelle aree a ticket più alto (Bryan–College, Tyler), mantenere i volumi a Beaumont; promuovere campagne di accessibilità finanziaria a Wichita Falls per ampliare la domanda.
Introduciamo una divisione per anni:
ggplot(dati, aes(x = reorder(city, median_price, FUN = median, na.rm = TRUE),
y = median_price)) +
geom_boxplot(aes(fill=city), outlier.shape = NA) +
coord_flip() +
facet_wrap(~ year, ncol = 1) +
labs(title = "Prezzo mediano per città, per anno",
x = "Città", y = "Prezzo mediano ($)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.3)) +
scale_fill_brewer(palette = "Pastel2")
Il boxplot mostra una gerarchia stabile dei livelli di prezzo lungo tutto il periodo: Bryan–College Station è sistematicamente il più caro (mediana in lieve crescita, ~160k→170k), Tyler segue con un trend positivo (≈140k→150k), Beaumont resta su valori medio‐bassi con variazioni contenute (≈125k→130k), mentre Wichita Falls è il mercato più accessibile (≈95–110k) e presenta la maggiore variabilità in alcuni anni.
Per la pianificazione del prossimo ciclo, assumere incrementi moderati nei mercati in crescita (Bryan e Tyler) e una dinamica lenta e lieve negli altri due.
Confronti tra città, mesi e anni - volume di vendite
ggplot(dati, aes(x = reorder(city, volume, FUN = median, na.rm = TRUE),
y = volume, fill = city)) +
geom_boxplot(outlier.alpha = 0.35) +
labs(title = "Confronto del volume medio mensile per città",
x = "Città",
y = "Volume (milioni $)") +
theme_minimal() +
theme(legend.position = "none") +
scale_fill_brewer(palette = "Pastel2")
dati$year <- factor(dati$year, levels = sort(unique(dati$year)))
ggplot(dati, aes(x = year, y = volume, fill = year)) +
geom_boxplot(outlier.alpha = 0.35) +
labs(title = "Confronto del volume medio mensile per anno",
x = "Anno", y = "Volume (milioni $)") +
theme_minimal() +
theme(legend.position = "none")
I due boxplot confermano che il volume transato varia in modo sistematico tra città e nel tempo:
Per città, il volume cresce da Wichita Falls (più bassa e stabile) a Beaumont, fino a Bryan–College Station e Tyler, che mostrano livelli più alti e dispersione maggiore.
Per anno, il volume e l’ampiezza delle distribuzioni aumentano dal 2010 al 2014, segnalando un ciclo espansivo accompagnato da volatilità crescente.
I grafici confermano quindi un trend crescente e geolocalizzato pertanto risultano ancora valdii i consigli operativi precedenti.
…
volume_m_c <- dati %>%
group_by(month, city) %>%
summarise(volume_tot = sum(volume, na.rm = TRUE), .groups = "drop")
ggplot(volume_m_c, aes(x = month, y = volume_tot, fill = city)) +
geom_col(position = position_dodge()) +
labs(title = "Volume totale per mese e città",
x = "Mese", y = "Volume (milioni $)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1),
legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2") 
ggplot(volume_m_c, aes(x = month, y = volume_tot, fill = city)) +
geom_col(position = "stack") + # impilate
labs(title = "Volume delle vendite per mese e città",
x = "Mese", y = "Volume (milioni $)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1),
legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2") 
ggplot(volume_m_c, aes(x = month, y = volume_tot, fill = city)) +
geom_col(position = "fill") +
labs(title = "Composizione % del volume delle vendite per mese",
x = "Mese", y = "% sul totale mensile") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1),
legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2") 
volume_m_cy <- dati %>%
group_by(year, month, city) %>%
summarise(volume_tot = sum(volume, na.rm = TRUE), .groups = "drop")
ggplot(volume_m_cy, aes(x = month, y = volume_tot, fill = city)) +
geom_col(position = "dodge") +
facet_wrap(~ year, ncol = 1, scales = "free_y") +
labs(title = "Totale vendite per mese, città e anno",
x = "Mese", y = "Volume delle vendite") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.3 ),
legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2") 
I quattro grafici raccontano la stessa situazione ma da prospettive diverse: il volume mensile cresce da gennaio fino al picco tra maggio-luglio, poi cala in agosto-settembre e chiude con un lieve rimbalzo a dicembre; nel grafico a barre sovrapposte appare evidente che il mercato complessivo è più ampio proprio in Q2 e inizio Q3. La scomposizione per città evidenzia che Tyler è il contributore principale per tutto l’anno, Bryan–College Station segue con un profilo stagionale molto marcato in primavera-estate, Beaumont pesa meno ma in modo costante, Wichita Falls ha quota ridotta e abbastanza stabile. Il grafico suddiviso per anni conferma che il pattern stagionale è pressochè ricorrente e che gli anni più recenti mostrano livelli più alti, a parità di mesi.
Un altro suggerimento operativo potrebbe essere quindi quello di tenere conto della stagionalità: una buona strategia potrebbe essere spostare budget e personale verso Aprile-Luglio, nei mesi “deboli” (tra Settembre e Novembre) attivare promo finanziarie per sostenere l’assorbimento, mentre a Dicembre pianificare incrementi tattici d’investimento per sfruttare il rimbalzo stagionale.
Confronti tra città, mesi e anni - numero di vendite
sales_m_c <- dati %>%
group_by(month, city) %>%
summarise(sales_tot = sum(sales, na.rm = TRUE), .groups = "drop")
ggplot(sales_m_c, aes(x = month, y = sales_tot, fill = city)) +
geom_col(position = position_dodge()) +
labs(title = "Totale vendite per mese e città",
x = "Mese", y = "Vendite (totale)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1),
legend.position = "bottom") +
scale_fill_brewer(palette = "Pastel2") 
Il grafico ribadisce una stagionalità netta: le vendite crescono da gennaio, raggiungono il picco tra maggio–luglio e poi calano in autunno, con un rimbalzo in dicembre; la gerarchia tra città è stabile con Tyler sistematicamente al primo posto, Bryan–College Station subito dietro, Beaumont terza (con un secondo picco autunnale più marcato) e Wichita Falls ultima e più regolare.
m_num <- match(as.character(dati$month), month.name)
dati$date <- as.Date(sprintf("%d-%02d-01", as.integer(as.character(dati$year)), m_num))
sales_time <- dati %>%
group_by(date, city) %>%
summarise(sales_tot = sum(sales, na.rm = TRUE), .groups = "drop")
ggplot(sales_time, aes(x = date, y = sales_tot, color = city)) +
geom_line() +
scale_x_date(limits = c(as.Date("2010-01-01"), as.Date("2014-12-31")),
date_breaks = "1 year", date_labels = "%Y") +
labs(title = "Andamento temporale delle vendite",
x = "Data", y = "Vendite (totale)") +
theme_minimal() +
theme(legend.position = "bottom")
ggplot(sales_time, aes(x = date, y = sales_tot, group = city, color = city)) +
geom_line(show.legend = FALSE) +
facet_wrap(~ city, scales = "free_y") +
scale_x_date(limits = c(as.Date("2010-01-01"), as.Date("2014-12-31")),
date_breaks = "1 year", date_labels = "%Y") +
labs(title = "Andamento temporale delle vendite",
x = "Data", y = "Vendite (totale)") +
theme_minimal()
I grafici mostrano chiaramente un profilo stagionale ricorrente delle vendite: in tutte le città i picchi si concentrano tra maggio–luglio, seguiti da un calo autunnale e da un rimbalzo a dicembre. Si nota una crescita graduale nel tempo (più marcata a Tyler e a Bryan–College Station);
Le differenze di volatilità sono visibili nelle oscillazioni: Tyler/Bryan hanno ampiezze maggiori e pertanto corrisponde un rapporto rischio/opportunità elevato, a Beaumont medio, mentre a Wichita basso (la più stabile).
Conclusioni
Sintesi dei risultati
Domanda e stagionalità: dalle barre per mese/città e dalle serie temporali aggregate per città appare evidente che il ciclo annuale è marcato: le vendite accellerano in tarda primavera-estate (picchi tra maggio-luglio) e rallentano in autunno-inizio inverno.
Efficacia commerciale per città: l’indice costruito per misurare l’efficacia degli annunci (eff_adj) pone Bryan-College Station al 1° posto, seguita da Wichita Falls, Beaumont e Tyler. Questa osservazione vale sia in media sia tenendo conto dei profili annuali.
Prezzi e posizionamento: Dai boxplot per città e anno emerge che il prezzo mediano è più alto a Bryan-College Station), si collocano nel mid-market Tyler e Beaumont, più basso a Wichita Falls(adatto ai segmenti entry-level).
Variabilità/eterogeneità: Il volume delle vendite è la variabile più “instabile”; ha l’asimmetria più elevata e il coefficiente di variazione maggiore; inoltre la suddivisione in classi restituisce un indice di Gini ≈ 0,95, segno di forte dispersione e quindi che i mercati locali sono molto diversificati tra loro.
Cambiamento del driver dei ricavi: tra 2010 e 2014 si osserva un cambio di traino; da Wichita Falls (primavera) nel 2010 a Bryan-College Station (estate) nel 2014. Questo riflette sia prezzi medi crescenti sia una maggiore efficacia delle inserzioni nell’area di Bryan-College Station.
Suggerimenti operativi
Pianificazione stagionale dell’offerta. Anticipare inventario e promuovere campagne su maggio-luglio (alta stagione).
Allocazione del budget marketing. Aumentare la quota di spesa su Bryan-College Station, dove l’efficacia risulta massima; sperimentare campagne mirate nella zona di Tyler (volumi alti ma efficienza più bassa) per migliorare la conversione.
Segmentazione di prezzo. In Wichita Falls spingere con campagne di accessibilità finanziaria; in Beaumont e Tyler, dove il mercato è più altalenante, adottare strategie di pricing dinamico.