Analisi del Mercato Immobiliare del Texas

Modifiche effettuate:

Ho inserito i commenti fuori dai blocchi di codice
Ho sistemato la formattazione dei risultati con kabble() eliminando i print della console
Ho eliminato la parte 1 inserendo le classificazioni delle variabili come quelle del feedback
Ho diminuito le classi del punto 4 riducendole a 10 ed ho commentato l’indice di Gini
Ho commentato la probabilità delle variabili nel punto 5
Ho commentato il punto 6 riguardo all’efficacia degli annunci di vendita
Ho trattato mesi e gli anni come factor negli assi dei grafici
Ho modificato la visualizzazione del grafico a barre creando più rappresentazioni con facet_wrap
Ho aggiunto il linechart e i commenti ai grafici

Librerie

library(knitr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2) 
library(tidyr)
library(e1071)
library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

Caricamento file

setwd("~/texas_real_estate")
data = read.csv("realestate_texas.csv")

Funzioni

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)
}

CV = function(x){
  return( sd(x)/mean(x) * 100 )
}


N=dim(data)[1]

1. Analisi delle variabili

city: Qualitativa nominale
Si può controllare come varia il prezzo e il numero di vendite in base alla città.
year: quantitativa continua da trattare come qualitativa ordinale
Si può controllare come varia il prezzo e il numero di vendite in base all’anno.
month: Qualitativa nominale (ciclica) ma codificata in numeri
Si può controllare come varia il prezzo e il numero di vendite in base al mese
sales: Quantitativa discreta
Insieme al volume è la variabile. Dovrebbe essere correlato positivamente con volume.
volume: Quantitativa continua
Dovrebbe essere correlato positivamente con sales
median_price: Quantitativa continua
listings: Quantitativa discreta
Si può controllare se c’è una correlazione positiva con sales
months_inventory: Quantitativa continua
Dovrebbe essere correlato negativamente con il numero di vendite. Anche in questo caso si può vedere l’andamento rispetto alle altre variabili temporali (year, month)

2. Indici di posizione, variabilità e forma

summary_stats = data %>%
  summarise(across(c(sales, volume, median_price, listings, months_inventory),
                   list(
                     media = ~mean(.x),
                     mediana = ~median(.x),
                     dev_std = ~sd(.x),
                     asimmetria = ~skewness(.x),
                     curtosi = ~kurtosis(.x)
                   )))
sales_stats <- summary_stats %>%
  select(contains("sales"))
volume_stats <- summary_stats %>%
  select(contains("volume"))
median_price <- summary_stats %>%
  select(contains("median_price"))
listings <- summary_stats %>%
  select(contains("listings"))
months_inventory <- summary_stats %>%
  select(contains("months_inventory"))



kable(sales_stats, digits=2, format = "html")%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

sales_media	sales_mediana	sales_dev_std	sales_asimmetria	sales_curtosi
192.29	175.5	79.65	0.71	-0.34

kable(volume_stats, digits=2, format = "html")%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

volume_media	volume_mediana	volume_dev_std	volume_asimmetria	volume_curtosi
31.01	27.06	16.65	0.88	0.15

kable(median_price, digits=2, format = "html")%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

median_price_media	median_price_mediana	median_price_dev_std	median_price_asimmetria	median_price_curtosi
132665.4	134500	22662.15	-0.36	-0.64

kable(listings, digits=2, format = "html")%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

listings_media	listings_mediana	listings_dev_std	listings_asimmetria	listings_curtosi
1738.02	1618.5	752.71	0.65	-0.81

kable(months_inventory, digits=2, format = "html")%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

months_inventory_media	months_inventory_mediana	months_inventory_dev_std	months_inventory_asimmetria	months_inventory_curtosi
9.19	8.95	2.3	0.04	-0.2

Sales

La media delle vendite è superiore alla mediana ed indica una distribuzione asimmetrica positiva
La deviazione standard alta mostra una variabilità significativa nelle vendite
L’asimmetria positiva mostra valori verso destra elevati
La curtosi indica che la distribuzione ha code più piatte rispetto a una normale.

Volume

La media anche qui è leggermente superiore alla mediana
La curtosi ha un valore piccolo e suggerisce una forma della distribuzione più vicino ad una normale

Median_price

In questo caso abbiamo la situazione inversa a volume e sales, con una media leggermente minore della mediana

Listings

Mediana leggermente minore della media
Curtosi leggermente negativa

Months_inventory

Distribizione omogenea per tutti gli indici

3. Identificazione delle variabili con maggiore variabilità e asimmetria

cv_stats = data %>%
  summarise(across(c(sales, volume, median_price, listings, months_inventory),
                   ~sd(.x)/mean(.x))) %>%
  gather(key = "variabile", value = "cv")

skew_stats = data %>%
  summarise(across(c(sales, volume, median_price, listings, months_inventory),
                   ~skewness(.x))) %>%
  gather(key = "variabile", value = "asimmetria")

kable(cv_stats, digits=2)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

variabile	cv
sales	0.41
volume	0.54
median_price	0.17
listings	0.43
months_inventory	0.25

kable(skew_stats, digits=2)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

variabile	asimmetria
sales	0.71
volume	0.88
median_price	-0.36
listings	0.65
months_inventory	0.04

Il volume è la variabile con il coefficiente di variabilità più alto e asimmetria più alta

4. Creazione di classi per la variabile median_price

#n_classi = ceiling(1 + 3.322 * log2(nrow(data))) 
n_classi <- 10
breaks = pretty(range(data$median_price), n = n_classi)
break_labels <- format(breaks, scientific = FALSE, big.mark = ",", trim = TRUE)
data$price_class = cut(data$median_price, breaks = breaks, include.lowest = TRUE, labels = paste0("(", break_labels[-length(break_labels)], ", ", break_labels[-1], "]"))

Distribuzione di frequenza

price_freq = table(data$price_class)
kable(price_freq)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Var1	Freq
(70,000, 80,000]	1
(80,000, 90,000]	10
(90,000, 100,000]	15
(100,000, 110,000]	23
(110,000, 120,000]	17
(120,000, 130,000]	29
(130,000, 140,000]	46
(140,000, 150,000]	39
(150,000, 160,000]	39
(160,000, 170,000]	15
(170,000, 180,000]	6

Calcolo indice di Gini

price_prop = prop.table(price_freq)
gini = gini.index(price_prop)
kable(paste("Indice di eterogeneità di Gini:", round(gini, 4)))%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
Indice di eterogeneità di Gini: 0.9855

barplot(price_freq, 
        main = "Distribuzione di Frequenza dei Prezzi Median",
        xlab = "Classi di Prezzo",
        ylab = "Frequenza",
        col = "lightblue", 
        border = "black")

L’indice di Gini è vicino a 1 quindi è presente una scarsa omogeneità nella distribuzione di frequenza dei prezzi dei median price.

5. Calcolo delle probabilità

p_beaumont = nrow(filter(data, city == "Beaumont")) / nrow(data)
p_july = nrow(filter(data, month == "7")) / nrow(data)
p_dec_2012 = nrow(filter(data, month == "12" & year == "2012")) / nrow(data)
kable(p_beaumont)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
0.25

kable(p_july)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
0.0833333

kable(p_dec_2012)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
0.0166667

p_beaumont: 1/4 dei dai corrispondi alla città di Beaumont (probabilità del 25% su quattro città)
P_july: 1/12 dei dati corrisponde al mese di Luglio (probabilità del 8% su dodici mesi)
p_dec_2012: 1.7% di probabilità

6. Creazione di nuove variabili

data = data %>%
  mutate(
    avg_price = volume * 1000000 / sales,  # Prezzo medio (volume in milioni)
    sales_efficiency = sales / listings *100    # Efficacia degli annunci
  )
kable(mean(data$sales_efficiency))%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
11.87449

Gli annunci hanno funzionato meglio soprattutto nella città di Bryan-College Station e negli anni 2013-2014, mentre hanno performato peggio nel 2010-2011. Inoltre sembra che l’efficacia corrisponda alle fasce di prezzo più alte. Il numero di vendite non è necessariamente correlato positivamente con il numero di annunci ma cambia in base alla città. Nella città con più domanda si effettuano più vendite con meno annunci.

7. Analisi condizionata

city_summary = data %>%
  group_by(city) %>%
  summarise(
    mean_sales = mean(sales),
    sd_sales = sd(sales),
    mean_price = mean(median_price),
    sd_price = sd(median_price)
  )

kable(city_summary)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

city	mean_sales	sd_sales	mean_price	sd_price
Beaumont	177.3833	41.48395	129988.3	10104.993
Bryan-College Station	205.9667	84.98374	157488.3	8852.235
Tyler	269.7500	61.96380	141441.7	9336.538
Wichita Falls	116.0667	22.15192	101743.3	11320.034

Differenze annuali

yearly_trend = data %>%
  group_by(year) %>%
  summarise(
    total_sales = sum(sales),
    avg_price = mean(median_price)
  )
kable(city_summary)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

city	mean_sales	sd_sales	mean_price	sd_price
Beaumont	177.3833	41.48395	129988.3	10104.993
Bryan-College Station	205.9667	84.98374	157488.3	8852.235
Tyler	269.7500	61.96380	141441.7	9336.538
Wichita Falls	116.0667	22.15192	101743.3	11320.034

Differenze mensili

month_trend = data %>%
  group_by(month) %>%
  summarise(
    total_sales = sum(sales),
    avg_price = mean(median_price)
  )
kable(month_trend)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

month	total_sales	avg_price
1	2548	124250
2	2817	130075
3	3789	127415
4	4234	131490
5	4777	134485
6	4871	137620
7	4715	134750
8	4629	136675
9	3647	134040
10	3598	133480
11	3137	134305
12	3388	133400

Grafico a barre delle vendite per mese e città

ggplot(data, aes(x = factor(month), y = sales, fill = city)) +
  geom_bar(stat = "identity", position = "stack") +
  theme_minimal() +
  labs(title = "Vendite mensili per città",
       x = "Mese",
       y = "Numero di vendite") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
facet_wrap(~ city, ncol = 2)

Le città di Beaumont e Tyler hanno un andamento più stabile nel tempo rispetto a Bryan-College station e Tyler che mostrano un numero di vendite maggiori nei mesi, tipico di un andamento del mercato stagionale.

Grafico a barre delle vendite per anno e città

ggplot(data, aes(x = factor(year), y = sales, fill = city)) +
  geom_bar(stat = "identity", position = "stack") +
  theme_minimal() +
  labs(title = "Vendite mensili per città",
       x = "anno",
       y = "Numero di vendite") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
facet_wrap(~ city, ncol = 2)

Le città di Tyler, Bryan-College e Beaumont station mostrano un trend positivo nell’andamento dei prezzi degli ultimi anni. Wichita Falls rimane abbastanza stabile per tutti gli anni, senza risentire del trend positivo.

Boxplot dei prezzi mediani per città

ggplot(data, aes(x = city, y = median_price)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "Distribuzione dei prezzi mediani per città",
       x = "Città",
       y = "Prezzo mediano ($)") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Le città con i prezzi mediani più alti mostrano un intrvallo interquartile più stretto. E’ presente solo un outlier a città ad esclusione di Tyler.

Linechart con andamento nel tempo (Anni) del numero totale di vendite raggruppando per città

data_summary <- data %>%
  group_by(year, city) %>%
  summarize(mean_sales = mean(sales))

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

ggplot(data_summary, aes(x = year, y = mean_sales, group = city)) +
  geom_line(aes(linetype=city)) +
  geom_point() +
  labs(y = "Media di Sales")

Come già visto nel grafico a barre precedente, tutte le città mostrano un trend positivo negli ultimi anni a partire dal 2011 ad eccezione fatta per Wichita Falls che pur avendo un leggero aumento delle vendite, si ferma al 2013 dove incomincia a calare.

Identificazione della variabile con maggiore CV

max_cv = cv_stats$variabile[which.max(cv_stats$cv)]
kable(max_cv)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
volume

La variabile con maggiore variabilità relativa è il volume

Analisi dell’asimmetria

max_skew <- skew_stats$variabile[which.max(abs(skew_stats$asimmetria))]
kable(max_skew)%>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

x
volume

La variabile con maggiore variabilità e asimmetria è il volume

CONCLUSIONI

Il maggior numero di vendite vengono fatte nel periodo Aprile - Agosto
Bryan-college Station risulta essere la città più cara mentre Wichita Falls quella più economica
Il trend delle vendite dal 2010 al 2014 è in crescita
L’incasso delle vendite è la variabile con maggiore variabilità dato dal cambiamento del numero di vendite negli anni, all’interno dello stesso anno e dal prezzo relativo alla città associata.