-
Notifications
You must be signed in to change notification settings - Fork 0
/
README.Rmd
104 lines (78 loc) · 3.45 KB
/
README.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
---
output: github_document
---
<!-- README.md is generated from README.Rmd. Please edit that file -->
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
```
# discountr
<!-- badges: start -->
<!-- badges: end -->
The goal of discountr is to provide data analysis tools for discounting studies.
## Installation
You can install the development version from [GitHub](https://github.com/) with:
``` r
# 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 .
```{r example}
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
#Get the data frame containing the area under the curve for each trapezoid
head(output_disc$data)
```
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:
```{r}
#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
#Get the data frame containing the area under the curve for each trapezoid
head(output_disc_2$data)
```
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)
```{r}
#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)
#Hyperbolic-like model (Behavioral model)
discount_hypl(A = A, b = b, X = X, s = s)
#Hyperbolic model (Behavioral model, must use s = 1)
discount_hypl(A = A, b = b, X = X, s = 1)
```