| Title: | Behavioral Economic Easy Demand |
|---|---|
| Description: | Facilitates many of the analyses performed in studies of behavioral economic demand. The package supports commonly-used options for modeling operant demand including (1) data screening proposed by Stein, Koffarnus, Snider, Quisenberry, & Bickel (2015; <doi:10.1037/pha0000020>), (2) fitting models of demand such as linear (Hursh, Raslear, Bauman, & Black, 1989, <doi:10.1007/978-94-009-2470-3_22>), exponential (Hursh & Silberberg, 2008, <doi:10.1037/0033-295X.115.1.186>) and modified exponential (Koffarnus, Franck, Stein, & Bickel, 2015, <doi:10.1037/pha0000045>), and (3) calculating numerous measures relevant to applied behavioral economists (Intensity, Pmax, Omax). Also supports plotting and comparing data. |
| Authors: | Brent Kaplan [aut, cre, cph], Shawn Gilroy [ctb] |
| Maintainer: | Brent Kaplan <[email protected]> |
| License: | GPL-2 | file LICENSE |
| Version: | 0.1.2 |
| Built: | 2025-03-06 05:20:08 UTC |
| Source: | https://github.com/brentkaplan/beezdemand |
Creates annotation layer
annotation_logticks2( base = 10, sides = "bl", scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), colour = "black", size = 0.5, linetype = 1, alpha = 1, data = data.frame(x = NA), color = NULL, ... )annotation_logticks2( base = 10, sides = "bl", scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), colour = "black", size = 0.5, linetype = 1, alpha = 1, data = data.frame(x = NA), color = NULL, ... )
base |
base for drawing in scale |
sides |
sides to draw, by default bottom and left |
scaled |
true by default |
short |
short tick settings |
mid |
mid tick settings |
long |
long tick settings |
colour |
default to black colour |
size |
size for labels |
linetype |
default linetype |
alpha |
default alpha level |
data |
data to include |
color |
colors to include |
... |
additional arguments |
Inherit and extend layer for use in ggplot draw
ggplot2 layer
Shawn Gilroy <[email protected]>
A dataset containing alcohol purchase task data for a small number of participants
aptapt
Long-form data.frame with columns: id, x, y. Participants were asked how many standard sized alcoholic beverages they would buy at various prices.
Changes demand data
ChangeData( dat, nrepl = 1, replnum = 0.01, rem0 = FALSE, remq0e = FALSE, replfree = NULL, xcol = "x", ycol = "y", idcol = "id" )ChangeData( dat, nrepl = 1, replnum = 0.01, rem0 = FALSE, remq0e = FALSE, replfree = NULL, xcol = "x", ycol = "y", idcol = "id" )
dat |
A long form dataframe |
nrepl |
Number of zeros to replace with replacement value (replnum). Can accept either a number or "all" if all zeros should be replaced. Default is to replace the first zero only |
replnum |
Value to replace zeros. Default is .01 |
rem0 |
If TRUE, removes all 0s in consumption data prior to analysis. Default value is FALSE |
remq0e |
If TRUE, removes consumption and price where price == 0. Default value is FALSE |
replfree |
Optionally replaces price == 0 with specified value. |
xcol |
Column name in dataframe that signifies x values (usually price or the IV) |
ycol |
Column name in dataframe that signifies y values (usually consumption or the DV) |
idcol |
Column name in dataframe that signifies identifying id grouping |
Change demand data in various ways. Ways include replacing any number of 0 values with a replacement number (or remove them completely), removing price and consumption at free, replacing free with some number. This will soon replace ReplaceZeros and certain arguments in FitCurves.
Long form dataframe resembling the originally provided dataframe
Brent Kaplan <[email protected]>
## Change just the first instance of 0 within each unique value of id with .1 ChangeData(apt, nrepl = 1, replnum = .1)## Change just the first instance of 0 within each unique value of id with .1 ChangeData(apt, nrepl = 1, replnum = .1)
Checks to ensure column names are specified
CheckCols(dat, xcol, ycol, idcol, groupcol = NULL)CheckCols(dat, xcol, ycol, idcol, groupcol = NULL)
dat |
Dataframe |
xcol |
Name of x column |
ycol |
Name of y column |
idcol |
Name of id column |
groupcol |
Name of group column |
Check column names
Dataframe
Brent Kaplan <[email protected]>
Applies Stein, Koffarnus, Snider, Quisenberry, & Bickel's (2015) criteria for identification of nonsystematic purchase task data.
CheckUnsystematic(dat, deltaq = 0.025, bounce = 0.1, reversals = 0, ncons0 = 2)CheckUnsystematic(dat, deltaq = 0.025, bounce = 0.1, reversals = 0, ncons0 = 2)
dat |
Dataframe in long form. Colums are id, x, y. |
deltaq |
Numeric vector of length equal to one. The criterion by which the relative change in quantity purchased will be compared. Relative changes in quantity purchased below this criterion will be flagged. Default value is 0.025. |
bounce |
Numeric vector of length equal to one. The criterion by which the number of price-to-price increases in consumption that exceed 25% of initial consumption at the lowest price, expressed relative to the total number of price increments, will be compared. The relative number of price-to-price increases above this criterion will be flagged. Default value is 0.10. |
reversals |
Numeric vector of length equal to one. The criterion by which the number of reversals from number of consecutive (see ncons0) 0s will be compared. Number of reversals above this criterion will be flagged. Default value is 0. |
ncons0 |
Numer of consecutive 0s prior to a positive value is used to flag for a reversal. Value can be either 1 (relatively more conservative) or 2 (default; as recommended by Stein et al., (2015). |
This function applies the 3 criteria proposed by Stein et al., (2015) for identification of nonsystematic purchase task data. The three criteria include trend (deltaq), bounce, and reversals from 0. Also reports number of positive consumption values.
Dataframe
Brent Kaplan <[email protected]>
## Using all default values CheckUnsystematic(apt, deltaq = 0.025, bounce = 0.10, reversals = 0, ncons0 = 2) ## Specifying just 1 zero to flag as reversal CheckUnsystematic(apt, deltaq = 0.025, bounce = 0.10, reversals = 0, ncons0 = 1)## Using all default values CheckUnsystematic(apt, deltaq = 0.025, bounce = 0.10, reversals = 0, ncons0 = 2) ## Specifying just 1 zero to flag as reversal CheckUnsystematic(apt, deltaq = 0.025, bounce = 0.10, reversals = 0, ncons0 = 1)
Extra Sum of Squares F-test
ExtraF( dat, equation = "hs", groups = NULL, verbose = FALSE, k, compare = "alpha", idcol = "id", xcol = "x", ycol = "y", groupcol = NULL, start_alpha = 0.001 )ExtraF( dat, equation = "hs", groups = NULL, verbose = FALSE, k, compare = "alpha", idcol = "id", xcol = "x", ycol = "y", groupcol = NULL, start_alpha = 0.001 )
dat |
Long form data frame |
equation |
"hs" |
groups |
NULL for all. Character vector matching groups in groupcol |
verbose |
If TRUE, prints all output including models |
k |
User-defined k value; if missing will attempt to find shared k and then mean emprirical range (in log units) |
compare |
Specify whether to compare alpha or Q0. Default is alpha |
idcol |
The column name that should be treated as dataset identifier |
xcol |
The column name that should be treated as "x" data |
ycol |
The column name that should be treated as "y" data |
groupcol |
The column name that should be treated as the groups |
start_alpha |
Optional numeric to inform starting value for alpha |
One alpha better than individual alphas?
List of results and models
Brent Kaplan <[email protected]>
## Compare two groups using equation by Koffarnus et al., 2015 and a fixed k of 2 apt$group <- NA apt[apt$id %in% sample(unique(apt$id), length(unique(apt$id))/2), "group"] <- "a" apt$group[is.na(apt$group)] <- "b" ExtraF(apt, "koff", k = 2, groupcol = "group")## Compare two groups using equation by Koffarnus et al., 2015 and a fixed k of 2 apt$group <- NA apt[apt$id %in% sample(unique(apt$id), length(unique(apt$id))/2), "group"] <- "a" apt$group[is.na(apt$group)] <- "b" ExtraF(apt, "koff", k = 2, groupcol = "group")
Analyzes purchase task data
FitCurves( dat, equation, k, agg = NULL, detailed = FALSE, xcol = "x", ycol = "y", idcol = "id", groupcol = NULL, lobound, hibound, constrainq0 = NULL, startq0 = NULL, startalpha = NULL )FitCurves( dat, equation, k, agg = NULL, detailed = FALSE, xcol = "x", ycol = "y", idcol = "id", groupcol = NULL, lobound, hibound, constrainq0 = NULL, startq0 = NULL, startalpha = NULL )
dat |
data frame (long form) of purchase task data. |
equation |
Character vector of length one. Accepts either "hs" for Hursh and Silberberg (2008) or "koff" for Koffarnus, Franck, Stein, and Bickel (2015). |
k |
A numeric (or character) vector of length one. Reflects the range of consumption in log10 units. If none provided, k will be calculated based on the max/min of the entire sample + .5. If k = "ind", k will be calculated per individual using max/min + .5. If k = "fit", k will be a free parameter on an individual basis. If k = "range", k will be calculated based on the max/min of the entire sample + .5. |
agg |
Character vector of length one accepts either "Mean" or "Pooled". If not NULL (default), data will be aggregrated appropriately and analyzed in the specified way. |
detailed |
If TRUE, output will be a 3 element list including (1) dataframe of results, (2) list of model objects, (3) list of individual dataframes used in fitting. Default value is FALSE, which returns only the dataframe of results. |
xcol |
The column name that should be treated as "x" data |
ycol |
The column name that should be treated as "y" data |
idcol |
The column name that should be treated as dataset identifier |
groupcol |
The column name that should be treated as the groups |
lobound |
Optional. A named vector of length 2 ("q0", "alpha") or 3 ("q0", "k", "alpha"), the latter length if k = "fit", specifying the lower bounds. |
hibound |
Optional. A named vector of length 2 ("q0", "alpha") or 3 ("q0", "k", "alpha"), the latter length if k = "fit", specifying the upper bounds. |
constrainq0 |
Optional. A number that will be used to constrain Q0 in the fitting process. Currently experimental and only works with a fixed k value. |
startq0 |
Optional. A number that will be used to start Q0 in the fitting process. Currently experimental. |
startalpha |
Optional. A number that will be used to start Alpha in the fitting process. Currently experimental. |
If detailed == FALSE (default), a dataframe of results. If detailed == TRUE, a 3 element list consisting of (1) dataframe of results, (2) list of model objects, (3) list of individual dataframes used in fitting
Brent Kaplan <[email protected]> Shawn Gilroy <[email protected]>
## Analyze using Hursh & Silberberg, 2008 equation with a k fixed to 2 FitCurves(apt[sample(apt$id, 5), ], "hs", k = 2)## Analyze using Hursh & Silberberg, 2008 equation with a k fixed to 2 FitCurves(apt[sample(apt$id, 5), ], "hs", k = 2)
Fits curve to pooled data
FitMeanCurves( dat, equation, k, remq0e = FALSE, replfree = NULL, rem0 = FALSE, nrepl = NULL, replnum = NULL, plotcurves = FALSE, method = NULL, indpoints = TRUE, vartext = NULL )FitMeanCurves( dat, equation, k, remq0e = FALSE, replfree = NULL, rem0 = FALSE, nrepl = NULL, replnum = NULL, plotcurves = FALSE, method = NULL, indpoints = TRUE, vartext = NULL )
dat |
data frame (long form) of purchase task data. |
equation |
Character vector of length one. Accepts either "hs" for Hursh and Silberberg (2008) or "koff" for Koffarnus, Franck, Stein, and Bickel (2015). |
k |
A numeric vector of length one. Reflects the range of consumption in log10 units. If none provided, k will be calculated based on the max/min of the entire sample. If k = "fit", k will be a free parameter |
remq0e |
If TRUE, removes consumption and price where price == 0. Default value is FALSE |
replfree |
Optionally replaces price == 0 with specified value. Note, if fitting using equation == "hs", and 0 is first price, 0 gets replaced by replfree. Default value is .01 |
rem0 |
If TRUE, removes all 0s in consumption data prior to analysis. Default value is FALSE. |
nrepl |
Number of zeros to replace with replacement value (replnum). Can accept either a number or "all" if all zeros should be replaced. Default is to replace the first zero only. |
replnum |
Value to replace zeros. Default is .01 |
plotcurves |
Boolean whether to create plot. If TRUE, a "plots/" directory is created one level above working directory. Default is FALSE. |
method |
Character string of length 1. Accepts "Mean" to fit to mean data or "Pooled" to fit to pooled data |
indpoints |
Boolean whether to plot individual points in gray. Default is TRUE. |
vartext |
Character vector specifying indices to report on plots. Valid indices include "Q0d", "Alpha", "Q0e", "EV", "Pmaxe", "Omaxe", "Pmaxd", "Omaxd", "K", "Q0se", "Alphase", "R2", "AbsSS" |
Data frame
Brent Kaplan <[email protected]>
## Fit aggregated data (mean only) using Hursh & Silberberg, 2008 equation with a k fixed at 2 FitMeanCurves(apt[sample(apt$id, 5), ], "hs", k = 2, method = "Mean")## Fit aggregated data (mean only) using Hursh & Silberberg, 2008 equation with a k fixed at 2 FitMeanCurves(apt[sample(apt$id, 5), ], "hs", k = 2, method = "Mean")
...
GetAnalyticPmax(Alpha, K, Q0)GetAnalyticPmax(Alpha, K, Q0)
Alpha |
alpha parameter |
K |
k parameter ( > lower limit ) |
Q0 |
Q0 |
...
Numeric
Shawn Gilroy <[email protected]>
Fallback method for Analytic Pmax
GetAnalyticPmaxFallback(K_, A_, Q0_)GetAnalyticPmaxFallback(K_, A_, Q0_)
K_ |
k parameter |
A_ |
alpha parameter |
Q0_ |
q0 parameter |
Derivative-based optimization strategy
numeric
Shawn Gilroy <[email protected]>
Calculates descriptive statistics from purchase task data.
GetDescriptives( dat, bwplot = FALSE, outdir = "../plots/", device = "png", filename = "bwplot" )GetDescriptives( dat, bwplot = FALSE, outdir = "../plots/", device = "png", filename = "bwplot" )
dat |
Dataframe (long form) |
bwplot |
Boolean. If TRUE, a ggplot2 box and whisker plot is saved. Default is FALSE. |
outdir |
Character. Directory where plot will be saved. Be sure to include trailing '/'. Default location is one level up in "../plots/". |
device |
Character. Type of file. Default is "png". Can be "pdf". |
filename |
Character. Specify filename. Defualt is "bwplot". |
Provides the following descriptive statistics from purchase task data at each price: mean consumption, median consumption, standard deviation of consumption, proportion of 0 values, number of NAs, minimum consumption, and maximum consumption.
Dataframe with descriptive statistics
Brent Kaplan <[email protected]>
GetDescriptives(apt)GetDescriptives(apt)
Calculates empirical measures for purchase task data
GetEmpirical(dat, xcol = "x", ycol = "y", idcol = "id")GetEmpirical(dat, xcol = "x", ycol = "y", idcol = "id")
dat |
data frame (long form) of purchase task data. |
xcol |
The column name that should be treated as "x" data |
ycol |
The column name that should be treated as "y" data |
idcol |
The column name that should be treated as dataset identifier |
Will calculate and return the following empirical measures: Intensity, BP0, BP1, Omax, and Pmax
Data frame of empirical measures
Brent Kaplan <[email protected]>
## Obtain empirical measures GetEmpirical(apt)## Obtain empirical measures GetEmpirical(apt)
Calculates a k value by looking for the max/min consumption across entire dataset and adds .5 to that range
GetK(dat, mnrange = TRUE)GetK(dat, mnrange = TRUE)
dat |
Dataframe (long form) |
mnrange |
Boolean for whether k should be calculated based on the mean range + .5 |
Will look for maximum/minimum greater zero
Numeric
Brent Kaplan <[email protected]>
GetK(apt)GetK(apt)
Gets values used in SimulateDemand
GetValsForSim(dat)GetValsForSim(dat)
dat |
Dataframe (long form) |
Gets values used in SimulateDemand
List of 3: setaparams, sdindex, x
Brent Kaplan <[email protected]>
GetValsForSim(apt)GetValsForSim(apt)
Ben Bolker's port of Lambert W from GNU Scientific Library (GPLV3)
lambertW(z, b = 0, maxiter = 10, eps = .Machine$double.eps, min.imag = 1e-09)lambertW(z, b = 0, maxiter = 10, eps = .Machine$double.eps, min.imag = 1e-09)
z |
input value |
b |
branch, set to principal by default |
maxiter |
Halley iteration count |
eps |
error precision |
min.imag |
minimum for imaginary solution |
Ben Bolker's port of Lambert W from GNU Scientific Library
numeric
Benjamin Bolker (port)
Creates a single plot object
PlotCurve(adf, dfrow, newdats, yscale = "log")PlotCurve(adf, dfrow, newdats, yscale = "log")
adf |
Data frame (long form) of purchase task data. |
dfrow |
A row of results from FitCurves |
newdats |
A newdat dataframe from FitCurves |
yscale |
Scaling of y axis. Default is "log". Can also take "linear" |
Creates individual demand curves
ggplot2 graphical object
Shawn Gilroy <[email protected]>
## Creates a single plot from elements of an object created by FitCurves fc <- FitCurves(apt, "hs", k = 2, detailed = TRUE) PlotCurve(fc$adfs[[1]], fc$dfres[1, ], fc$newdats[[1]])## Creates a single plot from elements of an object created by FitCurves fc <- FitCurves(apt, "hs", k = 2, detailed = TRUE) PlotCurve(fc$adfs[[1]], fc$dfres[1, ], fc$newdats[[1]])
Creates plots
PlotCurves(dat, outdir = NULL, device = "png", ending = NULL, ask = T, ...)PlotCurves(dat, outdir = NULL, device = "png", ending = NULL, ask = T, ...)
dat |
FitCurves object with 4 elements (dfres, newdats, adfs, fits) |
outdir |
Directory where plots are saved |
device |
Type of file. Default is "png". Can be "pdf" |
ending |
Optional. Can specify to only plot through a certain number of datasets |
ask |
Can view plots one by one. If TRUE, plots will not save |
... |
Pass arguments to PlotCurve (for example yscale = c("log", "linear")) |
Creates and saves plots of individual demand curves
Nothing
Brent Kaplan <[email protected]>, Shawn Gilroy <[email protected]>
## Interactively view plots from output from FitCurves fc <- FitCurves(apt, "hs", k = 2, detailed = TRUE) PlotCurves(fc, ask = TRUE)## Interactively view plots from output from FitCurves fc <- FitCurves(apt, "hs", k = 2, detailed = TRUE) PlotCurves(fc, ask = TRUE)
Pull vector from data frame
pull(x, y)pull(x, y)
x |
A data frame |
y |
Name of column |
Pulls a single vector from a data frame. Good to use with dplyr. From http://stackoverflow.com/questions/21618423/extract-a-dplyr-tbl-column-as-a-vector
Vector
Brent Kaplan <[email protected]>
Recodes outliers
RecodeOutliers(df, outval = 3.29, unitshigher = 0)RecodeOutliers(df, outval = 3.29, unitshigher = 0)
df |
A dataframe of consumption values |
outval |
Values greater/less than or equal to this number (specified in standard deviations) will be recoded. Default is 3.29SD as specified by Tabachnick and Fidell (2013) |
unitshigher |
Outliers identified by outval will be coded to a certain number of units higher/lower than the greatest nonoutlier value. Default is 0 units. |
Recodes outliers using Tabachnick and Fidell's (2013) criteria. A variable is standardized and values that are greater/less than or equal to a specified outlier value (specified in standard deviations; default 3.29SD) are recoded to a certain number of units (default 0) higher/lower than the greatest nonoutlier value. Disregards 'NA' values.
Invisibly, a dataframe with original and recoded (if any) values
Brent Kaplan <[email protected]>
## If any outliers are detected, they would be coded as 1 unit higher emp <- GetEmpirical(apt) RecodeOutliers(emp[, c(2:6)], unitshigher = 1)## If any outliers are detected, they would be coded as 1 unit higher emp <- GetEmpirical(apt) RecodeOutliers(emp[, c(2:6)], unitshigher = 1)
Replaces 0 values
ReplaceZeros(dat, nrepl = 1, replnum = 0.01)ReplaceZeros(dat, nrepl = 1, replnum = 0.01)
dat |
Dataframe (long form) |
nrepl |
Number of zeros to replace with replacement value (replnum). Can accept either a number or "all" if all zeros should be replaced. Default is to replace the first zero only. |
replnum |
Value to replace zeros. Default is .01 |
Replaces specified number of 0s with replacement value.
Dataframe (long form)
Brent Kaplan <[email protected]>
## Replace all zeros with .01 ReplaceZeros(apt, nrepl = "all", replnum = .01)## Replace all zeros with .01 ReplaceZeros(apt, nrepl = "all", replnum = .01)
Simulate demand data
SimulateDemand(nruns = 10, setparams, sdindex, x, outdir = NULL, fn = NULL)SimulateDemand(nruns = 10, setparams, sdindex, x, outdir = NULL, fn = NULL)
nruns |
Number of runs. Default value is 10 |
setparams |
A 6x1 matrix (or 6 element vector) containing (in order) mean log10alpha, sd log10alpha, mean log10q0, sd log10q0, k, sd of consumption values across all prices |
sdindex |
A vector of n length of sd consumption values for n prices |
x |
A vector of n prices |
outdir |
Optional. Directory to save results. Must end with a "/" |
fn |
Optional. Filename of saved RData object |
Generates and saves simulated datasets in the manner specified in Koffarnus, Franck, Stein, & Bickel (2015).
Invisibly a list consisting of: rounded consumption values, unrounded consumption values, simulation parameters, and inState and outState of seeds.
Brent Kaplan <[email protected]>
## set values setparams <- vector(length = 4) setparams <- c(-2.5547, .702521, 1.239893, .320221, 3.096, 1.438231) names(setparams) <- c("alphalm", "alphalsd", "q0lm", "q0lsd", "k", "yvalssd") sdindex <- c(2.1978, 1.9243, 1.5804, 1.2465, 0.8104, 0.1751, 0.0380, 0.0270) x <- c(.1, 1, 3, 10, 30, 100, 300, 1000) set.seed(1234) sim <- SimulateDemand(nruns = 1, setparams = setparams, sdindex = sdindex, x = x) sim## set values setparams <- vector(length = 4) setparams <- c(-2.5547, .702521, 1.239893, .320221, 3.096, 1.438231) names(setparams) <- c("alphalm", "alphalsd", "q0lm", "q0lsd", "k", "yvalssd") sdindex <- c(2.1978, 1.9243, 1.5804, 1.2465, 0.8104, 0.1751, 0.0380, 0.0270) x <- c(.1, 1, 3, 10, 30, 100, 300, 1000) set.seed(1234) sim <- SimulateDemand(nruns = 1, setparams = setparams, sdindex = sdindex, x = x) sim
APA theme for ggplot
theme_apa(plot.box = FALSE)theme_apa(plot.box = FALSE)
plot.box |
Boolean for a box around the plot |
Theme for ggplot graphics that closely align with APA formatting
ggplot theme
Brent Kaplan <[email protected]>
p <- ggplot2::ggplot(apt, ggplot2::aes(x = x, y = y)) + ggplot2::geom_point() p + theme_apa()p <- ggplot2::ggplot(apt, ggplot2::aes(x = x, y = y)) + ggplot2::geom_point() p + theme_apa()