Ejercicio

1.Importar la base de datos

#file.choose()
#read.csv("/Users/santiago/Downloads/ventas.csv")
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)

2.Entender base de datos

bd <- read.csv("/Users/santiago/Downloads/ventas.csv")
summary(bd)
##     BillNo            Itemname            Quantity            Date          
##  Length:522064      Length:522064      Min.   :-9600.00   Length:522064     
##  Class :character   Class :character   1st Qu.:    1.00   Class :character  
##  Mode  :character   Mode  :character   Median :    3.00   Mode  :character  
##                                        Mean   :   10.09                     
##                                        3rd Qu.:   10.00                     
##                                        Max.   :80995.00                     
##                                                                             
##      Hour               Price              CustomerID       Country         
##  Length:522064      Min.   :-11062.060   Min.   :12346    Length:522064     
##  Class :character   1st Qu.:     1.250   1st Qu.:13950    Class :character  
##  Mode  :character   Median :     2.080   Median :15265    Mode  :character  
##                     Mean   :     3.827   Mean   :15317                      
##                     3rd Qu.:     4.130   3rd Qu.:16837                      
##                     Max.   : 13541.330   Max.   :18287                      
##                                          NA's   :134041                     
##      Total          
##  Min.   :-11062.06  
##  1st Qu.:     3.75  
##  Median :     9.78  
##  Mean   :    19.69  
##  3rd Qu.:    17.40  
##  Max.   :168469.60  
## 
str(bd)
## 'data.frame':    522064 obs. of  9 variables:
##  $ BillNo    : chr  "536365" "536365" "536365" "536365" ...
##  $ Itemname  : chr  "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Quantity  : int  6 6 8 6 6 2 6 6 6 32 ...
##  $ Date      : chr  "01/12/2010" "01/12/2010" "01/12/2010" "01/12/2010" ...
##  $ Hour      : chr  "08:26:00" "08:26:00" "08:26:00" "08:26:00" ...
##  $ Price     : num  2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ CustomerID: int  17850 17850 17850 17850 17850 17850 17850 17850 17850 13047 ...
##  $ Country   : chr  "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
##  $ Total     : num  15.3 20.3 22 20.3 20.3 ...
#count(bd, BillNo, sort=TRUE)
#count(bd, Country, sort=TRUE)
#count(bd, Itemname, sort=TRUE)
# ¿Cuántos NA tengo en la base de datos?

sum(is.na(bd))
## [1] 134041
# ¿Cuántos NA tengo por variable?+
sapply(bd, function(x) sum(is.na(x)))
##     BillNo   Itemname   Quantity       Date       Hour      Price CustomerID 
##          0          0          0          0          0          0     134041 
##    Country      Total 
##          0          0
# Eliminar NA

bd <- na.omit(bd)

# Eliminar Totales negativos

bd <- bd[bd$Total > 0, ]

# Identificar Outliers

boxplot(bd$Total, horizontal = TRUE)

3.Limpiar base de datos

# Obtener el total por ticket
ticket_promedio <- aggregate(Total ~ CustomerID + BillNo, data = bd, sum)

ticket_promedio <- aggregate(Total ~ CustomerID, data= ticket_promedio, mean)
colnames(ticket_promedio) <- c("CustomerID", "TicketPromedio")

# Cantidad de visitas por cliente
visitas <- group_by(bd, CustomerID) %>% summarise(Visitas= n_distinct(BillNo))

# Juntar las tablas ticket promedio y visitas
objetos <- merge(ticket_promedio, visitas, by= "CustomerID")

#Llamar a los renglones como Customer ID
rownames(objetos) <- objetos$CustomerID
objetos <- subset(objetos, select = -c(CustomerID))

# Eliminar datos fuera de lo normal
# Los rangos fuera de lo normal están fuera de los siguientes límites 
# 1. Límite inferior: Q1 - 1.5*IQR
# 2. Límite superior: Q3 + 1.5*IQR
#IQR = rango intercuartil

# Columna de ticket promedio
IQR_TP <- IQR(objetos$TicketPromedio)
IQR_TP
## [1] 248.3318
summary(objetos)
##  TicketPromedio        Visitas       
##  Min.   :    3.45   Min.   :  1.000  
##  1st Qu.:  178.30   1st Qu.:  1.000  
##  Median :  292.00   Median :  2.000  
##  Mean   :  415.62   Mean   :  4.227  
##  3rd Qu.:  426.63   3rd Qu.:  5.000  
##  Max.   :84236.25   Max.   :209.000
LI_ITP <- 178.30 - 1.5*IQR_TP
LI_ITP
## [1] -194.1977
LS_ITP <- 426.63 + 1.5*IQR_TP
LS_ITP
## [1] 799.1277
objetos <- objetos[objetos$TicketPromedio<=799.13, ]

# Columna visitas
IQR_V <- IQR(objetos$Visitas)
IQR_V
## [1] 4
LI_V <- 1 - 1.5*IQR_V
LI_V
## [1] -5
LS_V <- 5 + 1.5*IQR_V
LS_V
## [1] 11
objetos <- objetos[objetos$Visitas <= 11, ]
summary(objetos)
##  TicketPromedio      Visitas      
##  Min.   :  3.45   Min.   : 1.000  
##  1st Qu.:168.66   1st Qu.: 1.000  
##  Median :267.12   Median : 2.000  
##  Mean   :293.86   Mean   : 2.971  
##  3rd Qu.:384.49   3rd Qu.: 4.000  
##  Max.   :797.45   Max.   :11.000

4.Asignación de grupos

# 0. Normalizar variables
objetos <- as.data.frame(scale(objetos))

# 1. Crear base de datos
df <- objetos 

# 2. Determinar el número de grupos

grupos <- 4

# 3. Realizar ka clasificación
segmentos <- kmeans(df, grupos)

# 4. Revisar la asignación de grupos
asignación <- cbind(df, cluster= segmentos$cluster)

# 5. Gráficar resultados
library(ggplot2)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_cluster(segmentos, data=df,
             palette=c("red","blue","yellow","green" ),
             ellipse.type="euclid",
             star.plot= T,
             repel= T,
             ggtheme = theme())

# 6. Optimizar cantidad de grupos
library(cluster)
library(data.table)
## 
## Attaching package: 'data.table'
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
set.seed(123)
optimizacion <- clusGap(df, FUN=kmeans, nstart=1, K.max=7)
plot(optimizacion, xlab= "Número de clusters K")

Reflexión

Con lo que llevamos de este módulo hemos aprendido acerca del método K vecinos más cercanos, este método es muy útil en la analítica de datos cuando buscamos clasificar diferentes variables en clusters para poder entender más ciertos comportamientos dentro de una base de datos, sobre este método aprendimos que existe una forma manual de clasificar los clusters que a pesar de ser un proceso tardado nos lleva a obtener un modelo optimizado, sin embargo, el software de R nos proporciona una manera más eficiente de obtener los resultados esperados. Para nuestro reto acerca de la educación financiera de la población de Nuevo León va a ser muy interesante usar este código para evaluar diferentes variables y ver como se podrían clasificar a las personas que contestan la encuesta, de tal forma que nos ayude a generar conclusiones acerca de porque existe una deficiencia en la educación financiera en el país.

LS0tCnRpdGxlOiAiQWN0aXZpZGFkIDQuMTogSyBWZWNpbm9zIG1hcyBjZXJjYW5vcyIKYXV0aG9yOiAiU2FudGlhZ28gTWFjaWFzIgpkYXRlOiAiMjAyMy0wOS0xOCIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiBUUlVFCiAgICB0b2NfZmxvYXQ6IFRSVUUKICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUKICAgIHRoZW1lOiAicmVhZGFibGUiCiAgICBoaWdobGlnaHQ6ICJweWdtZW50cyIKICAKLS0tCgojIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPkVqZXJjaWNpbzwvc3Bhbj4KCiFbXSgvVXNlcnMvc2FudGlhZ28vRGVza3RvcC9JS0VBLmdpZikKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPjEuSW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4gCmBgYHtyfQojZmlsZS5jaG9vc2UoKQojcmVhZC5jc3YoIi9Vc2Vycy9zYW50aWFnby9Eb3dubG9hZHMvdmVudGFzLmNzdiIpCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoZ2dwbG90MikKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4yLkVudGVuZGVyIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQpiZCA8LSByZWFkLmNzdigiL1VzZXJzL3NhbnRpYWdvL0Rvd25sb2Fkcy92ZW50YXMuY3N2IikKc3VtbWFyeShiZCkKc3RyKGJkKQojY291bnQoYmQsIEJpbGxObywgc29ydD1UUlVFKQojY291bnQoYmQsIENvdW50cnksIHNvcnQ9VFJVRSkKI2NvdW50KGJkLCBJdGVtbmFtZSwgc29ydD1UUlVFKQpgYGAKYGBge3J9CiMgwr9DdcOhbnRvcyBOQSB0ZW5nbyBlbiBsYSBiYXNlIGRlIGRhdG9zPwoKc3VtKGlzLm5hKGJkKSkKCiMgwr9DdcOhbnRvcyBOQSB0ZW5nbyBwb3IgdmFyaWFibGU/KwpzYXBwbHkoYmQsIGZ1bmN0aW9uKHgpIHN1bShpcy5uYSh4KSkpCgojIEVsaW1pbmFyIE5BCgpiZCA8LSBuYS5vbWl0KGJkKQoKIyBFbGltaW5hciBUb3RhbGVzIG5lZ2F0aXZvcwoKYmQgPC0gYmRbYmQkVG90YWwgPiAwLCBdCgojIElkZW50aWZpY2FyIE91dGxpZXJzCgpib3hwbG90KGJkJFRvdGFsLCBob3Jpem9udGFsID0gVFJVRSkKYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+My5MaW1waWFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQojIE9idGVuZXIgZWwgdG90YWwgcG9yIHRpY2tldAp0aWNrZXRfcHJvbWVkaW8gPC0gYWdncmVnYXRlKFRvdGFsIH4gQ3VzdG9tZXJJRCArIEJpbGxObywgZGF0YSA9IGJkLCBzdW0pCgp0aWNrZXRfcHJvbWVkaW8gPC0gYWdncmVnYXRlKFRvdGFsIH4gQ3VzdG9tZXJJRCwgZGF0YT0gdGlja2V0X3Byb21lZGlvLCBtZWFuKQpjb2xuYW1lcyh0aWNrZXRfcHJvbWVkaW8pIDwtIGMoIkN1c3RvbWVySUQiLCAiVGlja2V0UHJvbWVkaW8iKQoKIyBDYW50aWRhZCBkZSB2aXNpdGFzIHBvciBjbGllbnRlCnZpc2l0YXMgPC0gZ3JvdXBfYnkoYmQsIEN1c3RvbWVySUQpICU+JSBzdW1tYXJpc2UoVmlzaXRhcz0gbl9kaXN0aW5jdChCaWxsTm8pKQoKIyBKdW50YXIgbGFzIHRhYmxhcyB0aWNrZXQgcHJvbWVkaW8geSB2aXNpdGFzCm9iamV0b3MgPC0gbWVyZ2UodGlja2V0X3Byb21lZGlvLCB2aXNpdGFzLCBieT0gIkN1c3RvbWVySUQiKQoKI0xsYW1hciBhIGxvcyByZW5nbG9uZXMgY29tbyBDdXN0b21lciBJRApyb3duYW1lcyhvYmpldG9zKSA8LSBvYmpldG9zJEN1c3RvbWVySUQKb2JqZXRvcyA8LSBzdWJzZXQob2JqZXRvcywgc2VsZWN0ID0gLWMoQ3VzdG9tZXJJRCkpCgojIEVsaW1pbmFyIGRhdG9zIGZ1ZXJhIGRlIGxvIG5vcm1hbAojIExvcyByYW5nb3MgZnVlcmEgZGUgbG8gbm9ybWFsIGVzdMOhbiBmdWVyYSBkZSBsb3Mgc2lndWllbnRlcyBsw61taXRlcyAKIyAxLiBMw61taXRlIGluZmVyaW9yOiBRMSAtIDEuNSpJUVIKIyAyLiBMw61taXRlIHN1cGVyaW9yOiBRMyArIDEuNSpJUVIKI0lRUiA9IHJhbmdvIGludGVyY3VhcnRpbAoKIyBDb2x1bW5hIGRlIHRpY2tldCBwcm9tZWRpbwpJUVJfVFAgPC0gSVFSKG9iamV0b3MkVGlja2V0UHJvbWVkaW8pCklRUl9UUApzdW1tYXJ5KG9iamV0b3MpCkxJX0lUUCA8LSAxNzguMzAgLSAxLjUqSVFSX1RQCkxJX0lUUApMU19JVFAgPC0gNDI2LjYzICsgMS41KklRUl9UUApMU19JVFAKb2JqZXRvcyA8LSBvYmpldG9zW29iamV0b3MkVGlja2V0UHJvbWVkaW88PTc5OS4xMywgXQoKIyBDb2x1bW5hIHZpc2l0YXMKSVFSX1YgPC0gSVFSKG9iamV0b3MkVmlzaXRhcykKSVFSX1YKTElfViA8LSAxIC0gMS41KklRUl9WCkxJX1YKTFNfViA8LSA1ICsgMS41KklRUl9WCkxTX1YKb2JqZXRvcyA8LSBvYmpldG9zW29iamV0b3MkVmlzaXRhcyA8PSAxMSwgXQpzdW1tYXJ5KG9iamV0b3MpCgpgYGAKCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij40LkFzaWduYWNpw7NuIGRlIGdydXBvczwvc3Bhbj4KYGBge3J9CiMgMC4gTm9ybWFsaXphciB2YXJpYWJsZXMKb2JqZXRvcyA8LSBhcy5kYXRhLmZyYW1lKHNjYWxlKG9iamV0b3MpKQoKIyAxLiBDcmVhciBiYXNlIGRlIGRhdG9zCmRmIDwtIG9iamV0b3MgCgojIDIuIERldGVybWluYXIgZWwgbsO6bWVybyBkZSBncnVwb3MKCmdydXBvcyA8LSA0CgojIDMuIFJlYWxpemFyIGthIGNsYXNpZmljYWNpw7NuCnNlZ21lbnRvcyA8LSBrbWVhbnMoZGYsIGdydXBvcykKCiMgNC4gUmV2aXNhciBsYSBhc2lnbmFjacOzbiBkZSBncnVwb3MKYXNpZ25hY2nDs24gPC0gY2JpbmQoZGYsIGNsdXN0ZXI9IHNlZ21lbnRvcyRjbHVzdGVyKQoKIyA1LiBHcsOhZmljYXIgcmVzdWx0YWRvcwpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkoZmFjdG9leHRyYSkKCmZ2aXpfY2x1c3RlcihzZWdtZW50b3MsIGRhdGE9ZGYsCiAgICAgICAgICAgICBwYWxldHRlPWMoInJlZCIsImJsdWUiLCJ5ZWxsb3ciLCJncmVlbiIgKSwKICAgICAgICAgICAgIGVsbGlwc2UudHlwZT0iZXVjbGlkIiwKICAgICAgICAgICAgIHN0YXIucGxvdD0gVCwKICAgICAgICAgICAgIHJlcGVsPSBULAogICAgICAgICAgICAgZ2d0aGVtZSA9IHRoZW1lKCkpCgojIDYuIE9wdGltaXphciBjYW50aWRhZCBkZSBncnVwb3MKbGlicmFyeShjbHVzdGVyKQpsaWJyYXJ5KGRhdGEudGFibGUpCgpzZXQuc2VlZCgxMjMpCm9wdGltaXphY2lvbiA8LSBjbHVzR2FwKGRmLCBGVU49a21lYW5zLCBuc3RhcnQ9MSwgSy5tYXg9NykKcGxvdChvcHRpbWl6YWNpb24sIHhsYWI9ICJOw7ptZXJvIGRlIGNsdXN0ZXJzIEsiKQpgYGAKCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5SZWZsZXhpw7NuIDwvc3Bhbj4KCkNvbiBsbyBxdWUgbGxldmFtb3MgZGUgZXN0ZSBtw7NkdWxvIGhlbW9zIGFwcmVuZGlkbyBhY2VyY2EgZGVsIG3DqXRvZG8gSyB2ZWNpbm9zIG3DoXMgY2VyY2Fub3MsIGVzdGUgbcOpdG9kbyBlcyBtdXkgw7p0aWwgZW4gbGEgYW5hbMOtdGljYSBkZSBkYXRvcyBjdWFuZG8gYnVzY2Ftb3MgY2xhc2lmaWNhciBkaWZlcmVudGVzIHZhcmlhYmxlcyBlbiBjbHVzdGVycyBwYXJhIHBvZGVyIGVudGVuZGVyIG3DoXMgY2llcnRvcyBjb21wb3J0YW1pZW50b3MgZGVudHJvIGRlIHVuYSBiYXNlIGRlIGRhdG9zLCBzb2JyZSBlc3RlIG3DqXRvZG8gYXByZW5kaW1vcyBxdWUgZXhpc3RlIHVuYSBmb3JtYSBtYW51YWwgZGUgY2xhc2lmaWNhciBsb3MgY2x1c3RlcnMgcXVlIGEgcGVzYXIgZGUgc2VyIHVuIHByb2Nlc28gdGFyZGFkbyBub3MgbGxldmEgYSBvYnRlbmVyIHVuIG1vZGVsbyBvcHRpbWl6YWRvLCBzaW4gZW1iYXJnbywgZWwgc29mdHdhcmUgZGUgUiBub3MgcHJvcG9yY2lvbmEgdW5hIG1hbmVyYSBtw6FzIGVmaWNpZW50ZSBkZSBvYnRlbmVyIGxvcyByZXN1bHRhZG9zIGVzcGVyYWRvcy4gUGFyYSBudWVzdHJvIHJldG8gYWNlcmNhIGRlIGxhIGVkdWNhY2nDs24gZmluYW5jaWVyYSBkZSBsYSBwb2JsYWNpw7NuIGRlIE51ZXZvIExlw7NuIHZhIGEgc2VyIG11eSBpbnRlcmVzYW50ZSB1c2FyIGVzdGUgY8OzZGlnbyBwYXJhIGV2YWx1YXIgZGlmZXJlbnRlcyB2YXJpYWJsZXMgeSB2ZXIgY29tbyBzZSBwb2Ryw61hbiBjbGFzaWZpY2FyIGEgbGFzIHBlcnNvbmFzIHF1ZSBjb250ZXN0YW4gbGEgZW5jdWVzdGEsIGRlIHRhbCBmb3JtYSBxdWUgbm9zIGF5dWRlIGEgZ2VuZXJhciBjb25jbHVzaW9uZXMgYWNlcmNhIGRlIHBvcnF1ZSBleGlzdGUgdW5hIGRlZmljaWVuY2lhIGVuIGxhIGVkdWNhY2nDs24gZmluYW5jaWVyYSBlbiBlbCBwYcOtcy4gCgo=