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

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")

Descripción del problema

Media Solutions necesita producir reportes de noticias que entreguen mayor nivel de análisis de forma más automatizada. Para ello, cuentan con una base de datos en un servidor SQL que contiene información de las noticias en las que aparecen palabras claves seleccionadas por el cliente.

Algunos objetivos:

Qué tan frecuente hablan sobre los temas? Hablan bien o mal del cliente? Identificación y descripción de eventos informativos Tratar de describir la variable de impacto.

Plan de trabajo

1. Realizar un análisis exploratorio de la base de datos para

Descripción de datos

Variables cualitativas: Fecha,Pais,Medio,TipoNota, TipoMedio,Calificación

Variables Cuantitativas: Costo, Impacto

En el periodo entre r inicio_periodo y r fin_periodo 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.

(¿TABLA?) La mayoría de las notas son neutras con un porcentaje de r scales::percent(pp_neutro). El r scales::percent(pp_positivo) son notas positivas y el r scales::percent(pp_negativo) son negativas.

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

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

La siguiente tabla muestra el índice de calificación por tipo de medio. En este índice, 1 es 100% positivo, 0 es completamente neutro y -1 es 100% negativo.

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

La siguiente gráfica muestra la calificación obtenida por cada tipo de medio.

g_calificacion_tipomedio

Análisis

Frecuencia

Total del periódo

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

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 +
  geom_text(data=eventos,aes(x=Inicio, 
                 y=n, label=evento))

Eventos informativos

library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
evento2 <- eventos %>% slice_max(order_by = n, n=1)


palabras_clave <- function(evento, noticias){
  noticias <- noticias %>% mutate(evento=(Fecha>=evento2$Inicio&Fecha<=evento2$Fin))

  titulares_diarios <- noticias %>% 
    group_by(evento) %>% 
    summarise(titulares=paste(Titulo, 
                              collapse = "\n"))
  data_corpus <-corpus(titulares_diarios, text_field = "titulares")

  # Se detectan collocations
  col <-  tokens(data_corpus, remove_punct = TRUE) %>%
    tokens_remove(stopwords("spanish")) %>% 
    textstat_collocations(min_count = 5, tolower = FALSE)
  head(col)

  data_corpus <-corpus(titulares_diarios, text_field = "titulares")

  # Create a dfm grouped by president
  pres_dfm <- tokens(data_corpus, remove_punct = TRUE) %>%
    tokens_compound(pattern = col) %>% 
    tokens_remove(stopwords("spanish")) %>%
    tokens_group(groups = evento) %>%
    dfm()

  # Calculate keyness and determine Trump as target group
  result_keyness <- textstat_keyness(pres_dfm, target = "TRUE",measure = "lr")
  return(result_keyness)
}
palabras_clave(evento2, noticias = bd) %>% 
  top_n(n=10, wt=G2) %>% 
  filter(p<.05) %>% pull(feature) %>% 
  stringr::str_replace_all(pattern="_", replacement = " ") %>% 
  stringr::str_to_title()

El evento consistió en r evento2$n noticias en un periódo de r evento2$Fin -evento2$Inicio que fue del r evento2$Inicio al r evento2$Final.

# Plot estimated word keyness

En el tiempo

Cada cuántos días se escribe del tema

# Analizar frecuencia
bd %>% 
  count(Fecha) %>%
  mutate(difference=as.numeric(Fecha-lag(Fecha))) %>% 
  ggplot(aes(x=difference)) + geom_histogram()

En aquellos días que se escribe, cuántas notas por día se escriben

fechas <- bd %>% count(Fecha)
fechas %>% 
  summarise(media=mean(n), mediana=median(n), maximo=max(n))

Medios

bd %>% count(Medio) %>% top_n(n=10, wt=n) %>% arrange(desc(n))
bd %>% count(Medio, Costo)

Contenido

Impacto

Conclusión

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