add tests and documentation for TAX

README.md

@@ -1,6 +1,21 @@
 # UtilityModels
 
-UtilityModels.jl is a collection of utility based decision models. Currently, expected utlity theory and prospect theory are the only models in the collection, but more will be added in the future. 
+UtilityModels.jl is a collection of utility based decision models. Currently, expected utlity theory transfer of attention exchange, and prospect theory are implemented. More models soon to follow. 
+
+# Installation
+
+In the REPL, enter `]` to activate package mode, then type
+
+````julia 
+add UtilityModels
+````
+# Help
+
+In the REPL, enter `?` to activate help mode, then type the name of the function or object, such as:
+
+````julia
+TAX
+```
 
 # Examples
 
@@ -28,6 +43,27 @@ std(model, gamble)
 3.38863
 ````
 
+## Transfer of Attention Exchange
+
+````julia
+using UtilityModels
+# TAX with default values
+model = TAX()
+p = [.25,.25,.50]
+v = [100.0,0.0,-50.0]
+gamble = Gamble(;p, v)
+````
+### Expected Utility
+
+````julia
+eu = mean(model, gamble)
+````
+
+*References*
+
+1. Birnbaum, M. H., & Chavez, A. (1997). Tests of theories of decision making: Violations of branch independence and distribution independence. Organizational Behavior and human decision Processes, 71(2), 161-194.
+2. Birnbaum, M. H. (2008). New paradoxes of risky decision making. Psychological review, 115(2), 463.
+
 ## Prospect Theory
 ````julia
 using UtilityModels
@@ -50,5 +86,11 @@ mean(model, gamble)
 
 ````julia
 std(model, gamble)
-3.50402
+3.7516
 ````
+
+*References*
+
+1. Fennema, H., & Wakker, P. (1997). Original and cumulative prospect theory: A discussion of empirical differences. Journal of Behavioral Decision Making, 10(1), 53-64.
+
+2. Tversky, A., & Kahneman, D. (1992). Advances in prospect theory: Cumulative representation of uncertainty. Journal of Risk and uncertainty, 5(4), 297-323.

src/ProspectTheory.jl

@@ -53,36 +53,6 @@ function compute_utility(model::ProspectTheory, gamble)
     return [utill; utilg]
 end
 
-function sort!(model::ProspectTheory, gamble)
-    @unpack p,v = gamble
-    i = sortperm(v)
-    p .= p[i]; v .= v[i]
-    gains = v .>= 0
-    pg = @view p[gains]
-    pl = @view p[.!gains]
-    vg = @view v[gains] 
-    vl = @view v[.!gains]
-    reverse!(vl); reverse!(pl)
-    return nothing
-end
-
-function split_values(gamble)
-    @unpack v = gamble
-    gains = v .>= 0
-    vg = @view v[gains] 
-    vl = @view v[.!gains]
-    return vl,vg
-end
-
-function split_probs(gamble)
-    @unpack v,p = gamble
-    gains = v .>= 0
-    pg = @view p[gains] 
-    pl = @view p[.!gains]
-    return pl,pg
-end
-
-
 """
 *compute_weights*
 
@@ -124,4 +94,31 @@ function _compute_weights(p, γ)
     return ω
 end
 
-weight(p, γ) = (p^γ)/(p^γ + (1-p)^γ)^(1/γ)
+weight(p, γ) = (p^γ)/(p^γ + (1-p)^γ)^(1/γ)
+
+function sort!(model::ProspectTheory, gamble)
+    @unpack p,v = gamble
+    i = sortperm(v)
+    p .= p[i]; v .= v[i]
+    gains = v .>= 0
+    pl = @view p[.!gains]
+    vl = @view v[.!gains]
+    reverse!(vl); reverse!(pl)
+    return nothing
+end
+
+function split_values(gamble)
+    @unpack v = gamble
+    gains = v .>= 0
+    vg = @view v[gains] 
+    vl = @view v[.!gains]
+    return vl,vg
+end
+
+function split_probs(gamble)
+    @unpack v,p = gamble
+    gains = v .>= 0
+    pg = @view p[gains] 
+    pl = @view p[.!gains]
+    return pl,pg
+end

src/TAX.jl

@@ -0,0 +1,100 @@
+"""
+*TAX*
+
+`TAX` constructs a model object for transfer of attention exchange.
+
+- `δ`: transfer of attention parameter
+- `γ`: probability weighting parameter
+- `β`: utility curvature
+
+Constructor
+````julia
+TAX(;δ=.80, β=.3, γ=.70)
+````
+*References*
+
+Birnbaum, M. H., & Chavez, A. (1997). Tests of theories of decision making: Violations of branch independence and distribution independence. Organizational Behavior and human decision Processes, 71(2), 161-194.
+Birnbaum, M. H. (2008). New paradoxes of risky decision making. Psychological review, 115(2), 463.
+
+"""
+mutable struct TAX{T1,T2,T3} <:UtilityModel
+    δ::T1
+    γ::T2
+    β::T3
+end
+
+function TAX(;δ=-1.0, β=1.0, γ=.70)
+    return TAX(δ, γ, β)
+end
+
+"""
+*compute_utility*
+
+`compute_utility` computes utility of gamble outcomes according to TAX
+
+- `model`: a model object for TAX
+- `gamble`: a gamble object
+
+Function Signature
+````julia
+compute_utility(model::TAX, gamble::Gamble)
+````
+"""
+function compute_utility(model::TAX, gamble)
+    @unpack β = model
+    @unpack v = gamble
+    utility = @. sign(v)*abs(v)^β 
+    return utility
+end
+
+tax_weight(p, γ) = (p^γ)
+
+function ω(p, pk, n, δ, γ)
+    if δ > 0
+        return δ*tax_weight(pk, γ)/(n+1)
+    end
+    return δ*tax_weight(p, γ)/(n+1)
+end
+
+function sort!(model::TAX, gamble)
+    @unpack p,v = gamble
+    i = sortperm(v)
+    p .= p[i]; v .= v[i]
+    return nothing
+end
+
+"""
+*mean*
+
+`mean` a method for computing the mean for the TAX model
+
+- `model`: a model M <: UtilityModel
+- `gamble`: a gamble object
+
+Function Signature
+````julia
+mean(model::TAX, gamble::Gamble)
+````
+"""
+function mean(model::TAX, gamble::Gamble)
+    @unpack p,v = gamble
+    @unpack γ,δ = model
+    n = length(p)
+    sort!(model, gamble)
+    utility = compute_utility(model, gamble)
+    eu = 0.0
+    sum_weight = 0.0
+    for i in 1:n
+        eu += tax_weight(p[i], γ)*utility[i]
+        sum_weight += tax_weight(p[i], γ)
+        for k in 1:(i-1)
+            eu += (utility[i] - utility[k])*ω(p[i], p[k], n, δ, γ)
+        end
+    end
+    return eu/sum_weight
+end
+
+function var(model::TAX, gamble::Gamble)
+    error("var not implimented for TAX")
+    return -100.0
+end

src/UtilityModels.jl

@@ -1,12 +1,13 @@
 module UtilityModels
     using Parameters, Distributions
     import Distributions: mean, var, std
-    export ProspectTheory, ExpectedUtility, Gamble
+    export UtilityModel, TAX, ProspectTheory, ExpectedUtility, Gamble
     export mean, var , std
     abstract type UtilityModel end
 
     include("Gamble.jl")
     include("UtilityModel.jl")
     include("ProspectTheory.jl")
     include("ExpectedUtility.jl")
+    include("TAX.jl")
 end

test/runtests.jl

@@ -25,9 +25,45 @@ using SafeTestsets
     @test ω ≈ [0.1811,0.4962,0.0848,0.2415] atol = 1e-4
 end
 
+@safetestset "TAX" begin
+    # tested against http://psych.fullerton.edu/mbirnbaum/calculators/taxcalculator.htm
+    # using gambles from Birnbaum 2008
+    using Test, UtilityModels
+
+    model = TAX()
+    p = [.25,.25,.50]
+    v = [100.0,0.0,-50.0]
+    gamble = Gamble(;p, v)
+    eu = mean(model, gamble)
+    @test eu ≈ -15.5125 atol = 1e-4
+
+    model = TAX()
+    p = [.80,.10,.10]
+    v = [110.0,44.0,40.0]
+    gamble = Gamble(;p, v)
+    eu = mean(model, gamble)
+    @test eu ≈ 65.02513599372996 atol = 1e-8
+
+    model = TAX()
+    p = [.05,.05,.90]
+    v = [96.0,12.0,3.0]
+    gamble = Gamble(;p, v)
+    eu = mean(model, gamble)
+    @test eu ≈ 8.803653482548164 atol = 1e-8
+
+    using Test, UtilityModels
+    δ = 1.0; β = .9; γ = .70
+    model = TAX(;δ, β, γ)
+    p = [.05,.05,.90]
+    v = [96.0,12.0,3.0]
+    gamble = Gamble(;p, v)
+    eu = mean(model, gamble)
+    # calculator uses certainty equivalent
+    @test (eu)^(1/β) ≈ 33.567163255247856 atol = 1e-8
+end
+
 @safetestset "ExpectedUtility" begin
     using Test, UtilityModels
-    import UtilityModels: compute_weights
     α = 1.0
     model = ExpectedUtility(α)
     p = [.3,.2,.3,.2]