In gorantesj/mediaR: What the Package Does (One Line, Title Case)

Reporte Media

knitr::opts_chunk$set(
  fig.width=9, fig.height=4, fig.retina=3,
  out.width = "100%",
  echo = F,
  message = FALSE,
  warning = FALSE)

library(tidyverse)

bd <- readxl::read_excel("Reporte Philip Morris - Diciembre 2021.xlsx") 

bd <- as_tibble(bd)

source("R/informacion.R",
       encoding = "UTF-8")

En el periodo entre el r format(inicio_periodo, "%d de %B") y el r format(fin_periodo, "%d de %B del %Y") hubo un total de r total_notas notas en r total_medios medios distintos. La mayoría de estas notas fueron r tiponota_max con un r scales::percent(tiponota_max_per) del total de notas.

La mayoría de las notas publicadas en este periodo son neutras con un porcentaje de r scales::percent(pp_neutro). Asimismo, el r scales::percent(pp_positivo) de las notas son positivas y el r scales::percent(pp_negativo) son negativas.

En promedio, al dia fueron publicadas r scales::comma(promedio_notas_dia) notas.

Por Fechas

datos <- bd %>% count(Fecha) %>% 
  # Forzar que las fechas sin publicaciones se contabilicen con un 0
  complete(Fecha=seq(inicio_periodo, fin_periodo, by= "1 day"), fill=list(n=0))

# Hacer análisis de la tabla de contingencia.
g <- bd %>% 
  count(Fecha, Calificación) %>%
  complete(Fecha=seq(inicio_periodo, fin_periodo, by= "1 day"), 
           Calificación=c("Positivo","Negativo","Neutro"),
           fill=list(n=0)) %>% 
  mutate(Calificación=forcats::fct_relevel(Calificación,
                                           levels=c("Neutro", "Positivo", "Negativo"))) %>% 
  ggplot()+
  geom_area(aes(x=Fecha, y=n, fill=Calificación), stat="identity", alpha=.8) +
  geom_path(data=datos, aes(x=Fecha, y=n), color="#177E89")+
  scale_fill_manual(values=c("Negativo"="#FF6464", 
                             "Neutro"="#EDD958",
                             "Positivo"="#91C483"))+
  geom_hline(yintercept = 0) +
  geom_vline(xintercept = inicio_periodo)+
  theme(panel.background = element_blank(),
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank())

library(EnvStats)

detectar_eventos_informativos <- function(frecuencia_diaria){
  # Detectar eventos sospechosos
  cuartiles <- quantile(frecuencia_diaria$n, prob=seq(0, 1, .25))
  rango_intercuartilico <- cuartiles[3]-cuartiles[1]
  sospechosos <- frecuencia_diaria %>% 
    filter(n<cuartiles[1]-1.5*rango_intercuartilico |
             n>cuartiles[3]+1.5*rango_intercuartilico)
  # Realizar prueba de outlier para esos eventos
  test <- rosnerTest(frecuencia_diaria$n,
                     k = nrow(sospechosos)
  )
  # Detectar los días críticos
  sospechosos <- left_join(frecuencia_diaria,
                           test$all.stats %>% select(n=Value, Outlier))
  # Agrupar días en eventos #Recomiendo ver
  eventos <- sospechosos %>% 
    filter(Outlier) %>% 
    mutate(evento=Fecha-lag(Fecha)>1,
           evento=cumsum(ifelse(is.na(evento), 0, evento))+1)
  # Resumir info por evento
  eventos <- eventos %>% 
    group_by(evento) %>% 
    summarise(Inicio=min(Fecha), Fin=max(Fecha), n=sum(n))

  return(eventos)
}

eventos <- detectar_eventos_informativos(datos)

g_eventos <- g +
  geom_text(data=eventos,aes(x=Inicio, 
                 y=n, label=evento))

En este periodo ocurrieron los siguientes eventos informativos:

kableExtra::kbl(eventos) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Número de notas positivas, negativas, neutras y totales

g_eventos

Tipo de Medio

La siguiente gráfica muestra el porcentaje de notas por cada tipo de medio en el que fueron publicadas.

g_tipomedio

La siguiente gráfica muestra el número de notas en cada tipo de medio según su calificación.

g_calificacion_tipomedio

Impacto y Costo

Notas con mayor impacto

kableExtra::kbl(tbl_mayor_impacto) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Notas positivas con mayor impacto

kableExtra::kbl(tbl_mas_positivo) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Notas negativas con mayor impacto

kableExtra::kbl(tbl_mas_negativo) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Impacto por tipo de medio y clacificacion

kableExtra::kbl(tbl_tmedio_cal_imp) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Notas más costosas

kableExtra::kbl(tbl_mayor_costo) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

Relación Notas Costo

g_impacto_costo

Costo por tipo de medio y clacificacion

kableExtra::kbl(tbl_tmedio_cal_costo) %>% 
  kableExtra::kable_styling(bootstrap_options = "striped",
                            full_width = F, 
                            position = "center")

gorantesj/mediaR documentation built on Jan. 26, 2022, 6:07 a.m.