# chiamo le librerie
library(readr)
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)
# carico i dati
data <-read.csv("realestate_texas.csv")
# converto i dati in formato df
re_texas <- as.data.frame(data)
city: variabile qualitativa nominale -> adatta a un’analisi delle frequenze per valutare l’andamento delle vendite nelle singole città
year, month: variabili quantitative discrete con valore temporale -> adatte ad analisi temporale: trend, stagionalità, confronto
sales, volume, median_price, listings: variabili quantitative discrete -> adatta per il calcolo delle frequenze e per il calcolo degli indici di posizione, variabilità e forma
months_inventory: variabile quantitative continue: adatta per il calcolo degli indici di posizione, variabilità e forma
# inizio definendo una funzione per automatizzare la creazione delle tabelle di frequenze
tab_freq <- function(data, v, x){
# trovo il numero delle occorrenze totali
N <- dim(data)[1]
# ottengo le frequenze assolute creando il DataFrame
df_dist_frq <- as.data.frame(table(v))
# rinomino la prima colonna
colnames(df_dist_frq)[1] <- x
# rinomino la seconda colonna
colnames(df_dist_frq)[2] <- 'freq_ass'
# Calcolo le frequenze relative (Ora funziona perché ret_freq_ass è un numero!)
df_dist_frq$freq_rel <- round(df_dist_frq$freq_ass / N, 4)
# Calcolo le percentuali
df_dist_frq$freq_pct <- round(df_dist_frq$freq_rel * 100, 2)
# Ritorno il dataframe finale
df_dist_frq
}
# chiamo la funzione su city, year e month
tab_freq(re_texas, re_texas$city, 'Città')
## Città freq_ass freq_rel freq_pct
## 1 Beaumont 60 0.25 25
## 2 Bryan-College Station 60 0.25 25
## 3 Tyler 60 0.25 25
## 4 Wichita Falls 60 0.25 25
tab_freq(re_texas, re_texas$year, 'Anno')
## Anno freq_ass freq_rel freq_pct
## 1 2010 48 0.2 20
## 2 2011 48 0.2 20
## 3 2012 48 0.2 20
## 4 2013 48 0.2 20
## 5 2014 48 0.2 20
tab_freq(re_texas, re_texas$month, 'Mese')
## Mese freq_ass freq_rel freq_pct
## 1 1 20 0.0833 8.33
## 2 2 20 0.0833 8.33
## 3 3 20 0.0833 8.33
## 4 4 20 0.0833 8.33
## 5 5 20 0.0833 8.33
## 6 6 20 0.0833 8.33
## 7 7 20 0.0833 8.33
## 8 8 20 0.0833 8.33
## 9 9 20 0.0833 8.33
## 10 10 20 0.0833 8.33
## 11 11 20 0.0833 8.33
## 12 12 20 0.0833 8.33
# definisco una funzione per automatizzare la visualizzazione
freq_viz <- function(data, v, x){
ggplot(data)+
geom_bar(aes(x=v),
fill = 'red',
colour = 'black')+
labs(title=paste('Frequenze Assolute di', x), x=x, y='Frequenze')+
theme_classic()
}
# chiamo la funzione su tutte e tre le colonne
freq_viz(re_texas, re_texas$city, 'Città')
freq_viz(re_texas, re_texas$year, 'Anno')
freq_viz(re_texas, re_texas$month, 'Mese')
Le variabili ‘city’, ‘year’ e ‘month’ hanno natura differente in quanto ‘city’ è qualitativa nominale, mentre le altre numeriche/temporali.Tutte e tre presentano una distribuzione uniforme, le modalità non presentano sbilanciamenti evidenti
# definisco una funzione che calcola le statistiche
eda <- function(v){
# creo le variabili media, std e coefficiente di variazione
media <- round(mean(v, na.rm = TRUE), 2)
std <- round(sd(v, na.rm = TRUE), 2)
coef_var <- round((std/media)*100, 4)
# creo un vettore nel quale salvo tutti i risultati
# senza ottenevo solo risultati singoli.
# così sono incapsulati in un unico oggetto e vanno insieme a stampa
print(c(
min = round(min(v, na.rm = TRUE), 2),
max = round(max(v, na.rm = TRUE), 2),
mediana = round(median(v, na.rm = TRUE), 2),
media,
std,
IQR = round(IQR(v, na.rm = TRUE), 2),
coef_var
))
}
# definisco una funziona per automatizzare il calcolo degli indici di forma
indici_f <- function(variabile, nome){
variabile <- na.omit(variabile)
N <- length(variabile)
media <- mean(variabile)
std <- sd(variabile)
mu3 <- sum((variabile - media)^3)/N
mu4 <- sum((variabile - media)^4)/N
# calcolo e mostro il valore dell'indice di Fisher
cat("L'indice di asimmetria γ per la variabile", nome, "è pari a:\n")
cat(round(mu3/std^3, 2))
cat("\n-----------------------------------------------------\n")
# calcolo e mostro il valore della curtosi
cat("L'indice di curtosi γ2 per la variabile", nome, "è pari a:\n")
cat(round((mu4/std^4) - 3, 2))
}
# definisco una funzione per visualizzare le curve di densità e distribuzione
dens_viz <- function(variabile, x){
variabile <- na.omit(variabile)
dens <- density(variabile)
hist(variabile, probability = TRUE, main = paste("Distribuzione di", x), xlab = x, col = 'white', yaxt = "n")
lines(dens, col = "red", lwd = 2)
lines(seq(min(variabile), max(variabile), length.out = 100),
dnorm(seq(min(variabile), max(variabile), length.out = 100),
mean = mean(variabile),
sd = sd(variabile)),
col = "darkgreen", lwd = 2)
# utilizzo questi metodi per rendere l'asse delle y più leggibile,
# senza notazioni scientifiche.
# i valori esprimono la densità di probabilità,
# cioè una misura di quanto i dati sono concentrati in un certo intervallo.
y_ticks <- pretty(dens$y)
y_labels <- format(y_ticks, scientific = FALSE)
axis(2, at = y_ticks, labels = y_labels)
}
# calcolo le stats per le colonne con variabili quantitative:
# sales:
sales_ip <- eda(re_texas$sales)
## min max mediana IQR
## 79.0000 423.0000 175.5000 192.2900 79.6500 120.0000 41.4218
# calcolo indici di forma:
sales_if <- indici_f(re_texas$sales, 'sales')
## L'indice di asimmetria γ per la variabile sales è pari a:
## 0.71
## -----------------------------------------------------
## L'indice di curtosi γ2 per la variabile sales è pari a:
## -0.34
# volume:
vol_ip <- eda(re_texas$volume)
## min max mediana IQR
## 8.1700 83.5500 27.0600 31.0100 16.6500 23.2300 53.6924
# calcolo indici di forma
vol_if <- indici_f(re_texas$volume,'volume')
## L'indice di asimmetria γ per la variabile volume è pari a:
## 0.88
## -----------------------------------------------------
## L'indice di curtosi γ2 per la variabile volume è pari a:
## 0.15
# median_price
mp_ip <- eda(re_texas$median_price)
## min max mediana IQR
## 73800.0000 180000.0000 134500.0000 132665.4200 22662.1500 32750.0000
##
## 17.0822
# calcolo indici di forma
mp_f <- indici_f(re_texas$median_price, 'median_price')
## L'indice di asimmetria γ per la variabile median_price è pari a:
## -0.36
## -----------------------------------------------------
## L'indice di curtosi γ2 per la variabile median_price è pari a:
## -0.64
# listings:
listings_ip <- eda(re_texas$listings)
## min max mediana IQR
## 743.0000 3296.0000 1618.5000 1738.0200 752.7100 1029.5000 43.3085
# calcolo indici di forma
listings_f <- indici_f(re_texas$listings, 'listings')
## L'indice di asimmetria γ per la variabile listings è pari a:
## 0.65
## -----------------------------------------------------
## L'indice di curtosi γ2 per la variabile listings è pari a:
## -0.81
# months_inventory:
mi_stats <- eda(re_texas$months_inventory)
## min max mediana IQR
## 3.4000 14.9000 8.9500 9.1900 2.3000 3.1500 25.0272
# calcolo indici di forma
mi_f <- indici_f(re_texas$months_inventory, 'months_inventory')
## L'indice di asimmetria γ per la variabile months_inventory è pari a:
## 0.04
## -----------------------------------------------------
## L'indice di curtosi γ2 per la variabile months_inventory è pari a:
## -0.2
# visuzalizzo i grafici per le varibaili
dens_viz(re_texas$sales, 'Sales')
dens_viz(re_texas$volume, 'Volume')
dens_viz(re_texas$median_price, 'Median Price')
dens_viz(re_texas$listings, 'Listings')
dens_viz(re_texas$months_inventory, 'Months Inventory')
Le variabili Sales e Volume presentano una lieve asimmetria positiva, confermata sia dall’indice di asimmetria sia dal grafico di densità. La curva risulta abbastanza vicina alla normale teorica nella parte centrale, ma mostra una coda destra più pronunciata. Nel complesso, le due variabili non evidenziano forti deviazioni dalla campana normale, pur non risultando perfettamente gaussiane. Median Price mostra invece una lieve asimmetria negativa, mentre Months Inventory appare quasi simmetrica e complessivamente vicina a una distribuzione normale. La variabile Listings, infine, presenta una distribuzione meno regolare e apparentemente multimodale, con più concentrazioni di valori e un andamento che si discosta in modo più evidente da una singola curva gaussiana.
Le variabili presentano una dispersione proporzionalmente simile rispetto alla loro media, come evidenziato dal coefficiente di variazione (41.422) identico per ognuno di esse. Questo suggerisce che, anche se su scale differenti, le variabili mostrano una variabilità relativa equivalente.
In termini assoluti la variabile che presenta l’asimmetria maggiore è ‘volume’. Con un indice di asimmetria di Fisher pari a 0.88 presenta una leggera asimmetria positiva,quella che si avvicina di più ma in senso opposto è la variabile ‘months_inventory’ con un indice pari a -0.81
# suddivido in classi le osservazioni della variabile 'sales'
re_texas$sales_class <- cut(re_texas$sales, breaks = c(49, 99, 149, 199, 249, 299, 349, 399, 449))
# mostro la tabella di frequenza per le classi della variabile 'sales_class'
tab_freq(re_texas, re_texas$sales_class, 'Sales Class')
## Sales Class freq_ass freq_rel freq_pct
## 1 (49,99] 20 0.0833 8.33
## 2 (99,149] 69 0.2875 28.75
## 3 (149,199] 58 0.2417 24.17
## 4 (199,249] 33 0.1375 13.75
## 5 (249,299] 34 0.1417 14.17
## 6 (299,349] 14 0.0583 5.83
## 7 (349,399] 9 0.0375 3.75
## 8 (399,449] 3 0.0125 1.25
# mostro il grafico
freq_viz(re_texas, 'sales_class', 'Sales Class')
## Warning in geom_bar(aes(x = v), fill = "red", colour = "black"): All aesthetics have length 1, but the data has 240 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
# calcolo l'indice di eterogeneità di Gini creando una funzione
gini.index <- function(col_nome){
ni<- table(col_nome)
fi<- ni/length(col_nome)
fi2<- fi^2
J<- length(table(col_nome))
# avendo tutti gli elementi calcolo gini
gini<- 1-sum(fi2)
gini.normalizzato<- round(gini/((J-1)/J), 2)
cat("Il valore dell'indice di Gini normalizzato è pari a:", gini.normalizzato)
}
gini.index(re_texas$sales_class)
## Il valore dell'indice di Gini normalizzato è pari a: 0.92
# Il valore dell'indice di Gini è pari a 0.92, posso dunque concludere che i valori sono moderatamnte eterogenei
# Per il totale di righe uso già l'oggetto N
N <- dim(re_texas)[1]
# calcolo la probabilità che da un estrazione esca Beaumont
prob_beaumont <- sum(re_texas$city == "Beaumont")/N
# La probabilità è di 0.25, c'è quindi il 25% di possibilità che venga estratta
# calcolo la probabilità che da un estrazione esca Luglio
prob_luglio <- round(sum(re_texas$month == 7)/N, 2)
# La probabilità è di ~0.08, c'è quindi circa l'8% di possibiltà che venga estratta
# calcolo la probabilità che da un estrazione esca Dicembre e 2012
prob_anno_mese <- round(sum(re_texas$month == 12 & re_texas$year == 2012)/N, 2)
# La probabilità è di 0.02, c'è quindi circa il 2% di possibiltà che venga estratta
re_texas$prezzo_medio_mln <- round((re_texas$sales/re_texas$volume)*1000000, 3)
# controllo il range
range(re_texas$prezzo_medio_mln)
## [1] 4689685 10308194
Il prezzo medio varia da un minimo di ~4.7 e un massimo di~10.3 mln di dollari. Considerando che il prezzo mediano è in centinaia di miglaia di dollari posso concludere che all’interno della variabile sales sono presenti immobili con valori molto alti la distribuzione dei singoli prezzi vedrebbe degli outliers che spingono il alto in prezzo medio. per questo è più corretto considerare il prezzo mediano, in quanto più rappresentativo e robusto rispettoa quest’ultimi
re_texas$sales_eff <- round(re_texas$sales/re_texas$listings, 2)
# creo uno scatter mettendo in relazione months_inventory e sales_eff
ggplot(data=re_texas) +
geom_point(aes(x=re_texas$sales_eff,
y=re_texas$months_inventory),
colour = 'red')+
labs(x='Indice di efficienza',
y='Mesi Necessari',
title='Rapporto tra efficienza delle vendite e tempo per chiudere la vendita')+
theme_bw()
## Warning: Use of `re_texas$sales_eff` is discouraged.
## ℹ Use `sales_eff` instead.
## Warning: Use of `re_texas$months_inventory` is discouraged.
## ℹ Use `months_inventory` instead.
Lo scatter plot mostra che: osservazioni con livelli simili di efficienza possono presentare valori molto diversi di months inventory. Questo suggerisce che l’efficienza non dipende esclusivamente dalla velocità di assorbimento del mercato, ma anche da altri fattori. In generale, valori più elevati di months inventory sono associati a un mercato più lento e/o a una minore capacità di smaltire rapidamente le inserzioni.
# creo un boxplot mettendo in relazione l'efficienza nei singoli mesi di riferimento
ggplot(data=re_texas) +
geom_boxplot(aes(x=factor(month),
y=sales_eff),
colour = 'red')+
labs(x='Mese',
y='Indice di efficienza',
title='Rapporto tra mese di riferimento ed efficienza delle vendite')+
theme_bw()
Il boxplot suggerisce che: l’indice di efficienza tende a essere leggermente più elevato nei mesi centrali dell’anno. In particolare, tra primavera ed estate si osservano mediane superiori rispetto ai mesi iniziali e finali. La presenza di alcuni outlier nei mesi centrali indica inoltre una maggiore variabilità delle osservazioni in questi periodi.
# definisco una funzione per automatizzare l'EDA
eda_2 <- function(data, g_col, var_col){
data |>
group_by({{g_col}}) |>
summarise(media=mean({{var_col}}),
std=sd({{var_col}}))
}
# creo l'istanza chiamando la funzione creata: raggruppo per city e sales
city_sales <- eda_2(re_texas, city, volume)
city_sales
## # A tibble: 4 × 3
## city media std
## <chr> <dbl> <dbl>
## 1 Beaumont 26.1 6.97
## 2 Bryan-College Station 38.2 17.2
## 3 Tyler 45.8 13.1
## 4 Wichita Falls 13.9 3.24
# creo l'istanza chiamando la funzione creata: raggruppo per year e volume
year_volume <- eda_2(re_texas, year, volume)
year_volume
## # A tibble: 5 × 3
## year media std
## <int> <dbl> <dbl>
## 1 2010 25.7 10.8
## 2 2011 25.2 12.2
## 3 2012 29.3 14.5
## 4 2013 35.2 17.9
## 5 2014 39.8 21.2
# creo l'istanza chiamando la funzione creata: raggruppo per city e sales
month_list <- eda_2(re_texas, month, listings)
month_list
## # A tibble: 12 × 3
## month media std
## <int> <dbl> <dbl>
## 1 1 1647. 705.
## 2 2 1692. 711.
## 3 3 1757. 727.
## 4 4 1826. 770.
## 5 5 1824. 790.
## 6 6 1833. 812.
## 7 7 1821. 827.
## 8 8 1786. 816.
## 9 9 1749. 803.
## 10 10 1710. 779.
## 11 11 1653. 741.
## 12 12 1558. 693.
# rappresento graficamente i risultati, creo una funzione per un grafico a linea
line_viz <- function(dati, col_1, col_2){
ggplot(data = dati)+
geom_line(aes(x = {{col_1}}, y = {{col_2}}))+
theme_bw()
}
# visualizzo un grafico a barre per la combinazione città/vendite
ggplot(data = city_sales)+
geom_bar(aes(x = city, y = media),
stat = "identity",
fill ='red')+
theme_bw()
# visualizzo i trend temporali di 'year' e 'month' con un grafico a linee
line_viz(year_volume, year, media)
line_viz(month_list, month, media)
# BOXPLOT: distribuzione del prezzo mediano tra le città
ggplot(data = re_texas)+
geom_boxplot(aes(x = city, y = median_price),
fill ='red')+
labs(title = "Distribuzione del prezzo mediano tra le città",
x = 'Città',
y = 'Prezzo Mediano')+
theme_bw()
# BARPLOT: confronto il totale delle vendite raggruppate per mese e città
month_city_volume <- re_texas |>
summarise(.by = c(city, month),
tot_volume = sum(volume))
# visualizzo il grafico a barre
ggplot(data = month_city_volume)+
geom_col(aes(x = month, y = tot_volume,
fill = city),
position = position_dodge())+
labs(title = "Totale delle vendite raggruppate per mese e città",
x = 'Mese',
y = 'Totale volume')+
scale_x_continuous(breaks = seq(1,12,1))+
theme_bw()
# LINECHART: confronto il totale delle vendite per anni differenti
year_tot_sales <- re_texas |>
summarise(.by = c(month, year),
tot_volume = sum(volume))
# visualizzo il grafico a linee, una linea per anno di vendite raggruppate
ggplot(data = year_tot_sales)+
geom_line(aes(x = month, y = tot_volume, color = factor(year)))+
labs(title = "Andamento mensile delle vendite per anno",
x = 'Mese',
y = 'Totale volume',
color = 'Anno')+
scale_x_continuous(breaks = seq(1,12,1))+
theme_bw()
L’analisi descrittiva del dataset evidenzia un mercato caratterizzato da una stagionalità marcata, durante i mesi estivi si registrano picchi nelle vendite concluse e nel volume generato
Le variabili quantitative mostrano una variabilità relativa comparabile, come indicato da coefficienti di variazione sostanzialmente omogenei.
Dal punto di vista della forma, le variabili quantitative presentano una leggera asimmetria, sia positiva che negativa, a seconda della variabile esaminata
Le nuove variabili costruite suggeriscono, con forza diversa, trend temporali simili mettono in evidenza eterogeneità territoriale e differenze di efficienza: in particolare, l’efficienza delle vendite e il prezzo medio suggeriscono differenze nella capacità di assorbimento del mercato e nella presenza di valori estremi. I valori del prezzo, inoltre, differiscono in relazione all’area geografica; evidenziato dalla distribuzione dei valori nel grafico del boxplot
Nel complesso, i risultati indicano un contesto eterogeneo ma interpretabile, in cui la lettura congiunta di distribuzioni, indici sintetici e grafici permette di individuare con chiarezza le principali tendenze del mercato.