R Under development (unstable) (2024-02-23 r85978 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]
    (<https://orcid.org/0000-0002-0315-8888>),
  Christophe Dutang [ctb] (<https://orcid.org/0000-0001-6732-1501>),
  Reinhold Kainhofer [ctb] (<https://orcid.org/0000-0002-7895-1311>),
  Kevin J Owens [ctb],
  Ernesto Schirmacher [ctb],
  Gian Paolo Clemente [ctb] (<https://orcid.org/0000-0001-6795-4595>),
  Ivan Williams [ctb]
Version:  1.3.12
Date:     
BugReport: https://github.com/spedygiorgio/lifecontingencies/issues

> 
> data("soa08Act")
> 
> #test accuraccy
> AXn <- Vectorize(lifecontingencies:::Axnold, "x")
> AxN <- Vectorize(lifecontingencies:::Axnold, "n")
> AxnM <- Vectorize(lifecontingencies:::Axnold, "m")
> 
> Axnvect <- Axn
> 
> AxncheckR <- function(object, x, m, n)
+ {
+   i <- object@interest
+   f <- function(t)
+     tpx_q_xt <- pxt(object, x=x, t=t)*qxt(object, x=x+t, t=1)
+   prob <- sapply(m:(m+n-1), f)
+   rowSums(prob /( (1+i)^(m+1):(m+n)))
+ }
> 
> #basic check
> cbind(
+ AXn(soa08Act, 65:66, n=1, m=1) ,
+ Axnvect(soa08Act, 65:66, n=1, m=1),
+ AxncheckR(soa08Act, 65:66, m=1, n=1)
+ )
           [,1]       [,2]       [,3]
[1,] 0.02028353 0.02028353 0.02028353
[2,] 0.02211343 0.02211343 0.02211343
> 
> #k > 1
> x <- 85
> cbind(x=x, Axnvect(soa08Act, x=x, k=3), AXn(soa08Act, x=x, k=3))
      x                  
[1,] 85 0.748565 0.748565
> 
> #non-integer age
> x <- 30:35+1/2
> cbind(x=x, Axnvect(soa08Act, x=x), AXn(soa08Act, x=x))
        x                    
[1,] 30.5 0.1048737 0.1048737
[2,] 31.5 0.1097695 0.1097695
[3,] 32.5 0.1148929 0.1148929
[4,] 33.5 0.1202517 0.1202517
[5,] 34.5 0.1258537 0.1258537
[6,] 35.5 0.1317068 0.1317068
> 
> 
> #from testActuarialMathematics
> 
> x <- 0:9
> lx <- seq(100, 10, by = -10)
> tbl <- new("actuarialtable", x = x, lx = lx, interest = 0, name = "Uniformly decreasing lx")
> 
> 
> c(1, AXn(tbl, x = 0), Axnvect(tbl, x = 0))
[1] 1 1 1
> 
> c(1, AXn(tbl, x = 8.3, k = 1), Axnvect(tbl, x = 8.3, k = 1))
[1] 1 1 1
> 
> 
> v <- 1.06^(-seq(0.5, 2.0, by = 0.5))
> p <- c(rep(5/17,3), 2/17)
> ans <- sum(p * v)
> 
> c(AXn(tbl, x = 8.3, k = 2, i = 0.06), Axnvect(tbl, x = 8.3, k = 2, i = 0.06), ans)
[1] 0.9373494 0.9373494 0.9373494
> 
> v <- 1.06^(-seq(0.5, 1.5, by = 0.5))
> p <- c(rep(5/13,2), 3/13)
> ans <- sum(p * v)
> c(AXn(tbl, x = 8.7, k = 2, i = 0.06), Axnvect(tbl, x = 8.7, k = 2, i = 0.06), ans)
[1] 0.9478717 0.9478717 0.9478717
> 
> 
> round(c(Axn(soa08Act,x=30,i=0.06,k=4),
+         AXn(soa08Act,x=30,i=0.06,k=4),
+         0.1048),4) # 0.1048) #BOWERS P 339
[1] 0.1048 0.1048 0.1048
> 
> 
> #check previous and old
> 
> checkvalx <- function()
+   all(Axnvect(soa08Act, x=1:100) == AXn(soa08Act, x=1:100))
> checkvaln <- function()
+   all(Axnvect(soa08Act, x=33, n=10:50) == AxN(soa08Act, x=33, n=10:50))
> checkvalm <- function()
+   all(Axnvect(soa08Act, x=33, m=0:50) == AxnM(soa08Act, x=33, m=0:50))
> 
> checkvalk <- function(k)
+ {
+   allx <- seq(1, 50, by=0.5)
+   new <- Axnvect(soa08Act, x=allx, k=k)
+   old <- AXn(soa08Act, x=allx, k=k)
+   #print(cbind(old=old, new=new))
+   cbind("equal on all digit"=all(old == new), "equal with round off"=  sum(abs(old - new)) < 1e-6)
+ }
> 
> checkvalx()
[1] TRUE
> checkvaln()
[1] TRUE
> checkvalm()
[1] TRUE
> checkvalk(2)
     equal on all digit equal with round off
[1,]              FALSE                 TRUE
> checkvalk(4)
     equal on all digit equal with round off
[1,]              FALSE                 TRUE
> #checkvalk(6)
> #checkvalk(12)
> 
> nrep <- 5
> system.time(replicate(nrep, Axnvect(soa08Act, x=1:100) ))
   user  system elapsed 
   1.08    0.02    1.10 
> system.time(replicate(nrep, AXn(soa08Act, x=1:100) ))
   user  system elapsed 
   3.52    0.03    3.54 
> 
> system.time(replicate(nrep, Axnvect(soa08Act, x=33, n=1:50) ))
   user  system elapsed 
   0.30    0.00    0.29 
> system.time(replicate(nrep, AxN(soa08Act, x=33, n=1:50) ))
   user  system elapsed 
   0.55    0.00    0.55 
> 
> 
> proc.time()
   user  system elapsed 
  25.28    0.34   25.61