knitr::opts_chunk$set(warning = FALSE)

EDA proyecto

Descripción de datos

El siguiente set de datos pertenece a una serie de interacciones registradas en un centro de llamadas por día a lo largo del tiempo. Los datos están registrados por fecha identificando si es un día feriado o no y la cantidad de llamadas registrada por día.

Descripción de columnas: - Fecha: fecha de los registros. - StateHoliday: indicador de días feriados. - Real Calls: número de llamadas registrado en el día.

Carga y visualización de datos

library(readr)
df_proyect <- read_delim("C:/BK/Julian Acevedo/WFM_2021-11-08/WFM nov.2021/Analitica/U.NORTE/Vizualizacion datos R y Python/Proyecto/ts_dash.csv", 
    delim = ";", escape_double = FALSE, trim_ws = TRUE)
## Rows: 1367 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (1): FECHA
## dbl (2): StateHoliday, REAL CALLS
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_proyect$FECHA <- as.Date(df_proyect$FECHA, format = "%d/%m/%Y")

knitr::kable(head(df_proyect, 5))
FECHA StateHoliday REAL CALLS
2020-02-01 0 293
2020-02-02 0 29
2020-02-03 0 2881
2020-02-04 0 2776
2020-02-05 0 2586

Descripción de los datos

summary(df_proyect)
##      FECHA             StateHoliday       REAL CALLS  
##  Min.   :2020-02-01   Min.   :0.00000   Min.   :  25  
##  1st Qu.:2021-01-07   1st Qu.:0.00000   1st Qu.: 370  
##  Median :2021-12-15   Median :0.00000   Median :2693  
##  Mean   :2021-12-15   Mean   :0.03146   Mean   :2215  
##  3rd Qu.:2022-11-21   3rd Qu.:0.00000   3rd Qu.:3305  
##  Max.   :2023-10-29   Max.   :2.00000   Max.   :5575

Información de los datos

str(df_proyect)
## spc_tbl_ [1,367 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ FECHA       : Date[1:1367], format: "2020-02-01" "2020-02-02" ...
##  $ StateHoliday: num [1:1367] 0 0 0 0 0 0 0 0 0 0 ...
##  $ REAL CALLS  : num [1:1367] 293 29 2881 2776 2586 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   FECHA = col_character(),
##   ..   StateHoliday = col_double(),
##   ..   `REAL CALLS` = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

verificar datos unicos

nunique <- sapply(df_proyect, function(x) length(unique(x)))
nunique
##        FECHA StateHoliday   REAL CALLS 
##         1367            3         1039

Visualizacion de los datos

library(ggplot2)

# Crear el gráfico
p <- ggplot(df_proyect, aes(x = FECHA, y = `REAL CALLS`)) +
  geom_line() + 
  labs(title = 'Serie Temporal de Real Calls', 
       x = 'Fecha', 
       y = 'Número de Llamadas') +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 50, vjust = 1, hjust = 1))

# Mostrar cada 30 días, puedes usar scale_x_date
p <- p + scale_x_date(date_breaks = "30 days", date_labels = "%Y-%m-%d")

print(p)

Histograma

library(ggplot2)

ggplot(df_proyect, aes(x = `REAL CALLS`)) +
    geom_histogram(aes(y = ..density..), binwidth = 1, colour = "black", fill = "white") +
    geom_density(alpha = .2, fill = "#FF6666") +
    labs(title = 'Histograma de REAL CALLS', x = 'REAL CALLS', y = 'Frecuencia')

Boxplot

library(ggplot2)

# Crear el boxplot
ggplot(df_proyect, aes(y = `REAL CALLS`)) +
  geom_boxplot() +
  labs(title = 'Boxplot de REAL CALLS', x = 'REAL CALLS', y = '') +
  theme_minimal()

Graficas de datos por año, mes y dia

dff <- df_proyect
dff$AÑO <- format(dff$FECHA, "%Y")
dff$MES <- format(dff$FECHA, "%B")
dff$DiaSemana <- format(dff$FECHA, "%A")
head(dff)
## # A tibble: 6 × 6
##   FECHA      StateHoliday `REAL CALLS` AÑO   MES     DiaSemana
##   <date>            <dbl>        <dbl> <chr> <chr>   <chr>    
## 1 2020-02-01            0          293 2020  febrero sábado   
## 2 2020-02-02            0           29 2020  febrero domingo  
## 3 2020-02-03            0         2881 2020  febrero lunes    
## 4 2020-02-04            0         2776 2020  febrero martes   
## 5 2020-02-05            0         2586 2020  febrero miércoles
## 6 2020-02-06            0         2533 2020  febrero jueves
library(ggplot2)

# Crear el boxplot
ggplot(dff, aes(x = as.factor(AÑO), y = `REAL CALLS`)) +
  geom_boxplot() +
  labs(title = 'Boxplot llamadas por Año', x = 'Año', y = 'Valor') +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Rota las etiquetas del eje X

library(ggplot2)

# Crear el boxplot
ggplot(dff, aes(x = MES, y = `REAL CALLS`)) +
  geom_boxplot() +
  labs(title = 'Boxplot llamadas por Mes', x = 'Mes', y = 'Valor') +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Rota las etiquetas del eje X

library(ggplot2)
library(forcats)

# Ordenar los días de la semana
dff$DiaSemana <- factor(dff$DiaSemana, levels = c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo"))

# Crear el boxplot
ggplot(dff, aes(x = DiaSemana, y = `REAL CALLS`)) +
  geom_boxplot() +
  labs(title = 'Boxplot llamadas por Día de la Semana', x = 'Día', y = 'Valor') +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Rota las etiquetas del eje X

En los gráficos anteriores podemos identificar que la serie de tiempo de llamadas ha tenido una tendencia positiva a los largo del tiempo, adicional a esto se identifica visualmente una estacionalidad en el comportamiento de las llamadas a lo largo de los meses y mucho más pronunciada cuando lo vemos por día, se entiende que los lunes es cuando mayor cantidad de llamadas ingresa y va descendiendo hasta el día viernes, los sábados y domingos se tienen registros muy bajos de llamadas.

Datos faltantes

sum(is.na(df_proyect$`REAL CALLS`))
## [1] 0
sum(df_proyect$`REAL CALLS`)
## [1] 3028468
head(df_proyect$`REAL CALLS`)
## [1]  293   29 2881 2776 2586 2533
tail(df_proyect$`REAL CALLS`)
## [1] 3555 3220 3191 2930  393  119

2. Prueba Dickey-Fuller

library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
# Realizar la prueba de Dickey-Fuller aumentada
dickey_fuller_result <- adf.test(df_proyect$`REAL CALLS`)

# Extracción de los resultados
test_stat <- dickey_fuller_result$statistic
p_value <- dickey_fuller_result$p.value
alpha <- 0.05

cat("Hipótesis:\n")
## Hipótesis:
cat("H0: Serie no estacionaria\n")
## H0: Serie no estacionaria
cat("H1: Serie estacionaria\n")
## H1: Serie estacionaria
cat(sprintf("Estadístico de prueba: %.4f\n", test_stat))
## Estadístico de prueba: -6.5584
cat(sprintf("p-value: %.4f\n", p_value))
## p-value: 0.0100
cat(sprintf("Alpha: %f\n", alpha))
## Alpha: 0.050000
if (p_value > alpha) {
  cat("No se rechaza H0, por lo tanto la serie no es estacionaria.\n")
} else {
  cat("Se rechaza H0, por lo tanto la serie es estacionaria.\n")
}
## Se rechaza H0, por lo tanto la serie es estacionaria.

3. Descomposición

#ts_TGLS_2 <- ts(df_TGLS$Close, frequency=365, start=c(2012, 5))
ts_proyect <- ts(df_proyect$`REAL CALLS`,frequency=30)
library(TSstudio)
ts_decompose(ts_proyect)

4. Transformacion de serie no estacionaria a estacionaria

library(forecast)
library(ggplot2)

# Definir una función para crear un gráfico de diferenciación y ACF
plot_diff_acf <- function(data, lag.max, diff.order = 0, title.prefix = "") {
  # Aplicar diferenciación
  data.diff <- diff(data, differences = diff.order)
  
  # Crear gráfico de la serie de tiempo diferenciada
  plot.ts(data.diff, main = paste(title.prefix, "Order Differencing"), ylab = "Value")
  
  # Crear gráfico ACF
  Acf(data.diff, lag.max = lag.max, main = paste(title.prefix, "Order Differencing ACF"))
}

plot.ts(df_proyect$`REAL CALLS`, main = "Original Series", ylab = "Value")

Acf(df_proyect$`REAL CALLS`, lag.max = 1300, main = "Real Calls")

for (i in 1:2) {
  plot_diff_acf(df_proyect$`REAL CALLS`, lag.max = 1300, diff.order = i, title.prefix = paste(i, "nd"))
}

Primera diferenciación

library(tseries)

# Realizar la diferencia de la serie y eliminar valores NA
df_proyect_diff <- na.omit(diff(df_proyect$`REAL CALLS`, differences = 1))

# Realizar la prueba de Dickey-Fuller aumentada en la serie diferenciada
dickey_fuller_result <- adf.test(df_proyect_diff)

# Extracción de los resultados
test_stat <- dickey_fuller_result$statistic
p_value <- dickey_fuller_result$p.value
alpha <- 0.05

cat("Hipotesis:\n")
## Hipotesis:
cat("H0: Serie no estacionaria\n")
## H0: Serie no estacionaria
cat("H1: Serie estacionaria\n")
## H1: Serie estacionaria
cat(sprintf("Estadistico de prueba: %.4f\n", test_stat))
## Estadistico de prueba: -14.7073
cat(sprintf("p-value: %.4f\n", p_value))
## p-value: 0.0100
cat(sprintf("Alpha: %f\n", alpha))
## Alpha: 0.050000
if (p_value > alpha) {
  cat("No se rechaza H0, por lo tanto la serie no es estacionaria.\n")
} else {
  cat("Se rechaza H0, por lo tanto la serie es estacionaria.\n")
}
## Se rechaza H0, por lo tanto la serie es estacionaria.