R/make_willingness_utility.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 three 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
#'
#'
#' @param x a tbl() with the data.
#' @param money_pay_var_string Target variable name as string, represents money.
#' @param jump by defoult ==1  jumps on the cost axis
#' @param var_min by defoult = NA, allows you to specify the minimal value
#' @param var_max by defoult = 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(money_pay_var_string = "money_willing_to_pay")
#'
#' @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 <- function(x,
                                  money_pay_var_string,
                                  jump=1,
                                  var_min=NA,
                                  var_max=NA){


  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)




  return(x)

}