mncube / discountr

Tools to Analyze Discounting Data

discountr

The goal of discountr is to provide data analysis tools for discounting studies.

Installation

You can install the development version from GitHub with:

# install.packages("devtools")
devtools::install_github("mncube/discountr")

Example

This is a basic example which shows you how to compute the area under the empirical discounting function using the trapezoid approximation as described in:

Myerson, J., Green, L., & Warusawitharana, M. (2001). Area under the curve as a measure of discounting. Journal of the experimental analysis of behavior, 76 2, 235-43 .

library(discountr)

#Create data frame with successive delays and subjective values
df_disc <- data.frame(delay = sample(1:100, 50, replace = FALSE),
                      value = sample(1:100, 50, replace = TRUE))

#Normalize data in preparation for the auc calculation
#This will ensure that the auc is between 0 and 1
df_disc$delay <- df_disc$delay/max(df_disc$delay)
df_disc$value <- df_disc$value/max(df_disc$value)

#Calculate the area under the curve
output_disc <- trap_auc(df_disc, x = delay, y = value)

#Get the total area under the curve (i.e., sum over trapezoids)
output_disc$total
#> [1] 0.4964062

#Get the data frame containing the area under the curve for each trapezoid
head(output_disc$data)
#>   delay     value x_lead    y_lead         auc
#> 1  0.01 0.5312500   0.02 0.7604167 0.006458333
#> 2  0.02 0.7604167   0.03 0.6562500 0.007083333
#> 3  0.03 0.6562500   0.04 0.5208333 0.005885417
#> 4  0.04 0.5208333   0.05 0.6666667 0.005937500
#> 5  0.05 0.6666667   0.08 0.3854167 0.015781250
#> 6  0.08 0.3854167   0.09 0.8750000 0.006302083

You can also convert the data frame to trapazoidal form and then explicitly provide the x_lead and y_lead values when computing the area under the empirical discounting function:

#Create data frame with successive delays and subjective values
df_disc_2 <- data.frame(delay = sample(1:100, 50, replace = FALSE),
                      value = sample(1:100, 50, replace = TRUE))

#Normalize data in preparation for auc calculation
df_disc_2$delay <- df_disc_2$delay/max(df_disc_2$delay)
df_disc_2$value <- df_disc_2$value/max(df_disc_2$value)

#Reformat data in preparation to compute the trapezoidal auc
#The resulting data frame will have two new columns:
#delay_lead and value_lead
df_disc_2 <- traper(df_disc_2, x = delay, y = value, rename = TRUE)

#Calculate the area under the curve explicitly defining x_lead and y_lead
output_disc_2<- trap_auc(df_disc_2, x = delay, y = value,
                          x_lead = delay_lead, y_lead = value_lead)

#Get the total area under the curve (i.e., sum over trapezoids)
output_disc_2$total
#> [1] 0.4926

#Get the data frame containing the area under the curve for each trapezoid
head(output_disc_2$data)
#>   delay value delay_lead value_lead     auc
#> 1  0.02  0.87       0.05       0.96 0.02745
#> 2  0.05  0.96       0.06       0.94 0.00950
#> 3  0.06  0.94       0.07       0.21 0.00575
#> 4  0.07  0.21       0.09       0.78 0.00990
#> 5  0.09  0.78       0.10       0.17 0.00475
#> 6  0.10  0.17       0.11       0.02 0.00095

The package also contains functions to compute the exponential discounting model (commonly used in economics) and the hyperbolic-like discounting model (commonly used in behavioral data analysis)

#Set up values for models.  In this example assume that rewards are in dollars and delays are in days
A <- 100 #True amount of reward (in dollars for this example)
b <- 1/10 #Discounting rate parameter
X <- 2 #Delay (in days for his example)
s <- 2 #Non-linear scaling factor

#Exponential model (Standard economic account)
discount_exp(A = A, b = b, X = X)
#> [1] 81.87308

#Hyperbolic-like model (Behavioral model)
discount_hypl(A = A, b = b, X = X, s = s)
#> [1] 69.44444

#Hyperbolic model (Behavioral model, must use s = 1)
discount_hypl(A = A, b = b, X = X, s = 1)
#> [1] 83.33333