#Read Sales data

Sales <- read_excel("G:/My Drive/Guava Breeding/Datos Mercado/WM Store Detail WK 52.2021.xlsx",     sheet = "store detail ytd", skip = 25)


#Cleaning:
Sales = Sales %>% filter (Sales$`POS Sales` > 0)

stores <- read_excel("G:/My Drive/Guava Breeding/Datos Mercado/SOTC_DemogPivot_vendor.xls")

sales2bind = Sales %>% dplyr::select(`Store Nbr`,`POS Qty`, `POS Sales`) %>% 
    dplyr::rename(Store =`Store Nbr`)


stores2bind = stores 

d = merge(sales2bind, stores2bind, all.x = T, all.y = F, by = "Store")

d_modeling = d [, c(3,11:35)]
#d_modeling$`Store Type` = as.factor(d_modeling$`Store Type`)
#d_modeling$State = as.factor(d_modeling$State)
#str(d_modeling)

Este es un analisis realizado con los datos de venta de SPV a las diferentes tiendas de Walmart, cruzado con los datos demográficos de esas mismas tiendas.

Vamos a entender este ejercicio como una exploración que nos puede dar algunas pistas, pero sobre todo, más preguntas.

Parte I: Exploración de datos de venta crudos.

Una primera pregunta es: si graficamos las ventas de todas las tiendas, cómo se verian?

Ustedes ya lo saben, pero el gráfico aquí nos muestra que la forma de la curva es exponencial.

Es decir, a partir de cierto umbral de ventas (de mas o menos 27 k $, marcada en azul), la cantidad de ventas por tienda aumenta exponencialmente. O sea, unas pocas tiendas venden una grandísima cantidad de guayabas.

Sales = Sales %>% arrange(-Sales$`POS Sales`)
Sales$Index = 1:nrow(Sales)

ggplot(Sales, aes(x= Index, y =`POS Sales`/1000 ))+ geom_point()+
   ylab ("Ventas totales por tienda (k $)")+xlab("Tienda")+
   geom_line(aes(x= 100), col = 'blue')+
  geom_line(aes(y= 27), col = 'blue')+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

De hecho, las 100 tiendas que mas venden (el 2% de las tiendas), hacen el 14% de las ventas. En el gráfico lo vemos como la línea azul.

Las 400 tiendas que mas venden (el 10% de las tiendas), hacen el 33 % de las ventas. En el gráfico lo vemos como la linea roja.

Las 1000 tiendas que mas venden (el 25% de las tiendas), hacen el 57 % de las ventas. En el grafico lo vemos como la linea verde.

top100 = Sales %>% filter (Index < 101)
x_top100= sum(top100$`POS Sales`)/sum(Sales$`POS Sales`)*100

top400 = Sales %>% filter (Index < 401)
x_top400= sum(top400$`POS Sales`)/sum(Sales$`POS Sales`)*100

top1000 = Sales %>% filter (Index < 1001)
x_top1000= sum(top1000$`POS Sales`)/sum(Sales$`POS Sales`)*100



totalsales = sum(Sales$`POS Sales`)

quantiles = Sales %>% group_by(Index) %>% arrange(-Sales$`POS Sales`) %>%
  summarise(Sales = `POS Sales`)

quantiles$Sales_CUMSUM = cumsum(quantiles$`Sales`)
quantiles$Sales_CUMPERC = quantiles$Sales_CUMSUM*100/totalsales


ggplot(quantiles, aes (x= Index, y = Sales_CUMPERC)) + geom_point() + 
       ylab("Acumulado de ventas totales(%)") + xlab("Posición en el ranking de la tienda") + 
      geom_line(aes(x= 100), col = "blue")+
      geom_line(aes(y= 14), col = "blue")+
      geom_line(aes(x= 400), col = "red")+
      geom_line(aes(y= 33), col = "red")+
  geom_line(aes(x= 1000), col = "green")+
      geom_line(aes(y= 57), col = "green")+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

Evidentemente, la misma forma de la curva la vemos para la cantidad de de unidades vendidas, y para el porcentaje de Markdown.

Sales = Sales %>% arrange(-Sales$`POS Qty`)
Sales$Index = 1:nrow(Sales)

ggplot(Sales, aes(x= Index, y =`POS Qty` ))+ geom_point()+
   ylab ("Cantidad de unidades vendidas por tienda")+ xlab ("Tienda")+
  labs(title= "Unidades vendidas por tienda" )+
   geom_line(aes(x= 100))+
   geom_line(aes(y= 12000))+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

Sales = Sales %>% arrange(-Sales$`MD%`)
Sales$Index = 1:nrow(Sales)

ggplot(Sales, aes(x= Index, y =`MD%` ))+ geom_point()+
   ylab ("MD %")+ xlab ('Tienda')+
  labs(title= "MD% por tienda" )+
   geom_line(aes(x= 100))+
   geom_line(aes(y= 2))+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

Por último, si ponemos lado a lado el monto de ventas por tienda con el MD %, lo que vemos es lo siguiente: * Para la mayoria de tiendas, el MD% no sube de 0.9%.
* Sin embargo, algunas pocas tiendas, con ventas inferiores a 3000 %, el MD% se dispara muy por encima de 1%.

En total, hay 495 tiendas con ese perfil ( MD% > 1 y ventas < 3000$).

Y el total de ventas de ese grupo de tiendas es de 662,223 $

ggplot(Sales, aes(x= Sales$`POS Sales`/1000, y =`MD%` ))+ geom_point()+
   xlab ("Ventas totales por tienda (Miles de $)") + ylab("MD%")+
  labs(title= "Unidades vendidas y MD%  por tienda" )+
   geom_line(aes(x= 3), col = 'red')+
    geom_line(aes(y= 0.9), col = 'red')+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

  lowsalesandmd = Sales %>% filter (`MD%` > 1) %>% filter (`POS Sales` < 3000)
x_lowsalesandmd= sum(lowsalesandmd$`POS Sales`)

Desglose por Estado

Ventas totales

Otra pregunta que yo me hago es cuales son los estados donde más se vende guayaba.

Asi, el Estado donde mas se vende, por mucho, es Texas. Seguidos de Florida, California, North Carolina y Arizona. Donde menos se vende es en Vermont, Rhode Island y el Montana.

mean_state = d %>% dplyr::filter(!is.na(State))%>%  group_by(State) %>%  
              dplyr::summarise (mean_sales = mean(`POS Sales`),
                         total_sales = sum(`POS Sales`))


ggplot(mean_state, aes(y= reorder(State,total_sales),
                                 x = total_sales /1000000))+ 
         geom_bar(stat= "identity")+ labs(y = 'Estado', 
                                          x = "Ventas Totales (Millones de $)", 
                                          title = "Ventas totales por Estado")+
  theme(axis.text = element_text(size = 15))

state <- map_data("state")
state$region = str_to_title(state$region)
state[state$region == "District Of Columbia", "region"] = "District of Columbia"

equiv <- read.delim("G:/My Drive/Guava Breeding/Datos Mercado/Analisis/csvData.csv")

mean_state_equiv <- merge(mean_state, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)

state2 <- state2 %>% arrange(order)
state2$mean_sales = state2$mean_sales / 1000
state2$total_sales = state2$total_sales / 1000000
map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=total_sales, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
   coord_fixed(1.3)+
  labs(fill = "Ventas Totales \n(Millones de $)", title= "Ventas totales por Estado" )+       scale_fill_gradient(
  high= "#132B43",
  low = "#56B1F7")


ggplotly(map_means)

Hagamos el mismo mapa, pero sin Texas ni Florida, para poder ver mejor la escala de color.

state_notx = state2 %>% dplyr::filter (region != "Texas" & region != "Florida" )

map_means = ggplot(data=state_notx, aes(x=long, y=lat,  label = region,
                        fill=total_sales, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
  coord_fixed(1.3)+labs(fill = "Ventas Totales \n(Millones de $)", title= "Ventas totales por Estado (Sin TX ni FL)" )+ scale_fill_gradient(
  high= "#132B43",
  low = "#56B1F7")

ggplotly(map_means)

Promedio de ventas por tienda

Por otro lado, si nos fijamos en el promedio de ventas por tienda, la historia cambia.

Los siguientes estados tienen ventas promedio por tienda sobresalientes: DC, New Jersey, Texas, Connecticut, Washington y Maryland.

Y la lista de los estados de peores ventas es la siguiente: West Virginia, Vermont y Montana.

ggplot(mean_state, aes(y= reorder(State,mean_sales),
                                 x = mean_sales ))+ 
         geom_bar(stat= "identity")+ labs(y = 'State', x = "Mean Sales (Thousand $)",
                                          title = "Promedio de ventas por tienda según Estado")+
  theme(axis.text = element_text (size = 15))

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=mean_sales, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
  coord_fixed(1.3)+labs(fill = "Promedio de ventas \n por tienda \n(Miles de $)", title = "Promedio de ventas por tienda según Estado")+
  scale_fill_gradient(
  high= "#132B43",
  low = "#56B1F7")

ggplotly(map_means)

Parte II: Cruzando datos demográficos y datos de ventas.

Tenemos los datos de vetna de mas de 4000 tiendas de Walmart, y además, tambien tenemos datos demograficos de cada tienda, pero cada variable esta expresada en terminos de la poblacion total que acude al Walmart. Por ejemplo, existen las variables de porcentaje de personas con ingresos de 100k $ o mas, el porcentaje de personas con ingresos entre 50 y 99 k, el porcentaje de personas con ingresos entre 30 y 50 k y el porcentaje de personas con ingresos menores a 30 k. En total, esos cuatro porcentajes deben sumar 100%.

En el cuadro a continuacion vemos los resultados de un modelo linear, donde se intenta predecir cual de las variables demograficas, puede predecir mejor la cantidad de ventas totales por tienda.

En el cuadro vemos las variables acomodadadas según su importancia (Ranking).

Asi, por ejemplo, los metros cuadrados de la tienda son el factor mas importante.

Luego, los factores de mayor importancia son:

Por otro lado, el porcentaje de personas entre 55 y 64 tiene mas bien un efecto negativo sobre las ventas. La otra variable que afecta negativamente las ventas es el porcentaje de personas entre 18 y 34 años.

El porcentaje de latinos que asisten a la tienda es importante y significativo a nivel estadistico para predecir las ventas, pero es solo la variable número 11 en terminos de importancia. Similar ocurre con el porcentaje de ‘otras’ etnias (posiblemente asiáticos), que está en el puesto numero 12.

full.model <- lm(`POS Sales` ~., data = d_modeling)

# Stepwise regression model*
step_car <- stepAIC(full.model, trace = TRUE, direction= "both")
x= as.data.frame(summary(step_car)$coefficients)
x = x %>% arrange(`Pr(>|t|)`) 

x$Ranking = 1:nrow(x)
x$Efecto = "Positivo"
x[x$Estimate < 0, 'Efecto'] = "Negativo"
x_full= x
x$Variable = rownames(x)
x = x %>% dplyr::select (Variable,Ranking)

x= x[-7,]
x$Ranking = 1:nrow(x)
rownames(x)  = 1:nrow(x)
kable(x, align = "c" ) %>%
  kable_styling(position = "center")
Variable Ranking
Square Footage 1
Income $100,000+ 2
Age 35-54 3
Income $30,000 - $49,999 4
Some High School or Less 5
Age 55-64 6
Some College or More 7
4+ person HH 8
Age 18-34 9
No Children 10
Ethnics:Latin 11
Ethnics:Other 12
Children &lt; 6 only 13
Children &lt; 6 and 6 - 17 14
Ethnics:African American 15
Ethnics:Caucasian 16
Children 6 - 17 17

Tamaño de la tienda.

Lo primero es que vamos a graficar las ventas totales contra los pies cuadados de las tiendas. El patrón no es muy claro, pero evidentemente algunas tiendas grandes venden mucho. En el segúndo grafico, donde agrupamos las tiendas en categorias de tamano, nos confirma que este no es un factor definitivo.

PERO este factor nos va a servir mas tarde para corregir y observar mas en detalle los factores demograficos.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Square Footage`))+geom_point()+ 
  labs(y = "Ventas totales por tienda(Miles de $)", x = "Pies cuadrados de la tienda",
       title = "Ventas totales según el tamaño de la tienda")+
   stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+  ylim(c(0, NA))+
  theme(axis.title = element_text(size = 18),
        axis.text = element_text(size = 15))

d$store_size = '< 50k ft.'

for (i in 1:nrow(d)){
  if(!is.na(d[i,"Square Footage"])){
      if(d[i,"Square Footage"] > 50000 & d[i,"Square Footage"] <= 100000  ){
         d[i,"store_size"] = '50k - 100k ft.'}
      if(d[i,"Square Footage"] > 100000 & d[i,"Square Footage"] <= 150000  ){
           d[i,"store_size"] = '100k - 150k ft.'}
      if(d[i,"Square Footage"] > 150000 & d[i,"Square Footage"] < 200000  ){
         d[i,"store_size"] = '150k - 200k ft.' }
      if(d[i,"Square Footage"] > 200000 ){ 
         d[i,"store_size"] = '> 200k ft.'}
}}


d$store_size = factor(d$store_size, levels = c('< 50k ft.',
                                               '50k - 100k ft.' ,
                                               '100k - 150k ft.',
                                               '150k - 200k ft.', 
                                              '> 200k ft.'))

ggplot( d, aes(x= store_size, y =d$`POS Sales`/1000)) + geom_violin() + geom_point()+
  labs(y = "Ventas totales por tienda \n(Miles de $)", x = "Tamaño de la tienda",
       
       title = "Ventas totales según el tamaño de la tienda")+
  theme(axis.text = element_text (size = 13),
        axis.title = element_text (size = 14),
        axis.text.x = element_text(angle = 90))

Parte II a: Análisis por nivel de ingreso

Porcentaje de clientes con ingresos > 100 k

Si tomamos nuestro segúndo factor en importancia (el porcentaje de clientes con ingresos > 100 k”), vemos que, por si sola, la nube de puntos no tiene mucha forma y la correlación no es demasiado alta.

Pero, si separamos todas las tiendas según su categoría de tamaño, vemos que el efecto de ese factor es bien importante en las tiendas con un tamaño entre 50 y 150 k pies cuadrados.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Income  $100,000+`))+geom_point()+ 
  labs(y = "Ventas totales por tienda (Miles de $)", x = "Porcentaje de clientes con ingresos  > 100 k",
        title = "Ventas totales según el porcentaje de clientes con ingresos > 100 k")+
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+
  theme(axis.text = element_text (size = 15))

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Income  $100,000+`))+geom_point()+ 
  labs(y = "Ventas totales por tienda (Miles de$)",
       x = "Porcentaje de clientes con ingresos  > 100 k",
        title = "Ventas totales según el porcentaje de clientes con ingresos > 100 k \n(según el tamaño de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')

Otro elemento que nos puede resultar util para entender mejor la influencia de esta variable sobre las ventas, es el Estado donde su ubica la tienda.

Asi, hay estados donde esta variable es muy predictiva para las ventas, como Georgia, North Carolina, Ohio, Virgina y West Virginia.

Pero hay estados donde es lo contrario!! Los ejemplos son Utah, Arizona e Idaho.

Los Estados que salen en gris es porque la correlación no es significativa o porque no hay suficientes datos.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Income  $100,000+`))+geom_point()+ 
  labs(y = "Ventas totales (Miles de $)", x = "Porcentaje de clientes con ingresos > 100 k")+
  facet_wrap(State~., scales = "free_y")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+
  geom_smooth(method = 'lm')+ylim(c(0, NA))+
  theme(axis.text = element_text(size=20),
        strip.text.x = element_text(size = 20))

Mejor lo vemos en forma de mapa.

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Income  $100,000+`)
  r = cor$estimate
  p = cor$p.value
  if (p < 0.2 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de clientes con ingresos > 100k $", fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Porcentaje de personas con ingresos entre 50-99 k $

En este caso, el efecto es mas bien negativo. Es decir, entre más personas hay en esta franja, menores son las ventas.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Income $50,000 - $99,999`))+geom_point()+ 
  labs(y = "Ventas totales (Miles de $)", x = "Porcentaje de clientes con ingresos  50-99k $",
         title = "Correlación entre ventas totales y porcentaje de clientes con ingresos entre 50-99k $ \n(separado segun tipo de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+
  theme(axis.text = element_text (size= 12))

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Income $50,000 - $99,999`)
  r = cor$estimate
  p = cor$p.value
  if (p < 0.2 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de clientes con ingresos entre 50-99 $", fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Porcentaje de personas con ingresos entre 30-50 k

ggplot(d, aes(y = d$`POS Sales`, x= d$`Income $30,000 - $49,999`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes con ingresos  30-49k")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+
  theme(axis.text = element_text (size= 12))

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Income $30,000 - $49,999`)
  r = cor$estimate
  p = cor$p.value
  if (p < 0.2 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
  labs(title = "Correlación entre ventas totales y porcentaje de clientes con ingresos entre 30-49 $",
       fill = "Correlación")+
  scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Porcentaje de personas con ingresos <30 k

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Income under $30,000`))+geom_point()+ 
  labs(y = "Ventas totales (Miles de $)", x = "Porcentaje de clientes con ingresos de menos de 40 k $")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+
  theme(axis.text = element_text (size= 12))

Ojo con New Jersey !! Ahi, en cambio, entre más personas haya en esa franja, mejor nos va!

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Income under $30,000`)
  r = cor$estimate
  p = cor$p.value
  if (p < 0.2 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) +
    labs(title = "Correlación entre ventas totales y porcentaje de clientes con ingresos < 30k $",
       fill = "Correlación")+
  scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Parte II b: Análisis por edad

Porcentaje de personas entre 35 y 54 años

Esta es el rango de edad donde potencialmente se venden mas guayabas. Además, esta variable es muy predictiva sin importar el tamaño de la tienda.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Age 35-54`))+geom_point()+ 
  labs(y = "Ventas totales (Miles de $)", x = "Porcentaje de clientes con edad entre 35 y 54", 
  title = "Correlación entre ventas totales y porcentaje de clientes con edad entre 35 y 54")+
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')
ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Age 35-54`))+geom_point()+ 
  labs(y = "Ventas totales (Miles de $)", x = "Porcentaje de clientes con edad entre 35 y 54",  
  title = "Correlación entre ventas totales y porcentaje de clientes con edad entre 35 y 54 \n(separado según tipo de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')

Así, hay estados donde esta variable es muy predictiva para las ventas, como Georgia, North Carolina u Ohio por ejemplo. Mientras que en otros estados, como Utah y Nevada, esta variable no es muy predictiva.

ggplot(d, aes(y = d$`POS Sales`, x= d$`Age 35-54`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes con edad entre 35 y 54")+
  facet_wrap(State~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Age 35-54`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.1 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
  labs(title = "Correlación entre ventas totales y porcentaje de clientes con edad entre 35-54",
       fill = "Correlación")+     scale_fill_gradient2(
  high= "#132B43",
  mid= "white",
  low = "tomato")

ggplotly(map_means)

Porcentaje de personas entre 35 y 54 años

En este caso, un aumento del porcentaje de esta franja etárea es perjudicial para las ventas, sin importar el tipo de tienda, y sin importar el Estado.

ggplot(d, aes(y = d$`POS Sales`, x= d$`Age 55-64`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes con edad entre 55 y 64")+
  #facet_wrap(State~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))
ggplot(d, aes(y = d$`POS Sales`, x= d$`Age 55-64`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes con edad entre 55 y 64",  
  title = "Correlación entre ventas totales y porcentaje de clientes con edad entre 55 y 64 \n(separado según tipo de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Age 55-64`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) +   labs(title = "Correlación entre ventas totales y porcentaje de clientes con edad entre 55-64",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)
ggplot(d, aes(y = d$`POS Sales`, x= d$`Age 55-64`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes con edad 55-64")+
  facet_wrap(State~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))

Parte II c: Análisis por etnia

Porcentaje de Latinos

Evidentemente, el porcentaje de latinos es una variable muy predictiva para la cantidad de ventas.

Sin embargo, esto cambia según el Estado. Por ejemplo, es muy importante en New Jersey y en Kansas, pero poco importante en Texas.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Ethnics:Latin`))+geom_point()+ 
  labs(y = "Ventas totales (k $)", x = "Porcentaje de Latinos",  
  title = "Correlación entre ventas totales y porcentaje de latinos \n(separado según tipo de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Ethnics:Latin`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de clientes latinos",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)
ggplot(d, aes(y = d$`POS Sales`, x= d$`Ethnics:Latin`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes latinos")+
  facet_wrap(State~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))

Porcentaje de otras etnias (ni blancos, ni afroamericanos, ni latinos)

Esta variable es super importante en la costa Este: Maryland, Virginia, New York, pero muy poco o casi nada en el Centro y en el Oeste.

ggplot(d, aes(y = d$`POS Sales`/1000, x= d$`Ethnics:Other`))+geom_point()+ 
  labs(y = "Ventas totales (k $)", x = "Porcentaje de Otras Etnias",  
  title = "Correlación entre ventas totales y porcentaje de otras etnias \n(separado según tipo de tienda)")+
  facet_wrap(store_size~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Ethnics:Other`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de clientes de otras etnias",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)
ggplot(d, aes(y = d$`POS Sales`, x= d$`Ethnics:Latin`))+geom_point()+ 
  labs(y = "Ventas totales ($)", x = "Porcentaje de clientes latinos")+
  facet_wrap(State~., scales = "free")+ 
  stat_cor(method = "pearson", p.accuracy = 0.001, r.accuracy = 0.01)+geom_smooth(method = 'lm')+ylim(c(0, NA))

Parte II bonus: Otras correlaciones interesantes

 Y en Texas qué pedo?

Si hacemos el análisis sólo aquí, las variables mas predicitivas son:

* Tamaño de la tienda (ya visto)
* Porcentaje de clientes con casa propia!
* Porcentaje de clientes con ingreso > 100 k (ya visto)
* Porcentaje de otras etnias (ya visto)
* Nivel educativo de secundaria o menos 
* Hogares de mas de 4 personas
d = merge(sales2bind, stores2bind, all.x = T, all.y = F, by = "Store")
d_tx = d %>% subset(State == 'TX')
d_modeling_tx = d_tx[, c(3,11:35)]

full.model <- lm(`POS Sales` ~., data = d_modeling_tx)

# Stepwise regression model*
step_car <- stepAIC(full.model, trace = TRUE, direction= "both")

x= as.data.frame(summary(step_car)$coefficients)
x = x %>% arrange(`Pr(>|t|)`) 

x$Ranking = 1:nrow(x)
x$Efecto = "Positivo"
x[x$Estimate < 0, 'Efecto'] = "Negativo"
x$variable = rownames(x)
x = x %>% dplyr::select (variable,Ranking, Efecto)

x= x[-7,]
kable(x, align = "c" ) %>%
  kable_styling(position = "center")

Porcentaje de clientes con casa propia

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Owned Housing`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de clientes con casa propia",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Porcentaje de clientes con educacion secundaria incompleta o inferior

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`Some High School or Less`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y\n porcentaje de clientes con educacion secundaria incompleta o inferior",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Porcentaje de hogares con mas de 4 personas

estados = unique(d$State)
correlations = data.frame(State = as.character(), Correlation = as.numeric())
d_states = d %>% filter(!is.na(State))


for (i in estados) {
  #print(i)
  subset = d_states %>% filter(State == i)
  
  if(nrow(subset) > 20 ){
  cor = cor.test(y = subset$`POS Sales`, x= subset$`4+ person HH`)
  r = cor$estimate
  p = cor$p.value
  
  if (p < 0.15 ){
  vector = c(i, r)
  correlations[nrow(correlations)+1,] = vector
  }
  }
}

mean_state_equiv <- merge(correlations, equiv,
                          by.x = "State", by.y = "Code",
                          all.x = T)

mean_state_equiv  = mean_state_equiv[,c(4,2,3)]

state2 <- merge(x = state, y = mean_state_equiv  ,
               by.x = "region", by.y = "Estado", all.x = T, all.y = F)


state2 <- state2 %>% arrange(order)
state2$Correlation = as.numeric(state2$Correlation)

map_means = ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        fill=Correlation, 
                        group=group)) + 
  geom_polygon() +
  guides() + 
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + labs(title = "Correlación entre ventas totales y porcentaje de hogares con mas de 4 personas",
       fill = "Correlación")+ scale_fill_gradient2(
  high= "#132B43",
  mid= "gray",
  low = "tomato")

ggplotly(map_means)

Parte III: Clustering del top 400 de tiendas.

Vamos a utilisar una tecnica que se llama PCA (Principal Component Analisis), que toma muchas variables y las ‘simplifica’ en unas cuantas. Vamos a hacer con todas las variables demograficas, y como muestra vamos a usar solo las mejores cuarenta tiendas.

Esto eventualmente luego nos permite hacer clusters y categorias demograficas por tienda. En este caso, tenemos tres categorias, que estan ligadas a los colores y las flechas que estan en donde estan esos colores. A esas categorias les he llamado latinos, asiaticos y otros.

d_temp = d %>% arrange(-`POS Sales`)
d_pca = d_temp [1:400,c(1,12:35)]
d_pca = na.omit(d_pca)
rownames(d_pca) = d_pca$Store 
d_pca = d_pca %>% select(-Store)
#Seleccionando el numero de clusters

xxx.pca1<-prcomp(d_pca, center=FALSE, scale.=FALSE)
summary(xxx.pca1) 
fviz_eig(xxx.pca1)
fviz_pca_var(xxx.pca1, col.var="steelblue")#

#Parallel analysis (not shown)
paran(d_pca, iterations=10000, quietly=FALSE,
    status=FALSE, all=TRUE, cfa=FALSE, graph=TRUE,
    color=TRUE, col=c("black","red","blue"),
    lty=c(1,2,3), lwd=1, legend=TRUE, file="",
    width=640, height=640, grdevice="png", seed=0, mat=NA, n=NA)

# El numero esta entre 3 y 4!
# PCA
pca <- prcomp(d_pca, scale=TRUE)
df.pca <- pca$x
set.seed(42)
# Cluster over the three first PCA dimensions
kc <- kmeans(df.pca[,1:3], 3)

k = as.data.frame(kc$cluster)
k$Store = rownames(k)
names(k)  = c('cluster','Store')
k$clustername = k$cluster

k[k$clustername == '1', "clustername"] = 'Latinos'
k[k$clustername == '2', "clustername"] = 'Jubilados'
k[k$clustername == '3', "clustername"] = 'Adinerados'

plot(fviz_pca_biplot(pca, label="var", 
  habillage=as.factor(k$clustername), addEllipses = T) + ggtitle("Clustering de las 400 tiendas de mayores ventas") +
  theme(text = element_text(size = 18), 
      panel.background = element_blank(), 
      panel.grid.major = element_blank(), 
      panel.grid.minor = element_blank(), 
      axis.line = element_line(colour = "black")))

Numero de tiendas por cluster

xx= as.data.frame(table(k$clustername))
names(xx) = c("Cluster", "Numero de tiendas")
kable(xx, align = "c" ) %>%
  kable_styling(position = "center")
Cluster Numero de tiendas
Adinerados 97
Jubilados 214
Latinos 87 
d_clusters = merge(d,k, all.y = T )
d_clusters$cluster = as.factor(d_clusters$clustername)

Graficando las caracteristicas de los grupos

ggplot(d_clusters, aes(x= clustername, y =  d_clusters$`Ethnics:Latin`, 
                       fill = clustername))+  geom_violin()+ geom_point()+
        labs(x= "Cluster",y= "Porcentaje de latinos",
             title = "Porcentaje de latinos por grupo")+theme(legend.position = 'none')+theme(text = element_text(size = 18))

ggplot(d_clusters, aes(x= clustername, y =  d_clusters$`Income  $100,000+`, 
                       fill = clustername))+  geom_violin()+ geom_point()+
        labs(x= "Cluster",y= "Porcentaje de personas\ncon ingresos > 100 k",
             title = "Porcentaje de personas con ingresos > 100 k ")+theme(legend.position = 'none')+theme(text = element_text(size = 18))

ggplot(d_clusters, aes(x= clustername, y =  d_clusters$`1 person HH`, 
                       fill = clustername))+  geom_violin()+ geom_point()+
        labs(x= "Cluster",y= "Porcentaje de hogares de una sola persona",
             title = "Porcentaje de hogares de una sola persona")+theme(legend.position = 'none')+theme(text = element_text(size = 18))

Ventas segun grupo/cluster

En promedio por tienda, las ventas de las tres cateogorias son muy similares. La tercera categoria (jubilados) es interesante, porque tiene el promedio de ventas mas bajo (la ‘panza del violin’), pero tambien las tiendas con las ventas mas altas.

Luego, si nos vamos a las ventas totales por categoria, pues el mayor numero esta en la tercera categoria, por el simple hecho de que son mas tiendas.

ggplot(d_clusters, aes(x= clustername, y = `POS Sales`/1000, 
                       fill = clustername,))+ geom_violin()+
          geom_point()+labs(x= "Cluster",y= "Ventas por tienda \n(Miles de $)", title = "Ventas promedio por tienda segun categoria", fill= "Cluster")+  theme(text = element_text(size = 18))

ggplot(d_clusters, aes(x= clustername, y = `POS Sales`/1000, 
                       fill = clustername))+ geom_bar(stat = "sum")+
        labs(x= "Cluster",y= "Ventas totales por cluster \n(Miles de $)", 
             title = "Ventas totales por categoria")+
  theme(legend.position = 'none')+theme(text = element_text(size = 18))

Poniendo los clusters en el mapa

A continuacion, vemos el mapa de los EEUU y en cada estado (donde hay al menos una tienda que forme parte del top 400), vemos cuantas tiendas hay por categoria.

library(reshape2)

state_clusters = dcast(d_clusters, State ~ clustername)
datosestados <- read_excel("datosestados.xlsx")


state_clusters_equiv <- merge(state_clusters, datosestados,
                          all.x = T)

state_clusters_equiv$State = as.factor(state_clusters_equiv$State)
state_clusters_equiv$Adinerados = as.numeric(state_clusters_equiv$Adinerados)
state_clusters_equiv$Latinos = as.numeric(state_clusters_equiv$Latinos )
state_clusters_equiv$Jubilados = as.numeric(state_clusters_equiv$Jubilados )
state_clusters_equiv$radios =  state_clusters_equiv$Adinerados + state_clusters_equiv$Jubilados +
                                  state_clusters_equiv$Latinos


#Merge to have the same groups as State2
state_clusters_equiv <- merge(state_clusters_equiv, equiv, by.x = "State", by.y = "Estado",
                          all.x = T)
state_clusters_equiv <- merge(state_clusters_equiv, state2[,c("region","group")], by.x = "State", by.y = "region",
                          all.x = T)



ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        group=group)) + geom_polygon(col = "black")+
   geom_scatterpie(aes(x=lon, y=lat, group=State,
                       #r= radios
                       ), 
                        data=state_clusters_equiv,
                           cols= c('Adinerados','Latinos','Jubilados')) + guides() +
     # geom_scatterpie_legend(state_clusters_equiv$radios, x=-70, y=35)+
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
   coord_fixed(1.3)+
  labs(fill = "Grupo", title= "Perfil de tiendas del top 400 por estado" )

Si hacemos el mismo grafico, pero ajustamos el tamano del pastel para representar la cantidad de tiendas.

 ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        group=group)) + geom_polygon(col = "black")+
   geom_scatterpie(aes(x=lon, y=lat, group=State,
                       r= radios /10
                       ), 
                        data=state_clusters_equiv,
                           cols= c('Adinerados','Latinos','Jubilados')) + guides() +
 # geom_text(data=state_clusters_equiv_2,aes(x=lon, y=lat, label=radios), col = 'white')+
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
   coord_fixed(1.3)+
  labs(fill = "Grupo", title= "Perfil de tiendas del top 400 por estado" )

Lo hacemos de nuevo pero elmininamos Texas y Florida

Si hacemos el mismo grafico, pero ajustamos el tamano del pastel para representar la cantidad de tiendas.

state_clusters_equiv_2 = state_clusters_equiv %>% filter (State != "TX" &State != "FL")

ggplot(data=state2, aes(x=long, y=lat,  label = region,
                        group=group)) + geom_polygon(col = "black")+
   geom_scatterpie(aes(x=lon, y=lat, group=State,
                       r= radios/5                       ), 
                        data=state_clusters_equiv_2,  alpha = 0.5,
                           cols= c('Adinerados','Latinos','Jubilados')) + guides() +
  geom_text(data=state_clusters_equiv_2,aes(x=lon, y=lat, label=radios), col = 'white')+
      #geom_scatterpie_legend(state_clusters_equiv_2$radios, x=-60, y=35)+
  theme(axis.title.x=element_blank(), 
        axis.text.x=element_blank(), 
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(), 
        axis.ticks.y=element_blank()) + 
   coord_fixed(1.3)+
  labs(fill = "Grupo", title= "Perfil de tiendas del top 400 por estado" )

Ahora qué sigue?

Les pregunto a ustedes. Ideas?

Algunas mias: