tests/testthat/test_interp_lc_lim.R
In timriffe/DemoTools: Standardize, Evaluate, and Adjust Demographic Data
# tests against spreadsheet "Li_2018_Limited_Lee-Carter-v4.xlsm" -------------------------------------------------------------
context("test-interp_lc_lim")
# summary
# A to E tests againts spreadsheet
# F testing args from main fun
# G mixing input: single/abr with output single/abr, and mixing input nMx and lx
# H passing lt arguments
# I text/messages/warnings
# tolerance: .05% difference in e_0
tolerance_admited <- .005
# data included in spredsheet -------------------------------------------------------------
Age <- c(0,1,seq(5,100,5))
dates_in <- c(1980.671, 1991.668, 1996.586, 2000.586, 2010.71)
input <- data.frame(Date= c(rep(sort(rep(dates_in, length(Age))),2)),
Age = rep(Age, 2 * length(dates_in)),
Sex = c(rep("m", length(Age) * length(dates_in)),
rep("f", length(Age) * length(dates_in))),
nMx = c(0.058872, 0.002992, 0.000697, 0.000703, 0.001424, # males
0.002102, 0.002519, 0.003109, 0.004072, 0.005968, 0.00739, 0.010927,
0.013366, 0.018798, 0.028653, 0.037304, 0.052714, 0.059629, 0.070922,
0.093256, 0.135563, 0.217859, 0.030825, 0.001351, 0.000517, 0.000528,
0.001434, 0.002436, 0.002954, 0.003341, 0.003971, 0.004966, 0.006267,
0.009662, 0.012983, 0.019135, 0.024503, 0.032664, 0.047827, 0.057952,
0.073104, 0.099948, 0.148105, 0.237862, 0.026198, 0.001109, 0.000457,
0.000555, 0.001571, 0.002404, 0.003012, 0.003674, 0.004129, 0.005016,
0.006223, 0.008328, 0.012217, 0.017762, 0.025149, 0.032561, 0.042365,
0.057642, 0.080202, 0.116701, 0.177582, 0.282593, 0.018484, 0.000883,
0.000382, 0.000455, 0.001646, 0.002304, 0.002467, 0.003097, 0.003724,
0.004507, 0.005908, 0.00794, 0.010738, 0.016865, 0.022493, 0.032624,
0.040211, 0.051478, 0.068234, 0.09696, 0.147703, 0.241212, 0.01295,
0.00063, 0.000332, 0.000433, 0.001641, 0.002581, 0.002578, 0.002547,
0.00289, 0.004012, 0.005381, 0.007316, 0.009889, 0.013273, 0.018334,
0.028212, 0.03749, 0.052073, 0.073922, 0.109615, 0.169785, 0.274699,
0.045269, 0.002704, 0.000507, 0.00046, 0.000734, # females
0.000895, 0.001126, 0.001495, 0.002197, 0.003143, 0.003983, 0.005939,
0.007469, 0.01166, 0.018486, 0.026548, 0.042649, 0.050858, 0.063509,
0.086965, 0.130587, 0.215029, 0.023838, 0.001154, 0.000358, 0.000318,
0.000502, 0.000698, 0.000918, 0.001144, 0.001572, 0.002207, 0.003151,
0.005038, 0.007183, 0.011023, 0.014718, 0.022267, 0.035953, 0.048153,
0.066424, 0.097196, 0.150869, 0.248412, 0.020248, 0.000933, 0.00031,
0.000339, 0.000525, 0.000652, 0.000901, 0.001251, 0.001599, 0.00223,
0.00313, 0.004514, 0.007125, 0.01058, 0.015764, 0.021294, 0.032344,
0.049166, 0.07543, 0.117877, 0.18764, 0.304247, 0.014603, 0.000768,
0.000271, 0.000287, 0.000487, 0.000565, 0.000715, 0.001059, 0.001481,
0.002049, 0.002936, 0.004201, 0.006039, 0.009984, 0.013853, 0.021179,
0.02809, 0.042159, 0.064247, 0.100939, 0.163497, 0.273028, 0.010488,
0.000521, 0.00025, 0.00029, 0.000453, 0.000581, 0.000725, 0.000901,
0.001171, 0.001816, 0.002734, 0.003782, 0.005293, 0.007575, 0.011174,
0.018559, 0.026524, 0.041711, 0.066135, 0.106604, 0.174691, 0.291021)
)
# A to E tests againts spreadsheet -------------------------------------------------------------
# utils
. <- NULL
e_dagger <- function(lx){-sum(lx/lx[1]*log(lx/lx[1]))}
e_dagger_list <- function(y){
y %>%
split(list(y$Sex, y$Date)) %>%
lapply(FUN = function(X) {
e_dagger(X$lx)}) %>%
do.call("rbind", .)
}
# A - test with input nMx, allowing cross-over, and NOT reproducing e0 at given years
outputA <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83150,80337,79837,79431,78942,78185,77029,75385,73199,70275,67106,62278,56789,49566,40140,32042,22605,15933,10927,6875,3588,
100000,84678,81152,80771,80499,80075,79548,78850,77919,76488,74641,72644,69464,65742,60130,51912,43443,30927,22427,16100,10816,6196,
100000,86377,84053,83588,83196,82669,81857,80661,79004,76832,73942,70757,65968,60442,53142,43642,35132,25249,17958,12328,7704,3957,
100000,87704,84885,84531,84268,83857,83346,82671,81771,80408,78627,76647,73528,69806,64206,56054,47360,34637,25405,18223,12098,6756,
100000,89036,87134,86706,86329,85768,84906,83679,82023,79886,77057,73887,69183,63676,56374,46904,38065,27842,19978,13727,8521,4306,
100000,90178,87943,87617,87366,86972,86481,85835,84974,83687,81988,80045,77016,73334,67806,59811,50993,38231,28353,20321,13326,7247,
100000,91237,89690,89298,88939,88346,87436,86188,84545,82456,79707,76577,71991,66545,59302,49945,40851,30380,21988,15122,9322,4632,
100000,92217,90457,90159,89920,89545,89077,88463,87645,86440,84832,82939,80022,76408,70997,63226,54368,41703,31260,22386,14496,7666,
100000,93019,91767,91410,91070,90447,89493,88230,86611,84582,81928,78855,74415,69066,61931,52757,43475,32845,23973,16502,10102,4934,
100000,93832,92454,92185,91959,91604,91161,90581,89808,88688,87175,85344,82554,79033,73776,66281,57459,45010,34089,24391,15590,8007,
100000,94441,93433,93110,92790,92139,91143,89872,88283,86323,83773,80773,76496,71272,64285,55347,45940,35228,25925,17862,10857,5210,
100000,95116,94042,93798,93586,93252,92834,92289,91564,90527,89112,87350,84696,81285,76206,69024,60296,48156,36837,26335,16607,8272,
100000,95577,94769,94478,94177,93499,92464,91190,89637,87750,85311,82393,78291,73213,66402,57740,48261,37534,27844,19202,11587,5461,
100000,96136,95302,95083,94885,94571,94178,93668,92990,92033,90716,89027,86514,83223,78340,71492,62907,51144,39501,28216,17548,8464,
100000,96485,95839,95577,95296,94591,93519,92245,90732,88922,86596,83768,79847,74928,68315,59956,50450,39764,29729,20521,12292,5686,
100000,96946,96300,96104,95919,95625,95258,94782,94149,93270,92046,90434,88061,84899,80221,73719,65312,53978,42079,30032,18411,8587,
100000,97210,96694,96459,96197,95467,94358,93088,91618,89885,87672,84939,81201,76449,70049,62012,52518,41920,31581,21819,12973,5888,
100000,97589,97090,96914,96742,96468,96125,95682,95093,94287,93153,91617,89384,86353,81885,75733,67534,56663,44570,31783,19198,8642,
100000,97787,97376,97166,96921,96167,95023,93759,92332,90678,88576,85940,82385,77807,71628,63924,54474,44006,33398,23096,13628,6065,
100000,98099,97713,97556,97396,97141,96821,96409,95862,95125,94077,92617,90520,87622,83365,77560,69589,59205,46975,33469,19910,8636,
100000,98246,97920,97732,97504,96725,95547,94291,92909,91331,89339,86800,83426,79023,73072,65706,56328,46022,35182,24352,14259,6220,
100000,98502,98205,98065,97916,97678,97380,96998,96492,95818,94851,93465,91499,88733,84687,79223,71494,61610,49293,35091,20547,8572,
100000,98611,98352,98184,97973,97169,95957,94710,93373,91870,89985,87544,84345,80118,74397,67370,58088,47972,36932,25587,14865,6351,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94188,92348,89713,85872,80739,73264,63883,51526,36649,21112,8454,
100000,98901,98695,98546,98349,97522,96276,95039,93747,92317,90534,88189,85161,81109,75617,68926,59760,49857,38648,26800,15446,6461,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94808,93087,90580,86940,82127,74912,66032,53676,38145,21606,8288,
100000,99131,98967,98834,98652,97800,96520,95295,94048,92688,91003,88753,85890,82010,76744,70385,61350,51679,40330,27992,16003,6550,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95342,93734,91351,87907,83399,76448,68062,55743,39580,22032,8077)
)
outputA_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5))
test_that("lc w lim data works", {
expect_equal(
e_dagger_list(outputA),
e_dagger_list(outputA_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited)
})
# B - test with input nMx, NOT allowing cross-over, and NOT reproducing e0 at given years
outputB <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,80086,76290,75769,75352,74763,73899,72737,71195,69042,65995,62776,57914,52835,46292,37220,29207,19847,13903,9721,6388,3588,
100000,84151,80533,80133,79844,79522,79130,78571,77766,76489,74692,72707,69593,66116,60917,52929,44541,32573,24034,17440,11786,6760,
100000,83964,80855,80367,79959,79345,78445,77260,75715,73586,70567,67303,62431,57246,50552,41293,32762,22837,16174,11310,7366,4057,
100000,87323,84394,84023,83744,83412,83007,82445,81648,80402,78648,76667,73601,70122,64922,56987,48334,36084,26875,19505,13072,7356,
100000,87161,84645,84192,83799,83167,82239,81048,79517,77439,74486,71220,66400,61180,54425,45113,36172,25821,18482,12927,8341,4501,
100000,89907,87557,87216,86949,86610,86198,85638,84856,83653,81958,80002,77015,73572,68428,60633,51813,39435,29641,21515,14296,7889,
100000,89769,87752,87337,86960,86315,85370,84184,82682,80674,77815,74580,69863,64663,57925,48671,39418,28770,20807,14555,9304,4916,
100000,92033,90160,89849,89596,89253,88835,88281,87521,86368,84743,82826,79939,76559,71512,63924,55017,42634,32330,23471,15460,8359,
100000,91915,90309,89930,89572,88919,87963,86790,85328,83402,80656,77477,72899,67763,61098,51989,42511,31678,23140,16189,10250,5299,
100000,93713,92231,91949,91710,91364,90945,90401,89665,88568,87020,85156,82385,79090,74176,66845,57925,45650,34916,25352,16549,8761,
100000,93618,92345,92002,91665,91009,90048,88895,87481,85647,83026,79924,75511,70477,63936,55044,45422,34510,25455,17812,11166,5643,
100000,95043,93874,93620,93396,93050,92631,92099,91392,90353,88887,87082,84436,81244,76485,69447,60573,48492,37400,27161,17568,9100,
100000,95577,94769,94478,94177,93499,92464,91190,89637,87750,85311,82393,78291,73213,66402,57740,48261,37534,27844,19202,11587,5461,
100000,96136,95302,95083,94885,94571,94178,93668,92990,92033,90716,89027,86514,83223,78340,71492,62907,51144,39501,28216,17548,8464,
100000,96485,95839,95577,95296,94591,93519,92245,90732,88922,86596,83768,79847,74928,68315,59956,50450,39764,29729,20521,12292,5686,
100000,96946,96300,96104,95919,95625,95258,94782,94149,93270,92046,90434,88061,84899,80221,73719,65312,53978,42079,30032,18411,8587,
100000,97210,96694,96459,96197,95467,94358,93088,91618,89885,87672,84939,81201,76449,70049,62012,52518,41920,31581,21819,12973,5888,
100000,97589,97090,96914,96742,96468,96125,95682,95093,94287,93153,91617,89384,86353,81885,75733,67534,56663,44570,31783,19198,8642,
100000,97787,97376,97166,96921,96167,95023,93759,92332,90678,88576,85940,82385,77807,71628,63924,54474,44006,33398,23096,13628,6065,
100000,98099,97713,97556,97396,97141,96821,96409,95862,95125,94077,92617,90520,87622,83365,77560,69589,59205,46975,33469,19910,8636,
100000,98246,97920,97732,97504,96725,95547,94291,92909,91331,89339,86800,83426,79023,73072,65706,56328,46022,35182,24352,14259,6220,
100000,98502,98205,98065,97916,97678,97380,96998,96492,95818,94851,93465,91499,88733,84687,79223,71494,61610,49293,35091,20547,8572,
100000,98611,98352,98184,97973,97169,95957,94710,93373,91870,89985,87544,84345,80118,74397,67370,58088,47972,36932,25587,14865,6351,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94188,92348,89713,85872,80739,73264,63883,51526,36649,21112,8454,
100000,98901,98695,98546,98349,97522,96276,95039,93747,92317,90534,88189,85161,81109,75617,68926,59760,49857,38648,26800,15446,6461,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94808,93087,90580,86940,82127,74912,66032,53676,38145,21606,8288,
100000,99131,98967,98834,98652,97800,96520,95295,94048,92688,91003,88753,85890,82010,76744,70385,61350,51679,40330,27992,16003,6550,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95342,93734,91351,87907,83399,76448,68062,55743,39580,22032,8077)
)
outputB_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
prev_divergence = TRUE)
test_that("lc w lim data and prev divergence works", {
# allow for rounding differences, so maximum absolute difference of 1
expect_equal(
e_dagger_list(outputB),
e_dagger_list(outputB_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# C - test input nMx, allowing cross-over, and reproducing e0 at given years (e0_swe)
data("e0_swe")
outputC <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,96509,95867,95606,95325,94620,93546,92272,90761,88953,86630,83805,79889,74974,68368,60018,50512,39828,29783,20559,12312,5692,
100000,94600,93404,93149,92931,92588,92159,91599,90854,89780,88324,86531,83818,80358,75200,67880,59105,46823,35666,25507,16179,8168,
100000,96811,96223,95973,95700,94985,93897,92624,91129,89352,87073,84285,80441,75592,69067,60842,51337,40683,30515,21072,12582,5774,
100000,95354,94336,94098,93889,93559,93147,92610,91894,90874,89481,87734,85110,81724,76686,69574,60873,48809,37414,26743,16815,8320,
100000,97096,96559,96320,96054,95329,94227,92955,91477,89732,87499,84749,80980,76198,69761,61667,52168,41552,31262,21596,12857,5854,
100000,96071,95221,95001,94801,94486,94092,93580,92898,91936,90611,88917,86394,83094,78196,71324,62727,50936,39314,28084,17483,8453,
100000,97369,96882,96654,96396,95659,94542,93273,91813,90101,87916,85207,81516,76808,70463,62510,53024,42456,32044,22145,13141,5935,
100000,96730,96035,95832,95643,95344,94969,94483,93838,92936,91686,90051,87638,84438,79699,73097,64635,53173,41341,29513,18169,8558,
100000,97494,97030,96807,96553,95812,94687,93419,91969,90273,88112,85423,81771,77099,70801,62918,53440,42898,32429,22415,13280,5973,
100000,97218,96634,96446,96266,95980,95623,95160,94545,93695,92507,90925,88608,85497,80901,74537,66209,55055,43072,30730,18731,8616,
100000,97637,97199,96982,96733,95985,94851,93585,92146,90470,88337,85673,82067,77439,71197,63398,53933,43424,32889,22738,13446,6017,
100000,97611,97117,96942,96770,96496,96154,95712,95125,94322,93192,91659,89431,86405,81945,75806,67615,56763,44664,31849,19227,8643,
100000,98033,97667,97469,97233,96466,95304,94044,92640,91024,88979,86392,82929,78439,72376,64842,55426,45036,34307,23735,13951,6146,
100000,98005,97599,97438,97275,97016,96692,96274,95719,94967,93903,92427,90303,87378,83079,77203,69184,58700,46493,33132,19771,8642,
100000,98474,98189,98013,97795,97002,95803,94552,93198,91664,89736,87256,83987,79689,73874,66710,57386,47191,36228,25090,14622,6301,
100000,98335,98002,97855,97701,97456,97148,96753,96229,95527,94525,93107,91084,88260,84121,78507,70670,60564,48279,34382,20275,8607,
100000,98927,98726,98578,98384,97554,96304,95068,93781,92359,90586,88251,85240,81206,75737,69081,59927,50048,38823,26924,15505,6472,
100000,98668,98407,98274,98131,97902,97614,97246,96758,96114,95185,93835,91932,89231,85286,79986,72382,62745,50403,35866,20834,8520,
100000,99306,99174,99055,98886,98011,96698,95484,94279,92984,91389,89228,86515,82795,77744,71693,62798,53361,41902,29109,16511,6616,
100000,98943,98741,98623,98489,98276,98008,97667,97214,96624,95766,94486,92702,90126,86379,81395,74040,64891,52530,37348,21349,8383,
100000,99550,99465,99368,99221,98300,96924,95734,94606,93429,91997,90000,87560,84140,79488,74010,65411,56455,44849,31208,17430,6691,
100000,99142,98981,98874,98749,98549,98298,97978,97555,97011,96213,94993,93310,90844,87270,82559,75431,66715,54367,38625,21754,8223,
100000,99723,99671,99595,99469,98496,97047,95884,94839,93783,92516,90691,88530,85425,81197,76317,68083,59690,48009,33470,18360,6701,
100000,99334,99212,99118,99003,98818,98586,98292,97902,97410,96679,95530,93964,91628,88257,83865,77016,68820,56525,40121,22179,7985,
100000,99833,99801,99742,99635,98604,97079,95944,94978,94035,92919,91260,89356,86552,82731,78415,70579,62776,51104,35696,19211,6636,
100000,99477,99384,99300,99194,99023,98807,98535,98176,97728,97057,95971,94511,92294,89109,85005,78423,70708,58494,41483,22514,7719,
100000,99896,99876,99829,99738,98651,97050,95942,95047,94200,93211,91695,90008,87465,84000,80168,72717,65469,53874,37700,19913,6509,
100000,99592,99520,99446,99348,99190,98990,98740,98408,98002,97387,96364,95005,92904,89901,86075,79762,72522,60421,42811,22788,7413)
)
outputC_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"])
test_that("lc w lim data and fitting e0 works", {
expect_equal(
e_dagger_list(outputC),
e_dagger_list(outputC_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# D - test with input nqx, allowing cross-over, and NOT reproducing e0 at given years
input_nqx <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]))
LT$Date = X$Date
LT$Sex = X$Sex
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, nqx)
# paste in spreadsheet: input_nqx %>% tidyr::spread(Date,nqx) %>% write.csv("testD.csv")
outputD <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83165,80358,79858,79453,78963,78206,77050,75407,73222,70301,67135,62313,56831,49626,40209,32109,22643,15918,10885,6821,3630,
100000,84657,81137,80757,80485,80061,79534,78837,77906,76476,74632,72637,69462,65746,60148,51952,43509,30997,22436,16071,10770,6294,
100000,86387,84068,83603,83210,82684,81872,80676,79019,76849,73961,70780,65998,60479,53196,43707,35197,25288,17946,12286,7648,4005,
100000,87688,84873,84520,84257,83846,83335,82661,81762,80399,78621,76642,73527,69811,64225,56093,47425,34709,25421,18200,12053,6868,
100000,89043,87144,86716,86339,85778,84916,83689,82034,79898,77071,73905,69207,63707,56423,46965,38128,27881,19969,13688,8463,4360,
100000,90165,87934,87609,87357,86963,86473,85827,84966,83680,81984,80041,77017,73340,67824,59849,51057,38305,28376,20305,13284,7371,
100000,91241,89696,89304,88945,88352,87442,86194,84552,82465,79718,76590,72011,66573,59346,50002,40911,30420,21983,15086,9265,4694,
100000,92208,90450,90153,89914,89539,89071,88457,87640,86435,84829,82937,80024,76415,71015,63262,54430,41778,31290,22378,14458,7801,
100000,93021,91770,91414,91074,90451,89497,88234,86615,84588,81936,78866,74431,69090,61970,52809,43533,32886,23972,16471,10045,5002,
100000,93826,92449,92180,91955,91599,91156,90577,89805,88684,87174,85343,82557,79041,73794,66316,57518,45084,34126,24394,15557,8152,
100000,94441,93435,93112,92792,92140,91145,89874,88286,86327,83779,80781,76509,71293,64320,55395,45996,35270,25929,17837,10802,5284,
100000,95111,94038,93795,93583,93249,92831,92287,91562,90524,89111,87350,84699,81292,76223,69056,60352,48229,36882,26350,16581,8425,
100000,95577,94769,94478,94178,93499,92465,91191,89638,87753,85315,82399,78302,73230,66433,57784,48314,37577,27854,19184,11535,5541,
100000,96133,95300,95081,94882,94569,94176,93667,92988,92032,90715,89028,86517,83230,78355,71522,62958,51215,39554,28244,17529,8624,
100000,96484,95838,95577,95295,94591,93519,92245,90733,88924,86598,83773,79856,74942,68342,59996,50500,39807,29746,20511,12244,5773,
100000,96944,96299,96103,95917,95624,95257,94781,94148,93269,92046,90435,88064,84905,80235,73746,65360,54046,42140,30074,18401,8751,
100000,97209,96693,96458,96196,95466,94358,93088,91618,89886,87673,84942,81208,76462,70073,62048,52565,41965,31605,21819,12928,5980,
100000,97588,97089,96913,96741,96467,96124,95681,95092,94287,93153,91618,89387,86359,81898,75757,67577,56728,44639,31841,19198,8810,
100000,97786,97375,97165,96920,96166,95023,93758,92332,90678,88577,85942,82391,77818,71649,63957,54519,44051,33431,23106,13589,6163,
100000,98098,97713,97556,97396,97140,96820,96409,95862,95125,94077,92618,90522,87627,83377,77582,69629,59267,47051,33544,19920,8805,
100000,98245,97918,97730,97503,96724,95546,94290,92909,91331,89339,86802,83430,79032,73090,65735,56370,46068,35223,24374,14225,6322,
100000,98501,98204,98064,97915,97678,97380,96998,96491,95818,94851,93466,91501,88738,84697,79242,71530,61668,49378,35184,20569,8740,
100000,98610,98350,98183,97971,97168,95956,94709,93373,91870,89985,87545,84348,80126,74412,67396,58127,48018,36981,25620,14838,6459,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94189,92349,89717,85881,80756,73296,63938,51619,36761,21145,8620,
100000,98900,98694,98544,98348,97521,96275,95038,93747,92317,90534,88190,85164,81116,75629,68949,59797,49903,38705,26846,15426,6573,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94809,93088,90583,86948,82141,74940,66083,53776,38277,21652,8450,
100000,99130,98966,98833,98651,97799,96520,95295,94047,92687,91003,88754,85891,82015,76755,70404,61385,51725,40395,28052,15990,6665,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95343,93736,91354,87913,83411,76472,68109,55851,39732,22090,8234)
)
outputD_test <- interp_lc_lim(input = input_nqx, dates_out = seq(1953,2018,5))
test_that("lc w lim data and nqx as input works", {
expect_equal(
e_dagger_list(outputD),
e_dagger_list(outputD_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# E - test with input lx, allowing cross-over, and NOT reproducing e0 at given years
input_lx <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]))
LT$Date = X$Date
LT$Sex = X$Sex
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, lx)
# paste in spreadsheet: input_lx %>% tidyr::spread(Date,lx) %>% xlsx::write.xlsx("testD.xlsx")
outputE <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83165,80358,79858,79453,78963,78206,77050,75407,73222,70301,67135,62313,56831,49626,40209,32109,22643,15918,10885,6821,3630,
100000,84657,81137,80757,80485,80061,79534,78837,77906,76476,74632,72637,69462,65746,60148,51952,43509,30997,22436,16071,10770,6294,
100000,86387,84068,83603,83210,82684,81872,80676,79019,76849,73961,70780,65998,60479,53196,43707,35197,25288,17946,12286,7648,4005,
100000,87688,84873,84520,84257,83846,83335,82661,81762,80399,78621,76642,73527,69811,64225,56093,47425,34709,25421,18200,12053,6868,
100000,89043,87144,86716,86339,85778,84916,83689,82034,79898,77071,73905,69207,63707,56423,46965,38128,27881,19969,13688,8463,4360,
100000,90165,87934,87609,87357,86963,86473,85827,84966,83680,81984,80041,77017,73340,67824,59849,51057,38305,28376,20305,13284,7371,
100000,91241,89696,89304,88945,88352,87442,86194,84552,82465,79718,76590,72011,66573,59346,50002,40911,30420,21983,15086,9265,4694,
100000,92208,90450,90153,89914,89539,89071,88457,87640,86435,84829,82937,80024,76415,71015,63262,54430,41778,31290,22378,14458,7801,
100000,93021,91770,91414,91074,90451,89497,88234,86615,84588,81936,78866,74431,69090,61970,52809,43533,32886,23972,16471,10045,5002,
100000,93826,92449,92180,91955,91599,91156,90577,89805,88684,87174,85343,82557,79041,73794,66316,57518,45084,34126,24394,15557,8152,
100000,94441,93435,93112,92792,92140,91145,89874,88286,86327,83779,80781,76509,71293,64320,55395,45996,35270,25929,17837,10802,5284,
100000,95111,94038,93795,93583,93249,92831,92287,91562,90524,89111,87350,84699,81292,76223,69056,60352,48229,36882,26350,16581,8425,
100000,95577,94769,94478,94178,93499,92465,91191,89638,87753,85315,82399,78302,73230,66433,57784,48314,37577,27854,19184,11535,5541,
100000,96133,95300,95081,94882,94569,94176,93667,92988,92032,90715,89028,86517,83230,78355,71522,62958,51215,39554,28244,17529,8624,
100000,96484,95838,95577,95295,94591,93519,92245,90733,88924,86598,83773,79856,74942,68342,59996,50500,39807,29746,20511,12244,5773,
100000,96944,96299,96103,95917,95624,95257,94781,94148,93269,92046,90435,88064,84905,80235,73746,65360,54046,42140,30074,18401,8751,
100000,97209,96693,96458,96196,95466,94358,93088,91618,89886,87673,84942,81208,76462,70073,62048,52565,41965,31605,21819,12928,5980,
100000,97588,97089,96913,96741,96467,96124,95681,95092,94287,93153,91618,89387,86359,81898,75757,67577,56728,44639,31841,19198,8810,
100000,97786,97375,97165,96920,96166,95023,93758,92332,90678,88577,85942,82391,77818,71649,63957,54519,44051,33431,23106,13589,6163,
100000,98098,97713,97556,97396,97140,96820,96409,95862,95125,94077,92618,90522,87627,83377,77582,69629,59267,47051,33544,19920,8805,
100000,98245,97918,97730,97503,96724,95546,94290,92909,91331,89339,86802,83430,79032,73090,65735,56370,46068,35223,24374,14225,6322,
100000,98501,98204,98064,97915,97678,97380,96998,96491,95818,94851,93466,91501,88738,84697,79242,71530,61668,49378,35184,20569,8740,
100000,98610,98350,98183,97971,97168,95956,94709,93373,91870,89985,87545,84348,80126,74412,67396,58127,48018,36981,25620,14838,6459,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94189,92349,89717,85881,80756,73296,63938,51619,36761,21145,8620,
100000,98900,98694,98544,98348,97521,96275,95038,93747,92317,90534,88190,85164,81116,75629,68949,59797,49903,38705,26846,15426,6573,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94809,93088,90583,86948,82141,74940,66083,53776,38277,21652,8450,
100000,99130,98966,98833,98651,97799,96520,95295,94047,92687,91003,88754,85891,82015,76755,70404,61385,51725,40395,28052,15990,6665,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95343,93736,91354,87913,83411,76472,68109,55851,39732,22090,8234)
)
outputE_test <- interp_lc_lim(input = input_lx, dates_out = seq(1953,2018,5))
test_that("lc w lim data and nqx as input works", {
expect_equal(
e_dagger_list(outputE),
e_dagger_list(outputE_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# F - testing args ------------------------------------------------------------
# single ages out
outputF1_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
Single = T)
# single out diff OAG
outputF2_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
Single = T, extrapLaw = "makeham", OAnew = 100)
# bunch of args
outputF3_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
prev_divergence = T,
dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"],
Single = T, verbose = F, SVD = T,
extrapLaw = "ggompertz", OAnew = 100)
test_that("lc w lim data and nqx as input works", {
expect_length(unique(outputF1_test$lt_hat$Age), 101)
expect_s3_class(outputF3_test$lt_hat, "data.frame")
expect_length(unique(outputF2_test$lt_hat$Age), 101)
expect_length(outputF3_test$lt_hat$ex, 101 * 2 * length(seq(1953,2018,5)))
})
# G - mixing input --------------------------------------------------------
# some dates gives rates and some lx
input_mix1 <- rbind(input %>%
dplyr::filter(Date %in% dates_in[1:2]) %>%
mutate(lx = NA),
input_lx %>%
dplyr::filter(Date %in% dates_in[3:5]) %>%
mutate(nMx = NA)
)
outputG1_test <- interp_lc_lim(input = input_mix1, dates_out = seq(1953,2018,5))
# some single and abr ages
input_single <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged2single(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]),
OAnew = 100)
LT$Date = unique(X$Date)
LT$Sex = unique(X$Sex)
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, nMx)
input_mix2 <- rbind(input %>%
dplyr::filter(Date %in% dates_in[1:2]),
input_single %>%
dplyr::filter(Date %in% dates_in[3:5])
)
outputG2_test <- interp_lc_lim(input = input_mix2, dates_out = seq(1953,2018,5))
outputG3_test <- interp_lc_lim(input = input_mix2, dates_out = seq(1953,2018,5),
Single = T)
test_that("mixing inputs works", {
expect_s3_class(outputG1_test$lt_hat, "data.frame")
expect_true(all(outputG1_test$lt_hat$nMx > 0))
expect_length(unique(outputG2_test$lt_hat$Age), 22)
expect_length(unique(outputG3_test$lt_hat$Age), 101)
})
# H - lt args -------------------------------------------------------------
# various comb args from lt functions
outputH1_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
a0rule = "cd")
outputH2_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
axmethod = "un")
outputH3_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
region = "n")
outputH4_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "makeham")
outputH5_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "makeham", OAnew = 95)
outputH6_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "gompertz", OAnew = 100,
extrapFrom = 60, extrapFit = seq(50,95,5), radix = 1)
test_that("pass all lt args works", {
expect_s3_class(outputH1_test$lt_hat, "data.frame")
expect_s3_class(outputH2_test$lt_hat, "data.frame")
expect_s3_class(outputH3_test$lt_hat, "data.frame")
expect_s3_class(outputH4_test$lt_hat, "data.frame")
expect_s3_class(outputH5_test$lt_hat, "data.frame")
expect_s3_class(outputH6_test$lt_hat, "data.frame")
}
)
# I - messages/warnings -------------------------------------------------------
test_that("mess and warns works", {
# need n(dates)>2
expect_error(interp_lc_lim(input = input %>% dplyr::filter(Date %in% dates_in[1:2]),
dates_out = seq(1953,2018,5)))
# choose e0_dates for you
expect_error(interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
# dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"]))
# need to rethink these: messages shifted elsewhere
# # tell me you´ll fit with gompertz in case max(Age) is <90
# expect_output(interp_lc_lim(input = input %>% dplyr::filter(Age < 85),
# dates_out = seq(1953,2018,5)),
# regexp = "A Makeham function was fitted for older ages for sex ")
# # tell me you´ll fit with kannisto in case max(Age) is >=90
# expect_output(interp_lc_lim(input = input, dates_out = seq(1953,2018,5)),
# regexp = "A Kannisto function was fitted for older ages for sex ")
})
timriffe/DemoTools documentation built on Jan. 28, 2024, 5:13 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# tests against spreadsheet "Li_2018_Limited_Lee-Carter-v4.xlsm" -------------------------------------------------------------
context("test-interp_lc_lim")
# summary
# A to E tests againts spreadsheet
# F testing args from main fun
# G mixing input: single/abr with output single/abr, and mixing input nMx and lx
# H passing lt arguments
# I text/messages/warnings
# tolerance: .05% difference in e_0
tolerance_admited <- .005
# data included in spredsheet -------------------------------------------------------------
Age <- c(0,1,seq(5,100,5))
dates_in <- c(1980.671, 1991.668, 1996.586, 2000.586, 2010.71)
input <- data.frame(Date= c(rep(sort(rep(dates_in, length(Age))),2)),
Age = rep(Age, 2 * length(dates_in)),
Sex = c(rep("m", length(Age) * length(dates_in)),
rep("f", length(Age) * length(dates_in))),
nMx = c(0.058872, 0.002992, 0.000697, 0.000703, 0.001424, # males
0.002102, 0.002519, 0.003109, 0.004072, 0.005968, 0.00739, 0.010927,
0.013366, 0.018798, 0.028653, 0.037304, 0.052714, 0.059629, 0.070922,
0.093256, 0.135563, 0.217859, 0.030825, 0.001351, 0.000517, 0.000528,
0.001434, 0.002436, 0.002954, 0.003341, 0.003971, 0.004966, 0.006267,
0.009662, 0.012983, 0.019135, 0.024503, 0.032664, 0.047827, 0.057952,
0.073104, 0.099948, 0.148105, 0.237862, 0.026198, 0.001109, 0.000457,
0.000555, 0.001571, 0.002404, 0.003012, 0.003674, 0.004129, 0.005016,
0.006223, 0.008328, 0.012217, 0.017762, 0.025149, 0.032561, 0.042365,
0.057642, 0.080202, 0.116701, 0.177582, 0.282593, 0.018484, 0.000883,
0.000382, 0.000455, 0.001646, 0.002304, 0.002467, 0.003097, 0.003724,
0.004507, 0.005908, 0.00794, 0.010738, 0.016865, 0.022493, 0.032624,
0.040211, 0.051478, 0.068234, 0.09696, 0.147703, 0.241212, 0.01295,
0.00063, 0.000332, 0.000433, 0.001641, 0.002581, 0.002578, 0.002547,
0.00289, 0.004012, 0.005381, 0.007316, 0.009889, 0.013273, 0.018334,
0.028212, 0.03749, 0.052073, 0.073922, 0.109615, 0.169785, 0.274699,
0.045269, 0.002704, 0.000507, 0.00046, 0.000734, # females
0.000895, 0.001126, 0.001495, 0.002197, 0.003143, 0.003983, 0.005939,
0.007469, 0.01166, 0.018486, 0.026548, 0.042649, 0.050858, 0.063509,
0.086965, 0.130587, 0.215029, 0.023838, 0.001154, 0.000358, 0.000318,
0.000502, 0.000698, 0.000918, 0.001144, 0.001572, 0.002207, 0.003151,
0.005038, 0.007183, 0.011023, 0.014718, 0.022267, 0.035953, 0.048153,
0.066424, 0.097196, 0.150869, 0.248412, 0.020248, 0.000933, 0.00031,
0.000339, 0.000525, 0.000652, 0.000901, 0.001251, 0.001599, 0.00223,
0.00313, 0.004514, 0.007125, 0.01058, 0.015764, 0.021294, 0.032344,
0.049166, 0.07543, 0.117877, 0.18764, 0.304247, 0.014603, 0.000768,
0.000271, 0.000287, 0.000487, 0.000565, 0.000715, 0.001059, 0.001481,
0.002049, 0.002936, 0.004201, 0.006039, 0.009984, 0.013853, 0.021179,
0.02809, 0.042159, 0.064247, 0.100939, 0.163497, 0.273028, 0.010488,
0.000521, 0.00025, 0.00029, 0.000453, 0.000581, 0.000725, 0.000901,
0.001171, 0.001816, 0.002734, 0.003782, 0.005293, 0.007575, 0.011174,
0.018559, 0.026524, 0.041711, 0.066135, 0.106604, 0.174691, 0.291021)
)
# A to E tests againts spreadsheet -------------------------------------------------------------
# utils
. <- NULL
e_dagger <- function(lx){-sum(lx/lx[1]*log(lx/lx[1]))}
e_dagger_list <- function(y){
y %>%
split(list(y$Sex, y$Date)) %>%
lapply(FUN = function(X) {
e_dagger(X$lx)}) %>%
do.call("rbind", .)
}
# A - test with input nMx, allowing cross-over, and NOT reproducing e0 at given years
outputA <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83150,80337,79837,79431,78942,78185,77029,75385,73199,70275,67106,62278,56789,49566,40140,32042,22605,15933,10927,6875,3588,
100000,84678,81152,80771,80499,80075,79548,78850,77919,76488,74641,72644,69464,65742,60130,51912,43443,30927,22427,16100,10816,6196,
100000,86377,84053,83588,83196,82669,81857,80661,79004,76832,73942,70757,65968,60442,53142,43642,35132,25249,17958,12328,7704,3957,
100000,87704,84885,84531,84268,83857,83346,82671,81771,80408,78627,76647,73528,69806,64206,56054,47360,34637,25405,18223,12098,6756,
100000,89036,87134,86706,86329,85768,84906,83679,82023,79886,77057,73887,69183,63676,56374,46904,38065,27842,19978,13727,8521,4306,
100000,90178,87943,87617,87366,86972,86481,85835,84974,83687,81988,80045,77016,73334,67806,59811,50993,38231,28353,20321,13326,7247,
100000,91237,89690,89298,88939,88346,87436,86188,84545,82456,79707,76577,71991,66545,59302,49945,40851,30380,21988,15122,9322,4632,
100000,92217,90457,90159,89920,89545,89077,88463,87645,86440,84832,82939,80022,76408,70997,63226,54368,41703,31260,22386,14496,7666,
100000,93019,91767,91410,91070,90447,89493,88230,86611,84582,81928,78855,74415,69066,61931,52757,43475,32845,23973,16502,10102,4934,
100000,93832,92454,92185,91959,91604,91161,90581,89808,88688,87175,85344,82554,79033,73776,66281,57459,45010,34089,24391,15590,8007,
100000,94441,93433,93110,92790,92139,91143,89872,88283,86323,83773,80773,76496,71272,64285,55347,45940,35228,25925,17862,10857,5210,
100000,95116,94042,93798,93586,93252,92834,92289,91564,90527,89112,87350,84696,81285,76206,69024,60296,48156,36837,26335,16607,8272,
100000,95577,94769,94478,94177,93499,92464,91190,89637,87750,85311,82393,78291,73213,66402,57740,48261,37534,27844,19202,11587,5461,
100000,96136,95302,95083,94885,94571,94178,93668,92990,92033,90716,89027,86514,83223,78340,71492,62907,51144,39501,28216,17548,8464,
100000,96485,95839,95577,95296,94591,93519,92245,90732,88922,86596,83768,79847,74928,68315,59956,50450,39764,29729,20521,12292,5686,
100000,96946,96300,96104,95919,95625,95258,94782,94149,93270,92046,90434,88061,84899,80221,73719,65312,53978,42079,30032,18411,8587,
100000,97210,96694,96459,96197,95467,94358,93088,91618,89885,87672,84939,81201,76449,70049,62012,52518,41920,31581,21819,12973,5888,
100000,97589,97090,96914,96742,96468,96125,95682,95093,94287,93153,91617,89384,86353,81885,75733,67534,56663,44570,31783,19198,8642,
100000,97787,97376,97166,96921,96167,95023,93759,92332,90678,88576,85940,82385,77807,71628,63924,54474,44006,33398,23096,13628,6065,
100000,98099,97713,97556,97396,97141,96821,96409,95862,95125,94077,92617,90520,87622,83365,77560,69589,59205,46975,33469,19910,8636,
100000,98246,97920,97732,97504,96725,95547,94291,92909,91331,89339,86800,83426,79023,73072,65706,56328,46022,35182,24352,14259,6220,
100000,98502,98205,98065,97916,97678,97380,96998,96492,95818,94851,93465,91499,88733,84687,79223,71494,61610,49293,35091,20547,8572,
100000,98611,98352,98184,97973,97169,95957,94710,93373,91870,89985,87544,84345,80118,74397,67370,58088,47972,36932,25587,14865,6351,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94188,92348,89713,85872,80739,73264,63883,51526,36649,21112,8454,
100000,98901,98695,98546,98349,97522,96276,95039,93747,92317,90534,88189,85161,81109,75617,68926,59760,49857,38648,26800,15446,6461,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94808,93087,90580,86940,82127,74912,66032,53676,38145,21606,8288,
100000,99131,98967,98834,98652,97800,96520,95295,94048,92688,91003,88753,85890,82010,76744,70385,61350,51679,40330,27992,16003,6550,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95342,93734,91351,87907,83399,76448,68062,55743,39580,22032,8077)
)
outputA_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5))
test_that("lc w lim data works", {
expect_equal(
e_dagger_list(outputA),
e_dagger_list(outputA_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited)
})
# B - test with input nMx, NOT allowing cross-over, and NOT reproducing e0 at given years
outputB <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,80086,76290,75769,75352,74763,73899,72737,71195,69042,65995,62776,57914,52835,46292,37220,29207,19847,13903,9721,6388,3588,
100000,84151,80533,80133,79844,79522,79130,78571,77766,76489,74692,72707,69593,66116,60917,52929,44541,32573,24034,17440,11786,6760,
100000,83964,80855,80367,79959,79345,78445,77260,75715,73586,70567,67303,62431,57246,50552,41293,32762,22837,16174,11310,7366,4057,
100000,87323,84394,84023,83744,83412,83007,82445,81648,80402,78648,76667,73601,70122,64922,56987,48334,36084,26875,19505,13072,7356,
100000,87161,84645,84192,83799,83167,82239,81048,79517,77439,74486,71220,66400,61180,54425,45113,36172,25821,18482,12927,8341,4501,
100000,89907,87557,87216,86949,86610,86198,85638,84856,83653,81958,80002,77015,73572,68428,60633,51813,39435,29641,21515,14296,7889,
100000,89769,87752,87337,86960,86315,85370,84184,82682,80674,77815,74580,69863,64663,57925,48671,39418,28770,20807,14555,9304,4916,
100000,92033,90160,89849,89596,89253,88835,88281,87521,86368,84743,82826,79939,76559,71512,63924,55017,42634,32330,23471,15460,8359,
100000,91915,90309,89930,89572,88919,87963,86790,85328,83402,80656,77477,72899,67763,61098,51989,42511,31678,23140,16189,10250,5299,
100000,93713,92231,91949,91710,91364,90945,90401,89665,88568,87020,85156,82385,79090,74176,66845,57925,45650,34916,25352,16549,8761,
100000,93618,92345,92002,91665,91009,90048,88895,87481,85647,83026,79924,75511,70477,63936,55044,45422,34510,25455,17812,11166,5643,
100000,95043,93874,93620,93396,93050,92631,92099,91392,90353,88887,87082,84436,81244,76485,69447,60573,48492,37400,27161,17568,9100,
100000,95577,94769,94478,94177,93499,92464,91190,89637,87750,85311,82393,78291,73213,66402,57740,48261,37534,27844,19202,11587,5461,
100000,96136,95302,95083,94885,94571,94178,93668,92990,92033,90716,89027,86514,83223,78340,71492,62907,51144,39501,28216,17548,8464,
100000,96485,95839,95577,95296,94591,93519,92245,90732,88922,86596,83768,79847,74928,68315,59956,50450,39764,29729,20521,12292,5686,
100000,96946,96300,96104,95919,95625,95258,94782,94149,93270,92046,90434,88061,84899,80221,73719,65312,53978,42079,30032,18411,8587,
100000,97210,96694,96459,96197,95467,94358,93088,91618,89885,87672,84939,81201,76449,70049,62012,52518,41920,31581,21819,12973,5888,
100000,97589,97090,96914,96742,96468,96125,95682,95093,94287,93153,91617,89384,86353,81885,75733,67534,56663,44570,31783,19198,8642,
100000,97787,97376,97166,96921,96167,95023,93759,92332,90678,88576,85940,82385,77807,71628,63924,54474,44006,33398,23096,13628,6065,
100000,98099,97713,97556,97396,97141,96821,96409,95862,95125,94077,92617,90520,87622,83365,77560,69589,59205,46975,33469,19910,8636,
100000,98246,97920,97732,97504,96725,95547,94291,92909,91331,89339,86800,83426,79023,73072,65706,56328,46022,35182,24352,14259,6220,
100000,98502,98205,98065,97916,97678,97380,96998,96492,95818,94851,93465,91499,88733,84687,79223,71494,61610,49293,35091,20547,8572,
100000,98611,98352,98184,97973,97169,95957,94710,93373,91870,89985,87544,84345,80118,74397,67370,58088,47972,36932,25587,14865,6351,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94188,92348,89713,85872,80739,73264,63883,51526,36649,21112,8454,
100000,98901,98695,98546,98349,97522,96276,95039,93747,92317,90534,88189,85161,81109,75617,68926,59760,49857,38648,26800,15446,6461,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94808,93087,90580,86940,82127,74912,66032,53676,38145,21606,8288,
100000,99131,98967,98834,98652,97800,96520,95295,94048,92688,91003,88753,85890,82010,76744,70385,61350,51679,40330,27992,16003,6550,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95342,93734,91351,87907,83399,76448,68062,55743,39580,22032,8077)
)
outputB_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
prev_divergence = TRUE)
test_that("lc w lim data and prev divergence works", {
# allow for rounding differences, so maximum absolute difference of 1
expect_equal(
e_dagger_list(outputB),
e_dagger_list(outputB_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# C - test input nMx, allowing cross-over, and reproducing e0 at given years (e0_swe)
data("e0_swe")
outputC <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,96509,95867,95606,95325,94620,93546,92272,90761,88953,86630,83805,79889,74974,68368,60018,50512,39828,29783,20559,12312,5692,
100000,94600,93404,93149,92931,92588,92159,91599,90854,89780,88324,86531,83818,80358,75200,67880,59105,46823,35666,25507,16179,8168,
100000,96811,96223,95973,95700,94985,93897,92624,91129,89352,87073,84285,80441,75592,69067,60842,51337,40683,30515,21072,12582,5774,
100000,95354,94336,94098,93889,93559,93147,92610,91894,90874,89481,87734,85110,81724,76686,69574,60873,48809,37414,26743,16815,8320,
100000,97096,96559,96320,96054,95329,94227,92955,91477,89732,87499,84749,80980,76198,69761,61667,52168,41552,31262,21596,12857,5854,
100000,96071,95221,95001,94801,94486,94092,93580,92898,91936,90611,88917,86394,83094,78196,71324,62727,50936,39314,28084,17483,8453,
100000,97369,96882,96654,96396,95659,94542,93273,91813,90101,87916,85207,81516,76808,70463,62510,53024,42456,32044,22145,13141,5935,
100000,96730,96035,95832,95643,95344,94969,94483,93838,92936,91686,90051,87638,84438,79699,73097,64635,53173,41341,29513,18169,8558,
100000,97494,97030,96807,96553,95812,94687,93419,91969,90273,88112,85423,81771,77099,70801,62918,53440,42898,32429,22415,13280,5973,
100000,97218,96634,96446,96266,95980,95623,95160,94545,93695,92507,90925,88608,85497,80901,74537,66209,55055,43072,30730,18731,8616,
100000,97637,97199,96982,96733,95985,94851,93585,92146,90470,88337,85673,82067,77439,71197,63398,53933,43424,32889,22738,13446,6017,
100000,97611,97117,96942,96770,96496,96154,95712,95125,94322,93192,91659,89431,86405,81945,75806,67615,56763,44664,31849,19227,8643,
100000,98033,97667,97469,97233,96466,95304,94044,92640,91024,88979,86392,82929,78439,72376,64842,55426,45036,34307,23735,13951,6146,
100000,98005,97599,97438,97275,97016,96692,96274,95719,94967,93903,92427,90303,87378,83079,77203,69184,58700,46493,33132,19771,8642,
100000,98474,98189,98013,97795,97002,95803,94552,93198,91664,89736,87256,83987,79689,73874,66710,57386,47191,36228,25090,14622,6301,
100000,98335,98002,97855,97701,97456,97148,96753,96229,95527,94525,93107,91084,88260,84121,78507,70670,60564,48279,34382,20275,8607,
100000,98927,98726,98578,98384,97554,96304,95068,93781,92359,90586,88251,85240,81206,75737,69081,59927,50048,38823,26924,15505,6472,
100000,98668,98407,98274,98131,97902,97614,97246,96758,96114,95185,93835,91932,89231,85286,79986,72382,62745,50403,35866,20834,8520,
100000,99306,99174,99055,98886,98011,96698,95484,94279,92984,91389,89228,86515,82795,77744,71693,62798,53361,41902,29109,16511,6616,
100000,98943,98741,98623,98489,98276,98008,97667,97214,96624,95766,94486,92702,90126,86379,81395,74040,64891,52530,37348,21349,8383,
100000,99550,99465,99368,99221,98300,96924,95734,94606,93429,91997,90000,87560,84140,79488,74010,65411,56455,44849,31208,17430,6691,
100000,99142,98981,98874,98749,98549,98298,97978,97555,97011,96213,94993,93310,90844,87270,82559,75431,66715,54367,38625,21754,8223,
100000,99723,99671,99595,99469,98496,97047,95884,94839,93783,92516,90691,88530,85425,81197,76317,68083,59690,48009,33470,18360,6701,
100000,99334,99212,99118,99003,98818,98586,98292,97902,97410,96679,95530,93964,91628,88257,83865,77016,68820,56525,40121,22179,7985,
100000,99833,99801,99742,99635,98604,97079,95944,94978,94035,92919,91260,89356,86552,82731,78415,70579,62776,51104,35696,19211,6636,
100000,99477,99384,99300,99194,99023,98807,98535,98176,97728,97057,95971,94511,92294,89109,85005,78423,70708,58494,41483,22514,7719,
100000,99896,99876,99829,99738,98651,97050,95942,95047,94200,93211,91695,90008,87465,84000,80168,72717,65469,53874,37700,19913,6509,
100000,99592,99520,99446,99348,99190,98990,98740,98408,98002,97387,96364,95005,92904,89901,86075,79762,72522,60421,42811,22788,7413)
)
outputC_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"])
test_that("lc w lim data and fitting e0 works", {
expect_equal(
e_dagger_list(outputC),
e_dagger_list(outputC_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# D - test with input nqx, allowing cross-over, and NOT reproducing e0 at given years
input_nqx <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]))
LT$Date = X$Date
LT$Sex = X$Sex
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, nqx)
# paste in spreadsheet: input_nqx %>% tidyr::spread(Date,nqx) %>% write.csv("testD.csv")
outputD <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83165,80358,79858,79453,78963,78206,77050,75407,73222,70301,67135,62313,56831,49626,40209,32109,22643,15918,10885,6821,3630,
100000,84657,81137,80757,80485,80061,79534,78837,77906,76476,74632,72637,69462,65746,60148,51952,43509,30997,22436,16071,10770,6294,
100000,86387,84068,83603,83210,82684,81872,80676,79019,76849,73961,70780,65998,60479,53196,43707,35197,25288,17946,12286,7648,4005,
100000,87688,84873,84520,84257,83846,83335,82661,81762,80399,78621,76642,73527,69811,64225,56093,47425,34709,25421,18200,12053,6868,
100000,89043,87144,86716,86339,85778,84916,83689,82034,79898,77071,73905,69207,63707,56423,46965,38128,27881,19969,13688,8463,4360,
100000,90165,87934,87609,87357,86963,86473,85827,84966,83680,81984,80041,77017,73340,67824,59849,51057,38305,28376,20305,13284,7371,
100000,91241,89696,89304,88945,88352,87442,86194,84552,82465,79718,76590,72011,66573,59346,50002,40911,30420,21983,15086,9265,4694,
100000,92208,90450,90153,89914,89539,89071,88457,87640,86435,84829,82937,80024,76415,71015,63262,54430,41778,31290,22378,14458,7801,
100000,93021,91770,91414,91074,90451,89497,88234,86615,84588,81936,78866,74431,69090,61970,52809,43533,32886,23972,16471,10045,5002,
100000,93826,92449,92180,91955,91599,91156,90577,89805,88684,87174,85343,82557,79041,73794,66316,57518,45084,34126,24394,15557,8152,
100000,94441,93435,93112,92792,92140,91145,89874,88286,86327,83779,80781,76509,71293,64320,55395,45996,35270,25929,17837,10802,5284,
100000,95111,94038,93795,93583,93249,92831,92287,91562,90524,89111,87350,84699,81292,76223,69056,60352,48229,36882,26350,16581,8425,
100000,95577,94769,94478,94178,93499,92465,91191,89638,87753,85315,82399,78302,73230,66433,57784,48314,37577,27854,19184,11535,5541,
100000,96133,95300,95081,94882,94569,94176,93667,92988,92032,90715,89028,86517,83230,78355,71522,62958,51215,39554,28244,17529,8624,
100000,96484,95838,95577,95295,94591,93519,92245,90733,88924,86598,83773,79856,74942,68342,59996,50500,39807,29746,20511,12244,5773,
100000,96944,96299,96103,95917,95624,95257,94781,94148,93269,92046,90435,88064,84905,80235,73746,65360,54046,42140,30074,18401,8751,
100000,97209,96693,96458,96196,95466,94358,93088,91618,89886,87673,84942,81208,76462,70073,62048,52565,41965,31605,21819,12928,5980,
100000,97588,97089,96913,96741,96467,96124,95681,95092,94287,93153,91618,89387,86359,81898,75757,67577,56728,44639,31841,19198,8810,
100000,97786,97375,97165,96920,96166,95023,93758,92332,90678,88577,85942,82391,77818,71649,63957,54519,44051,33431,23106,13589,6163,
100000,98098,97713,97556,97396,97140,96820,96409,95862,95125,94077,92618,90522,87627,83377,77582,69629,59267,47051,33544,19920,8805,
100000,98245,97918,97730,97503,96724,95546,94290,92909,91331,89339,86802,83430,79032,73090,65735,56370,46068,35223,24374,14225,6322,
100000,98501,98204,98064,97915,97678,97380,96998,96491,95818,94851,93466,91501,88738,84697,79242,71530,61668,49378,35184,20569,8740,
100000,98610,98350,98183,97971,97168,95956,94709,93373,91870,89985,87545,84348,80126,74412,67396,58127,48018,36981,25620,14838,6459,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94189,92349,89717,85881,80756,73296,63938,51619,36761,21145,8620,
100000,98900,98694,98544,98348,97521,96275,95038,93747,92317,90534,88190,85164,81116,75629,68949,59797,49903,38705,26846,15426,6573,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94809,93088,90583,86948,82141,74940,66083,53776,38277,21652,8450,
100000,99130,98966,98833,98651,97799,96520,95295,94047,92687,91003,88754,85891,82015,76755,70404,61385,51725,40395,28052,15990,6665,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95343,93736,91354,87913,83411,76472,68109,55851,39732,22090,8234)
)
outputD_test <- interp_lc_lim(input = input_nqx, dates_out = seq(1953,2018,5))
test_that("lc w lim data and nqx as input works", {
expect_equal(
e_dagger_list(outputD),
e_dagger_list(outputD_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# E - test with input lx, allowing cross-over, and NOT reproducing e0 at given years
input_lx <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]))
LT$Date = X$Date
LT$Sex = X$Sex
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, lx)
# paste in spreadsheet: input_lx %>% tidyr::spread(Date,lx) %>% xlsx::write.xlsx("testD.xlsx")
outputE <- data.frame(
Sex = rep(c(rep("m",22),rep("f",22)),14),
Age = rep(c(0,1,seq(5,100,5)),14*2),
Date = sort(rep(seq(1953,2018,5), 22 * 2)),
lx=c(100000,83165,80358,79858,79453,78963,78206,77050,75407,73222,70301,67135,62313,56831,49626,40209,32109,22643,15918,10885,6821,3630,
100000,84657,81137,80757,80485,80061,79534,78837,77906,76476,74632,72637,69462,65746,60148,51952,43509,30997,22436,16071,10770,6294,
100000,86387,84068,83603,83210,82684,81872,80676,79019,76849,73961,70780,65998,60479,53196,43707,35197,25288,17946,12286,7648,4005,
100000,87688,84873,84520,84257,83846,83335,82661,81762,80399,78621,76642,73527,69811,64225,56093,47425,34709,25421,18200,12053,6868,
100000,89043,87144,86716,86339,85778,84916,83689,82034,79898,77071,73905,69207,63707,56423,46965,38128,27881,19969,13688,8463,4360,
100000,90165,87934,87609,87357,86963,86473,85827,84966,83680,81984,80041,77017,73340,67824,59849,51057,38305,28376,20305,13284,7371,
100000,91241,89696,89304,88945,88352,87442,86194,84552,82465,79718,76590,72011,66573,59346,50002,40911,30420,21983,15086,9265,4694,
100000,92208,90450,90153,89914,89539,89071,88457,87640,86435,84829,82937,80024,76415,71015,63262,54430,41778,31290,22378,14458,7801,
100000,93021,91770,91414,91074,90451,89497,88234,86615,84588,81936,78866,74431,69090,61970,52809,43533,32886,23972,16471,10045,5002,
100000,93826,92449,92180,91955,91599,91156,90577,89805,88684,87174,85343,82557,79041,73794,66316,57518,45084,34126,24394,15557,8152,
100000,94441,93435,93112,92792,92140,91145,89874,88286,86327,83779,80781,76509,71293,64320,55395,45996,35270,25929,17837,10802,5284,
100000,95111,94038,93795,93583,93249,92831,92287,91562,90524,89111,87350,84699,81292,76223,69056,60352,48229,36882,26350,16581,8425,
100000,95577,94769,94478,94178,93499,92465,91191,89638,87753,85315,82399,78302,73230,66433,57784,48314,37577,27854,19184,11535,5541,
100000,96133,95300,95081,94882,94569,94176,93667,92988,92032,90715,89028,86517,83230,78355,71522,62958,51215,39554,28244,17529,8624,
100000,96484,95838,95577,95295,94591,93519,92245,90733,88924,86598,83773,79856,74942,68342,59996,50500,39807,29746,20511,12244,5773,
100000,96944,96299,96103,95917,95624,95257,94781,94148,93269,92046,90435,88064,84905,80235,73746,65360,54046,42140,30074,18401,8751,
100000,97209,96693,96458,96196,95466,94358,93088,91618,89886,87673,84942,81208,76462,70073,62048,52565,41965,31605,21819,12928,5980,
100000,97588,97089,96913,96741,96467,96124,95681,95092,94287,93153,91618,89387,86359,81898,75757,67577,56728,44639,31841,19198,8810,
100000,97786,97375,97165,96920,96166,95023,93758,92332,90678,88577,85942,82391,77818,71649,63957,54519,44051,33431,23106,13589,6163,
100000,98098,97713,97556,97396,97140,96820,96409,95862,95125,94077,92618,90522,87627,83377,77582,69629,59267,47051,33544,19920,8805,
100000,98245,97918,97730,97503,96724,95546,94290,92909,91331,89339,86802,83430,79032,73090,65735,56370,46068,35223,24374,14225,6322,
100000,98501,98204,98064,97915,97678,97380,96998,96491,95818,94851,93466,91501,88738,84697,79242,71530,61668,49378,35184,20569,8740,
100000,98610,98350,98183,97971,97168,95956,94709,93373,91870,89985,87545,84348,80126,74412,67396,58127,48018,36981,25620,14838,6459,
100000,98820,98591,98466,98328,98108,97831,97477,97007,96392,95501,94189,92349,89717,85881,80756,73296,63938,51619,36761,21145,8620,
100000,98900,98694,98544,98348,97521,96275,95038,93747,92317,90534,88190,85164,81116,75629,68949,59797,49903,38705,26846,15426,6573,
100000,99071,98895,98784,98656,98451,98194,97866,97432,96871,96051,94809,93088,90583,86948,82141,74940,66083,53776,38277,21652,8450,
100000,99130,98966,98833,98651,97799,96520,95295,94047,92687,91003,88754,85891,82015,76755,70404,61385,51725,40395,28052,15990,6665,
100000,99269,99134,99035,98917,98727,98488,98184,97783,97272,96517,95343,93736,91354,87913,83411,76472,68109,55851,39732,22090,8234)
)
outputE_test <- interp_lc_lim(input = input_lx, dates_out = seq(1953,2018,5))
test_that("lc w lim data and nqx as input works", {
expect_equal(
e_dagger_list(outputE),
e_dagger_list(outputE_test$lt_hat %>% dplyr::arrange(Date,Sex,Age)),
tolerance = tolerance_admited
)
})
# F - testing args ------------------------------------------------------------
# single ages out
outputF1_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
Single = T)
# single out diff OAG
outputF2_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
Single = T, extrapLaw = "makeham", OAnew = 100)
# bunch of args
outputF3_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
prev_divergence = T,
dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"],
Single = T, verbose = F, SVD = T,
extrapLaw = "ggompertz", OAnew = 100)
test_that("lc w lim data and nqx as input works", {
expect_length(unique(outputF1_test$lt_hat$Age), 101)
expect_s3_class(outputF3_test$lt_hat, "data.frame")
expect_length(unique(outputF2_test$lt_hat$Age), 101)
expect_length(outputF3_test$lt_hat$ex, 101 * 2 * length(seq(1953,2018,5)))
})
# G - mixing input --------------------------------------------------------
# some dates gives rates and some lx
input_mix1 <- rbind(input %>%
dplyr::filter(Date %in% dates_in[1:2]) %>%
mutate(lx = NA),
input_lx %>%
dplyr::filter(Date %in% dates_in[3:5]) %>%
mutate(nMx = NA)
)
outputG1_test <- interp_lc_lim(input = input_mix1, dates_out = seq(1953,2018,5))
# some single and abr ages
input_single <- split(input, list(input$Date, input$Sex), drop = F) %>%
lapply(function(X){
LT = lt_abridged2single(nMx = X[["nMx"]],
Age = X[["Age"]],
Sex = unique(X[["Sex"]]),
OAnew = 100)
LT$Date = unique(X$Date)
LT$Sex = unique(X$Sex)
LT}) %>%
do.call("rbind", .) %>%
dplyr::select(Date, Sex, Age, nMx)
input_mix2 <- rbind(input %>%
dplyr::filter(Date %in% dates_in[1:2]),
input_single %>%
dplyr::filter(Date %in% dates_in[3:5])
)
outputG2_test <- interp_lc_lim(input = input_mix2, dates_out = seq(1953,2018,5))
outputG3_test <- interp_lc_lim(input = input_mix2, dates_out = seq(1953,2018,5),
Single = T)
test_that("mixing inputs works", {
expect_s3_class(outputG1_test$lt_hat, "data.frame")
expect_true(all(outputG1_test$lt_hat$nMx > 0))
expect_length(unique(outputG2_test$lt_hat$Age), 22)
expect_length(unique(outputG3_test$lt_hat$Age), 101)
})
# H - lt args -------------------------------------------------------------
# various comb args from lt functions
outputH1_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
a0rule = "cd")
outputH2_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
axmethod = "un")
outputH3_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
region = "n")
outputH4_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "makeham")
outputH5_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "makeham", OAnew = 95)
outputH6_test <- interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
extrapLaw = "gompertz", OAnew = 100,
extrapFrom = 60, extrapFit = seq(50,95,5), radix = 1)
test_that("pass all lt args works", {
expect_s3_class(outputH1_test$lt_hat, "data.frame")
expect_s3_class(outputH2_test$lt_hat, "data.frame")
expect_s3_class(outputH3_test$lt_hat, "data.frame")
expect_s3_class(outputH4_test$lt_hat, "data.frame")
expect_s3_class(outputH5_test$lt_hat, "data.frame")
expect_s3_class(outputH6_test$lt_hat, "data.frame")
}
)
# I - messages/warnings -------------------------------------------------------
test_that("mess and warns works", {
# need n(dates)>2
expect_error(interp_lc_lim(input = input %>% dplyr::filter(Date %in% dates_in[1:2]),
dates_out = seq(1953,2018,5)))
# choose e0_dates for you
expect_error(interp_lc_lim(input = input, dates_out = seq(1953,2018,5),
# dates_e0 = unique(e0_swe$Date),
e0_Males = e0_swe$e0[e0_swe$Sex=="m"],
e0_Females = e0_swe$e0[e0_swe$Sex=="f"]))
# need to rethink these: messages shifted elsewhere
# # tell me you´ll fit with gompertz in case max(Age) is <90
# expect_output(interp_lc_lim(input = input %>% dplyr::filter(Age < 85),
# dates_out = seq(1953,2018,5)),
# regexp = "A Makeham function was fitted for older ages for sex ")
# # tell me you´ll fit with kannisto in case max(Age) is >=90
# expect_output(interp_lc_lim(input = input, dates_out = seq(1953,2018,5)),
# regexp = "A Kannisto function was fitted for older ages for sex ")
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.