In erblast/oetteR: Collection of personal R functions

knitr::opts_chunk$set(echo = TRUE, message = F, warning = F, results = 'show')

suppressPackageStartupMessages( require(tidyverse) )
suppressPackageStartupMessages( require(stringr) )

Simulation Parameters

For the sake of the simulation we are at the end of year 1. All the rates we use for this simulation are taken from this timepoint. The data at year 0 and 2+ are simulated values.

retention_rate          = params$retention_rate
n_customers             = round( (params$n_customers / retention_rate) , 0 )
retention_rate_common   = params$retention_rate_common
nca_per_year            = params$nca_per_year
nca_per_year_opt        = nca_per_year * params$expected_increase_nca
profit_cm1_per_customer = params$profit_cm1_per_customer
fix_cost                = params$fix_cost


tab = tibble( n_customers = n_customers
              , retention_rate = retention_rate
              , retention_rate_common = retention_rate_common
              , nca_per_year = nca_per_year
              , nca_per_year_opt = nca_per_year_opt
              , profit_cm1_per_customer = profit_cm1_per_customer
              , fix_cost = fix_cost) %>%
  gather(key = 'Parameter', value = 'value') %>%
  mutate( value = as.character(value)
          , Parameter_long = c('number of customers (extrapolated to time 0)'
                               , 'retention rate'
                               , 'retention rate common in business'
                               , 'new customers per year'
                               , paste('new customers per year optimistic (x'
                                       ,params$expected_increase_nca
                                       ,')')
                               , 'profit cm1 per customer'
                               , 'fixed cost') ) %>%
  select(Parameter, Parameter_long, value)

knitr::kable(tab)

Development Customer Base

calc_accounts = function( iter = 10
                          , start_accounts = 1000
                          , growth_accounts = 500
                          , retention = 0.8 
                          ){

  if( iter == 0){
    return( start_accounts )
  }

  results = c(start_accounts)

  for ( i in 1:iter ){

    len_results = length(results)

    results[ len_results+1 ] = results[len_results] * retention + growth_accounts
  }

  return( results[ length(results) ] )

}

tib_n = tibble( years = 0:10 ) %>%
  mutate( pres_rates_wo_acqui = map_dbl(years, calc_accounts
                                        , n_customers
                                        , 0, retention_rate )
          , pres_rates_wi_acqui = map_dbl(years, calc_accounts
                                          , n_customers
                                          , nca_per_year
                                          , retention_rate )
          , opt_rates_wo_acqui = map_dbl(years, calc_accounts
                                        , n_customers
                                        , 0, retention_rate_common )
          , opt_rates_wi_acqui = map_dbl(years, calc_accounts
                                          , n_customers
                                          , nca_per_year_opt
                                          , retention_rate_common )
          )






p = tib_n %>%
  gather( key = 'calculation', value = 'customer', - years  ) %>%
  mutate( acquisition = ifelse( str_detect( calculation, '_wi_')
                                , 'with', 'without' )
          , rates = ifelse( str_detect( calculation, 'pres_' )
                            , 'present', 'optimistic' )
          , rates = as.factor(rates)
          , rates = fct_rev(rates)
          ) %>%
  ggplot( aes(years, customer, group = calculation) ) +
  geom_line( aes( color = acquisition, linetype = rates) ) +
  ylim( c(0, n_customers) )


plotly::ggplotly(p)

Development Profit CM1

tib_prof = tib_n %>%
  mutate( pres_rates_wo_acqui = pres_rates_wo_acqui * profit_cm1_per_customer
          , pres_rates_wi_acqui = pres_rates_wi_acqui * profit_cm1_per_customer
          , opt_rates_wo_acqui = opt_rates_wo_acqui * profit_cm1_per_customer
          , opt_rates_wi_acqui = opt_rates_wi_acqui * profit_cm1_per_customer
            )


p = tib_prof %>%
  gather( key = 'calculation', value = 'profit', - years  ) %>%
  mutate( acquisition = ifelse( str_detect( calculation, '_wi_')
                                , 'with', 'without' )
          , rates = ifelse( str_detect( calculation, 'pres_' )
                            , 'present', 'optimistic' )
          , rates = as.factor(rates)
          , rates = fct_rev(rates)
          ) %>%
  ggplot( aes(years, profit, group = calculation) ) +
  geom_line( aes( color = acquisition, linetype = rates) ) +
  ylim( c(0, n_customers * profit_cm1_per_customer ) ) +
  geom_hline( yintercept = fix_cost, linetype = 2 ) +
  labs( caption = 'dashed line shows fixed costs' )

plotly::ggplotly(p)

Profitability Projection

profitability_in_x_years = function(x){

  # create value pairs
  grid = expand.grid( retention_rate = seq(.70, .975, .005)
                      , nca_per_year = seq(1000, 20000, 1000) )

  #calculate profit and make groupings
  grid = grid %>%
    as_tibble() %>%
    mutate( n_accounts_xth_year = map2_dbl( nca_per_year, retention_rate 
                                            , function( nca, retention) calc_accounts( x, n_customers, nca, retention)
                                            )
            , profit_net_xth_year = n_accounts_xth_year * profit_cm1_per_customer - fix_cost
            , group = cut(profit_net_xth_year, c( min(profit_net_xth_year) - 1 
                                                  , -5e6, -1e6, -1e5, 1e5, 1e6, 5e6
                                                  , max(profit_net_xth_year) + 1 ) 
                          )
            , group = fct_rev(group)
            )


  ggplot(grid, aes(x = retention_rate
                   , y = nca_per_year
                   , fill = group) 
         ) +
    geom_raster() +
    scale_fill_manual( values = rev(RColorBrewer::brewer.pal(7,'RdYlGn') ) ) +
    geom_vline( xintercept = retention_rate ) +
    geom_hline( yintercept = nca_per_year ) + 
    geom_vline( xintercept = retention_rate_common, linetype = 2 ) +
    geom_hline( yintercept = nca_per_year_opt, linetype = 2) + 
    labs( title = paste('Profitability projection for', x, ' years from today' )
          , caption = paste('black lines indicate present rates'
                            , 'dashed lines optimistic rates'
                            , sep = '\n')
          , subtitle = paste( 'Profit CM1 per customer:', profit_cm1_per_customer, 'CHF \n'
                              , 'Fix Cost:', fix_cost, 'CHF') )

}

plots = tibble( years = seq(1:10)
                , plot = map(years, profitability_in_x_years )
                #, plotly = map(plot, plotly::ggplotly) 
                )

walk(plots$plot, print)