1) Analisi delle variabili

Il dataset contiene le seguenti variabili:

Le variabili quantitative continue sono su scale di rapporti.

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

2) Tabulazione indici di posizione per tutte le variabili

Tabulo gli indici di posizione, variabilità e forma per sales, volume, median_price, listings e months_inventory TOTALI

# Definisco una funzione che calcoli le statistiche da applicare alla variabile x
statistiche <- function(x) {
  c(
    mean = mean(x),
    median = median(x),
    sd = sd(x),
    cv = sd(x)/mean(x)*100,
    range = diff(range(x)),
    min = min(x),
    max = max(x),
    skewness = skewness(x),
    curtosi = kurtosis(x)
  )
}

# Applico la funzione statistiche alle colonne con variabili quantitative
tabella <- apply(dataset[, -c(1,2,3)], 2, statistiche)
tabella <- round(tabella, 2)

Indici di posizione, variabilità e forma

sales volume median_price listings months_inventory
mean 192.29 31.01 132665.42 1738.02 9.19
median 175.50 27.06 134500.00 1618.50 8.95
sd 79.65 16.65 22662.15 752.71 2.30
cv 41.42 53.71 17.08 43.31 25.06
range 344.00 75.38 106200.00 2553.00 11.50
min 79.00 8.17 73800.00 743.00 3.40
max 423.00 83.55 180000.00 3296.00 14.90
skewness 0.72 0.88 -0.36 0.65 0.04
curtosi 2.69 3.18 2.38 2.21 2.83

3) Determinazione delle variabili con maggior variabilità e asimmetria

I dati del coefficiente di variazione CV ci mostrano come la variabile Volume abbia la massima variabilità (CV = 53.71%), mentre la variabile Median_price abbia variabilità più bassa (CV = 17.08%). I dati riguardanti le asimmetrie delle distribuzioni mostrano una massima simmetria per i dati di months_inventory (skewness = 0.04, lieve asimmetria positiva), e massima asimmetria per Volume (skewness = 0.88, asimmetria positiva). La variabile Median_price è l’unica con asimmetria negativa (skewness = -0.36). Per quanto riguarda la curtosi invece tutte le varibili hanno coefficiente positivo, quindi mostrano una distribuzione leptocurtica.

4) Divisione in classi per la variabile sales

Divido la variabile sales in 6 classi di ampiezza 60, che mi permettono di classificare tutto lo spettro di vendite che ha minimo 79 e massimo 423.

dataset$fasce_sales <- cut(dataset$sales, breaks = c(70, 130, 190, 250, 310, 370, 430))
ggplot(dataset)+
  geom_bar(aes(y= fasce_sales), fill = "blue")+
  scale_x_continuous(breaks = seq(0, 80, by = 5))+
  labs( y = "fasce di vendite mensili", x = "mensilità", title = "Distribuzione vendite per fasce")

Il grafico mostra la distribuzione in sei fasce dell’andamento mensile delle vendite: sull’asse y sono evidenziate le sei fasce in cui sono state divise le quantità di vendite mensili, mentre sull’asse x viene conteggiata la quantità di menislità in cui si verificano le vendite corrispettive alle diverse fasce.

Funzione per calcolo indice di etereogenità di gini

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

Sulla distribuzione fasce_sales calcolo l’indice di etereogenità di gini normalizzato.

gini <- round(gini_Norm(dataset$fasce_sales, length(levels(dataset$fasce_sales))),2)

L’inice di Gini normalizzato è 0.93, che descrive una etereogenità alta dei dati della variabile sales.

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à

Determinazione prezzo medio

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

rate <- function(x,y){
  step = x/y
  rate = case_when(
    step > 1      ~ "asim positiva",
    step < 1      ~ "asim negativa",
    near(step, 1) ~ "simmetria")
  return(rate)
}
# Utilizzo la funzione rate per calcolare il rapporto tra media e mediana e definire la asimmetria della distribuzione.


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

dataset$mean_price <- volume/sales*(10^6)
dataset$notes <- rate(dataset$mean_price, dataset$median_price)

output_tab <- dataset %>%
  select(city, date, median_price, mean_price, notes)

Tabella di confronto media-mediana per ogni mese(prime 6 righe)

knitr::kable(head(output_tab))
city date median_price mean_price notes
Beaumont 2010-01-01 163800 170626.5 asim positiva
Beaumont 2010-02-01 138200 163796.3 asim positiva
Beaumont 2010-03-01 122400 157697.8 asim positiva
Beaumont 2010-04-01 123200 134095.0 asim positiva
Beaumont 2010-05-01 123100 142737.6 asim positiva
Beaumont 2010-06-01 122800 144015.9 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

Il coefficiente che mostra l’efficacia delle vendite è dato dal rapporto tra il numero di vendite e il numero di annunci. Di seguito le prime righe della tabella che tabula per ogni mese l’efficacia percentuale:

dataset$efficiency <- sales/listings*100

output_eff <- dataset %>%
  select(city, date, efficiency)


knitr::kable(head(output_eff))
city date efficiency
Beaumont 2010-01-01 5.414220
Beaumont 2010-02-01 6.809584
Beaumont 2010-03-01 10.775607
Beaumont 2010-04-01 11.709602
Beaumont 2010-05-01 11.405985
Beaumont 2010-06-01 10.482529

Il grafico seguente mostra l’andamento del coefficiente di efficacia nei 5 anni in analisi nelle varie città

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

Ho provato a migliorare il coefficiente di efficacia in una valutazione annuale inserendo nella media del coefficiente anche una media pesata sulla durata degli annunci (months inventory).

dataset$steps <- ((sales/listings)*months_inventory)*100

table_eff <- dataset%>%
  group_by(city, year)%>%
  summarise(
  efficiency = round(sum(sales)/sum(listings)*100,4),
  weighted_efficiency = round(sum(steps)/sum(months_inventory),4)
  )
## `summarise()` has grouped output by 'city'. You can override using the
## `.groups` argument.

La tabella seguente mostra i dati a confronto:

knitr::kable(table_eff)
city year efficiency weighted_efficiency
Beaumont 2010 9.0213 9.0093
Beaumont 2011 8.2384 8.2568
Beaumont 2012 10.1646 10.1157
Beaumont 2013 12.2694 12.2243
Beaumont 2014 13.4664 13.4468
Bryan-College Station 2010 10.7259 10.6137
Bryan-College Station 2011 10.4234 10.4738
Bryan-College Station 2012 12.2243 12.1901
Bryan-College Station 2013 16.9146 16.6697
Bryan-College Station 2014 23.5201 23.4307
Tyler 2010 7.4564 7.4195
Tyler 2011 7.7804 7.7871
Tyler 2012 9.0537 9.0416
Tyler 2013 10.1785 10.1654
Tyler 2014 12.4142 12.3589
Wichita Falls 2010 12.8637 12.8277
Wichita Falls 2011 10.8993 10.9178
Wichita Falls 2012 12.5465 12.5316
Wichita Falls 2013 14.4174 14.3865
Wichita Falls 2014 13.3460 13.3436

Dal grafico e dalla tabella con medie annuali si può osservare anche un trend di miglioramento del coefficiente di efficacia all’interno del quinquennio in ogni città in analisi.

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", fill = "Città") +
  theme_minimal()

Dal grafico precedente si possono vedere due lievi tendenze:

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", fill = "Città") +
  theme_minimal()

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

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

Lo studio con boxplot delle dinamiche del median price nelle differenti città ci permette di vedere graficamente i dati che avevamo tabulato al punto 2). In particolare avevamo rilevato dai dati relativi al prezzo mediano: - CV = 17.08% - skewness = -0.36 - curtosi = 2.38

Il boxplot precedente ci permette di vedere graficamente la bassa dispersione dei dati anche nella divisione grafica in città; si può osservare anche la forma leptocurtica della distribuzione, legata all’indice di curtosi, dalla dimensione più stretta dei box relativi ai due quartili centreal; e in ultimo si può vedere la tendenza ad una asimmetria negativa osservabile dalla posizione del valore mediano asimmetrica nei box delle città (tranne per Bryan-College Station)

ggplot(dataset, aes(x = city, y = median_price, fill = as.factor(year)))+
  geom_boxplot()+
  labs(y = "Prezzo mediano", x = "Città", title = "Confronto distribuzione prezzo per le varie città con differenze annue", fill = "Anni")

Il Boxplot precedente mostra la specifica dei prezzi mediani in ogni anno raggruppato per le città in analisi. Questo grafico ci permette di vedere in maniera più esplicita il lieve aumento del prezzo a Wichita Falls e di vedere la dispersione delle distribuzioni tra 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

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
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", color = "Città")+
  scale_x_date(
    breaks = as.Date(paste0(year, "-01-01")),
    date_labels = "%Y")

ggplot(dataset, aes(x= month, y = sales, color = city))+
  geom_line()+
  labs(x = "data", y = "vendite", title = "Serie storica delle vendite nel quinquennio", color = "Città")+
  scale_x_continuous(breaks = 1:12, labels = 1:12)+
  facet_wrap(~year, nrow = 2)

I due grafici precedenti evidenziano le serie storiche di vendite per le città in analisi. Nel primo grafico si può osservare il trend di crescita complessivo e la stagnazione delle vendite a Wichita Falls, dato evidenziato nel grafico a barre sovrapposte con lo studio delle quote di vendite. Il secondo grafico separa la serie storica nell’arco di cinque anni in modo da mettere in evidenza la ciclicità delle vendite all’interno dell’anno nelle varie città. Nelle città di Tyler e Bryan-College Station è particolarmente evidente un aumento di vendite nei mesi centrali dell’anno, mentre per Wichita Falls e Beaumont vi è una maggior omogeneità durante l’anno.

Si può osservare lo stesso trend anche dal grafico successivo:

ggplot(dataset, aes(x = city, y = sales, fill = as.factor(year)))+
  geom_boxplot()+
  labs(y = "Vendite annue", x = "Città", title = "Risultati vendite per le varie città con differenze annue", fill = "Anni")

Nel boxplot precedente si può vedere come i range di vendita annua siano maggiori per Tyler e Bryan-College Station rispetto alle altre due città; si può osservare inoltre il trend di crescita nei cinque anni delle vendite di Tyler, Bryan-College Station e Beaumont e la difficoltà di Wichita Falls.