Analisi del mercato immobiliare della Texas Realty Insights

library(ggplot2)
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, union

library(moments)
library(knitr)
dataset <- read.csv("realestate_texas.csv",sep = ",", fileEncoding = "latin1")
summary(dataset)

##      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.900

attach(dataset)

1) Analisi delle variabili

Il dataset contiene le seguenti variabili:

city: città di riferimento (variabile discreta qualitativa)
year: anno di riferimento (variabile temporale discreta quantitativa)
month: mese di riferimento (variabile temporale discreta quantitativa)
sales: numero totale di vendite (variabile continua quantitativa)
volume: valore totale delle vendite (in milioni di dollari) (variabile continua quantitativa)
median_price: prezzo mediano di vendita (in dollari) (variabile continua quantitativa)
listings: numero totale di annunci attivi (variabile continua quantitativa)
months_inventory: quantità di tempo necessaria per vendere tutte le inserzioni correnti, espresso in mesi (variabile temporale discreta quantitativa)

E’ possibile analizzare i comportamenti delle variabili quantitative per produrre valutazioni sulla efficacia di vendita, sia impostare una confronto temporale su:

anni differenti
periodi dell’anno diversi, raggruppando i dati di tutti gli anni
l’intero periodo in analisi

2) Tabulazione indici di posizione per tutte le variabili

Tabulo i valori medi per le variabili continue sales, volume, median_price, listings e months_inventory Ho mantenuto la divisione per City e creato la colonna Saled (che è il totale di vendite nel quinquennio) come indice di confronto della dimensione di attività per ogni città

data_x_city <- dataset %>%
  group_by(city)%>%
  summarise(saled = sum(sales),
            media_sales = mean(sales),
            media_volume= mean(volume),
            media_median_price = mean(median_price),
            media_annunounc = mean(listings),
            media_time = mean(months_inventory))

knitr::kable(head(data_x_city))

city	saled	media_sales	media_volume	media_median_price	media_annunounc	media_time
Beaumont	10643	177.3833	26.13160	129988.3	1679.3167	9.970000
Bryan-College Station	12358	205.9667	38.19160	157488.3	1458.1333	7.658333
Tyler	16185	269.7500	45.76738	141441.7	2905.0500	11.325000
Wichita Falls	6964	116.0667	13.93017	101743.3	909.5833	7.816667

Tabulo i valori di range e deviazione standard per sales, volume, median_price, listings e months_inventory raggruppate per città

variabilità_x_city <- dataset %>%
  group_by(city)%>%
  summarise(range_sales = max(sales)-min(sales),
            dev_std_sales = sd(sales),
            range_volume = max(volume)-min(volume),
            dev_std_volume = sd(volume),
            range_median_price = max(median_price)-min(median_price),
            dev_std_price = sd(median_price),
            range_listings = max(listings)-min(listings),
            dev_std_listings = sd(listings),
            range_time = max(months_inventory)-min(months_inventory),
            dev_std_time = sd(months_inventory)
  )

knitr::kable(head(variabilità_x_city))

city	range_sales	dev_std_sales	range_volume	dev_std_volume	range_median_price	dev_std_price	range_listings	dev_std_listings	range_time	dev_std_time
Beaumont	190	41.48395	28.532	6.970384	57100	10104.993	357	91.13382	5.6	1.6495814
Bryan-College Station	314	84.98374	68.396	17.248577	39300	8852.235	1102	252.52753	8.2	2.2472048
Tyler	280	61.96380	59.764	13.107146	41000	9336.538	1024	226.75458	8.0	1.8864032
Wichita Falls	88	22.15192	12.715	3.239766	61500	11320.034	309	73.75504	3.3	0.7809526

Tabulo i valori di range e deviazione standard per sales, volume, median_price, listings e months_inventory TOTALI

variabilità_tot <- dataset %>%
  summarise(dev_std_sales = sd(sales),
            dev_std_volume = sd(volume),
            dev_std_price = sd(median_price),
            dev_std_listings = sd(listings),
            dev_std_time = sd(months_inventory))

knitr::kable(head(variabilità_tot))

dev_std_sales	dev_std_volume	dev_std_price	dev_std_listings	dev_std_time
79.65111	16.65145	22662.15	752.7078	2.303669

Tabulo i valori di asimmetria con l’indice di Skewness

asimmetria_tot <- dataset %>%
  summarise(asim_sales = skewness(sales),
            asim_volume = skewness(volume),
            asim_price = skewness(median_price),
            asim_listings = skewness(listings),
            asim_time = skewness(months_inventory))

3) Determinazione delle variabili con maggior variabilità e asimmetria

I valori della deviazione standard mostrano che i valori del median_price sono quelli con maggior variabilità (sd = 22662.15), mentre quelli di months_inventiry sono quelli con minore variabilità (sd = 2.30) Nel raggruppamento per city si vede che all’interno della variabile median_price la città di Wichita Falls ha massima variabilità (sd = 11320.034), mentre Bryan-College Station ha minor variabilità (sd = 8852.235). I dati riguardanti le asimmetrie delle distribuzioni mostrano una massima simmetria per i dati di months_inventory (skewness = 0.04), e massima asimmetria per volume (skewness = 0.88).

Complessivamente la distribuzione di months_inventory è quella più simmetrica e con minor variabilità.

dataset$date <- as.Date(paste(dataset$year, dataset$month, 1, sep = "-")) #aggiunge una colonna data con date in ordine cronologico per tutti i 5 anni in esame

4) Divisione in classi per la variabile sales

Divido la variabile Sales in classi trimestrali, mantendo il raggruppamento per city

dataset_trim <- dataset %>%
  select(city, month, sales) %>%
  mutate(
    trim = paste0(ceiling(month / 3))
  ) %>%
  group_by(city, trim) %>%
  summarise(trimestral_sales = sum(sales), .groups = "drop") %>%
  left_join(
    dataset %>%
      group_by(city) %>%
      summarise(total_sales = sum(sales), .groups = "drop"),
    by = "city"
  ) %>%
  mutate(
    perc_on_total = round(trimestral_sales / total_sales * 100, 2)
  )

knitr::kable(head(dataset_trim))

city	trim	trimestral_sales	total_sales	perc_on_total
Beaumont	1	2140	10643	20.11
Beaumont	2	3007	10643	28.25
Beaumont	3	2884	10643	27.10
Beaumont	4	2612	10643	24.54
Bryan-College Station	1	2168	12358	17.54
Bryan-College Station	2	4287	12358	34.69

Il grafico a barre rappresenta l’andamento nei 4 trimestri per ogni città, considerando i dati cumulati dell’intero quinquennio

ggplot(dataset_trim, aes(x = trim, y = trimestral_sales, fill = city)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(x = "Trimestre", y = "Vendite Trimestrali", fill = "Città", title = "Dati di vendite trimestrali nel quinquennio in analisi") +
  theme_minimal()

Dal grafico si può osservare come in ogni città vi sia un trend differenziato nei trimestri, con il due trimestri centrali con più vendite Nel dataframe dataset_trim la colonna perc_on total indica i valori percentuali di ogni trimestre sul totale di vendite per città

Il trend differenziato tra i mesi si può osservare anche cumulando le vendite di tutte le città

total_dataset_monthly <- dataset %>%
  select(month, sales) %>%
  group_by(month) %>%
  summarise(
    monthly_sales = sum(sales),
    .groups = "drop"
  )

knitr::kable(head(total_dataset_monthly))

month	monthly_sales
1	2548
2	2817
3	3789
4	4234
5	4777
6	4871

ggplot(total_dataset_monthly, aes(x = month, y = monthly_sales)) +
  geom_bar(stat = "identity", fill = "light blue", col = "blue") +
  labs(x = "Mesi", y = "Vendite Mensili", title = "Dati complessivi di vendite mensili nel quinquennio in analisi") +
  scale_x_continuous(breaks = seq(0,12,1))+
  theme_minimal()

Dal grafico a barre si può immediatamente vedere la variazione di vendite nei differenti mesi (dati complessivi del quinquennio in analisi)

Funzione per calcolo indice di etereogenità di gini

gini <- function(x){
  freq_ass = table(x)
  freq_rel = freq_ass/sum(freq_ass)
  gini <- 1- sum(freq_rel^2)
  return(gini)
}

Su questo dataset calcolo gli indici di simmetria, variabilità ed etereogenità

index_monthly <- total_dataset_monthly %>%
  reframe(v_medio = mean(monthly_sales),
          v_median = median(monthly_sales),
          dev= sd(monthly_sales),
          asim= skewness(monthly_sales),
          k = kurtosis(monthly_sales)-3,
          gini = gini(monthly_sales))

knitr::kable(head(index_monthly))

v_medio	v_median	dev	asim	k	gini
3845.833	3718	797.5316	-0.1254432	-1.263172	0.9166667

I dati di index_monthly mostrano una distribuzione con deviazione stnd piuttosto alta, quindi disordinati rispetto al valore medio con un indice di simmetria basso (-0.12), quindi una buona simmetria un indice di curtosi negativo che rappresenta una distribuzione platicurtica (cioè più appiattita) e un coefficiente di gini vicino a 1, per cui una distribuzione disomogenea

5) Calcolo probabilità per estrazione dati

Probabilità città di Beaumont

freq_city <- table(city)/sum(table(city))*100

La probabilià è del 25% per ogni città

Probabilità mese di luglio

freq_month <- table(month)/sum(table(month))*100

la probabilità è dell’8,33% (1/12) per ogni mese

Probabilità per dicembre 2012

freq_month_year <- table(year, month)/sum(table(year, month))*100

la probabilità è del 1,67% per ogni misura condizionata di mese e anno

6) Creare una colonna “prezzo medio” e un coefficiente che misuri l’efficacia di vendità nelle diverse città

Il calcolo del prezzo medio è derivato dal rapporto tra volume totale di vendite (in $) e il numero di vendite

mean_price <- dataset %>%
  group_by(city, year, month, median_price)%>%
  reframe(
    mean_price = volume/sales*(10^6),
    rate = mean_price/median_price,
    notes = case_when(
      rate > 1      ~ "asim positiva",
      rate < 1      ~ "asim negativa",
      near(rate, 1) ~ "simmetria"
    )
  )

knitr::kable(head(mean_price, 5))

city	year	month	median_price	mean_price	rate	notes
Beaumont	2010	1	163800	170626.5	1.041676	asim positiva
Beaumont	2010	2	138200	163796.3	1.185212	asim positiva
Beaumont	2010	3	122400	157697.8	1.288381	asim positiva
Beaumont	2010	4	123200	134095.0	1.088433	asim positiva
Beaumont	2010	5	123100	142737.6	1.159526	asim positiva

Ho aggiunto la colonna notes per commentare se i dati relativi a prezzo medio e mediano per ogni trimestre evidenziassero una asimmetria Essendo il prezzo medio maggiore del prezzo mediano in tutte le rilevazioni tranne una (Beaumont, novembre 2010), si può valutare che la distribuzione dei prezzi delle case abbia una asimmetria con code lunghe vero prezzi più alti

Efficacia annunci di vendita

Dalla tabella table_efficiency si vede il trend trimestrale per città di variazione di efficacia di vendita su numero di annunci

table_efficiency <- dataset %>%
  mutate(city = factor(city, levels = sort(unique(city)))) %>%
  arrange(year, city) %>%
  mutate(
    trim = paste0(ceiling(month / 3)),
    middle_step = sales/listings,
  ) %>%
  group_by(city, year, trim) %>%
  reframe(
    sales_anno = sum(sales),
    listings_anno = sum(listings),
    year_inventory = sum(months_inventory),
    efficiency_listings = sales_anno/listings_anno*100,
    weighted_efficiency_listings = sum(middle_step*months_inventory)/sum(months_inventory)*100
  ) %>%
  ungroup()

Un coefficiente in grado di esprimere l’efficacia delle politiche di vendita può essere dato dal rapporto percentuale tra vendite e annunci. Ho provato a considerare una media del rapporto vendite/annunci pesata sul tempo months_inventory, ma la variazione non è apprezzabile nè maggiormente indicativa

table_efficiency$month_trim <- (as.numeric(table_efficiency$trim)) * 3
table_efficiency$date <- as.Date(paste(table_efficiency$year, table_efficiency$month_trim, 1, sep = "-"))

ggplot(table_efficiency, aes(x= date, y = efficiency_listings, color = city))+
  geom_line()+
  labs( x = "data", y = "efficienza % di vendita", title = "Andamento coefficente di efficacia" )

Dal grafico si può osservare anche un trand di miglioramento del coefficiente di efficacia all’interno del quinquennio in ogni città in analisi.

La tabella efficiency_skewness evidenzia i valori medi di efficienza e efficienza pesata per tutte le città. I ceoefficienti di skewness positivi indicano un allungamento della distribuzione verso valori più alti, quindi una misura differente di quanto era osservabile nel grafico precedente.

efficiency_skewness <- table_efficiency %>%
  group_by(city)%>%
  summarise(
    mean(efficiency_listings),
    skewness(efficiency_listings),
    mean(weighted_efficiency_listings),
    skewness(weighted_efficiency_listings)
  )

knitr::kable(head(efficiency_skewness))

city	mean(efficiency_listings)	skewness(efficiency_listings)	mean(weighted_efficiency_listings)	skewness(weighted_efficiency_listings)
Beaumont	10.615742	0.3366012	10.612259	0.3391820
Bryan-College Station	14.735769	0.8760285	14.728776	0.8810173
Tyler	9.352381	0.6108735	9.349529	0.6077307
Wichita Falls	12.797652	0.7351822	12.790734	0.7504676

7) Statistiche condizionate per città, anno e mese

Studio la variazione nelle proporzioni di vendita nei differenti anni tra le città

vendite_per_citta_anno <- dataset %>%
  group_by(year, city) %>%
  reframe(
    tot_vendite = sum(sales)
  )%>%
  mutate(city = factor(city, levels = sort(unique(city)))) %>%
  arrange(year, city) %>%
  group_by(year) %>%
  mutate(
    tot_annuo = sum(tot_vendite),
    freq_citta = tot_vendite / tot_annuo,
    perc = freq_citta*100,
    pos = 1-cumsum(freq_citta)+(freq_citta/2)
  ) %>%
  ungroup()

ggplot(vendite_per_citta_anno, aes(x = factor(year), y = freq_citta, fill = city)) +
  geom_bar(stat = "identity", position = "fill") +
  geom_text(aes(y = pos, label = sprintf("%.1f%%", perc)), color = "black") +
  scale_y_continuous(breaks = seq(0, 1, 0.1), labels = scales::percent_format(accuracy = 1)) +
  labs(y = "Frequenza (%)", x = "Anno", title = "Confronto quote di Vendite per Città e anno") +
  theme_minimal()

Dal grafico precedente si possono vedere due lievi tendenze:

un calo della quota di vendite di Wichita Falls (che pure aveva evidenziato un buon coefficiente di efficacia)
Una crescita delle quote di Bryan-College Station (che aveva il miglior coefficiente di efficacia)

Può essere utile confrontare il grafico sulle quote di vendita con uno con le quote di annunci

listings_per_citta_anno <- dataset %>%
  group_by(year, city) %>%
  reframe(
    tot_listings = sum(listings)
  )%>%
  mutate(city = factor(city, levels = sort(unique(city)))) %>%
  arrange(year, city) %>%
  group_by(year) %>%
  mutate(
    tot_annuo = sum(tot_listings),
    freq_citta = tot_listings / tot_annuo,
    perc = freq_citta*100,
    pos = 1-cumsum(freq_citta)+(freq_citta/2)
  ) %>%
  ungroup()

ggplot(listings_per_citta_anno, aes(x = factor(year), y = freq_citta, fill = city)) +
  geom_bar(stat = "identity", position = "fill") +
  geom_text(aes(y = pos, label = sprintf("%.1f%%", perc)), color = "black") +
  scale_y_continuous(breaks = seq(0, 1, 0.1), labels = scales::percent_format(accuracy = 1)) +
  labs(y = "Frequenza (%)", x = "Anno", title = "Confronto quote di Annunci per Città e anno") +
  theme_minimal()

Da questo secondo grafico è possibile vedere differenze tra le quote di vendite e quelle di annunci per ogni città

Solo Beaumont sembra avere un trend crescente come quote di annunci, per tutte le altre città le quote sono stabili
Tyler (che detiene la quota maggioritaria delle vendite) ha una percentuale di annunci maggiore

ggplot(dataset, aes(x = city, y = median_price, fill = city)) +
  geom_boxplot()+
  labs(y = "Prezzo mediano", x = "Città", title = "Confronto distribuzione prezzo per le varie città")

Nei casi di Beaumont e Tyler ho provato a vedere se ci fosse una correlazione anche tra prezzo mediano e numero di vendite

Beaumont <- dataset %>%
  filter(city == "Beaumont") %>%
  select(sales, median_price, month, year, date)

breaksB <- seq(from = min(Beaumont$median_price, na.rm=TRUE),
               to = max(Beaumont$median_price, na.rm=TRUE),
               length.out = 6)
labelsB <- paste0(round(breaksB[-length(breaksB)], 0), "-", round(breaksB[-1], 0))

Beaumont <- Beaumont %>%
  mutate(
    fascia_median_price = cut(median_price, 
                              breaks = breaksB, 
                              labels = labelsB, 
                              include.lowest = TRUE)
  )

ggplot(Beaumont, aes(x = fascia_median_price, y = sales))+
  geom_boxplot()+
  labs(y = "Vendite", x = "Fasce di prezzo", title = "Analisi Beaumont")

Tyler <- dataset %>%
  filter(city == "Tyler") %>%
  select(sales, median_price, month, year, date)

breaksT <- seq(from = min(Tyler$median_price, na.rm=TRUE),
               to = max(Tyler$median_price, na.rm=TRUE),
               length.out = 6)
labelsT <- paste0(round(breaksT[-length(breaksT)], 0), "-", round(breaksT[-1], 0))

Tyler <- Tyler %>%
  mutate(
    fascia_median_price = cut(median_price, 
                              breaks = breaksT, 
                              labels = labelsT, 
                              include.lowest = TRUE)
  )

ggplot(Tyler, aes(x = fascia_median_price, y = sales))+
  geom_boxplot()+
  labs(y = "Vendite", x = "Fasce di prezzo", title = "Analisi Tyler")

I due boxplot precedenti non mostrano particolari tendenze di legame tra le fasce di prezzo delle vendite e il numero di vendite Nota: le fasce di prezzo nei due grafici risultano estremamente grezze, ma sono quelle che dividono in 5 fasce uguali i prezzi di vendita delle rispettive città

Grafici con serie storiche di dati

ggplot(dataset, aes(x= date, y = sales, color = city))+
  geom_line()+
  labs(x = "data", y = "vendite", title = "Serie storica delle vendite nel quinquennio")

ggplot(Tyler, aes(x= date, y = sales, color = year))+
  geom_line()+
  labs(x = "data", y = "vendite", title = "Serie storica delle vendite nel quinquennio per la città di Tyler")