Clever Geek Handbook

R en manos de un comercializador. Análisis de cohortes de bricolaje

El análisis de cohortes es muy popular en marketing . Su popularidad probablemente se deba a la facilidad del algoritmo y los cálculos. No hay conceptos matemáticos serios en la base, las matemáticas elementales se realizan en Excel. Desde el punto de vista de la obtención de conocimientos, el análisis de la supervivencia es mucho más interesante.







Sin embargo, creemos que existe tal tarea y debe resolverse. La búsqueda de paquetes y funciones listas para usar no es interesante: las matemáticas son simples, hay muchas configuraciones. A continuación se muestra un posible ejemplo de implementación (sin una fijación especial en la velocidad de ejecución), el código completo para un par de docenas de líneas.







Es una continuación de una serie de publicaciones anteriores .







Algún código



Al crear un conjunto de prueba, es posible que no nos centremos particularmente en las zonas horarias, de todos modos, los datos son aleatorios.







Creación de casos de prueba 
#    15 
set.seed(42)

events_dt <- tibble(user_id = 1000:9000) %>%
  mutate(birthday = Sys.Date() + as.integer(rexp(n(), 1/10))) %>%
  rowwise() %>%
  mutate(timestamp = list(as_datetime(birthday) + 24*60*60 * (
     rexp(10^3, rate = 1/runif(1, 2, 25))))) %>%
  ungroup() %>%
  unnest(timestamp) %>%
  #        
  filter(timestamp >= quantile(timestamp, probs = 0.1),
         timestamp <= quantile(timestamp, probs = 0.95)) %>%
  mutate(date = as_date(timestamp)) %>%
  select(user_id, date) %>%
  setDT(key = c("user_id", "date")) %>%
  #      
  unique()


Veamos la distribución acumulativa resultante







ggplot(events_dt, aes(date)) +
  geom_histogram()








Paso 1. Elaboración de una guía de usuario



" ", .. , . data.table



.







users_dict <- events_dt[, .(birthday = head(date, 1)), by = user_id] %>%
  #       
  .[, week_start := floor_date(.BY[[1]], unit = "week"), by = birthday] %>%
    #      
  .[, cohort := stri_c(
        lubridate::isoyear(.BY[[1]]), 
        sprintf("%02d", lubridate::isoweek(.BY[[1]])), 
        sep = "/"), by = week_start]
#    ,      
as_tibble(janitor::tabyl(users_dict, birthday))








2.



.







. .







data.frame 
cohort_dict <- unique(users_dict[, .(cohort, week_start)])

cohort_tbl <- users_dict[events_dt, on = "user_id"] %>%
  #         
  .[, rel_week := floor(as.numeric(difftime(date, birthday, units = "week")))] %>%
  #   10 
  .[rel_week <= 9] %>%
  #    
  unique(by = c("user_id", "cohort", "rel_week")) %>%
  #       
  .[, .N, by = .(cohort, rel_week)] %>%
  .[, rate := N/max(N), by = cohort]


3.



1. ggplot





ggplot 
#  ggplot
data_tbl <- cohort_tbl %>%
  #      
  left_join(cohort_dict)

data_tbl %>%
  mutate(cohort_group = forcats::fct_reorder(cohort, week_start, .desc = TRUE)) %>%
  ggplot(mapping = aes(x = rel_week, y = cohort_group, fill = rate)) +
  geom_tile()  +
  geom_text(aes(label = N), colour = "darkgray") +
  labs(x = "  ",
       y = "  ",
       fill = "\n",
       title = "graph_title") +
  scale_fill_viridis_c(option = "inferno") +
  scale_x_continuous(breaks = scales::breaks_width(1)) +
  theme_minimal() +
  theme(panel.grid = element_blank())








2. gt





, .







gt 
#  -
data_tbl <- cohort_tbl %>%
  pivot_longer(cols = c(N, rate)) %>%
  pivot_wider(names_from = rel_week, values_from = value) %>%
  #      
  left_join(cohort_dict) %>%
  arrange(week_start, desc(name))

odd_rows <- seq(1, to = nrow(data_tbl), by = 2)
even_rows <- seq(2, to = nrow(data_tbl), by = 2)

tab <- data_tbl %>%
  mutate(cohort = if_else(rep(c(TRUE, FALSE), length.out = nrow(.)), 
                          cohort, "")) %>%
  select(-name, -week_start) %>%
  gt(rowname_col = "cohort") %>%
  fmt_percent(columns = matches("[0-9]+"), 
              rows = odd_rows, 
              decimals = 0, pattern = "<big>{x}</big>") %>%
  fmt_missing(columns = everything(), 
              missing_text = "---") %>%
  tab_stubhead(label = "  ") %>%
  tab_spanner(label = "  ",
              columns = everything()) %>%
  tab_header(title = "") %>%
  data_color(columns = everything(),
             colors = scales::col_numeric(palette = "inferno",
                                          domain = c(0, 1), 
                                          alpha = 0.6,
                                          na.color = "lightgray")) %>%
  tab_options(
    table.font.size = "smaller",
    data_row.padding = px(1),
    table.width = pct(75)
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(style = "italic"),
      cell_borders(sides = "bottom")
    ),
    locations = cells_body(
      columns = everything(),
      rows = even_rows)
  ) %>%
  tab_style(
    style = list(
      cell_borders(sides = "top")
    ),
    locations = cells_body(
      columns = everything(),
      rows = odd_rows)
  )

tab








, .







Publicación anterior - “R y trabajar con tiempo. ¿Qué hay detrás de escena? " ...







More articles:


All Articles