progetto statistica descrittiva
marco falchi
2025-08-24
Punto 1
suppressPackageStartupMessages(library(knitr))
data <- read.csv("realestate_texas.csv" )
str(data)## '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 ...colSums(is.na(data))## city year month sales
## 0 0 0 0
## volume median_price listings months_inventory
## 0 0 0 0dim(data)## [1] 240 8n <- dim(data)[1]
suppressWarnings(attach(data))Sono presenti 8 Variabili, non hanno valori mancanti (NA), tra queste
troviamo:
city= [chr], variabile qualitativa nominale.
year=[int], variabile quantitativa ordinale
month= [int], variabile qualitativa ciclica codificata in numeri
sales=[int], variabile quantitativa discreta
volume=[num], variabile quantitativa continua
median_price=[num], variabile quantitativa continua
listings=[int], variabile quantitativa discreta
month_inventory=[int], variabile quantitativa continua
Punto 2
statistiche <- function(variabile){
mean_variabile <- sum(variabile)/length(variabile)
median_variabile <- median(variabile)
var_variabile <- var(variabile)
dev_std_variabile <- sd(variabile)
stats <- c(Media= mean_variabile,
Mediana= median_variabile,
Varianza= var_variabile,
Deviazione_Standard= dev_std_variabile)
stats_approx <- round(stats,digits = 2)
quantile_variabile=round(quantile(variabile),digits = 2)
percentile_variabile=round(quantile(variabile,c(seq(from=0,to=1,by=0.1))),digits = 2)
stats_finali <- c(stats_approx,Quantile=quantile_variabile,Percentile=percentile_variabile)
return(stats_finali)
}
asimmetria <- function(variabile, nome_variabile) {
mu <- mean(variabile)
len <- length(variabile)
sigma <- sd(variabile)
m3 <- sum((variabile - mu)^3) / len
fisher_index <- m3 / sigma^3
round_fisher_index <- round(fisher_index,digits = 2)
titolo <- paste("Distribuzione di", nome_variabile)
hist(variabile, main = titolo, col = "lightblue", border = "white")
grid()
abline(v = mu, col = "red", lwd = 2)
return(round_fisher_index)
}
curtosi <- function(variabile){
mu <- mean(variabile)
len<-length(variabile)
sigma<-sd(variabile)
m4 <- sum((variabile-mu)^4)/len
fisher_index <- m4/sigma^4-3
round_fisher_index <- round(fisher_index,digits = 2)
return(round_fisher_index)
}
distribuzione_frequenza <- function(var,n, cumulata=TRUE) {
ni <- table(var)
fi <- round(table(var)/n,digits = 2)
if (cumulata) {
Ni <- cumsum(ni)
Fi <- round(Ni/n,digits = 2)
distr <- cbind(ni,fi,Ni,Fi)
} else {
distr <- cbind(ni,fi)
}
return(distr)
}
variabili_quant <- data[c("sales", "volume", "median_price", "listings", "months_inventory")]
risultati_statistiche <- lapply(variabili_quant,statistiche)
df_statistiche <- as.data.frame(do.call(cbind,risultati_statistiche))
kable(df_statistiche)| sales | volume | median_price | listings | months_inventory | |
|---|---|---|---|---|---|
| Media | 192.29 | 31.01 | 132665.42 | 1738.02 | 9.19 |
| Mediana | 175.50 | 27.06 | 134500.00 | 1618.50 | 8.95 |
| Varianza | 6344.30 | 277.27 | 513572983.09 | 566568.97 | 5.31 |
| Deviazione_Standard | 79.65 | 16.65 | 22662.15 | 752.71 | 2.30 |
| Quantile.0% | 79.00 | 8.17 | 73800.00 | 743.00 | 3.40 |
| Quantile.25% | 127.00 | 17.66 | 117300.00 | 1026.50 | 7.80 |
| Quantile.50% | 175.50 | 27.06 | 134500.00 | 1618.50 | 8.95 |
| Quantile.75% | 247.00 | 40.89 | 150050.00 | 2056.00 | 10.95 |
| Quantile.100% | 423.00 | 83.55 | 180000.00 | 3296.00 | 14.90 |
| Percentile.0% | 79.00 | 8.17 | 73800.00 | 743.00 | 3.40 |
| Percentile.10% | 101.90 | 13.10 | 99960.00 | 899.90 | 6.69 |
| Percentile.20% | 120.60 | 16.12 | 110000.00 | 968.00 | 7.50 |
| Percentile.30% | 135.00 | 19.03 | 121650.00 | 1208.70 | 7.97 |
| Percentile.40% | 155.00 | 24.00 | 130700.00 | 1525.20 | 8.40 |
| Percentile.50% | 175.50 | 27.06 | 134500.00 | 1618.50 | 8.95 |
| Percentile.60% | 197.00 | 31.84 | 141220.00 | 1687.80 | 9.40 |
| Percentile.70% | 228.50 | 36.93 | 147960.00 | 1796.00 | 10.53 |
| Percentile.80% | 271.00 | 45.59 | 152360.00 | 2721.40 | 11.40 |
| Percentile.90% | 302.10 | 53.74 | 158850.00 | 2946.70 | 12.21 |
| Percentile.100% | 423.00 | 83.55 | 180000.00 | 3296.00 | 14.90 |
I valori delle statistiche hanno riportato i seguenti risultati: la media e la mediana risultano piuttosto simili per tutte le variabili, suggerendo una distribuzione dei dati piuttosto simmetrica. I valori della varianza e della deviazione standard ci danno informazioni circa la dispersione dei dati rispetto alla media, per la variabile listings abbiamo valori molto alti di entrambi suggerendo che il numero di annunci può variare facilmente tra le città o il periodo temporale. la variabile sales ha valori piuttosto alti, sottolineando come il volume delle vendite tende a cambiare in modo singificativo. median price e month inventory sono le variabili con i valori di varianza e deviazione standard più stabili. Analizzando i quantili possiamo notare come la variabili listings e sales risultano le più variabili, con valori estremi piuttosto differenti. al contrario, volume, median_price e month_inventory registrano una distribuzione più stabile.
nomi_variabili <- c("sales", "volume", "median_price", "listings", "months_inventory")
risultati_asimmetrie <- list()
for (nome in nomi_variabili) {
variabile_corrente <- data[[nome]]
risultati_asimmetrie[[nome]] <- asimmetria(variabile_corrente, nome)
}
df_asimmetrie <- as.data.frame(do.call(cbind,risultati_asimmetrie))
kable(df_asimmetrie)| sales | volume | median_price | listings | months_inventory |
|---|---|---|---|---|
| 0.71 | 0.88 | -0.36 | 0.65 | 0.04 |
L’analisi delle variabili ha riportato le differenti caratteristiche in termini di forma e variabilità. Le variabili sales, month_inventory, volume, median_price e listings mostrano una chiara eterogeneità nelle loro distirbuzioni. nello specifico: le variabili sales, volume e listings presentano un’asimmetria positiva, con indici di fisher rispettivamente pari a 0.71, 0.88 e 0.65. indicando una maggiore concentrazione di valori lungo la coda sinistra della distribuzione, ciò viene confermato dai grafici. median_price mostra un’asimmetria negativa, con un indice di -0.36, evidenziando una maggiore concentrazione lungo la coda destra della distribuzione. la variabile month_inventory, presenta un asimmetria trascurabile, il valore dell’indice di fisher è pari a 0.04.
risultati_curtosi <- lapply(variabili_quant,curtosi)
df_curtosi <- as.data.frame(do.call(cbind,risultati_curtosi))
kable(df_curtosi)| sales | volume | median_price | listings | months_inventory |
|---|---|---|---|---|
| -0.34 | 0.15 | -0.64 | -0.81 | -0.2 |
I valori della curtosi per le variabili sales, median_price, listings
e month_inventory presentano una distribuzione platicurtica, ossia una
distribuzione meno appuntina (più piatta) rispetto a una distribuzione
gaussiana (o normale/campanulare). i valori dell’indice delle rispettive
variabili sono: -0.34, -0.64, -0.81, -0.2.
L’unica eccezione riguarda la variabile volume, questa ha una
distribuzione leptocurtica (leggermente appuntita), il suo valore
dell’indice è pari a 0.15.
city_distr_freq <- distribuzione_frequenza(city,n,cumulata = F)
kable(city_distr_freq)| ni | fi | |
|---|---|---|
| Beaumont | 60 | 0.25 |
| Bryan-College Station | 60 | 0.25 |
| Tyler | 60 | 0.25 |
| Wichita Falls | 60 | 0.25 |
year_distr_freq <- distribuzione_frequenza(year,n,cumulata = T)
kable(year_distr_freq)| ni | fi | Ni | Fi | |
|---|---|---|---|---|
| 2010 | 48 | 0.2 | 48 | 0.2 |
| 2011 | 48 | 0.2 | 96 | 0.4 |
| 2012 | 48 | 0.2 | 144 | 0.6 |
| 2013 | 48 | 0.2 | 192 | 0.8 |
| 2014 | 48 | 0.2 | 240 | 1.0 |
month_distr_freq <- distribuzione_frequenza(month,n,cumulata = F)
kable(month_distr_freq)| ni | fi |
|---|---|
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
| 20 | 0.08 |
L’analisi circa le distribuzioni di frequenze mostra che le variabili city, year e month hanno una distribuzione uniforme. Le osservzioni sono equamente ripartite lungo le rispettive classi.
Punto 3
coefficiente_variazione <- function(variabile){
media <- mean(variabile)
dev <- sd(variabile)
coef <- dev/media
coef <- round(coef,digits=2)
return(coef)
}
risultati_coef_var <- lapply(variabili_quant, coefficiente_variazione)
df_coef_variaz <- as.data.frame(do.call(cbind,risultati_coef_var))
kable(df_coef_variaz)| sales | volume | median_price | listings | months_inventory |
|---|---|---|---|---|
| 0.41 | 0.54 | 0.17 | 0.43 | 0.25 |
I valori del coefficiente di variazione per le variabili quantitative evidenziano che la variabile median_price risulta la variabile più stabile, con un coefficiente di variazione pari a 0.17, anche month_inventory presenta un valore piuttosto stabile pari a 0.25; Le restanti variabili presentano un coefficiente di variazione alto evidenziando una maggiore oscillazione.
Punto 4
nomi_classi <- c("<=100k","100-120k","120-140k","140-160kg","160-180k")
breaks <- c(0,100000,120000,140000,160000,180001)
new_median_price <- cut(median_price, breaks = breaks, label=nomi_classi, right = FALSE)
count_new_median_price <- table(new_median_price)
new_median_price_distr_freq <- distribuzione_frequenza(new_median_price,n)
n_frequenze_median_price <- new_median_price_distr_freq[,1]
barplot(n_frequenze_median_price,
main="Distribuzione frequenza di Median Price",
xlab = "Prezzo delle case espresso i migliaia di dollari",
ylab = "Frequenze assolute",
col= "lightblue")
gini <- function(var){
ni <- table(var)
fi <- ni/length(var)
fi2 <- fi^2
j <- length(ni)
gini = 1-sum(fi2)
gini.normalizzato = gini/((j-1)/j)
gini.normalizzato <- round(gini.normalizzato,digits = 2)
return(gini.normalizzato)
}
gini_median_price <- gini(new_median_price)
df_gini_medianp <- data.frame(Gini_Median_Price=round(gini_median_price,digits = 2))
kable(df_gini_medianp)| Gini_Median_Price |
|---|
| 0.93 |
La variabile median_price mostra una distribuzione fortemente eterogena, evidenziando un valore dell’indice di gini elevato (0.93)
Punto 5
città<- table(city)
n_bea<- as.numeric(città["Beaumont"])
prob_bea <- n_bea/n
df_prob_city <- data.frame(Probabilità_Beaumont=round(prob_bea,digits = 3))
kable(df_prob_city)| Probabilità_Beaumont |
|---|
| 0.25 |
La probabilità che, presa una riga a caso di questo dataset, essa riporti la città “Beaumont” è pari al 25%
mesi <- table(month)
n_luglio <- as.numeric(mesi[7])
prob_luglio <- n_luglio/n
df_prob_luglio <- data.frame(Probabilità_Luglio=round(prob_luglio,digits = 3))
kable(df_prob_luglio)| Probabilità_Luglio |
|---|
| 0.083 |
La probabilità che riporti il mese di Luglio è pari all’8.3%
anno2012_dicembre <- data[data$year == 2012 & data$month==12,]
n_2012_dicembre <- nrow(anno2012_dicembre)
prob_2012_dicembre <- n_2012_dicembre/n
df_prob_2012 <- data.frame(Probabilità_dicembre2012=round(prob_2012_dicembre,digits = 3))
kable(df_prob_2012)| Probabilità_dicembre2012 |
|---|
| 0.017 |
La probabilità che riporti il mese di dicembre 2012 è pari all’1.7%
Punto 6
data$prezzo_medio <- (data$volume/data$sales)*1000000
summary(data$prezzo_medio)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 97010 132939 156588 154320 173915 213234data$efficacia_annunci <- data$sales/data$listings
summary(data$efficacia_annunci)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.05014 0.08980 0.10963 0.11874 0.13492 0.38713Possiamo notare come i prezzi medi degli immobili variano da un minimo di 97010$ a un massimo di 213234$, con una media di 154320$. La distribuzione sembra piuttosto simmetrica visto i valori vicini di media e mediana (156588$). La maggior parte della distribuzione si concentra nell’intervallo che va da 132939$ a 173915$, ossia l’intervallo interquartile.
L’analisi generica sui summary dell’eficacia degli annunci mostra un basso tasso di annunci positivi medio (12% circa), con la maggior parte dei casi tra il 9% e il 13,5% circa. la distribuzione sembra piuttosto simmetrica, vi è presenza di valori elevati fino al 39%, mostrando una forte efficacia in determinate condizioni (probabilmente influenzato dalla città in questione).
Punto 7
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
statistiche_citta <- data %>% group_by(city) %>% summarise(
media=round(mean(prezzo_medio)/1000,digits = 2),
sd=round(sd(prezzo_medio)/1000,digits = 2))
kable(statistiche_citta)| city | media | sd |
|---|---|---|
| Beaumont | 146.64 | 11.23 |
| Bryan-College Station | 183.53 | 15.15 |
| Tyler | 167.68 | 12.35 |
| Wichita Falls | 119.43 | 11.40 |
statistiche_citta %>%
ggplot(aes(x=city,y=media))+
geom_bar(stat="identity",color="black",lwd=0.3, fill="lightblue")+
labs(title="Prezzo medio per città (in migliaia)",x="città",y="media ($)")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
statistiche_anno <- data %>% group_by(year) %>% summarise(
media=round(mean(prezzo_medio)/1000,digits = 2),
sd=round(sd(prezzo_medio)/1000,digits = 2))
kable(statistiche_anno)| year | media | sd |
|---|---|---|
| 2010 | 150.19 | 23.28 |
| 2011 | 148.25 | 24.94 |
| 2012 | 150.90 | 26.44 |
| 2013 | 158.71 | 26.52 |
| 2014 | 163.56 | 31.74 |
statistiche_anno %>%
ggplot(aes(x=year,y=media))+
geom_line(stat="identity",color="black",lwd=0.5)+
labs(title="Prezzo medio negli anni (in migliaia)", x="anni",y="media ($)")
statistiche_quadrimestri <- data %>%
group_by( quadrimestre = case_when(
month %in% c(1, 2, 3, 4) ~ "1° quadrimestre",
month %in% c(5, 6, 7, 8) ~ "2° quadrimestre",
month %in% c(9, 10, 11, 12) ~ "3° quadrimestre"
)
) %>% summarise(
media = round(mean(prezzo_medio, na.rm = TRUE) / 1000, digits = 2),
sd = round(sd(prezzo_medio, na.rm = TRUE) / 1000, digits = 2))
kable(statistiche_quadrimestri)| quadrimestre | media | sd |
|---|---|---|
| 1° quadrimestre | 149.27 | 25.80 |
| 2° quadrimestre | 158.28 | 25.82 |
| 3° quadrimestre | 155.41 | 29.23 |
statistiche_quadrimestri %>%
ggplot(aes(x=quadrimestre, y=media))+
geom_bar(stat="identity",color="black",lwd=0.3,fill="lightblue")+
geom_text(aes(label = media), vjust = -0.01, size = 4.4, color = "black")+
labs(title="Prezzo medio per quadrimestre (in migliaia)",x="Quadrimestre",y="Media ($)")
Punto 8
suppressPackageStartupMessages(library(ggplot2))
ggplot(data = data) +
geom_boxplot(aes(x = city, y = median_price, fill = city), linewidth = 0.5) +
labs(x = "città",y = "prezzo mediano in $",title = "prezzo mediano tra le città")+ theme(axis.text.x = element_text(angle = 45, hjust = 1))
Il primo grafico mostra il prezzo mediano delle città, possiamo osservare come la mediana (linea all’interno del box) più alta si trovi a Bryan-College. Per ottenere informazioni circa la distribuzione dei prezzi mediani osserviamo le altezze dei box delle rispettive città: la città di Bryan-College mostra una minore variabilità del prezzo mediano in quanto ha una distribuzione meno ampia rispetto alle altre città (box con l’altezza più bassa). Tutte le città ad eccezione di Tyler presentano valori anomali. Possiamo evidenziare come la città di Bryan-College abbia una distribuzione dei prezzi mediani più alta e concentrata, mentre Wichita Falls ha i prezzi mediani più bassi.
ggplot(data=data)+
geom_bar(aes(x=as.factor(month),y=sales,fill=city),stat="identity")+
labs(x="città",y="totale vendite",title="totale vendite per città nei mesi")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+ facet_wrap(~year)
Il secondo grafico mostra l’andamento delle vendite mensili suddivise per le quattro città nel periodo 2010-2014. Le vendite totali mostrano un andamento stagionale, che si ripete lungo tutti gli anni. Nello specifico nei primi due mesi dell’anno le vendite sono più basse, aumentano gradualmente verso la stagione primaverile per poi raggiungere il picco nei mesi estivi. Verso la fine dell’anno tendono a diminuire. Nel dettaglio, Tyler e Bryan sono le città che registrano il volume di vendite più elevato in tutto il periodo. Wichita Falls è la città con il volume di vendita più basso, il suo andamento risulta piuttosto stabile lungo tutto il periodo, a differenza delle altre città che risultano più volatili. La città di Beaumont registra un volume di vendite poco superiore a quello di Wichita Falls, la sua distribuzione però appare più volatile rispetto a quest’ultima, mostrando dei picchi nei mesi estivi.
data$date_string <- paste(data$year,data$month,"01",sep="-")
data$date <- as.Date(data$date_string, format = "%Y-%m-%d")
ggplot(data=data)+
geom_line(aes(x=date,y=sales,color=city))+
labs(x="mese",y="totale vendite",title="andamento vendite (2010-2014)")+
scale_x_date(date_breaks = "4 month",date_labels = "%Y-%m")+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
Il terzo grafico mostra il volume delle vendite durante il periodo 2010-2014, possiamo osservare quanto visto nelle rappresentazion grafiche precedenti: vi è una stagionalità, le vendite tendono ad essere più basse nei primi mesi e ad aumentare, raggiungendo un picco nel periodo estivo, per poi ridursi verso la fine dell’anno. Le città di Tyler e Bryan mostrano i volumi di vendita più alti con picchi superiori alle 300 unità. Le restanti città invece, mostrano un volume nettamente più basso, con valori che raramente superano le 250 unità.
Ulteriori considerazioni
suppressPackageStartupMessages(library(ggplot2))
ggplot(data=data)+
geom_boxplot(aes(x = city, y = sales, fill = city))+
labs(x="anno",y="totale vendite",title="vendite immobili (2010-2014)")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+ facet_wrap(~year)
Il primo grafico mostra la distribuzione delle vendite immobiliari per ogni anno (2010-2014), delle rispettive città. il grafico evidenzia come il volume delle vendite differisce per città: Tyler e Bryan registrano un numero più alto di vendite; Beaumont si trova in una fascia intermedia; Wichita Falls ha i volumi e variabilità più bassa. Tutte le città, ad eccezione di Wichita Falls, mostrano un trend crescente con l’aumentare degli anni. I box di Tyler e Bryan risultano più alti rispetto alle altre città evidenziando una maggiore variabilità della distribuzione. Il grafico conferma quanto visto precedentemente: Bryan e Tyler sono le città che dominano il mercato, mentre le altre operano su scale inferiori.
ggplot(data) +
geom_bar(aes(x = factor(month), y = sales, fill = city),
stat = "identity",position = "fill") +
labs(title = "quota percentuale di vendite per città e mese",x = "mese",y = "quota di vendite (%)")+
facet_wrap(~year) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
Il secondo grafico mostra la quota percentuale di vendite immobiliari
suddivisa tra le varie dal 2010 al 2014. possiamo osservare come le
rispettive quote percentuali rimangano quasi costanti nel tempo, non ci
sono inversioni di tendenza forti o movimenti singificativi.
La città di Tyler mantiene la quota più alta di tutti (intorno al
35-40%);Bryan college ha una quota intorno al 25%; Beaumont si posiziona
al di sotto con una quota del 20-25% circa. La quota più bassa è di
Wichita Falls (tra il 15 e 20%). Le proporzioni sembrano mantenersi
stabili durante tutti gli anni analizzati.
ggplot(data) +
geom_bar(aes(x = factor(month), y = sales, fill = city),
stat = "identity",position = "fill") +
labs(title = "quota percentuale di vendite per città e mese",x = "mese",y = "quota di vendite (%)")+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
Il terzo grafico, più generale, mostra la quota percentuale di vendite immobiliare senza suddividerla per il periodo 2010-2014. Anche qui vengono confermate le analisi del secondo grafico.
ggplot(data=data)+
geom_line(aes(x=date,y=prezzo_medio,color=city))+
labs(x="mese",y="prezzo medio ($)",title="prezzo medio case (2010-2014)")+
scale_x_date(date_breaks = "4 month",date_labels = "%Y-%m")+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
L’ultimo grafico mostra l’andamento del prezzo medio delle case dal
2010 al 2014. Si osserva un andamento crescente, con intensità diverse e
segnato da una marcata volatilità, in tutte le città. La città di Bryan
registra i valori più alti e una crescita costante dal 2012. Tyler
risulta invece più volatile lungo tutto l’intervallo temporale,
nonostante sia in crescita.
La città di Beaumont registra prezzi più bassi e delle oscillazioni
piuttosto frequenti. Wichita Falls presenta i valori più bassi in quasi
tutto il periodo, mostrando difficoltà sia nell’aumentare il prezzo
medio che il volume delle vendite.