Las librerías a usar.

library(readr)
library(ggplot2)
library(reshape2)
library(wordcloud)
Loading required package: RColorBrewer
library(DataExplorer)
library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages --------------------------------------- tidyverse 1.3.0 --
v tibble  2.1.3     v dplyr   0.8.3
v tidyr   1.0.2     v stringr 1.4.0
v purrr   0.3.3     v forcats 0.4.0
-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
library(DBI)
library(tibble)
library(RSQLite)
library(dbplyr)

Attaching package: 㤼㸱dbplyr㤼㸲

The following objects are masked from 㤼㸱package:dplyr㤼㸲:

    ident, sql
library(magrittr)

Attaching package: 㤼㸱magrittr㤼㸲

The following object is masked from 㤼㸱package:purrr㤼㸲:

    set_names

The following object is masked from 㤼㸱package:tidyr㤼㸲:

    extract
       
    
rm(list=ls())
gc()
          used  (Mb) gc trigger  (Mb) max used  (Mb)
Ncells 2296944 122.7    3860925 206.2  3860925 206.2
Vcells 4168522  31.9    8388608  64.0  6249239  47.7

1 Archivos

1.1 Datasets originales

Las Mediciones corresponden a precios de diversos alimentos comercializados en la Ciudad Autónoma de Buenos Aires durante el periodo de Noviembre 2018 a Febrero 2019 a partir de un scrapeo a la página de preciosclaro

Se utilizaron para este trabajo datos de precios, sucursales y productos del programa “Precios Claros”. El proceso de relevamiento de precios fue generado de manera automática mediante la técnica de web crawling

2 Maneras distintas de importar los archivos

2.1 Desde la base de datos

ddbb_precios <- "../_datasets/precios.db"
con <- dbConnect(RSQLite::SQLite(), dbname = ddbb_precios)
(precios <- dbGetQuery(con, "SELECT * FROM precios") %>% as_tibble(.))
#Convierto a fecha y factor
precios$fecha  %<>%  as.Date(., origin = "1970-01-01")
precios$idProducto  %<>% as.factor(.)
precios$idSucursal  %<>% as.factor(.)

# Tabla Productos
###############################
(productos <- dbGetQuery(con, "SELECT * FROM productos") %>% as_tibble(.))
#Convierto a factor
productos$id %<>% as.factor(.) 
productos$marca %<>% as.factor(.) 

# Tabla Sucursales
###############################
(sucursales <- dbGetQuery(con, "SELECT * FROM sucursales") %>% as_tibble(.))
#Convierto a factor
sucursales$id %<>% as.factor(.)
sucursales$sucursalTipo %<>% as.factor(.)
sucursales$comercioRazonSocial %<>% as.factor(.)
sucursales$provincia %<>% as.factor(.)
sucursales$localidad %<>% as.factor(.)
glimpse(sucursales)
Observations: 706
Variables: 9
$ id                  <fct> 15-1-480, 3-1-1506, 10-3-675, 3-1-1507, 3-1-29, 10-3-300, 15-1-498, 1...
$ sucursalNombre      <chr> "480 - Saavedra", "GRAL PAZ - NORTE", "Cabildo 4861", "GRAL PAZ - SUR...
$ sucursalTipo        <fct> Autoservicio, Autoservicio, Autoservicio, Autoservicio, Autoservicio,...
$ comercioRazonSocial <fct> DIA Argentina S.A, Deheza S.A.I.C.F. e I., INC S.A., Deheza S.A.I.C.F...
$ direccion           <chr> "Av Dr. Ricardo Balbin 4881", "San Juan Bautista De La Salle 4356", "...
$ provincia           <fct> AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, AR-...
$ localidad           <fct> capital federal, capital federal, ciudad autónoma de buenos aires, ca...
$ lat                 <dbl> -34.55212, -34.55945, -34.54004, -34.55998, -34.54147, -34.54054, -34...
$ lng                 <dbl> -58.49841, -58.50503, -58.47474, -58.50454, -58.47384, -58.47205, -58...

2.1.1 Limpiar el entorno

rm(list=ls())
gc()
          used  (Mb) gc trigger  (Mb)  max used   (Mb)
Ncells 3157955 168.7    4764052 254.5   4764052  254.5
Vcells 9029784  68.9   35626142 271.9 182019909 1388.8

2.2 Read CSV

Tengo un par de csv y direcatamente los leo.

precios <- read_csv("./files/Datasets originales/precios.txt.zip")
productos <- read.csv("./files/Datasets adicionales/productos_categoria.csv")
sucursales <- read.csv("./files/Datasets adicionales/sucursales_barrios.csv")

left join ## inner Join

inner join

inner join

2.2.1 Inner Join Productos-Precio

glimpse(precios)
Observations: 1,584,661
Variables: 5
$ producto <chr> "7790762052364", "12-1-2800000937881", "77934400...
$ sucursal <chr> "12-1-44", "12-1-44", "12-1-44", "12-1-44", "12-...
$ precio   <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 70.25, 60.39...
$ fecha    <dttm> 2019-01-15 04:51:28, 2019-01-15 04:51:28, 2019-...
$ medicion <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, ...
glimpse(productos)
Observations: 1,016
Variables: 6
$ X_id..oid    <fct> 5cbc69be7af152186c0cd784, 5cbc69be7af152186c...
$ nombre       <fct> Aceite de Girasol Can?uelas 1.5 Lt, Aceite d...
$ Categoria    <fct> Aceite, Aceite, Aceite, Aceite, Aceite, Acei...
$ marca        <fct> CAÑUELAS, CAÑUELAS, COCINERO, COCINERO, NATU...
$ presentacion <fct> 1.5 lt, 900.0 cc, 1.5 lt, 900.0 ml, 1.5 lt, ...
$ id           <fct> 7792180001665, 7792180001641, 7790060023684,...

Agregamos la info de los productos al df “precios”. Utilizamos inner join que matchea la columna producto del data frame precios y la columna ID de la columna del data frame productos

data1 <- precios %>% inner_join(productos, by = c("producto" = "id"))
glimpse(data1)
Observations: 1,559,443
Variables: 10
$ producto     <chr> "7790762052364", "12-1-2800000937881", "7793...
$ sucursal     <chr> "12-1-44", "12-1-44", "12-1-44", "12-1-44", ...
$ precio       <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 70.25, 6...
$ fecha        <dttm> 2019-01-15 04:51:28, 2019-01-15 04:51:28, 2...
$ medicion     <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,...
$ X_id..oid    <fct> 5cbc69be7af152186c0cd67e, 5cbc69be7af152186c...
$ nombre       <fct> Vino Rosado Seleccion Especial Santa Ana 700...
$ Categoria    <fct> Bebidas con alcohol, Conservas, Bebidas con ...
$ marca        <fct> SANTA ANA, COTO, NIETO SANETINER, BODEGA TRA...
$ presentacion <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml, 642.0...

Creamos un nuevo dataset. Compuesto por ahora 10 variables. entre Precios y productos

Quedan sucursales

glimpse(sucursales)
Observations: 837
Variables: 15
$ X_id..oid           <fct> 5cbc698b7af152186c0cd13f, 5cbc698b7af...
$ sucursalTipo        <fct> Autoservicio, Autoservicio, Autoservi...
$ direccion           <fct> Av Dr. Ricardo Balbin 4881, San Juan ...
$ provincia           <fct> AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, A...
$ banderaId           <int> 1, 1, 3, 1, 1, 3, 1, 1, 1, 3, 1, 1, 1...
$ localidad           <fct> Capital Federal, CAPITAL FEDERAL, Ciu...
$ banderaDescripcion  <fct> Supermercados DIA, DEHEZA S.A.I.C.F. ...
$ lat                 <dbl> -34.55212, -34.55945, -34.54004, -34....
$ comercioRazonSocial <fct> DIA Argentina S.A, Deheza S.A.I.C.F. ...
$ lng                 <dbl> -58.49841, -58.50503, -58.47474, -58....
$ sucursalNombre      <fct> 480 - Saavedra, GRAL PAZ - NORTE, Cab...
$ comercioId          <int> 15, 3, 10, 3, 3, 10, 15, 15, 15, 10, ...
$ sucursalId          <int> 480, 1506, 675, 1507, 29, 300, 498, 1...
$ id                  <fct> 15-1-480, 3-1-1506, 10-3-675, 3-1-150...
$ barrio              <fct> SAAVEDRA, 0, SAAVEDRA, SAAVEDRA, SAAV...

Agregamos la info de sucursales a “data1”, se crea un nuevo data frame, ver que ya no es necesario data1

2.2.2 Inner Join Sucursal con mi data1

data2 <- data1 %>% inner_join(sucursales, by = c("sucursal" = "id"))
glimpse(data2)
Observations: 1,559,443
Variables: 24
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ precio              <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 7...
$ fecha               <dttm> 2019-01-15 04:51:28, 2019-01-15 04:5...
$ medicion            <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6...
$ X_id..oid.x         <fct> 5cbc69be7af152186c0cd67e, 5cbc69be7af...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ X_id..oid.y         <fct> 5cbc698b7af152186c0cd187, 5cbc698b7af...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ provincia           <fct> AR-C, AR-C, AR-C, AR-C, AR-C, AR-C, A...
$ banderaId           <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1...
$ localidad           <fct> Belgrano, Belgrano, Belgrano, Belgran...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ lat                 <dbl> -34.56358, -34.56358, -34.56358, -34....
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ lng                 <dbl> -58.46841, -58.46841, -58.46841, -58....
$ sucursalNombre      <fct> MONROE , MONROE , MONROE , MONROE , M...
$ comercioId          <int> 12, 12, 12, 12, 12, 12, 12, 12, 12, 1...
$ sucursalId          <int> 44, 44, 44, 44, 44, 44, 44, 44, 44, 4...
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...

data2 Mi nuevo dataset tiene ahora 24 variables.

Borramos data1, nos quedamos con data2

rm(data1)

2.3 Seleccion de columnas

preciosclaros <- select(data2, `producto`, "producto", "nombre", "Categoria", "marca", "presentacion", "precio", "medicion", "sucursal", "sucursalTipo", "banderaDescripcion", "comercioRazonSocial", "direccion", "barrio")

#elimino data2 porque ya no la necesito
rm(data2)

glimpse(preciosclaros)
Observations: 1,559,443
Variables: 13
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ precio              <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 7...
$ medicion            <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...

Me quedan las 13 columnas que me importan

3 Missing Values

3.1 Exploremos el dataset

Analicemos precios claros como nuestra union entre Precios, productos y sucursales. ¿Que pasa cuando vemos un solo producto?

head(preciosclaros)

3.2 sum(is.na(data))

sum(is.na(preciosclaros))
[1] 0

sardinillas


sardina <- preciosclaros %>% filter(nombre== "Sardinillas en Aceite Lata Coto 81 Gr" & direccion == "Av. Monroe 3284")

sum(is.na(sardina))
[1] 0

Son 10 mediciones, 1,2,3,4,5,6,7,8,9,10

unique(sardina$medicion)
[1]  6  9  8  5 10  4  2  7  3

Falta la medición 1 y sin embargo, cuando preguntamos si hay nulos no aparece ¿Por qué?

3.3 Tidy vs Untidy:

Todas las familias felices se parecen unas a otras, pero cada familia infeliz lo es a su manera» Leon Tolstoi, 1877 escritor de la Guerra y la Paz

Like families, tidy datasets are all alike but every messy dataset is messy in its own way.» Hadley Wickham, 2014 Chief Data Scientist de R Studio

https://cran.r-project.org/web/packages/tidyr/vignettes/tidy-data.html

  • Tipos de data desordenada:
    • Los headers de las columnas son valores y no variables.(año como columna)
    • Hay multiples variables en una sola columna. (en la misma columna peso y altura)
    • Cada valor esta escrito en distintas unidades, en cms y mts.
    • Una misma observacion esta en muchas tablas.

Valores como columnas Dice Hadley Wickham que esta manera de presentar la data es desordenada pero puede ser muy util. Provee una manera de eficiente de almacenamiento muy eficiente para operaciones computacionales. ***

3.4 Las mediciones de filas a columnas

Long to wide Necesito pasar los precios de productos por sucursal a formato columnar. Cada fila representará un producto de una sucursal con diez columnas asociadas a los precios en cada medición.

glimpse(preciosclaros)
Observations: 1,559,443
Variables: 13
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ precio              <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 7...
$ medicion            <dbl> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...

pivot_wider()

precioswide <- preciosclaros %>%
  pivot_wider(names_from = medicion,  names_sep = "_", values_from = precio)
glimpse(precioswide)
Observations: 164,592
Variables: 21
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...
$ `6`                 <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 7...
$ `7`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `9`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `8`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `1`                 <dbl> 56.20, NA, 215.00, 85.99, 72.09, 70.2...
$ `3`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
$ `5`                 <dbl> 56.20, 76.99, 215.00, 85.99, 81.99, 7...
$ `10`                <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `4`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
$ `2`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
head(precioswide)

Tengo desordenadas las mediciones, la intento ordenar pero me pone el 1 y el 10 al lado

precioswide[12:21] %>%
    select(sort(names(.)))

Ordenar a lo criollo

precioswide <- select(precioswide, `producto`, "producto", "nombre", "Categoria", "marca", "presentacion", "sucursal", "sucursalTipo", "banderaDescripcion", "comercioRazonSocial", "direccion", "barrio","1","2","3","4","5","6","7","8","9","10")
glimpse(precioswide)
Observations: 164,592
Variables: 21
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...
$ `1`                 <dbl> 56.20, NA, 215.00, 85.99, 72.09, 70.2...
$ `2`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
$ `3`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
$ `4`                 <dbl> 56.20, 76.99, 215.00, 85.99, 72.09, 7...
$ `5`                 <dbl> 56.20, 76.99, 215.00, 85.99, 81.99, 7...
$ `6`                 <dbl> 56.20, 76.99, 215.00, 92.87, 81.99, 7...
$ `7`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `8`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `9`                 <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...
$ `10`                <dbl> 56.20, 80.59, 215.00, 92.87, 81.99, 7...

3.5 Faltantes


sum(is.na(precioswide))
[1] 86477

sardinillas

3.6 Formas de saber si hay NA

Recordemos que el anterior dataset con la forma larga, donde cada fila tenia una medicion, tenia 0 faltnates. Nuestro nuevo dataset

# Para saber la cantidad exacta de NAs que están presentes en los datos 
sum(is.na(precioswide ))
[1] 86477

3.6.1 Cant filas con NA?

sum(!complete.cases(precioswide ))
[1] 53170
        

3.6.2 Columnas con NA?

# Tengo 53170 registros que tienen al menos 1 NA
colnames(precioswide )[colSums(is.na(precioswide )) > 0] # Obtengo las columnas que tienen un al menos NA. Mediciones sin datos.
 [1] "1"  "2"  "3"  "4"  "5"  "6"  "7"  "8"  "9"  "10"

3.6.3 Mapeo NA aplicando purrr::map

map(precioswide , ~sum(is.na(.)))
$producto
[1] 0

$nombre
[1] 0

$Categoria
[1] 0

$marca
[1] 0

$presentacion
[1] 0

$sucursal
[1] 0

$sucursalTipo
[1] 0

$banderaDescripcion
[1] 0

$comercioRazonSocial
[1] 0

$direccion
[1] 0

$barrio
[1] 0

$`1`
[1] 5891

$`2`
[1] 12734

$`3`
[1] 4801

$`4`
[1] 8327

$`5`
[1] 5297

$`6`
[1] 27193

$`7`
[1] 5628

$`8`
[1] 5162

$`9`
[1] 5216

$`10`
[1] 6228

3.6.4 Funcion de libreria Fun Modeling

funModeling::status(precioswide )

4 Tratamiento de Faltantes

4.1 Opcion 1: Sustitucion por medias

#Hago una copia del dataset para trabajar
df<- precioswide 

Solo puedo hacer media de valores numericos

numerico<- sapply(df, is.numeric)#Creo funcion para seleccionar tipo
dfnum <- df[numerico] #aplico la funcion

Tener en cuenta que no seria correcto rempalzar por el valor de toda la columna, dado que para la medicion 1 tenemos los precios de distintos productos.

# Sustitución por la media de cada Row
ind <- which(is.na(dfnum), arr.ind=TRUE)
dfnum[ind] <- rowMeans(dfnum,  na.rm = TRUE)[ind[,1]]
head(dfnum)
df[numerico] <- dfnum

Ya tengo mi dataset sin NA

sum(is.na(df))
[1] 0

4.2 Opcion 2: Eliminar los NA

dfomit <- precioswide 
# Eliminamos toda la fila por contener un faltante
dfomit <- na.omit(dfomit)
sum(is.na(dfomit))
[1] 0
omit <- nrow(dfomit) #nrow funcion para sumar filas
omit
[1] 111422

Cantidad de filas de mi dataset original

original <- nrow(precioswide )
original
[1] 164592

Un manejo inapropiado de DF en el análisis puede introducir sesgos y puede resultar en conclusiones engañosas.


Efectos de eliminar faltantes Cantidad de rows que elimino, pierdo informacion

original-omit
[1] 53170
(original-omit)/omit
[1] 0.4771948

Perder el 47% de mis filas puede generar mucha distorción.

4.3 Opcion 3: Solucion “Creativa”

  • Medicion 1-2-3 son de Noviembre 2018
  • Medicion 4-5 son de Diciembre 2018
  • Medicion 6-7 son de Enero 2019
  • Medicion 8-9-10 son de Febrero

El periodo de la medicion 1 a la 10 pueden haber sido varios meses, no sería correcta reemplazarla por el promedio de la anterior y de la siguiente? ¿O como segunda opcion el remplazo por el promedio del periodo?

4.3.1 Reemplazos de adyancentes

dfremplazo <- precioswide 
sum(is.na(precioswide ))
[1] 86477
head(dfremplazo[12:21])

Remplazo los Na de la medicion 1 por los de la 2 dado que no tiene adyacentes

Mi medición 2 se expresa cómo la columna 13, recordar que DF[Indice filas, Indice Columnas]

# Reemplaza los NA en la medición 1 por el valor de la medición 2
i = which(is.na(dfremplazo$`1`)) # Devuelve número de filas con NA
dfremplazo[i,12] = dfremplazo[i,13] # reemplaza los nulos en la primer medición por el valor en la segunda

De la medicion 2 hasta la 9 hago los adyacentes, utilizo el numero de columna

# Reemplaza NA entre la columna 13 y la 20 (valores d las mediciones 2 a 9) por el promedio de sus adyacentes
for (j in 0:7) {
  ii = which(is.na(dfremplazo[,13+j])) 
    dfremplazo[ii,13+j] = (dfremplazo[ii,13+j-1]+dfremplazo[ii,13+j+1])/2
}

Medicion 10 que tenga NA la reemplazo por la 9

# Reemplazo los NA de la medición 10 por el valor de la medición 9
iii = which(is.na(dfremplazo$`10`))
dfremplazo[iii,21] = dfremplazo[iii,20]

NA que me quedan

sum(is.na(dfremplazo))
[1] 32005

¿Cuantas filas tengo de diferencia?

original
[1] 164592

Filas en mi nuevo dataset

reemplazo
[1] 155274
original-reemplazo #difrencia con el dataset original
[1] 9318
(original-reemplazo)/original
[1] 0.05661272

5% de filas menos.


4.4 Opcion 4: Generar media por periodo

Genero columnas con los precios promedios de cada periodo.

*¿Que pasa con la media cuando hay NA?

# Promedios por periodo y total
dfremplazo =
(
dfremplazo %>%
  mutate(periodo1 = rowMeans(select(., "1","2","3"),na.rm
=TRUE), periodo2 = rowMeans(select(., "4","5"),na.rm
=TRUE), periodo3 = rowMeans(select(., "6","7"),na.rm
=TRUE), periodo4 = rowMeans(select(., "8","9","10"),na.rm
=TRUE), promedio = rowMeans(select(., "1","2","3","4","5","6","7","8","9","10"),na.rm
=TRUE))
)
head(dfremplazo)

4.4.0.1 Seleccion de mi mutate periodos

preciosmedios <- select(dfremplazo, "producto", "nombre", "Categoria", "marca", "presentacion", "sucursal", "sucursalTipo", "banderaDescripcion", "comercioRazonSocial", "direccion", "barrio", "periodo1", "periodo2","periodo3","periodo4","promedio")
glimpse(preciosmedios)
Observations: 164,592
Variables: 16
$ producto            <chr> "7790762052364", "12-1-2800000937881"...
$ nombre              <fct> Vino Rosado Seleccion Especial Santa ...
$ Categoria           <fct> Bebidas con alcohol, Conservas, Bebid...
$ marca               <fct> SANTA ANA, COTO, NIETO SANETINER, BOD...
$ presentacion        <fct> 700.0 ml, 81.0 gr, 750.0 cc, 750.0 ml...
$ sucursal            <chr> "12-1-44", "12-1-44", "12-1-44", "12-...
$ sucursalTipo        <fct> Supermercado, Supermercado, Supermerc...
$ banderaDescripcion  <fct> COTO CICSA, COTO CICSA, COTO CICSA, C...
$ comercioRazonSocial <fct> Coto Centro Integral de Comercializac...
$ direccion           <fct> Av. Monroe 3284, Av. Monroe 3284, Av....
$ barrio              <fct> COGHLAN, COGHLAN, COGHLAN, COGHLAN, C...
$ periodo1            <dbl> 56.20000, 76.99000, 215.00000, 85.990...
$ periodo2            <dbl> 56.20, 76.99, 215.00, 85.99, 77.04, 7...
$ periodo3            <dbl> 56.20, 78.79, 215.00, 92.87, 81.99, 7...
$ periodo4            <dbl> 56.20000, 80.59000, 215.00000, 92.870...
$ promedio            <dbl> 56.200, 78.430, 215.000, 89.430, 78.0...
sum(is.na(preciosmedios))
[1] 8935
# puede ver que faltante habia con preciosmedios[!complete.cases(preciosmedios),]

preciosmedios %>% filter(producto==7794000960329)
NA

Mi periodo 4 eran Medicion 8-9-10 correspondientes a febrero

precioswide %>% filter(producto==7794000960329)

4.4.0.2 Elimino menos cantidad

preciosmedios <- na.omit(preciosmedios)

Diferencia entre filas del dataset original y el de filas eliminadas

medios <- nrow(preciosmedios) #cantidad de filas

original-medios #difrencia con el dataset original
[1] 5726
(original-medios)/original # que %?
[1] 0.03478905
LS0tDQp0aXRsZTogIk1pc3NpbmcgUHJlY2lvcyINCmF1dGhvcjogIktvbm5hIg0KZGF0ZTogIjExLzMvMjAyMCINCg0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazoNCiAgICB0b2M6IHRydWUNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICB0b2NfY29sbGFwc2VkOiB0cnVlIA0KICAgIHRvY19kZXB0aDogNA0KICAgIG51bWJlcl9zZWN0aW9uczogdHJ1ZQ0KICAgIHRoZW1lOiBzcGFjZWxhYg0KLS0tDQo8c3R5bGU+DQpib2R5IHsNCnRleHQtYWxpZ246IGp1c3RpZnl9DQoNCi5saXN0LWdyb3VwLWl0ZW0uYWN0aXZlLCAubGlzdC1ncm91cC1pdGVtLmFjdGl2ZTpmb2N1cywgLmxpc3QtZ3JvdXAtaXRlbS5hY3RpdmU6aG92ZXIgew0KICAgIGJhY2tncm91bmQtY29sb3I6ICNERDhEMTsNCn0NCjwvc3R5bGU+DQoNCg0KDQpMYXMgbGlicmVyw61hcyBhIHVzYXIuPGJyPg0KYGBge3IgTGlicmVyw61hc30NCmxpYnJhcnkocmVhZHIpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHJlc2hhcGUyKQ0KbGlicmFyeSh3b3JkY2xvdWQpDQpsaWJyYXJ5KERhdGFFeHBsb3JlcikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShEQkkpDQpsaWJyYXJ5KHRpYmJsZSkNCmxpYnJhcnkoUlNRTGl0ZSkNCmxpYnJhcnkoZGJwbHlyKQ0KbGlicmFyeShtYWdyaXR0cikNCiAgICAgICANCiAgICANCnJtKGxpc3Q9bHMoKSkNCmdjKCkNCmBgYA0KDQojIEFyY2hpdm9zDQojIyBEYXRhc2V0cyBvcmlnaW5hbGVzDQoNCkxhcyBNZWRpY2lvbmVzIGNvcnJlc3BvbmRlbiBhIHByZWNpb3MgZGUgZGl2ZXJzb3MgYWxpbWVudG9zIGNvbWVyY2lhbGl6YWRvcyBlbiBsYSBDaXVkYWQgQXV0w7Nub21hIGRlIEJ1ZW5vcyBBaXJlcyBkdXJhbnRlIGVsIHBlcmlvZG8gZGUgTm92aWVtYnJlIDIwMTggYSBGZWJyZXJvIDIwMTkgYSBwYXJ0aXIgZGUgdW4gc2NyYXBlbyBhIGxhIHDDoWdpbmEgZGUgcHJlY2lvc2NsYXJvDQoNClNlIHV0aWxpemFyb24gcGFyYSBlc3RlIHRyYWJham8gZGF0b3MgZGUgcHJlY2lvcywgc3VjdXJzYWxlcyB5IHByb2R1Y3RvcyBkZWwgcHJvZ3JhbWEgIlByZWNpb3MgQ2xhcm9zIi4gRWwgcHJvY2VzbyBkZSByZWxldmFtaWVudG8gZGUgcHJlY2lvcyBmdWUgZ2VuZXJhZG8gZGUgbWFuZXJhIGF1dG9tw6F0aWNhIG1lZGlhbnRlIGxhIHTDqWNuaWNhIGRlIHdlYiBjcmF3bGluZw0KDQojIE1hbmVyYXMgZGlzdGludGFzIGRlIGltcG9ydGFyIGxvcyBhcmNoaXZvcw0KDQojIyBEZXNkZSBsYSBiYXNlIGRlIGRhdG9zDQoNCmBgYHtyfQ0KZGRiYl9wcmVjaW9zIDwtICIuLi9fZGF0YXNldHMvcHJlY2lvcy5kYiINCmNvbiA8LSBkYkNvbm5lY3QoUlNRTGl0ZTo6U1FMaXRlKCksIGRibmFtZSA9IGRkYmJfcHJlY2lvcykNCmBgYA0KDQpgYGB7cn0NCihwcmVjaW9zIDwtIGRiR2V0UXVlcnkoY29uLCAiU0VMRUNUICogRlJPTSBwcmVjaW9zIikgJT4lIGFzX3RpYmJsZSguKSkNCiNDb252aWVydG8gYSBmZWNoYSB5IGZhY3Rvcg0KcHJlY2lvcyRmZWNoYSAgJTw+JSAgYXMuRGF0ZSguLCBvcmlnaW4gPSAiMTk3MC0wMS0wMSIpDQpwcmVjaW9zJGlkUHJvZHVjdG8gICU8PiUgYXMuZmFjdG9yKC4pDQpwcmVjaW9zJGlkU3VjdXJzYWwgICU8PiUgYXMuZmFjdG9yKC4pDQoNCiMgVGFibGEgUHJvZHVjdG9zDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjDQoocHJvZHVjdG9zIDwtIGRiR2V0UXVlcnkoY29uLCAiU0VMRUNUICogRlJPTSBwcm9kdWN0b3MiKSAlPiUgYXNfdGliYmxlKC4pKQ0KI0NvbnZpZXJ0byBhIGZhY3Rvcg0KcHJvZHVjdG9zJGlkICU8PiUgYXMuZmFjdG9yKC4pIA0KcHJvZHVjdG9zJG1hcmNhICU8PiUgYXMuZmFjdG9yKC4pIA0KDQojIFRhYmxhIFN1Y3Vyc2FsZXMNCiMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMNCihzdWN1cnNhbGVzIDwtIGRiR2V0UXVlcnkoY29uLCAiU0VMRUNUICogRlJPTSBzdWN1cnNhbGVzIikgJT4lIGFzX3RpYmJsZSguKSkNCiNDb252aWVydG8gYSBmYWN0b3INCnN1Y3Vyc2FsZXMkaWQgJTw+JSBhcy5mYWN0b3IoLikNCnN1Y3Vyc2FsZXMkc3VjdXJzYWxUaXBvICU8PiUgYXMuZmFjdG9yKC4pDQpzdWN1cnNhbGVzJGNvbWVyY2lvUmF6b25Tb2NpYWwgJTw+JSBhcy5mYWN0b3IoLikNCnN1Y3Vyc2FsZXMkcHJvdmluY2lhICU8PiUgYXMuZmFjdG9yKC4pDQpzdWN1cnNhbGVzJGxvY2FsaWRhZCAlPD4lIGFzLmZhY3RvciguKQ0KDQpgYGANCmBgYHtyfQ0KZ2xpbXBzZShzdWN1cnNhbGVzKQ0KYGBgDQojIyMgTGltcGlhciBlbCBlbnRvcm5vDQpgYGB7cn0NCnJtKGxpc3Q9bHMoKSkNCmdjKCkNCmBgYA0KDQojIyBSZWFkIENTVg0KVGVuZ28gdW4gcGFyIGRlIGNzdiB5IGRpcmVjYXRhbWVudGUgbG9zIGxlby4gDQpgYGB7ciBtZXNzYWdlPUZBTFNFfQ0KcHJlY2lvcyA8LSByZWFkX2NzdigiLi9maWxlcy9EYXRhc2V0cyBvcmlnaW5hbGVzL3ByZWNpb3MudHh0LnppcCIpDQpwcm9kdWN0b3MgPC0gcmVhZC5jc3YoIi4vZmlsZXMvRGF0YXNldHMgYWRpY2lvbmFsZXMvcHJvZHVjdG9zX2NhdGVnb3JpYS5jc3YiKQ0Kc3VjdXJzYWxlcyA8LSByZWFkLmNzdigiLi9maWxlcy9EYXRhc2V0cyBhZGljaW9uYWxlcy9zdWN1cnNhbGVzX2JhcnJpb3MuY3N2IikNCg0KYGBgDQoNCiFbbGVmdCBqb2luXShqb2luLWxlZnQucG5nKQ0KIyMgaW5uZXIgSm9pbg0KDQohW2lubmVyIGpvaW5dKGpvaW4taW5uZXIucG5nKQ0KDQoNCg0KIyMjIElubmVyIEpvaW4gUHJvZHVjdG9zLVByZWNpbw0KYGBge3J9DQpnbGltcHNlKHByZWNpb3MpDQoNCmBgYA0KYGBge3J9DQpnbGltcHNlKHByb2R1Y3RvcykNCmBgYA0KQWdyZWdhbW9zIGxhIGluZm8gZGUgbG9zIHByb2R1Y3RvcyBhbCBkZiAicHJlY2lvcyIuIFV0aWxpemFtb3MgaW5uZXIgam9pbiBxdWUgbWF0Y2hlYSAgbGEgY29sdW1uYSBwcm9kdWN0byBkZWwgZGF0YSBmcmFtZSBwcmVjaW9zIHkgbGEgY29sdW1uYSBJRCBkZSBsYSBjb2x1bW5hIGRlbCBkYXRhIGZyYW1lIHByb2R1Y3Rvcw0KYGBge3Igd2FybmluZzwtRkFMU0UsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpkYXRhMSA8LSBwcmVjaW9zICU+JSBpbm5lcl9qb2luKHByb2R1Y3RvcywgYnkgPSBjKCJwcm9kdWN0byIgPSAiaWQiKSkNCg0KYGBgDQoNCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQpnbGltcHNlKGRhdGExKQ0KYGBgDQpDcmVhbW9zIHVuIG51ZXZvIGRhdGFzZXQuIENvbXB1ZXN0byBwb3IgYWhvcmEgMTAgdmFyaWFibGVzLiBlbnRyZSBQcmVjaW9zIHkgcHJvZHVjdG9zDQoNCipRdWVkYW4gc3VjdXJzYWxlcyoNCmBgYHtyfQ0KZ2xpbXBzZShzdWN1cnNhbGVzKQ0KYGBgDQpBZ3JlZ2Ftb3MgbGEgaW5mbyBkZSBzdWN1cnNhbGVzIGEgImRhdGExIiwgc2UgY3JlYSB1biBudWV2byBkYXRhIGZyYW1lLCB2ZXIgcXVlIHlhIG5vIGVzIG5lY2VzYXJpbyBkYXRhMQ0KDQojIyMgSW5uZXIgSm9pbiBTdWN1cnNhbCBjb24gbWkgZGF0YTENCmBgYHtyIGlubmVyIGpvaW4gd2FybmluZzwtRkFMU0UsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpkYXRhMiA8LSBkYXRhMSAlPiUgaW5uZXJfam9pbihzdWN1cnNhbGVzLCBieSA9IGMoInN1Y3Vyc2FsIiA9ICJpZCIpKQ0KDQpgYGANCmBgYHtyfQ0KZ2xpbXBzZShkYXRhMikNCmBgYA0KKipkYXRhMioqIE1pIG51ZXZvIGRhdGFzZXQgdGllbmUgYWhvcmEgMjQgdmFyaWFibGVzLg0KDQpCb3JyYW1vcyBkYXRhMSwgbm9zIHF1ZWRhbW9zIGNvbiBkYXRhMg0KYGBge3J9DQpybShkYXRhMSkNCmBgYA0KDQoNCiMjIFNlbGVjY2lvbiBkZSBjb2x1bW5hcw0KDQpgYGB7cn0NCnByZWNpb3NjbGFyb3MgPC0gc2VsZWN0KGRhdGEyLCBgcHJvZHVjdG9gLCAicHJvZHVjdG8iLCAibm9tYnJlIiwgIkNhdGVnb3JpYSIsICJtYXJjYSIsICJwcmVzZW50YWNpb24iLCAicHJlY2lvIiwgIm1lZGljaW9uIiwgInN1Y3Vyc2FsIiwgInN1Y3Vyc2FsVGlwbyIsICJiYW5kZXJhRGVzY3JpcGNpb24iLCAiY29tZXJjaW9SYXpvblNvY2lhbCIsICJkaXJlY2Npb24iLCAiYmFycmlvIikNCg0KI2VsaW1pbm8gZGF0YTIgcG9ycXVlIHlhIG5vIGxhIG5lY2VzaXRvDQpybShkYXRhMikNCg0KZ2xpbXBzZShwcmVjaW9zY2xhcm9zKQ0KDQpgYGANCk1lIHF1ZWRhbiBsYXMgMTMgY29sdW1uYXMgcXVlIG1lIGltcG9ydGFuDQoNCiMgTWlzc2luZyBWYWx1ZXMNCg0KIyMgRXhwbG9yZW1vcyBlbCBkYXRhc2V0DQpBbmFsaWNlbW9zIHByZWNpb3MgY2xhcm9zIGNvbW8gbnVlc3RyYSB1bmlvbiBlbnRyZSBQcmVjaW9zLCBwcm9kdWN0b3MgeSBzdWN1cnNhbGVzLiAqwr9RdWUgcGFzYSBjdWFuZG8gdmVtb3MgdW4gc29sbyBwcm9kdWN0bz8qDQpgYGB7cn0NCmhlYWQocHJlY2lvc2NsYXJvcykNCmBgYA0KIyMgc3VtKGlzLm5hKGRhdGEpKQ0KYGBge3J9DQpzdW0oaXMubmEocHJlY2lvc2NsYXJvcykpDQpgYGANCg0KKnNhcmRpbmlsbGFzKg0KYGBge3J9DQoNCnNhcmRpbmEgPC0gcHJlY2lvc2NsYXJvcyAlPiUgZmlsdGVyKG5vbWJyZT09ICJTYXJkaW5pbGxhcyBlbiBBY2VpdGUgTGF0YSBDb3RvIDgxIEdyIiAmIGRpcmVjY2lvbiA9PSAiQXYuIE1vbnJvZSAzMjg0IikNCg0Kc3VtKGlzLm5hKHNhcmRpbmEpKQ0KYGBgDQoqU29uIDEwIG1lZGljaW9uZXMsIDEsMiwzLDQsNSw2LDcsOCw5LDEwKg0KYGBge3J9DQp1bmlxdWUoc2FyZGluYSRtZWRpY2lvbikNCmBgYA0KKkZhbHRhIGxhIG1lZGljacOzbiAxIHkgc2luIGVtYmFyZ28sIGN1YW5kbyBwcmVndW50YW1vcyBzaSBoYXkgbnVsb3Mgbm8gYXBhcmVjZSDCv1BvciBxdcOpPyoNCg0KDQojIyBUaWR5IHZzIFVudGlkeToNCg0KPlRvZGFzIGxhcyBmYW1pbGlhcyBmZWxpY2VzIHNlIHBhcmVjZW4gdW5hcyBhIG90cmFzLCBwZXJvIGNhZGEgZmFtaWxpYSBpbmZlbGl6IGxvIGVzIGEgc3UgbWFuZXJhwrsgTGVvbiBUb2xzdG9pLCAxODc3IGVzY3JpdG9yIGRlIGxhIEd1ZXJyYSB5IGxhIFBheg0KDQo+TGlrZSBmYW1pbGllcywgdGlkeSBkYXRhc2V0cyBhcmUgYWxsIGFsaWtlIGJ1dCBldmVyeSBtZXNzeSBkYXRhc2V0IGlzIG1lc3N5IGluIGl0cyBvd24gd2F5LsK7IEhhZGxleSBXaWNraGFtLCAyMDE0IENoaWVmIERhdGEgU2NpZW50aXN0IGRlIFIgU3R1ZGlvDQoNCg0KIGh0dHBzOi8vY3Jhbi5yLXByb2plY3Qub3JnL3dlYi9wYWNrYWdlcy90aWR5ci92aWduZXR0ZXMvdGlkeS1kYXRhLmh0bWwNCg0KKiAqKlRpcG9zIGRlIGRhdGEgZGVzb3JkZW5hZGEqKjoNCiAgKyBMb3MgaGVhZGVycyBkZSBsYXMgY29sdW1uYXMgc29uIHZhbG9yZXMgeSBubyB2YXJpYWJsZXMuKGHDsW8gY29tbyBjb2x1bW5hKQ0KICArIEhheSBtdWx0aXBsZXMgdmFyaWFibGVzIGVuIHVuYSBzb2xhIGNvbHVtbmEuIChlbiBsYSBtaXNtYSBjb2x1bW5hIHBlc28geSBhbHR1cmEpDQogICsgQ2FkYSB2YWxvciBlc3RhIGVzY3JpdG8gZW4gZGlzdGludGFzIHVuaWRhZGVzLCBlbiBjbXMgeSBtdHMuDQogICsgVW5hIG1pc21hIG9ic2VydmFjaW9uIGVzdGEgZW4gbXVjaGFzIHRhYmxhcy4NCg0KDQoqKlZhbG9yZXMgY29tbyBjb2x1bW5hcyoqIERpY2UgSGFkbGV5IFdpY2toYW0gcXVlIGVzdGEgbWFuZXJhIGRlIHByZXNlbnRhciBsYSBkYXRhIGVzIGRlc29yZGVuYWRhIHBlcm8gcHVlZGUgc2VyIG11eSB1dGlsLiBQcm92ZWUgdW5hIG1hbmVyYSBkZSBlZmljaWVudGUgZGUgYWxtYWNlbmFtaWVudG8gbXV5IGVmaWNpZW50ZSBwYXJhIG9wZXJhY2lvbmVzIGNvbXB1dGFjaW9uYWxlcy4NCioqKg0KDQojIyBMYXMgbWVkaWNpb25lcyBkZSBmaWxhcyBhIGNvbHVtbmFzDQoqKkxvbmcgdG8gd2lkZSoqDQpOZWNlc2l0byBwYXNhciBsb3MgcHJlY2lvcyBkZSBwcm9kdWN0b3MgcG9yIHN1Y3Vyc2FsIGEgZm9ybWF0byBjb2x1bW5hci4gQ2FkYSBmaWxhIHJlcHJlc2VudGFyw6EgdW4gcHJvZHVjdG8gZGUgdW5hIHN1Y3Vyc2FsIGNvbiBkaWV6IGNvbHVtbmFzIGFzb2NpYWRhcyBhIGxvcyBwcmVjaW9zIGVuIGNhZGEgbWVkaWNpw7NuLjxicj4NCmBgYHtyfQ0KZ2xpbXBzZShwcmVjaW9zY2xhcm9zKQ0KYGBgDQoNCg0KDQoqcGl2b3Rfd2lkZXIoKSoNCmBgYHtyfQ0KcHJlY2lvc3dpZGUgPC0gcHJlY2lvc2NsYXJvcyAlPiUNCiAgcGl2b3Rfd2lkZXIobmFtZXNfZnJvbSA9IG1lZGljaW9uLCAgbmFtZXNfc2VwID0gIl8iLCB2YWx1ZXNfZnJvbSA9IHByZWNpbykNCmBgYA0KDQpgYGB7cn0NCmdsaW1wc2UocHJlY2lvc3dpZGUpDQpgYGANCg0KDQpgYGB7cn0NCmhlYWQocHJlY2lvc3dpZGUpDQpgYGANCg0KDQoqVGVuZ28gZGVzb3JkZW5hZGFzIGxhcyBtZWRpY2lvbmVzLCBsYSBpbnRlbnRvIG9yZGVuYXIgcGVybyBtZSBwb25lIGVsIDEgeSBlbCAxMCBhbCBsYWRvKg0KYGBge3J9DQpwcmVjaW9zd2lkZVsxMjoyMV0gJT4lDQogICAgc2VsZWN0KHNvcnQobmFtZXMoLikpKQ0KYGBgDQoNCipPcmRlbmFyIGEgbG8gY3Jpb2xsbyoNCmBgYHtyfQ0KcHJlY2lvc3dpZGUgPC0gc2VsZWN0KHByZWNpb3N3aWRlLCBgcHJvZHVjdG9gLCAicHJvZHVjdG8iLCAibm9tYnJlIiwgIkNhdGVnb3JpYSIsICJtYXJjYSIsICJwcmVzZW50YWNpb24iLCAic3VjdXJzYWwiLCAic3VjdXJzYWxUaXBvIiwgImJhbmRlcmFEZXNjcmlwY2lvbiIsICJjb21lcmNpb1Jhem9uU29jaWFsIiwgImRpcmVjY2lvbiIsICJiYXJyaW8iLCIxIiwiMiIsIjMiLCI0IiwiNSIsIjYiLCI3IiwiOCIsIjkiLCIxMCIpDQoNCmBgYA0KDQoNCmBgYHtyfQ0KZ2xpbXBzZShwcmVjaW9zd2lkZSkNCmBgYA0KDQojIyBGYWx0YW50ZXMNCmBgYHtyfQ0KDQpzdW0oaXMubmEocHJlY2lvc3dpZGUpKQ0KYGBgDQoNCioqc2FyZGluaWxsYXMqKg0KYGBge3J9DQpoZWFkKHByZWNpb3N3aWRlWzIsMTI6MTRdKQ0KYGBgDQoNCg0KIyMgRm9ybWFzIGRlIHNhYmVyIHNpIGhheSBOQQ0KUmVjb3JkZW1vcyBxdWUgZWwgYW50ZXJpb3IgZGF0YXNldCBjb24gbGEgZm9ybWEgbGFyZ2EsIGRvbmRlIGNhZGEgZmlsYSB0ZW5pYSB1bmEgbWVkaWNpb24sIHRlbmlhIDAgZmFsdG5hdGVzLiBOdWVzdHJvIG51ZXZvIGRhdGFzZXQNCmBgYHtyfQ0KIyBQYXJhIHNhYmVyIGxhIGNhbnRpZGFkIGV4YWN0YSBkZSBOQXMgcXVlIGVzdMOhbiBwcmVzZW50ZXMgZW4gbG9zIGRhdG9zIA0Kc3VtKGlzLm5hKHByZWNpb3N3aWRlICkpDQpgYGANCiMjIyBDYW50IGZpbGFzIGNvbiBOQT8NCmBgYHtyfQ0Kc3VtKCFjb21wbGV0ZS5jYXNlcyhwcmVjaW9zd2lkZSApKQ0KICAgICAgICANCmBgYA0KIyMjIENvbHVtbmFzIGNvbiBOQT8NCmBgYHtyfQ0KIyBUZW5nbyA1MzE3MCByZWdpc3Ryb3MgcXVlIHRpZW5lbiBhbCBtZW5vcyAxIE5BDQpjb2xuYW1lcyhwcmVjaW9zd2lkZSApW2NvbFN1bXMoaXMubmEocHJlY2lvc3dpZGUgKSkgPiAwXSAjIE9idGVuZ28gbGFzIGNvbHVtbmFzIHF1ZSB0aWVuZW4gdW4gYWwgbWVub3MgTkEuIE1lZGljaW9uZXMgc2luIGRhdG9zLg0KYGBgDQojIyMgTWFwZW8gTkEgYXBsaWNhbmRvIHB1cnJyOjptYXANCmBgYHtyfQ0KbWFwKHByZWNpb3N3aWRlICwgfnN1bShpcy5uYSguKSkpDQpgYGANCg0KIyMjIEZ1bmNpb24gZGUgbGlicmVyaWEgRnVuIE1vZGVsaW5nDQpgYGB7cn0NCmZ1bk1vZGVsaW5nOjpzdGF0dXMocHJlY2lvc3dpZGUgKQ0KYGBgDQoNCiMgVHJhdGFtaWVudG8gZGUgRmFsdGFudGVzDQoNCiMjIE9wY2lvbiAxOiBTdXN0aXR1Y2lvbiBwb3IgbWVkaWFzDQpgYGB7cn0NCiNIYWdvIHVuYSBjb3BpYSBkZWwgZGF0YXNldCBwYXJhIHRyYWJhamFyDQpkZjwtIHByZWNpb3N3aWRlIA0KYGBgDQoNClNvbG8gcHVlZG8gaGFjZXIgbWVkaWEgZGUgdmFsb3JlcyBudW1lcmljb3MNCmBgYHtyfQ0KbnVtZXJpY288LSBzYXBwbHkoZGYsIGlzLm51bWVyaWMpI0NyZW8gZnVuY2lvbiBwYXJhIHNlbGVjY2lvbmFyIHRpcG8NCmRmbnVtIDwtIGRmW251bWVyaWNvXSAjYXBsaWNvIGxhIGZ1bmNpb24NCg0KYGBgDQoNCipUZW5lciBlbiBjdWVudGEgcXVlIG5vIHNlcmlhIGNvcnJlY3RvIHJlbXBhbHphciBwb3IgZWwgdmFsb3IgZGUgdG9kYSBsYSBjb2x1bW5hLCBkYWRvIHF1ZSBwYXJhIGxhIG1lZGljaW9uIDEgdGVuZW1vcyBsb3MgcHJlY2lvcyBkZSBkaXN0aW50b3MgcHJvZHVjdG9zLioNCmBgYHtyfQ0KIyBTdXN0aXR1Y2nDs24gcG9yIGxhIG1lZGlhIGRlIGNhZGEgUm93DQppbmQgPC0gd2hpY2goaXMubmEoZGZudW0pLCBhcnIuaW5kPVRSVUUpDQpkZm51bVtpbmRdIDwtIHJvd01lYW5zKGRmbnVtLCAgbmEucm0gPSBUUlVFKVtpbmRbLDFdXQ0KYGBgDQoNCmBgYHtyfQ0KaGVhZChkZm51bSkNCmBgYA0KDQpgYGB7cn0NCmRmW251bWVyaWNvXSA8LSBkZm51bQ0KYGBgDQoNCipZYSB0ZW5nbyBtaSBkYXRhc2V0IHNpbiBOQSoNCmBgYHtyfQ0Kc3VtKGlzLm5hKGRmKSkNCmBgYA0KDQojIyBPcGNpb24gMjogRWxpbWluYXIgbG9zIE5BDQoNCmBgYHtyIEVsaW1pbmFjacOzbiBkZSBmYWx0YW50ZXN9DQpkZm9taXQgPC0gcHJlY2lvc3dpZGUgDQojIEVsaW1pbmFtb3MgdG9kYSBsYSBmaWxhIHBvciBjb250ZW5lciB1biBmYWx0YW50ZQ0KZGZvbWl0IDwtIG5hLm9taXQoZGZvbWl0KQ0KDQpgYGANCg0KYGBge3J9DQpzdW0oaXMubmEoZGZvbWl0KSkNCmBgYA0KDQpgYGB7cn0NCm9taXQgPC0gbnJvdyhkZm9taXQpICNucm93IGZ1bmNpb24gcGFyYSBzdW1hciBmaWxhcw0Kb21pdA0KYGBgDQoNCipDYW50aWRhZCBkZSBmaWxhcyBkZSBtaSBkYXRhc2V0IG9yaWdpbmFsKg0KYGBge3J9DQpvcmlnaW5hbCA8LSBucm93KHByZWNpb3N3aWRlICkNCm9yaWdpbmFsDQoNCmBgYA0KDQo+IFVuIG1hbmVqbyBpbmFwcm9waWFkbyBkZSBERiBlbiBlbCBhbsOhbGlzaXMgcHVlZGUgaW50cm9kdWNpciBzZXNnb3MgeSBwdWVkZSByZXN1bHRhciBlbiBjb25jbHVzaW9uZXMgZW5nYcOxb3Nhcy4NCg0KKioqDQpFZmVjdG9zIGRlIGVsaW1pbmFyIGZhbHRhbnRlcw0KQ2FudGlkYWQgZGUgcm93cyBxdWUgZWxpbWlubywgcGllcmRvIGluZm9ybWFjaW9uDQpgYGB7cn0NCm9yaWdpbmFsLW9taXQNCmBgYA0KYGBge3J9DQoob3JpZ2luYWwtb21pdCkvb21pdA0KYGBgDQpQZXJkZXIgZWwgNDclIGRlIG1pcyBmaWxhcyBwdWVkZSBnZW5lcmFyIG11Y2hhIGRpc3RvcmNpw7NuLg0KDQojIyBPcGNpb24gMzogU29sdWNpb24gIkNyZWF0aXZhIg0KDQoqIE1lZGljaW9uIDEtMi0zIHNvbiBkZSBOb3ZpZW1icmUgMjAxOA0KKiBNZWRpY2lvbiA0LTUgc29uIGRlIERpY2llbWJyZSAyMDE4DQoqIE1lZGljaW9uIDYtNyBzb24gZGUgIEVuZXJvIDIwMTkNCiogTWVkaWNpb24gOC05LTEwIHNvbiBkZSBGZWJyZXJvDQogDQpFbCBwZXJpb2RvIGRlIGxhIG1lZGljaW9uIDEgYSBsYSAxMCBwdWVkZW4gaGFiZXIgc2lkbyB2YXJpb3MgbWVzZXMsIG5vIHNlcsOtYSBjb3JyZWN0YSByZWVtcGxhemFybGEgcG9yIGVsIHByb21lZGlvIGRlIGxhIGFudGVyaW9yIHkgZGUgbGEgc2lndWllbnRlPyANCsK/TyBjb21vIHNlZ3VuZGEgb3BjaW9uIGVsIHJlbXBsYXpvIHBvciBlbCBwcm9tZWRpbyBkZWwgcGVyaW9kbz8NCiANCg0KIyMjIFJlZW1wbGF6b3MgZGUgYWR5YW5jZW50ZXMNCg0KYGBge3J9DQpkZnJlbXBsYXpvIDwtIHByZWNpb3N3aWRlIA0KYGBgDQoNCmBgYHtyfQ0Kc3VtKGlzLm5hKHByZWNpb3N3aWRlICkpDQpgYGANCg0KDQpgYGB7cn0NCmhlYWQoZGZyZW1wbGF6b1sxMjoyMV0pDQpgYGANCg0KKipSZW1wbGF6byBsb3MgTmEgZGUgbGEgbWVkaWNpb24gMSBwb3IgbG9zIGRlIGxhIDIgZGFkbyBxdWUgbm8gdGllbmUgYWR5YWNlbnRlcyoqDQoNCk1pIG1lZGljacOzbiAyIHNlIGV4cHJlc2EgY8OzbW8gbGEgY29sdW1uYSAxMywgcmVjb3JkYXIgcXVlIERGW0luZGljZSBmaWxhcywgSW5kaWNlIENvbHVtbmFzXQ0KYGBge3J9DQpkZnJlbXBsYXpvWzEsMTNdDQpgYGANCg0KDQpgYGB7cn0NCiMgUmVlbXBsYXphIGxvcyBOQSBlbiBsYSBtZWRpY2nDs24gMSBwb3IgZWwgdmFsb3IgZGUgbGEgbWVkaWNpw7NuIDINCmkgPSB3aGljaChpcy5uYShkZnJlbXBsYXpvJGAxYCkpICMgRGV2dWVsdmUgbsO6bWVybyBkZSBmaWxhcyBjb24gTkENCmRmcmVtcGxhem9baSwxMl0gPSBkZnJlbXBsYXpvW2ksMTNdICMgcmVlbXBsYXphIGxvcyBudWxvcyBlbiBsYSBwcmltZXIgbWVkaWNpw7NuIHBvciBlbCB2YWxvciBlbiBsYSBzZWd1bmRhDQpgYGANCg0KKipEZSBsYSBtZWRpY2lvbiAyIGhhc3RhIGxhIDkgaGFnbyBsb3MgYWR5YWNlbnRlcywgdXRpbGl6byBlbCBudW1lcm8gZGUgY29sdW1uYSoqDQpgYGB7ciBwcm9tZWRpbyBkZSBhZHlhY2VudGVzfQ0KIyBSZWVtcGxhemEgTkEgZW50cmUgbGEgY29sdW1uYSAxMyB5IGxhIDIwICh2YWxvcmVzIGQgbGFzIG1lZGljaW9uZXMgMiBhIDkpIHBvciBlbCBwcm9tZWRpbyBkZSBzdXMgYWR5YWNlbnRlcw0KZm9yIChqIGluIDA6Nykgew0KICBpaSA9IHdoaWNoKGlzLm5hKGRmcmVtcGxhem9bLDEzK2pdKSkgDQoJZGZyZW1wbGF6b1tpaSwxMytqXSA9IChkZnJlbXBsYXpvW2lpLDEzK2otMV0rZGZyZW1wbGF6b1tpaSwxMytqKzFdKS8yDQp9DQpgYGANCg0KKipNZWRpY2lvbiAxMCBxdWUgdGVuZ2EgTkEgbGEgcmVlbXBsYXpvIHBvciBsYSA5KioNCmBgYHtyIFJlZW1wbGF6byBOQSBlbiBtMTAgcG9yIGVsIHZhbG9yIGRlIG05fQ0KIyBSZWVtcGxhem8gbG9zIE5BIGRlIGxhIG1lZGljacOzbiAxMCBwb3IgZWwgdmFsb3IgZGUgbGEgbWVkaWNpw7NuIDkNCmlpaSA9IHdoaWNoKGlzLm5hKGRmcmVtcGxhem8kYDEwYCkpDQpkZnJlbXBsYXpvW2lpaSwyMV0gPSBkZnJlbXBsYXpvW2lpaSwyMF0NCmBgYA0KDQoqKk5BIHF1ZSBtZSBxdWVkYW4qKg0KYGBge3J9DQpzdW0oaXMubmEoZGZyZW1wbGF6bykpDQpgYGANCioqKg0Kwr9DdWFudGFzIGZpbGFzIHRlbmdvIGRlIGRpZmVyZW5jaWE/DQpgYGB7cn0NCm9yaWdpbmFsDQpgYGANCg0KKkZpbGFzIGVuIG1pIG51ZXZvIGRhdGFzZXQqDQpgYGB7cn0NCmRmcmVtcGxhem8yIDwtIG5hLm9taXQoZGZyZW1wbGF6bykNCg0KcmVlbXBsYXpvIDwtIG5yb3coZGZyZW1wbGF6bzIpICNjYW50aWRhZCBkZSBmaWxhcw0KDQpyZWVtcGxhem8NCg0KYGBgDQpgYGB7cn0NCm9yaWdpbmFsLXJlZW1wbGF6byAjZGlmcmVuY2lhIGNvbiBlbCBkYXRhc2V0IG9yaWdpbmFsDQpgYGANCmBgYHtyfQ0KKG9yaWdpbmFsLXJlZW1wbGF6bykvb3JpZ2luYWwNCmBgYA0KNSUgZGUgZmlsYXMgbWVub3MuDQoNCioqKg0KDQoNCiMjIE9wY2lvbiA0OiBHZW5lcmFyIG1lZGlhIHBvciBwZXJpb2RvDQoNCkdlbmVybyBjb2x1bW5hcyBjb24gbG9zIHByZWNpb3MgcHJvbWVkaW9zIGRlIGNhZGEgcGVyaW9kby4NCg0KKsK/UXVlIHBhc2EgY29uIGxhIG1lZGlhIGN1YW5kbyBoYXkgTkE/DQoNCg0KDQpgYGB7ciBQcm9tZWRpb3MgcG9yIHBlcmlvZG8geSB0b3RhbH0NCiMgUHJvbWVkaW9zIHBvciBwZXJpb2RvIHkgdG90YWwNCmRmcmVtcGxhem8gPQ0KKA0KZGZyZW1wbGF6byAlPiUNCiAgbXV0YXRlKHBlcmlvZG8xID0gcm93TWVhbnMoc2VsZWN0KC4sICIxIiwiMiIsIjMiKSxuYS5ybQ0KPVRSVUUpLCBwZXJpb2RvMiA9IHJvd01lYW5zKHNlbGVjdCguLCAiNCIsIjUiKSxuYS5ybQ0KPVRSVUUpLCBwZXJpb2RvMyA9IHJvd01lYW5zKHNlbGVjdCguLCAiNiIsIjciKSxuYS5ybQ0KPVRSVUUpLCBwZXJpb2RvNCA9IHJvd01lYW5zKHNlbGVjdCguLCAiOCIsIjkiLCIxMCIpLG5hLnJtDQo9VFJVRSksIHByb21lZGlvID0gcm93TWVhbnMoc2VsZWN0KC4sICIxIiwiMiIsIjMiLCI0IiwiNSIsIjYiLCI3IiwiOCIsIjkiLCIxMCIpLG5hLnJtDQo9VFJVRSkpDQopDQpgYGANCg0KYGBge3J9DQpoZWFkKGRmcmVtcGxhem8pDQpgYGANCiMjIyMgU2VsZWNjaW9uIGRlIG1pIG11dGF0ZSBwZXJpb2Rvcw0KYGBge3J9DQpwcmVjaW9zbWVkaW9zIDwtIHNlbGVjdChkZnJlbXBsYXpvLCAicHJvZHVjdG8iLCAibm9tYnJlIiwgIkNhdGVnb3JpYSIsICJtYXJjYSIsICJwcmVzZW50YWNpb24iLCAic3VjdXJzYWwiLCAic3VjdXJzYWxUaXBvIiwgImJhbmRlcmFEZXNjcmlwY2lvbiIsICJjb21lcmNpb1Jhem9uU29jaWFsIiwgImRpcmVjY2lvbiIsICJiYXJyaW8iLCAicGVyaW9kbzEiLCAicGVyaW9kbzIiLCJwZXJpb2RvMyIsInBlcmlvZG80IiwicHJvbWVkaW8iKQ0KYGBgDQoNCmBgYHtyfQ0KZ2xpbXBzZShwcmVjaW9zbWVkaW9zKQ0KYGBgDQpgYGB7cn0NCnN1bShpcy5uYShwcmVjaW9zbWVkaW9zKSkNCmBgYA0KYGBge3J9DQojIHB1ZWRlIHZlciBxdWUgZmFsdGFudGUgaGFiaWEgY29uIHByZWNpb3NtZWRpb3NbIWNvbXBsZXRlLmNhc2VzKHByZWNpb3NtZWRpb3MpLF0NCg0KcHJlY2lvc21lZGlvcyAlPiUgZmlsdGVyKHByb2R1Y3RvPT03Nzk0MDAwOTYwMzI5KQ0KDQpgYGANCk1pIHBlcmlvZG8gNCBlcmFuICpNZWRpY2lvbiA4LTktMTAqIGNvcnJlc3BvbmRpZW50ZXMgYSBmZWJyZXJvDQoNCmBgYHtyfQ0KcHJlY2lvc3dpZGUgJT4lIGZpbHRlcihwcm9kdWN0bz09Nzc5NDAwMDk2MDMyOSkNCmBgYA0KIyMjIyBFbGltaW5vIG1lbm9zIGNhbnRpZGFkDQoNCmBgYHtyfQ0KcHJlY2lvc21lZGlvcyA8LSBuYS5vbWl0KHByZWNpb3NtZWRpb3MpDQpgYGANCg0KKipEaWZlcmVuY2lhIGVudHJlIGZpbGFzIGRlbCBkYXRhc2V0IG9yaWdpbmFsIHkgZWwgZGUgZmlsYXMgZWxpbWluYWRhcyoqDQpgYGB7cn0NCm1lZGlvcyA8LSBucm93KHByZWNpb3NtZWRpb3MpICNjYW50aWRhZCBkZSBmaWxhcw0KDQpvcmlnaW5hbC1tZWRpb3MgI2RpZnJlbmNpYSBjb24gZWwgZGF0YXNldCBvcmlnaW5hbA0KDQoob3JpZ2luYWwtbWVkaW9zKS9vcmlnaW5hbCAjIHF1ZSAlPw0KDQpgYGANCg0KDQoNCg==