R Under development (unstable) (2024-09-28 r87201 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(lifecontingencies) Package: lifecontingencies Authors: Giorgio Alfredo Spedicato [aut, cre] (), Christophe Dutang [ctb] (), Reinhold Kainhofer [ctb] (), Kevin J Owens [ctb], Ernesto Schirmacher [ctb], Gian Paolo Clemente [ctb] (), Ivan Williams [ctb] Version: 1.3.12 Date: BugReport: https://github.com/spedygiorgio/lifecontingencies/issues > > data("soa08Act") > > #test access functions > f <- function(x) + soa08Act@lx[which(soa08Act@x == x)] > > g <- function(j) + if(soa08Act@x[1] == 0) + soa08Act@lx[soa08Act@x[j+2]] > if(all(g(1:10) == sapply(1:10, f))) + { + system.time(replicate(1e3, sapply(0:139, f))) + system.time(replicate(1e3, g(0:139) )) + } user system elapsed 0 0 0 > > #test accuraccy > pXt <- Vectorize(lifecontingencies:::pxtold, "x") > pxT <- Vectorize(lifecontingencies:::pxtold, "t") > pxtvect <- pxt > > #non-integer age > compalldigit <- function(x, t, fractional) + print( + cbind(x=x, + new=pxtvect(soa08Act, x=x, t=t, fractional=fractional), + old=pXt(object=soa08Act, x=x, t=t, fractional=fractional)) + , digits=22) > > compalldigit(80+0:6/4, t=1, "exp") x new old [1,] 80.00 0.9196991452118752352618 0.9196991452118752352618 [2,] 80.25 0.9178596283415730860966 0.9178596283415730860966 [3,] 80.50 0.9160237907421864278490 0.9160237907421864278490 [4,] 80.75 0.9141916250546993083503 0.9141916250546993083503 [5,] 81.00 0.9123631239348144461587 0.9123631239348144461587 [6,] 81.25 0.9103624155842635623515 0.9103624155842635623515 [7,] 81.50 0.9083660945591083279993 0.9083660945591083279993 > compalldigit(80+0:6/4, t=1, "lin") x new old [1,] 80.00 0.9196991452118752352618 0.9196991452118752352618 [2,] 80.25 0.9179778568558516482767 0.9179778568558516482767 [3,] 80.50 0.9161845671517676592543 0.9161845671517676592543 [4,] 80.75 0.9143146618778100753744 0.9143146618778100753744 [5,] 81.00 0.9123631239348144461587 0.9123631239348144461587 [6,] 81.25 0.9105029928731027677458 0.9105029928731027677458 [7,] 81.50 0.9085576185470340959682 0.9085576185470339849459 > compalldigit(80+0:6/4, t=1, "hyp") x new old [1,] 80.00 0.9196991452118752352618 0.9196991452118752352618 [2,] 80.25 0.9177361144820218585849 0.9177361144820218585849 [3,] 80.50 0.9158630425464114876988 0.9158630425464114876988 [4,] 80.75 0.9140738841780660095537 0.9140738841780660095537 [5,] 81.00 0.9123631239348144461587 0.9123631239348144461587 [6,] 81.25 0.9102149405824918604324 0.9102149405824918604324 [7,] 81.50 0.9081746109444482906170 0.9081746109444482906170 > > > > cbind(x=10+0:6/6, lx=g(10+0:6/6), pxtvect(soa08Act, x=10+0:6/6, t=1), pXt(object=soa08Act, x=10+0:6/6, t=1)) x lx [1,] 10.00000 97055.88 0.9991525 0.9991525 [2,] 10.16667 97055.88 0.9991520 0.9991520 [3,] 10.33333 97055.88 0.9991515 0.9991515 [4,] 10.50000 97055.88 0.9991511 0.9991511 [5,] 10.66667 97055.88 0.9991506 0.9991506 [6,] 10.83333 97055.88 0.9991501 0.9991501 [7,] 11.00000 96973.63 0.9991496 0.9991496 > > #high-age > cbind(x=135:145, lx=g(135:145), pxtvect(soa08Act, x=135:145, t=1), pXt(object=soa08Act, x=135:145, t=1)) x lx [1,] 135 5.34820e-55 1.932519e-06 1.932519e-06 [2,] 136 1.03355e-60 5.431077e-07 5.431077e-07 [3,] 137 5.61329e-67 1.350422e-07 1.350422e-07 [4,] 138 7.58031e-74 2.935883e-08 2.935883e-08 [5,] 139 2.22549e-81 5.508989e-09 5.508989e-09 [6,] 140 NA 0.000000e+00 0.000000e+00 [7,] 141 NA 0.000000e+00 0.000000e+00 [8,] 142 NA 0.000000e+00 0.000000e+00 [9,] 143 NA 0.000000e+00 0.000000e+00 [10,] 144 NA 0.000000e+00 0.000000e+00 [11,] 145 NA 0.000000e+00 0.000000e+00 > > > #non consecutive age > x <- rpois(10, 45) > cbind(x=x, pxtvect(soa08Act, x=x, t=1), pXt(object=soa08Act, x=x, t=1)) x [1,] 54 0.9917636 0.9917636 [2,] 58 0.9884248 0.9884248 [3,] 34 0.9981020 0.9981020 [4,] 52 0.9930276 0.9930276 [5,] 40 0.9972188 0.9972188 [6,] 51 0.9935779 0.9935779 [7,] 41 0.9970182 0.9970182 [8,] 36 0.9978598 0.9978598 [9,] 52 0.9930276 0.9930276 [10,] 34 0.9981020 0.9981020 > > > checkvalx <- function(fractional) + { + allfracage <- seq(1, 100, by=1/4) + new <- pxtvect(soa08Act, x=allfracage, t=1/3, fractional = fractional) + old <- pXt(object=soa08Act, x=allfracage, t=1/3, fractional = fractional) + cbind("equal on all digit"=all(old == new), "equal with round off"= sum(abs(old - new)) < 1e-6) + } > checkvalt <- function(fractional) + { + allfractime <- seq(1, 30, by=1/4) + new <- pxtvect(soa08Act, x=2, t=allfractime, fractional = fractional) + old <- pxT(object=soa08Act, x=2, t=allfractime, fractional = fractional) + cbind("equal on all digit"=all(old == new), "equal with round off"= sum(abs(old - new)) < 1e-6) + } > > rbind("lin"=checkvalx("linear"), "harm"=checkvalx("harm"), "exp"=checkvalx("exp")) equal on all digit equal with round off [1,] FALSE TRUE [2,] TRUE TRUE [3,] TRUE TRUE > > rbind("lin"=checkvalt("linear"), "harm"=checkvalt("harm"), "exp"=checkvalt("exp")) equal on all digit equal with round off [1,] FALSE TRUE [2,] TRUE TRUE [3,] TRUE TRUE > > > nrep <- 10 > T1 <- system.time(replicate(nrep, pxtvect(soa08Act, x=1:130, t=1/2) )) > T2 <- system.time(replicate(nrep, pXt(soa08Act, x=1:130, t=1/2) )) > > T3 <- system.time(replicate(nrep, pxtvect(soa08Act, x=1, t=1:130/2) )) > T4 <- system.time(replicate(nrep, pxT(soa08Act, x=1, t=1:130/2) )) > > alltime <- rbind(T1, T2, T3, T4)[, 1:3] > #library(xtable);xtable(alltime, digits=3) > > proc.time() user system elapsed 2.82 0.18 3.00