tests/testthat/test_fooddmnd.R

In JGCRI/ambrosia: An R package for calculating and analyzing food demand that is responsive to changing incomes and prices

context('Test food demand model outputs')
library(dplyr)

test_that('Food demand model runs and produces the expected result with old parameters from Edmonds et al.', {
    ps <- 0.1
    pn <- 0.5
    y <- seq(0.1, 10, 0.1)
    samp.params <- vec2param(c(1.28,1.14,-0.19,0.21,-0.33,0.5,0.1,16,5.06,100,20))
    expect_silent(rslt <- food.dmnd(ps, pn, y, samp.params))
    expect_equal_to_reference(rslt, 'food_demand_result.rds', update=FALSE)
})


test_that('New food demand budget shares are not unreasonable', {
    parameter_data <- read.csv("test_outputs/parameter_data.csv")
    params <- vec2param(c(parameter_data$params_vector.par))
    ps <- 0.1
    pn <- 0.2
    y <- seq(0.1, 10, 0.1)
    expect_silent(rslt <- food.dmnd(ps, pn, y, params))

    rslt %>% dplyr:::mutate(alpha.t = alpha.s+alpha.n) %>%
                    filter(alpha.t >0.9)->tmp

    as.numeric(nrow(tmp))->e_rows

    expect(e_rows==0,"Budget shares generated by the food demand model are higher than 90 percent at some income levels.")
})

test_that('Income elasticities calculated are valid',{

    #First get parameters
    samp.params <- vec2param(c(1.28,1.14,-0.19,0.21,-0.33,0.5,0.1,16,5.06,100,20))

    #Get new demand
    ps <- 0.1
    pn <- 0.5
    y <- seq(0.1, 10, 0.1)


    #Calculate income elasticities on demand
    expect_silent(eta.s <- samp.params$yfunc[[1]](Y=y,FALSE))
    expect_silent(eta.n <- samp.params$yfunc[[2]](Y=y,FALSE))

    #Calculate Y terms
    expect_silent(eta.s <- samp.params$yfunc[[1]](Y=y,TRUE))
    expect_silent(eta.n <- samp.params$yfunc[[2]](Y=y,TRUE))

})

test_that('Price elasticities calculated are valid',{

    #First get parameters
    samp.params <- vec2param(c(1.28,1.14,-0.19,0.21,-0.33,0.5,0.1,16,5.06,100,20))

    #Get new demand
    ps <- 0.1
    pn <- 0.5
    y <- seq(0.1, 10, 0.1)
    rslt <- food.dmnd(ps,pn,y,samp.params)

    #Calculate income elasticities on demand
    expect_silent(eta.s <- samp.params$yfunc[[1]](Y=y,FALSE))
    expect_silent(eta.n <- samp.params$yfunc[[2]](Y=y,FALSE))

    #Calculate new price elasticities
    expect_silent(epsilon_matrix_new <- calc1eps(rslt$alpha.s,rslt$alpha.n,eta.s,eta.n,samp.params$xi))

    #Calculate old price elasticities
    Old_Demand <- readRDS("food_demand_result.rds")

    #Calculate  price elasticities
    expect_silent(epsilon_matrix_old <- calc1eps(Old_Demand$alpha.s,Old_Demand$alpha.n,eta.s,eta.n,samp.params$xi))

    expect_equal(epsilon_matrix_old,epsilon_matrix_new,tolerance=0.001,info=paste("New price elasticities are not equal to old price elasticities."))
})

test_that("Actual elasticities calculated are valid ",{

    ps <- 0.1
    pn <- 0.5
    y <- seq(0.1, 10, 0.1)
    samp.params <- vec2param(c(1.28,1.14,-0.19,0.21,-0.33,0.5,0.1,16,5.06,100,20))

    expect_silent(tmp <- calc.elas.actual(ps,pn,y,params = samp.params ))

    columns <- colnames(tmp)

    for (i in columns){
        tmpna <- tmp[is.na(toString(i)),]
        expect((nrow(tmpna))==0,"There are NA values in actual elasticity values calculated.")
    }


})

test_that("Food demand by year is reasonable compared to observations",{

    parameter_data <- read.csv("test_outputs/parameter_data.csv")
    params <- vec2param(c(parameter_data$params_vector.par))

    raw_data <- read.csv("test_outputs/Training_Data.csv") %>% filter(year %in% (2013:2015))

    (food_demand <- food.dmnd.byyear(raw_data,params = params))

    food_demand %>%  group_by(year) %>% mutate(Qs_ratio = mean(Qs/Qs.Obs), Qn_ratio= mean(Qn/Qn.Obs)) %>% ungroup()->food_demand

    food_demand$rgn <- raw_data$iso
    food_demand$income <- raw_data$gdp_pcap_thous/1000

    tmpna <- food_demand %>%
             filter(Qs_ratio>1.5  | Qn_ratio>1.5)


   expect(nrow(tmpna)==0,"The estimated values are unreasonably higher than actual values by a ratio higher than 1.5 globally for a single year. ")

})

test_that("Constant elasticities returned are valid ",{

    expect_silent(elas_func <- eta.constant(0.39))

    expect_equal(elas_func(Y=10),elas_func(Y=20),tolerance=0.01,info=("Constant elasticities functions are valid for non-staples"))

    expect_equal(elas_func(Y=10,calcQ = TRUE),elas_func(Y=11,calcQ=TRUE),tolerance=0.05,info=(" Y terms returned by constant elasticities functions are valid for non-staples"))

    expect_silent(staples_elasticity <- eta.s(0.39,9.7))
    expect_silent(staples_elasticity <- eta.s(0.39,9.7,mc.mode = TRUE))

    expect_equal(staples_elasticity(Y=10),staples_elasticity(Y=11),tolerance=0.01,info=("Constant elasticities functions are valid for staples"))

    expect_equal(staples_elasticity(Y=10,calcQ = TRUE),staples_elasticity(Y=12,calcQ=TRUE),tolerance=0.05,info=(" Y terms returned by constant elasticities functions are valid for staples"))



})