R/make_willingness_utility_group_by.R

In sarid-ins/saridr: An R package for common tasks related to market research analysis via R

#' Generate a 1-ecdf willing to pay  + utility table
#'
#' Function accepts  from a numeric variable of payment the respondent is willing to make.
#' The function produces table with four variables:
#' price- this is a spreading of the willing to pay price on a new scale
#' prop_willing- proportion of respondents that are willing to pay any given price
#' utility- prop_willing * price
#' group- the group for which the curve is relevant
#'
#'
#' @param x a tbl() with the data.
#' @param money_pay_var_string Target variable name as string, represents money.
#' @param group_var_string the grouping variable as string for which the process needs to be repeated
#' @param jump by default ==1  jumps on the cost axis
#' @param var_min by default = NA, allows you to specify the minimal value
#' @param var_max by default = NA, allows you to specify the maximal value
#'
#'
#' @return the function generates the cost, 1-ecdf willingness to pay cost value, and utility
#'
#'
#' @examples
#' quality_assurance <- data.frame(
#' ID = 1:500,
#' money_willing_to_pay = sample(seq(0,20,5), size = 500, replace = T),
#' year = sample(c("2018", "2019", "2020"), size = 500, replace = T))
#'
#' quality_assurance %>%
#'   make_willingness_utility_group_by(money_pay_var_string = "money_willing_to_pay",
#'                                    group_var_string = "year")
#'
#' @importFrom magrittr %>%
#' @importFrom dplyr sym
#' @importFrom dplyr pull
#' @importFrom dplyr select
#' @importFrom dplyr ends_with
#' @importFrom dplyr group_by
#' @importFrom dplyr ungroup
#' @importFrom dplyr mutate
#' @importFrom dplyr arrange
#' @importFrom dplyr desc
#' @importFrom dplyr summarize
#' @importFrom dplyr filter
#' @importFrom tidyr gather
#' @importFrom stringr str_wrap
#' @importFrom RColorBrewer brewer.pal
#'
#' @export







make_willingness_utility_group_by <- function(x,
                                           money_pay_var_string,
                                           group_var_string,
                                           jump=1,
                                           var_min=NA,
                                           var_max=NA){



  make_willingness_utility_inner <- function(x,
                                       money_pay_var_string,
                                       jump=1,
                                       var_min=NA,
                                       var_max=NA,
                                       group_name="no group"){


    var <- sym(money_pay_var_string)

    vec <- x %>% pull(!!var)

    vmin <- ifelse(is.na(var_min),min(vec,na.rm = T),var_min)

    vmax <- ifelse(is.na(var_max),max(vec,na.rm = T),var_max)

    var_ecdf <- ecdf(vec)

    var_ecdf_one_minus <- function(x){1-var_ecdf(x)}

    x <- tibble(price = seq(vmin, vmax, jump)) %>%
      mutate(prop_willing = var_ecdf_one_minus(price)) %>%
      mutate(utility = prop_willing*price) %>%
      mutate(group = group_name)




    return(x)

  }


  var <- sym(money_pay_var_string)
  group <- sym(group_var_string)

  vec <- x %>%
                  pull(!!var)

  vmin <- ifelse(is.na(var_min),min(vec,na.rm = T),var_min)

  vmax <- ifelse(is.na(var_max),max(vec,na.rm = T),var_max)


  data_split <- split(x, f = list(x[[group_var_string]]))

  result <- lapply(data_split, function(x)
  {
    g_name <- unique(x[[group_var_string]])
    make_willingness_utility_inner(x,
                          money_pay_var_string,
                          jump,
                          var_min=vmin,
                          var_max=vmax,
                          group_name=g_name)
  })

  x <- do.call(rbind, result) %>%
    mutate(group=factor(group))

  return(x)

}