Title: | Behavioral Economic Easy Discounting |
---|---|
Description: | Facilitates some of the analyses performed in studies of behavioral economic discounting. The package supports scoring of the 27-Item Monetary Choice Questionnaire (see Kaplan et al., 2016; <doi:10.1007/s40614-016-0070-9>), calculating k values (Mazur's simple hyperbolic and exponential) using nonlinear regression, calculating various Area Under the Curve (AUC) measures, plotting regression curves for both fit-to-group and two-stage approaches, checking for unsystematic discounting (Johnson & Bickel, 2008; <doi:10.1037/1064-1297.16.3.264>) and scoring of the minute discounting task (see Koffarnus & Bickel, 2014; <doi:10.1037/a0035973>) using the Qualtrics 5-trial discounting template (see the Qualtrics Minute Discounting User Guide; <doi:10.13140/RG.2.2.26495.79527>), which is also available as a .qsf file in this package. |
Authors: | Brent A. Kaplan [aut, cre, cph]
|
Maintainer: | Brent A. Kaplan <[email protected]> |
License: | GPL (>= 2) |
Version: | 0.3.2 |
Built: | 2025-03-10 04:34:26 UTC |
Source: | https://github.com/brentkaplan/beezdiscounting |
Converts answers from 5.5 trial delay discounting from Qualtrics template
ans_dd(df)
ans_dd(df)
df |
A dataframe containing all the columns |
A dataframe with the ResponseId, index, and response (ss or ll).
ans_dd(five.fivetrial_dd)
ans_dd(five.fivetrial_dd)
Converts answers from 5.5 trial probability discounting from Qualtrics template
ans_pd(df)
ans_pd(df)
df |
A dataframe containing all the columns |
A dataframe with the ResponseId, index, and response (sc or lu).
ans_pd(five.fivetrial_pd)
ans_pd(five.fivetrial_pd)
This function calculates three types of Area-Under-the-Curve (AUC) metrics for delay discounting data: regular AUC (using raw delays), log10 AUC (using logarithmically scaled delays), and ordinal AUC (using ordinally scaled delays). These metrics provide different perspectives on the rate of delay discounting.
calc_aucs(dat)
calc_aucs(dat)
dat |
A data frame containing delay discounting data. It must include the following columns:
|
A tibble with the following columns:
id
: The participant or group identifier.
auc_regular
: The regular AUC, calculated using the raw delay values.
auc_log10
: The log10 AUC, calculated using logarithmically transformed delay values.
auc_rank
: The rank AUC, calculated using ordinally scaled delay values.
# Example data data <- data.frame( id = rep("P1", 6), x = c(1, 7, 30, 90, 180, 365), y = c(0.8, 0.5, 0.3, 0.2, 0.1, 0.05) ) # Calculate AUC metrics for a single participant calc_aucs(data)
# Example data data <- data.frame( id = rep("P1", 6), x = c(1, 7, 30, 90, 180, 365), y = c(0.8, 0.5, 0.3, 0.2, 0.1, 0.05) ) # Calculate AUC metrics for a single participant calc_aucs(data)
This function computes the lower and upper bounds of the confidence interval for a parameter estimate, given its standard error, a specified significance level, and the degrees of freedom from the model.
calc_conf_int(estimate, std_error, model, alpha = 0.05)
calc_conf_int(estimate, std_error, model, alpha = 0.05)
estimate |
A numeric value representing the parameter estimate. |
std_error |
A numeric value representing the standard error of the parameter estimate. |
model |
A fitted model object that provides the residual degrees of freedom via |
alpha |
A numeric value representing the significance level. Default is 0.05 (95% confidence interval). |
A numeric vector of length two:
First element: Lower bound of the confidence interval.
Second element: Upper bound of the confidence interval.
# Example using a linear model data <- data.frame(x = 1:10, y = c(2.3, 2.1, 3.7, 4.5, 5.1, 6.8, 7.3, 7.9, 9.2, 10.1)) lm_model <- lm(y ~ x, data = data) calc_conf_int(estimate = 0.5, std_error = 0.1, model = lm_model, alpha = 0.05)
# Example using a linear model data <- data.frame(x = 1:10, y = c(2.3, 2.1, 3.7, 4.5, 5.1, 6.8, 7.3, 7.9, 9.2, 10.1)) lm_model <- lm(y ~ x, data = data) calc_conf_int(estimate = 0.5, std_error = 0.1, model = lm_model, alpha = 0.05)
Calculate scores, answers, and timing for 5.5 trial delay discounting from Qualtrics template
calc_dd(df)
calc_dd(df)
df |
A dataframe containing all the columns from the template. |
A dataframe with k/ed50 values, answers, timing
calc_dd(five.fivetrial_dd)
calc_dd(five.fivetrial_dd)
Calculate scores, answers, and timing for 5.5 trial probability discounting from Qualtrics template
calc_pd(df)
calc_pd(df)
df |
A dataframe containing all the columns from the template. |
A dataframe with h/ep50 values, answers, timing
calc_pd(five.fivetrial_pd)
calc_pd(five.fivetrial_pd)
This function calculates the coefficient of determination () for a given model by comparing the sum of squared errors (SSE)
to the total sum of squares (SST).
calc_r2(model)
calc_r2(model)
model |
A fitted model object. The model must have |
A numeric value representing the value of the model. Returns
NA
if the model is NULL
.
# Example using a simple linear model data <- data.frame(x = 1:10, y = c(1, 2, 3, 4, 5, 6, 7, 9, 10, 11)) lm_model <- lm(y ~ x, data = data) calc_r2(lm_model)
# Example using a simple linear model data <- data.frame(x = 1:10, y = c(1, 2, 3, 4, 5, 6, 7, 9, 10, 11)) lm_model <- lm(y ~ x, data = data) calc_r2(lm_model)
This function checks a dataset for violations of two criteria commonly used to identify unsystematic delay-discounting data:
Criterion 1: Any subsequent value of y
exceeds the previous value by more than a specified proportion of the larger later reward (ll
).
Criterion 2: The last value of y
is not at least a specified proportion less than the first value of y
.
check_unsystematic(dat, ll = 1, c1 = 0.2, c2 = 0.1)
check_unsystematic(dat, ll = 1, c1 = 0.2, c2 = 0.1)
dat |
A data frame containing the delay-discounting data. It must have at least two columns:
|
ll |
A numeric value representing the larger later reward. Default is 1. |
c1 |
A numeric value for the threshold proportion for Criterion 1. Default is 0.2. |
c2 |
A numeric value for the threshold proportion for Criterion 2. Default is 0.1. |
A tibble with the following columns:
id
: The unique identifier for the data set.
c1_pass
: Logical value indicating whether Criterion 1 was passed.
c2_pass
: Logical value indicating whether Criterion 2 was passed.
data <- tibble::tibble( id = c(rep("P1", 6)), x = c(1, 7, 30, 90, 180, 365), # delays y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05) # indifference points ) check_unsystematic(data, ll = 1, c1 = 0.2, c2 = 0.1)
data <- tibble::tibble( id = c(rep("P1", 6)), x = c(1, 7, 30, 90, 180, 365), # delays y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05) # indifference points ) check_unsystematic(data, ll = 1, c1 = 0.2, c2 = 0.1)
A dataset containing a set of fake delay discounting responses
dd_ip
dd_ip
A data frame with delay discounting responses
This function fits a delay-discounting model to the given dataset using the specified equation and method.
fit_dd(dat, equation, method)
fit_dd(dat, equation, method)
dat |
A data frame containing delay ( |
equation |
A character string specifying the delay-discounting equation to use. Options include:
|
method |
A character string specifying the method for fitting the model. Options include:
|
A list object of class "fit_dd"
, containing:
The fitted model(s).
The original dataset (dat
).
The specified method (method
).
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit_dd(data, equation = "mazur", method = "two stage")
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit_dd(data, equation = "mazur", method = "two stage")
An example dataset containing four participants' data (two typical discounting patterns and two patterns suggesting potential misattention to the task).
five.fivetrial_dd
five.fivetrial_dd
Example Qualtrics output
An example dataset containing four participants' data.
five.fivetrial_pd
five.fivetrial_pd
Example Qualtrics output
Generate fake MCQ data
generate_data_mcq(n_ids = 100, n_items = 27, seed = 1234, prop_na = 0)
generate_data_mcq(n_ids = 100, n_items = 27, seed = 1234, prop_na = 0)
n_ids |
Number of subjectids |
n_items |
Number of trials |
seed |
Random seed |
prop_na |
Proportion of NAs in the entire data set |
Dataframe of subjectid, questionid, and response
generate_data_mcq(n_ids = 2, n_items = 27, prop_na = .01)
generate_data_mcq(n_ids = 2, n_items = 27, prop_na = .01)
Get internal lookup table for the 27-item MCQ
get_lookup_table()
get_lookup_table()
Dataframe with questionid, magnitude, and kindiff
get_lookup_table()
get_lookup_table()
Calculates item nearest neighbor imputation approach discussed by Yeh et al. (2023)
inn(dat, random, verbose)
inn(dat, random, verbose)
dat |
A single subject's 27-item MCQ data in long form |
random |
Boolean whether to insert a random draw (0 or 1) for NAs |
verbose |
Boolean whether to print subject and question ids pertaining to missing data |
An imputed data set to be scored
Reshape MCQ data long to wide
long_to_wide_mcq(dat, q_col = "questionid", ans_col = "response")
long_to_wide_mcq(dat, q_col = "questionid", ans_col = "response")
dat |
Long format MCQ |
q_col |
Name of the question column (default is "questionid") |
ans_col |
Name of the answer column (defualt is "response") |
Wide format data frame
Reshape MCQ data from long to wide (as used in the 21- and 27-Item Monetary Choice Questionnaire Automated Scorer)
long_to_wide_mcq_excel(dat, subj_col = "subjectid", ans_col = "response")
long_to_wide_mcq_excel(dat, subj_col = "subjectid", ans_col = "response")
dat |
Long format MCQ data |
subj_col |
Character column name of subject ids |
ans_col |
Character column name of responses |
Wide format MCQ data that can be used in the Excel Automated Scorers
long_to_wide_mcq_excel(generate_data_mcq(2))
long_to_wide_mcq_excel(generate_data_mcq(2))
A dataset containing two participants' data (same data as in the paper by Kaplan et al., 2016)
mcq27
mcq27
Long-form data.frame with columns: subjectid, questionid, response.
This function generates a plot of the delay-discounting data and the fitted model.
plot_dd( fit_dd_object, xlabel = "Delay", ylabel = "Indifference Point", title = "", logx = TRUE )
plot_dd( fit_dd_object, xlabel = "Delay", ylabel = "Indifference Point", title = "", logx = TRUE )
fit_dd_object |
A fitted delay-discounting model object of class |
xlabel |
A character string specifying the label for the x-axis. Default is |
ylabel |
A character string specifying the label for the y-axis. Default is |
title |
A character string specifying the plot title. Default is |
logx |
Logical. If |
A ggplot object representing the fitted model and data.
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit <- fit_dd(data, equation = "mazur", method = "mean") plot_dd(fit)
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit <- fit_dd(data, equation = "mazur", method = "mean") plot_dd(fit)
This function creates a plot of the proportion of SIR/SS
choices by k value using the output of the prop_ss
function.
## S3 method for class 'prop_ss_output' plot( x, ..., pt_shape = 21, pt_fill = "white", pt_size = 3, title = "Proportion of SIR/SS choices by k value", xlab = "k value rank", ylab = "Proportion of SS choices" )
## S3 method for class 'prop_ss_output' plot( x, ..., pt_shape = 21, pt_fill = "white", pt_size = 3, title = "Proportion of SIR/SS choices by k value", xlab = "k value rank", ylab = "Proportion of SS choices" )
x |
Output from the |
... |
Additional arguments passed to |
pt_shape |
Shape of the points in the plot. Default is 21. |
pt_fill |
Fill color of the points in the plot. Default is "white". |
pt_size |
Size of the points in the plot. Default is 3. |
title |
Title of the plot. Default is "Proportion of SIR/SS choices by k value". |
xlab |
Label for the x-axis. Default is "k value rank". |
ylab |
Label for the y-axis. Default is "Proportion of SS choices". |
A ggplot object.
plot(prop_ss(mcq27))
plot(prop_ss(mcq27))
This function creates a plot of the MCQ-27 scores for different metrics (small_k, medium_k, large_k, geomean_k, overall_k). The function handles different logarithmic transformations of the k-values and adjusts the y-axis label accordingly.
## S3 method for class 'score_mcq27_output' plot(x, ..., xlab = "Metric", alpha = 0.3)
## S3 method for class 'score_mcq27_output' plot(x, ..., xlab = "Metric", alpha = 0.3)
x |
A data frame returned by the |
... |
Additional arguments passed to methods. |
xlab |
Label for the x-axis. Default is "Metric". |
alpha |
Transparency of the points in the plot. Default is 0.3. |
A ggplot object showing the boxplot of MCQ-27 scores.
plot(score_mcq27(mcq27))
plot(score_mcq27(mcq27))
Calculate proportion of SIR/SS responses at each k value
prop_ss(dat)
prop_ss(dat)
dat |
Dataframe (longform) with subjectid, questionid, and response (0 for SIR/SS and 1 for LDR/LL) |
Dataframe with proportion of SIR/SS responses at each k rank
prop_ss(mcq27)
prop_ss(mcq27)
This function extracts model parameter estimates, fit statistics, and confidence intervals from a fitted delay-discounting model.
results_dd(fit_dd_object)
results_dd(fit_dd_object)
fit_dd_object |
A fitted delay-discounting model object of class |
A tibble containing the following columns:
id
: The participant or group ID (if applicable).
term
: The model parameter (e.g., k
).
estimate
: The estimated value of the parameter.
std.error
: The standard error of the parameter estimate.
statistic
: The t-statistic for the parameter estimate.
p.value
: The p-value for the parameter estimate.
conf_low
: The lower bound of the 95% confidence interval.
conf_high
: The upper bound of the 95% confidence interval.
R2
: The coefficient of determination ().
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit <- fit_dd(data, equation = "mazur", method = "two stage") results_dd(fit)
data <- data.frame( id = rep(1:2, each = 6), x = rep(c(1, 7, 30, 90, 180, 365), 2), y = c(0.9, 0.5, 0.3, 0.2, 0.1, 0.05, 0.85, 0.55, 0.35, 0.15, 0.1, 0.05) ) fit <- fit_dd(data, equation = "mazur", method = "two stage") results_dd(fit)
Score 5.5 trial delay discounting from Qualtrics template
score_dd(df)
score_dd(df)
df |
A dataframe containing all the columns |
Currently assumes the attending questions are present and labeled "Attend-LL" and "Attend-SS"
A dataframe with id, indexes, response, k value, and effective delay 50.
score_dd(five.fivetrial_dd)
score_dd(five.fivetrial_dd)
Score 27-item MCQ
score_mcq27( dat = dat, impute_method = "none", round = 6, random = FALSE, trans = "none", return_data = FALSE, verbose = FALSE )
score_mcq27( dat = dat, impute_method = "none", round = 6, random = FALSE, trans = "none", return_data = FALSE, verbose = FALSE )
dat |
Dataframe (longform) with subjectid, questionid, and response (0 for SIR/SS and 1 for LDR/LL) |
impute_method |
One of: "none", "ggm", "GGM", "inn", "INN" |
round |
Numeric specifying number of decimal places
(passed to |
random |
Boolean whether to insert a random draw (0 or 1) for NAs. Default is FALSE |
trans |
Transformation to apply to k values: "none", "log", or "ln". Default is "none" |
return_data |
Boolean whether to return the original data and new imputed responses. Default is FALSE. |
verbose |
Boolean whether to print subject and question ids pertaining to missing data. Default is FALSE. |
Summary dataframe
score_mcq27(mcq27)
score_mcq27(mcq27)
Score one subject's 27-item MCQ
score_one_mcq27(dat, impute_method = "none", round = 6)
score_one_mcq27(dat, impute_method = "none", round = 6)
dat |
One subject's 27 items from the MCQ |
impute_method |
One of: "none", "ggm", "GGM", "inn", "INN" |
round |
Numeric specifying number of decimal places
(passed to |
Vector with scored 27-item MCQ metrics
beezdiscounting:::score_one_mcq27(mcq27[mcq27$subjectid %in% 1, ])
beezdiscounting:::score_one_mcq27(mcq27[mcq27$subjectid %in% 1, ])
Score 5.5 trial probability discounting from Qualtrics template
score_pd(df)
score_pd(df)
df |
A dataframe containing all the columns |
Currently assumes the attending questions are present and labeled "Attend-LL" and "Attend-SS"
A dataframe with id, indexes, response, h value, and effective probability 50.
score_pd(five.fivetrial_pd)
score_pd(five.fivetrial_pd)
Provide a summary of the results from the MCQ ouutput table.
summarize_mcq(res, na.rm = TRUE)
summarize_mcq(res, na.rm = TRUE)
res |
Dataframe with MCQ results (output from the |
na.rm |
Boolean whether to remove NAs from the calculation |
Dataframe with summary statistics
summarize_mcq(score_mcq27(mcq27))
summarize_mcq(score_mcq27(mcq27))
Extract timing metrics from 5.5 trial delay discounting from Qualtrics template
timing_dd(df)
timing_dd(df)
df |
A dataframe containing all the columns |
Currently assumes the attending questions are present and labeled "Attend-LL" and "Attend-SS"
A dataframe with ResponseId, indexes, values and timing
timing_dd(five.fivetrial_dd)
timing_dd(five.fivetrial_dd)
Extract timing metrics from 5.5 trial probability discounting from Qualtrics template
timing_pd(df)
timing_pd(df)
df |
A dataframe containing all the columns |
Currently assumes the attending questions are present and labeled "Attend-LL" and "Attend-SS"
A dataframe with ResponseId, indexes, values and timing
timing_pd(five.fivetrial_pd)
timing_pd(five.fivetrial_pd)
Reshape MCQ data wide to long
wide_to_long_mcq(dat, items = 27)
wide_to_long_mcq(dat, items = 27)
dat |
Wide format MCQ assuming subject id is in column 1 |
items |
Number of MCQ questions |
Long format data frame
Reshape MCQ data from wide (as used in the 21- and 27-Item Monetary Choice Questionnaire Automated Scorer) to long
wide_to_long_mcq_excel(dat)
wide_to_long_mcq_excel(dat)
dat |
Wide format MCQ data as used in the Excel Automated Scorers |
Long format data frame
wide_to_long_mcq_excel(long_to_wide_mcq_excel(generate_data_mcq(2)))
wide_to_long_mcq_excel(long_to_wide_mcq_excel(generate_data_mcq(2)))