knitr::opts_chunk$set(echo = TRUE, warning = FALSE)

Sobre:

Análise estatística do dataset “diamonds” disponibilizado pela biblioteca do ggplot2, uma das mais importantes bibliotecas para visualização de dados quando falamos em data science.

Dentre os objetivos deste projeto, estão a prática de técnicas de análise exploratória e modelagem estatística para obtenção de insights em relação aos dados.

O dataset possui variáveis categóricas e numéricas que explicam o preço de um diamante.

Serão aplicadas aqui as mais variadas técnicas de visualização e compreensão dos dados.

Pré-visualização dos dados:

pacman::p_load(tidyverse,knitr,qcc,corrplot,lvplot,e1071,caret)
df <- diamonds %>% 
  select_all() %>% 
  transmute(peso = carat,
            qualidade = cut,
            cor = color,
            claridade = clarity,
            comprimento = x,
            largura = y,
            profundidade = depth,
            tabela = table,
            preco = price);kable(head(df));kable(tail(df))
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.23 Ideal E SI2 3.95 3.98 61.5 55 326
0.21 Premium E SI1 3.89 3.84 59.8 61 326
0.23 Good E VS1 4.05 4.07 56.9 65 327
0.29 Premium I VS2 4.20 4.23 62.4 58 334
0.31 Good J SI2 4.34 4.35 63.3 58 335
0.24 Very Good J VVS2 3.94 3.96 62.8 57 336
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.72 Premium D SI1 5.69 5.73 62.7 59 2757
0.72 Ideal D SI1 5.75 5.76 60.8 57 2757
0.72 Good D SI1 5.69 5.75 63.1 55 2757
0.70 Very Good D SI1 5.66 5.68 62.8 60 2757
0.86 Premium H SI2 6.15 6.12 61.0 58 2757
0.75 Ideal D SI2 5.83 5.87 62.2 55 2757

Dicionário de dados:

Originalmente, o dataset está todo em inglês, mas para facilitar a compreensão dos dados, foi realizada a tradução das variáveis para pt-br que seguem-se:

Número de diamantes por qualidade:

Tabela de contingência - Frequência relativa por tipo de diamante

df_fi <- df %>% 
  select(qualidade) %>% 
  group_by(qualidade) %>% 
  summarise(n = n()) %>% 
  mutate(fi = n/sum(n));kable(df_fi)
## `summarise()` ungrouping output (override with `.groups` argument)
qualidade n fi
Fair 1610 0.0298480
Good 4906 0.0909529
Very Good 12082 0.2239896
Premium 13791 0.2556730
Ideal 21551 0.3995365

40% dos diamantes presentes no dataset sao classificados como o tipo “Ideal”. Em valores absolutos, isso nos diz que há mais de 20.000 registros para esse tipo de diamantes presentes no dataset.

p1 <- ggplot(df_fi,aes(x = qualidade))+
  geom_bar(aes(y = n),fill = "steelblue", alpha = 0.8, stat = "identity")+
  theme_minimal()+
  labs(title = "Número de diamantes por qualidade", x = "Qualidade",y="");p1

p2 <- ggplot(df, aes(x = peso))+
  geom_histogram(bins = 30, fill = "steelblue", color = "white" ,alpha = 0.8)+
  theme_minimal()+
  labs(title = "Número de diamantes por faixa de peso", x = "Kilogramas", y="");p2

Grande parte dos diamantes possuem entre aproximadamente 0,25 e 1 kilogramas.

options(warnings = -1)
p3 <- ggplot(df,aes(x = peso,color=qualidade))+
  geom_freqpoly(bins = 30,size = 2)+
  theme_minimal()+
  labs(title = "Número de diamantes por faixa de peso e qualidade", x = "Kilogramas",y="");p3

É possível ver aqui a relação do tipo de diamantes por qualidade e sua distribuição de contagem por Kilogramas.

Em sua grande maioria, diamantes do tipo “Ideal”, estão mais concentrados na faixa de aproximadamente 0,25 kilogramas.

p4 <- ggplot(df,aes(x = qualidade, y = peso, fill = qualidade))+
  geom_boxplot(color = "grey")+
  theme_minimal()+
  labs(title="Boxplot por qualidade dos diamantes", x = "Qualidade",y="Kilogramas",
       subtitle = "Análise de Kilogramas");p4

Há alguns insights interessantes que podemos tirar analisando o box-plot por peso e qualidade dos diamantes:

Diamantes do tipo “Fair” posssuem intervalo interquatilico menor que os demais tipos de diamantes, sendo o diamante do tipo “Premium”, o que possui maior intervalo interquatilico do conjunto de dados.

Essa medida é importante pois aqui conseguimos avaliar a variabilidade dos dados sem sofrer influência da presença de outliers (valores muito distantes da média).

Podemos medir a variabilidade também através da amplitude (valor máximo - valor minimo), a diferença é que aqui estamos considerando valores outliers.

Por essa visão, “Fair” é o tipo que mais apresenta variabilidade em sua distribuição de dados. É importante notar também a concentração de outliers na faixa acima de 4 Kilogramas para esse tipo de diamante, sendo o único a apresentar essa característica.

Também podemos notar que em todos os casos, temos a média maior que a mediana, pois o “bigode” possui inclinação para a parte superior, ou seja ambas as amostras podem ser ditas como assimétricas.

Tal observação é confirmada calculando o coeficiente de Assimetria (skewness).

Considerações para o cálculo o coeficiente de Assimetria:

Se menor que -1 ou maior que 1, a distribuição é altamente distorcida.

Se entre -1 e -0,5 ou entre 0,5 e 1, a distribuição é enviesada moderadamente.

Se entre -0,5 e 0,5, a distribuição é aproximadamente simétrica.

premium <- df %>% filter(qualidade == "Premium")
ideal <- df %>% filter(qualidade == "Ideal")
verygood <- df %>% filter(qualidade == "Very Good")
good <- df %>% filter(qualidade == "Good")
fair <- df %>% filter(qualidade == "Fair")

Coeficiente de Assimetria, avaliação de kilogramas dos diamantes:

Pode-se concluir que as amostras são de fato assimétricas, pois para possuir simetria os coeficientes deveriam ficar entre -0,5 e 0,5, isso significa dizer que, temos um indicio comum de que as amostras não tratam-se de distribuições normais.

p5 <- ggplot(df,aes(x = qualidade, y = preco, fill = qualidade))+
  geom_boxplot(color = "grey")+
  theme_minimal()+
  labs(title="Boxplot por qualidade dos diamantes", subtitles= "Analise de preços", x = "Qualidade",y="Preço");p5

Um insight interessante que podemos tirar dessa análise é que, diamantes do tipo “Ideal”, que é a melhor qualidade de diamantes, tem uma mediana de preço menor que os demais tipos de diamantes. Ou seja, a primeira vista, diamantes de qualidade inferior custam mais caro.

Para essas distribuições, também temos dados assimétricos.

Quando falamos em intervalo interquatilico, ou seja, a variabilidade dos dados desconsiderando os valores outliers, diamantes do tipo ‘Fair’, possuem menor variabilidade.

Realizando teste de hipótese: Diamantes de qualidade inferior são realmente mais caros?

Através do teste-T de student será verificada a hipótese de se de fato diamantes do tipo “Fair” custam mais caro que diamantes de qualidade superior:

Uma das premissas para a aplicação desse teste é a existência de uma distribuição normal dos dados. Contudo, existem 3 tipos de teste T:

Para verificar se as amostras são normalmente distribuídas, realizaremos o shapiro Test antes nas seguintes condições:

df_fair <- df %>% filter(qualidade == "Fair") %>% sample_frac(0.5)
df_ideal <- df %>% filter(qualidade == "Ideal") %>% sample_frac(0.2)
## 
##  Shapiro-Wilk normality test
## 
## data:  df_fair$preco
## W = 0.83234, p-value < 2.2e-16
## 
##  Shapiro-Wilk normality test
## 
## data:  df_ideal$preco
## W = 0.74735, p-value < 2.2e-16

Como o p-value de ambas as amostras estão abaixo de 0.5 rejeitamos a hipótese nula e NÃO podemos assumir a normalidade dos dados.

Verificando se as amostras são independentes:

df_fair2 <- df_fair %>% select(preco) %>% sample_n(800);colnames(df_fair2) <- c("fair")
df_ideal2 <- df_ideal %>% select(preco) %>% sample_n(800);colnames(df_ideal2) <- c("ideal")
df_corr <- cbind(df_fair2,df_ideal2);kable(head(df_corr))
fair ideal
8529 1292
3991 628
2700 1566
2381 1094
579 3884
4398 5099

Coeficiente de correlação de pearson:

## [1] 0.008995536
ggplot(df_corr,aes(x=fair,y=ideal))+
  geom_point(color = "steelblue", alpha = 0.8)+
  labs(title = "Correlação Fair x Ideal",
       subtitle = cor(df_corr$fair,df_corr$ideal))+
  theme_minimal()

Visualizando tanto o coeficiente de correlação quanto o gráfico de dispersão, podemos concluir que de fato não há correlação alguma entre nossas amostras e então, podemos seguir com o teste de hipótese.

Vamos realizar um teste de hipótese bicaudal, ou seja, testaremos a hipótese de que o preço dos diamantes do tipo “Fair” e dos diamantes do tipo “Ideal” não apresentam diferenças significativas.

## 
##  Welch Two Sample t-test
## 
## data:  df_corr$fair and df_corr$ideal
## t = 4.3868, df = 1567.9, p-value = 1.227e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##   422.5966 1106.1359
## sample estimates:
## mean of x mean of y 
##  4179.278  3414.911

De acordo com o teste-t realizado, rejeitamos a hipotese nula, pois o valor p é muito baixo.

há diferenças significativas entre os preços dos dois tipos de diamantes e a análise de média nos diz que de fato, diamantes do tipo “Fair” são mais caros que os do tipo “Ideal”.

p6 <- ggplot(df)+
  geom_histogram(aes(x = largura), binwidth = 0.5, fill = "steelblue", color = "white")+
  coord_cartesian(ylim = c(0,50))+
  ggtitle("Análise de largura dos diamantes",subtitle= "Identificando outliers com coordenadas cartesianas")+
  theme_minimal();p6

Há valores outliers na faixa intermediária de 30 e na faixa superior de 50 e também há valores na faixa de 0.

Analisando os outliers mais a fundo

Vamos aplicar um filtro em nossos dados afim de identificar as incosistências segundo os outliers encontrados no plot anterior.

Neste filtro, listaremos apenas os valores desde que largura = 0 e largura > 20.

df_out <- df %>% 
  filter(largura == 0 | largura > 20) %>% 
  arrange(largura);kable(df_out)
peso qualidade cor claridade comprimento largura profundidade tabela preco
1.00 Very Good H VS2 0.00 0.0 63.3 53 5139
1.14 Fair G VS1 0.00 0.0 57.5 67 6381
1.56 Ideal G VS2 0.00 0.0 62.2 54 12800
1.20 Premium D VVS1 0.00 0.0 62.1 59 15686
2.25 Premium H SI2 0.00 0.0 62.8 59 18034
0.71 Good F SI2 0.00 0.0 64.1 60 2130
0.71 Good F SI2 0.00 0.0 64.1 60 2130
0.51 Ideal E VS1 5.15 31.8 61.8 55 2075
2.00 Premium H SI2 8.09 58.9 58.9 57 12210

Analisando a tabela, podemos então concluir que esses valores encontrados são outliers pois possuem erros de input, tal afirmação é sustentada por:

  1. Não é possível haver diamantes com 0cm de largura (curiosamente, quando possuem 0cm de largura também possuem 0cm de comprimento no dataset).

  2. É muito improvavel que existam diamantes com ~30cm e ~60cm, mas ainda que existam, eles custariam milhares de dolares, o que podemos ver que não acontece.

df2 <- df %>% 
  mutate(largura = ifelse(largura < 3 | largura > 20, NA, largura))
kable(head(df2));kable(tail(df2))
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.23 Ideal E SI2 3.95 3.98 61.5 55 326
0.21 Premium E SI1 3.89 3.84 59.8 61 326
0.23 Good E VS1 4.05 4.07 56.9 65 327
0.29 Premium I VS2 4.20 4.23 62.4 58 334
0.31 Good J SI2 4.34 4.35 63.3 58 335
0.24 Very Good J VVS2 3.94 3.96 62.8 57 336
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.72 Premium D SI1 5.69 5.73 62.7 59 2757
0.72 Ideal D SI1 5.75 5.76 60.8 57 2757
0.72 Good D SI1 5.69 5.75 63.1 55 2757
0.70 Very Good D SI1 5.66 5.68 62.8 60 2757
0.86 Premium H SI2 6.15 6.12 61.0 58 2757
0.75 Ideal D SI2 5.83 5.87 62.2 55 2757

Verificando valores outliers com correlação comprimento x largura:

Uma outra forma de identificar valores outliers é correlacionar uma variável independente a uma variável dependente.

Isso também é muito útil para entendermos como se relacionam as variáveis do dataset. no caso, vamos correlacionar o comprimento com a largura, pois levando-se em consideração de que estamos falando de diamantes, o normal é que a medida que seu comprimento aumente, sua largura também deve aumentar.

p7 <- ggplot(df2, aes(x = comprimento, y = largura))+
  geom_point(color = "steelblue", size = 3)+
  theme_minimal()+
  ggtitle("Correlação - Comprimento x Largura");p7

O Gráfico de correlação nos mostra que esse padrão é verdadeiro.

Contudo, é possível identifcar um valor outlier na faixa de 0cm de comprimento.

Vamos aplicar a mesma técnica realizada anteriormente e filtrar esses valores a fim de, encontrarmos as inconsistências nos dados.

df_com_out <- df2 %>% 
  filter(comprimento <3);kable(df_com_out)
peso qualidade cor claridade comprimento largura profundidade tabela preco
1.07 Ideal F SI2 0 6.62 61.6 56 4954
1.00 Very Good H VS2 0 NA 63.3 53 5139
1.14 Fair G VS1 0 NA 57.5 67 6381
1.56 Ideal G VS2 0 NA 62.2 54 12800
1.20 Premium D VVS1 0 NA 62.1 59 15686
2.25 Premium H SI2 0 NA 62.8 59 18034
0.71 Good F SI2 0 NA 64.1 60 2130
0.71 Good F SI2 0 NA 64.1 60 2130

Nosso grafico havia desconsiderado outros valores com comprimento = 0 pois os dados de largura estavam como NA (valores faltantes). Vamos desconsiderar os inputs errados do dataset.

df3 <- df2 %>%
  mutate(comprimento = ifelse(comprimento < 3, NA, comprimento));kable(head(df3));kable(tail(df3))
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.23 Ideal E SI2 3.95 3.98 61.5 55 326
0.21 Premium E SI1 3.89 3.84 59.8 61 326
0.23 Good E VS1 4.05 4.07 56.9 65 327
0.29 Premium I VS2 4.20 4.23 62.4 58 334
0.31 Good J SI2 4.34 4.35 63.3 58 335
0.24 Very Good J VVS2 3.94 3.96 62.8 57 336
peso qualidade cor claridade comprimento largura profundidade tabela preco
0.72 Premium D SI1 5.69 5.73 62.7 59 2757
0.72 Ideal D SI1 5.75 5.76 60.8 57 2757
0.72 Good D SI1 5.69 5.75 63.1 55 2757
0.70 Very Good D SI1 5.66 5.68 62.8 60 2757
0.86 Premium H SI2 6.15 6.12 61.0 58 2757
0.75 Ideal D SI2 5.83 5.87 62.2 55 2757 
p8 <- ggplot(df3, aes(x = comprimento, y = largura))+
  geom_point(color = "steelblue", size = 3, alpha = 0.5)+
  theme_minimal()+
  ggtitle("Correlação - Comprimento x Largura", subtitle = "Desconsiderando os outliers");p8

Conclusão:

Comprimento x largura possuem forte correlação positiva.

Podemos avaliar ainda, quais variáveis são mais determinantes para a precificação dos diamantes.

Faremos isso utilizando uma matriz de correlação com o corrplot.

df4 <- df3 %>% 
  drop_na()
num_vars <- sapply(df4, is.numeric)
cor <- cor(df4[num_vars])
corrplot(cor,method = "number")

Aqui, podemos ver que, o peso, comprimento e largura são as variáveis mais determinantes para o preço de um diamante, enquanto as demais variáveis possuem pouca significância.

Também podemos analisar o que determina a qualidade de um diamante quando este é Ideal, Premium, Good e etc.

Isso também nos auxiliará a entender o motivo pelo qual diamantes do tipo “Fair” (pior qualidade) tem mediana de preços mais elevados que diamantes do tipo “Ideal” (melhor qualidade).

Para isso, vamos padronizar nossos dados, e transformar a variavel “qualidade” em numérica e em seguida fazer o estudo de correlação novamente.

qualidade <- unique(df4$qualidade);qualidade
## [1] Ideal     Premium   Good      Very Good Fair     
## Levels: Fair < Good < Very Good < Premium < Ideal
cor <- unique(df4$cor);cor
## [1] E I J H F G D
## Levels: D < E < F < G < H < I < J
claridade <- unique(df$claridade);claridade
## [1] SI2  SI1  VS1  VS2  VVS2 VVS1 I1   IF  
## Levels: I1 < SI2 < SI1 < VS2 < VS1 < VVS2 < VVS1 < IF

Definição das variáveis categóricas:

Qualidade:

df_ <- df4 %>% 
  mutate(qualidade = ifelse(qualidade == "Fair", 1,
                            ifelse(qualidade == "Good",2,
                                   ifelse(qualidade == "Very Good",3,
                                          ifelse(qualidade == "Premium",4,5)))))

num_vars <- sapply(df_,is.numeric)
cor <- cor(df_[num_vars])
corrplot(cor,method = "number")

A variável qualidade, não é peça determinante na composição do preço do diamante, mas sim seu comprimento, largura e principlamente seu peso.

Muito provalvelmente, diamantes de qualidade inferior costumam pesar mais, logo tem preço maior. Vamos verificar esse hipótese estudando o peso dos diamantes novamente:

p4 <- ggplot(df,aes(x = qualidade, y = peso, fill = qualidade))+
  geom_boxplot(color = "grey")+
  theme_minimal()+
  labs(title="Boxplot por qualidade dos diamantes",subtitle = "Análise de kilogramas", x = "Qualidade",y="Kilogramas");p4

Revisitando esse plot acerca dos kilogramas dos diamantes por qualidade, podemos atestar aqui que, diamantes de qualidade inferior (Fair) possuem mais kilogramas em comparação com diamantes de qualidade superior (Ideal).

Ou seja, diamantes “Fair” são mais caros pois possuem mais kilogramas, pois conforme vimos no plot de correlação, Peso é a variável que mais está correlacionada ao Preço.

plot <- ggplot(df_, aes(x = peso, y = preco))+
  geom_point(color = "steelblue", alpha = 0.3)+
  theme_minimal()+
  ggtitle("Correlação entre peso e preço do diamante");plot

corrplot(cor,method = "number")

É possível ver também que há correlação negativa moderada entre qualidade e tabela (largura do topo do diamante em relação ao ponto mais largo), ou seja, quanto menor a largura do topo em relação ao ponto mais largo do diamante, sua qualidade tende a aumentar de forma moderada.

p9 <- ggplot(df_,aes(x = qualidade,y=tabela))+
  geom_point(size = 3, color = "steelblue")+
  theme_minimal()+
  ggtitle("Correlação - Qualidade x Tabela");p9

Plotando principais correlações:

p10 <- ggplot(df_,aes(x=comprimento,y=preco))+
  geom_point(color = "lightblue",alpha = 0.5)+
  theme_minimal()+
  ggtitle("Comprimento x Preco")

p11 <- ggplot(df_,aes(x=largura,y=preco))+
  geom_point(color = "green",alpha = 0.1)+
  theme_minimal()+
  ggtitle("Largura x Preco")

p12 <-  ggplot(df_,aes(x=peso,y=preco))+
  geom_point(color = "red",alpha = 0.1)+
  theme_minimal()+
  ggtitle("Peso x Preco")

p13 <-  ggplot(df_,aes(x=tabela,y=preco))+
  geom_point(color = "grey",alpha = 0.3)+
  theme_minimal()+
  ggtitle("Tabela x Preco")


gridExtra::grid.arrange(p10,p11,p12,p13,nrow = 2)

Também é possível ver que, dentre as medidas do diamante, tabela (largura do topo do diamante em relação ao ponto mais largo) é a unica na qual não possui relação significativa com o preço aplicado ao diamante, embora possua correlação negativa moderada com a qualidade do diamante.

Conclusão da análise: