R/a_psm.R

In pelishk/upax_library: Librería de análisis

#' función para generar modelo y mapas de sensibilidad de precios
#'
#' A partir de una variable multirespuesta se genera una variable dummy  con respuestas TRUE/FALSE la cual se puede utilizar como filtro de varibales
#'
#' @param tabla dataframe - dataframe que contenga las variables ordenadas del precio muy barato, precio barato, precio caro , precio muy caro, probabilidad de compra precio parato, probabilidad de compra precio caro, y en caso de ir ponderado, la variable de ponderación
#' @param arreglar boolean - indica si se realizara el ajuste de los datos
#' @param titulo character - nombre del mapa que se va a generar, default "Análisis de sensitividad de precio"
#' @param ponderador character - variable que contiene el ponderador, default "ninguna"
#' @param salto numeric - indica el salto que va a hacer la interpolación de precios, default 0.01
#' @param metodo character - define el metodo con el cual se van a determinar los puntos de precio, opciones "min", "max", "mean" o "median", default "min"


a_psm <- function(tabla, arreglar = F, titulo = "Análisis de sensitividad de precio", ponderador = "ninguna",
                        salto = 0.01, metodo = "min"){
  
  # wrangling
  
  if (ponderador != "ninguna") {
    tabla <- tabla %>%
      setNames(c('muy_barato','barato','caro','muy_caro','prob_barato','prob_caro',ponderador)) %>% 
      mutate_all(as.double) %>%
      na.omit
  }else{
    tabla <- tabla %>%
      setNames(c('muy_barato','barato','caro','muy_caro','prob_barato','prob_caro')) %>% 
      mutate_all(as.double) %>%
      na.omit
  }
  
  # fixing
  
  funcion_ajuste <- function(tabla){
    resultado <- tabla %>%
      mutate_all(as.double) %>%
      mutate(
        muy_barato = if_else(muy_barato == barato,muy_barato - 1,muy_barato),
        caro = if_else(caro == muy_caro,caro - 1,caro)
      )
    return(resultado)
  }
  if(arreglar){
    tabla <- funcion_ajuste(tabla)
  }
  
  # modeling
  if (ponderador != "ninguna") {
    diseno<-svydesign(ids = ~1,data = tabla,weights = ponderador)
    output.psm <- psm_analysis_weighted(toocheap = "muy_barato",
                                        cheap = "barato",
                                        expensive = "caro",
                                        tooexpensive = "muy_caro",
                                        design = diseno,
                                        pi_cheap = "prob_barato",
                                        pi_expensive = "prob_caro",
                                        validate = TRUE,interpolate = T,
                                        interpolation_steps = salto,
                                        intersection_method = metodo)
    
  }else{
    output.psm <- psm_analysis(toocheap = "muy_barato",
                               cheap = "barato",
                               expensive = "caro",
                               tooexpensive = "muy_caro",
                               data = tabla,
                               pi_cheap = "prob_barato",
                               pi_expensive = "prob_caro",
                               validate = TRUE,interpolate = T,
                               interpolation_steps = salto,
                               intersection_method = metodo)
  }
  
  # plotting
  
  tabla_sugerido <- output.psm$data_nms %>%
    filter(price >= output.psm$price_optimal_trial) %>%
    filter(price <= output.psm$price_optimal_revenue) %>%
    mutate(trial_n = trial/max(trial),
           revenue_n = revenue/max(revenue),
           diferencia = abs(trial_n - revenue_n),
           maximo = trial_n + revenue_n,
           sugerido = if_else(diferencia == min(diferencia),T,F)) %>% 
    filter(sugerido == T)
  
  psm_tabla <- data.frame(
    variable = c(paste0('IDP: ',output.psm$idp),
                 paste0('OPP: ',output.psm$opp),
                 paste0('Optimo Unidades: ',output.psm$price_optimal_trial),
                 paste0('Optimo Ingresos: ',output.psm$price_optimal_revenue),
                 paste0('Precio Sugerido:',tabla_sugerido$price)),
    x = c(output.psm$idp,
          output.psm$opp,
          output.psm$price_optimal_trial,
          output.psm$price_optimal_revenue,
          tabla_sugerido$price),
    y = c(output.psm$data_vanwestendorp$ecdf_not_cheap[output.psm$data_vanwestendorp$price == output.psm$idp],
          output.psm$data_vanwestendorp$ecdf_toocheap[output.psm$data_vanwestendorp$price == output.psm$opp],
          subset(output.psm$data_nms, trial == max(trial))$trial,
          subset(output.psm$data_nms, revenue == max(revenue))$trial,
          tabla_sugerido$trial)
  )
  
  # all plot elements without any labels 
  psmplot <-  ggplot(data = output.psm$data_vanwestendorp, aes(x = price)) +
    annotate(geom = "rect", # shaded background area for range of optimal prices
             xmin = output.psm$price_optimal_trial,
             xmax = output.psm$price_optimal_revenue,
             ymin = 0, ymax = Inf,
             fill="grey50", alpha = 0.5) +
    geom_line(aes(y = ecdf_toocheap, # línea: muy barato
                  colour = "muy barato",
                  linetype = "muy barato"),
              size= 1) +
    geom_line(aes(y = ecdf_tooexpensive, # línea: muy caro
                  colour = "muy caro",
                  linetype = "muy caro"),
              size = 1) + 
    geom_line(aes(y = ecdf_not_cheap, # línea: no es barato
                  colour = "no es barato",
                  linetype = "no es barato"),
              size = 1) +
    geom_line(aes(y = ecdf_not_expensive, # línea: no es caro
                  colour = "no es caro",
                  linetype = "no es caro"),
              size = 1) + 
    geom_point(data = psm_tabla,aes(x = x, y = y, label = variable)) +
    geom_label_repel(data = psm_tabla,aes(x = x, y = y, label = variable))
  
  
  # Labels and Colours
  psmplot <- psmplot +
    labs(x = "Precio",
         y = "Share de Respuesta (0-1)",
         title = titulo,
         caption = paste0("Área sombreada: Rango óptimo de precios\n Casos Válidos: ",output.psm$total_sample - output.psm$invalid_cases))  + 
    scale_colour_manual(name = "Descripción",
                        values = c("muy barato" = "#009E73",
                                   "no es barato" = "#009E73",
                                   "no es caro" = "#D55E00",
                                   "muy caro" = "#D55E00")) + 
    scale_linetype_manual(name="Descripción",
                          values = c("muy barato" = "dotted",
                                     "no es barato" = "solid",
                                     "no es caro" = "solid",
                                     "muy caro" = "dotted")) + 
    theme_minimal()
  
  distribucion_share <- ggplot(data = output.psm$data_nms, aes(x = price)) + 
    geom_line(aes(y = trial)) + # trial curve
    geom_vline(xintercept = output.psm$price_optimal_trial,
               linetype = "dotted") + # highlighting the optimal price
    geom_text(data = subset(output.psm$data_nms, trial == max(trial)),
              aes(x = price + 0.5, y = trial),
              label = paste("Precio Óptimo:", output.psm$price_optimal_trial),
              hjust = 0) + # labelling the optimal price
    labs(x = "Precio", y = "Probabilidad de compra (Prueba)",
         title = "Sensitividad de precios: Precio óptimo de prueba") +
    theme_minimal()
  
  distribucion_revenue <- ggplot(data = output.psm$data_nms, aes(x = price)) + 
    geom_line(aes(y = revenue)) + # revenue curve
    geom_vline(xintercept = output.psm$price_optimal_revenue,
               linetype = "dotted") + # highlighting the optimal price
    geom_text(data = subset(output.psm$data_nms, revenue == max(revenue)),
              aes(x = price + 0.5, y = revenue),
              label = paste("Precio Óptimo:", output.psm$price_optimal_revenue),
              hjust = 0) + # labelling the optimal price
    labs(x = "Precio", y = "Ingresos",
         title = "Sensitividad de precios: Precio óptimo de ingresos") +
    theme_minimal()
  
  return(list(output.psm,psmplot,distribucion_share,distribucion_revenue))
  
}