library(lmomco)
library(Lmoments)

pwmf <- function(f, para, r=0) quaben(f, para)*f^r # Probabililty-weighted moment (Beta definition)
subdivs <- 20000; rel.tol <- .Machine$double.eps^0.5; nsim=5E5; fold=5000

# L-moments of the Benford distribution for the first significant digit
para  <- list(para=c(1, 10))
tlmr  <- theoLmoms(para=para, quafunc=quaben, subdivisions=subdivs, rel.tol=rel.tol, nsim=nsim, fold=fold)
print(tlmr$lambdas, 16)
print(tlmr$ratios,  16)
L1l   <- 3.43855826820559152
L2l   <- 1.34460010664953189
T3l   <- 0.24849390038410821
T4l   <- 0.01568210253354345
# ix <- 1:9; prob <- pmfben(ix, para)
# MU1  <- mean(replicate(fold, mean(sample(ix, nsim*10, replace=TRUE, prob=prob))))
# LMR1 <- replicate(fold, Lmoments::Lmoments(sample(ix, nsim*10, replace=TRUE, prob=prob)))
# LMR1 <- as.vector(LMR1)
# LMRMU1 <- sapply(1:4, function(i) mean(LMR1[seq(1+i-1, length(LMR1)-(4-i), by=4)]))
# LMRMU1[3:4] <- LMRMU1[3:4]/LMRMU1[2]; print(LMRMU1, 16)
# print(MU1, 16)
MU1   <- 3.44026692
L1m   <- 3.44021646816000004
L2m   <- 1.34459857558248963
T3m   <- 0.24847816313897597
T4m   <- 0.01573717051069297


Beta0 <- integrate(pwmf, 0, 1, para=para, r=0, subdivisions=subdivs, rel.tol=rel.tol)
Beta1 <- integrate(pwmf, 0, 1, para=para, r=1, subdivisions=subdivs, rel.tol=rel.tol)
Beta2 <- integrate(pwmf, 0, 1, para=para, r=2, subdivisions=subdivs, rel.tol=rel.tol)
Beta3 <- integrate(pwmf, 0, 1, para=para, r=3, subdivisions=subdivs, rel.tol=rel.tol)
tpwm  <- vec2pwm(c(Beta0$value, Beta1$value, Beta2$value, Beta3$value), as.list=TRUE)
tlmp  <- lmorph(pwm2lmom(tpwm))
print(tlmp$lambdas, 16)
print(tlmp$ratios,  16)
L1p   <- 3.43848625215942505
L2p   <- 1.34635434315349123
T3p   <- 0.24685066316172560
T4p   <- 0.01701601923517905

L1_1  <- (L1l + L1m + L1p) / 3
L2_1  <- (L2l + L2m + L2p) / 3
T3_1  <- (T3l + T3m + T3p) / 3
T4_1  <- (T4l + T4m + T4p) / 3
print(c(L1_1, L2_1, T3_1, T4_1), 16)



# L-moments of the Benford distribution for the first two significant digits
para  <- list(para=c(2, 10))
tlmr  <- theoLmoms(para=para, quafunc=quaben, subdivisions=subdivs, rel.tol=rel.tol, nsim=nsim, fold=fold)
print(tlmr$lambdas, 16)
print(tlmr$ratios,  16)
L1l   <- 38.58996229639999598
L2l   <- 13.81881307908152401
T3l   <-  0.22226930914756252
T4l   <-  0.03540631368352534
# ix <- 10:99; prob <- pmfben(10:99, para)
# MU2   <- mean(replicate(fold, mean(sample(ix, nsim, replace=TRUE, prob=prob))))
# print(MU2, 16)
# LMR2 <- replicate(fold, Lmoments::Lmoments(sample(ix, nsim*10, replace=TRUE, prob=prob)))
# LMR2 <- as.vector(LMR2)
# LMRMU2 <- sapply(1:4, function(i) mean(LMR2[seq( 1+i-1, length(LMR2)-(4-i), by=4)]))
# LMRMU2[3:4] <- LMRMU2[3:4] / LMRMU2[2]; print(LMRMU2, 16)
MU2   <- 38.590361773
L1m   <- 38.58973688615999720
L2m   <- 13.81834111498303308
T3m   <-  0.22232151618387719
T4m   <-  0.03549779478978188


# We seem to get blow-up on integration to the L-moments as resort to Monte Carlo integration;
# so, flip to the probability weighted moments.
Beta0 <- integrate(pwmf, 0, 1, para=para, r=0, subdivisions=subdivs, rel.tol=rel.tol)
Beta1 <- integrate(pwmf, 0, 1, para=para, r=1, subdivisions=subdivs, rel.tol=rel.tol)
Beta2 <- integrate(pwmf, 0, 1, para=para, r=2, subdivisions=subdivs, rel.tol=rel.tol)
Beta3 <- integrate(pwmf, 0, 1, para=para, r=3, subdivisions=subdivs, rel.tol=rel.tol)
tpwm  <- vec2pwm(c(Beta0$value, Beta1$value, Beta2$value, Beta3$value), as.list=TRUE)
tlmp  <- lmorph(pwm2lmom(tpwm))
print(tlmp$lambdas, 16)
print(tlmp$ratios,  16)
L1p   <- 38.5921883615227870
L2p   <- 13.8158800822372214
T3p   <- 0.22253542829437414
T4p   <- 0.03532701409351359

L1_2   <- (L1l + L1m + L1p) / 3
L2_2   <- (L2l + L2m + L2p) / 3
T3_2   <- (T3l + T3m + T3p) / 3
T4_2   <- (T4l + T4m + T4p) / 3
print(c(L1_2, L2_2, T3_2, T4_2), 16)

# L-moments of the Benford distribution for the first three significant digits
para  <- list(para=c(3, 10))
tlmr  <- theoLmoms(para=para, quafunc=quaben, subdivisions=subdivs, rel.tol=rel.tol, nsim=nsim, fold=fold)
print(tlmr$lambdas, 16)
print(tlmr$ratios,  16)
L1l   <- 390.355159280400017
L2l   <- 138.224362793417868
T3l   <-   0.221723052356321781
T4l   <-   0.035670495059571483
# ix <- 100:999; prob <- pmfben(100:999, para)
# MU3   <- mean(replicate(fold, mean(sample(ix, nsim, replace=TRUE, prob=prob))))
# print(MU3, 16)
# LMR3 <- replicate(fold, Lmoments::Lmoments(sample(ix, nsim*10, replace=TRUE, prob=prob)))
# LMR3 <- as.vector(LMR3)
# LMRMU3 <- sapply(1:4, function(i) mean(LMR3[seq( 1+i-1, length(LMR3)-(4-i), by=4)]))
# LMRMU3[3:4] <- LMRMU3[3:4] / LMRMU3[2]; print(LMRMU3, 16)
MU3   <- 390.375577365
L1m   <- 390.36553371287999425
L2m   <- 138.22207919255154707
T3m   <-   0.22202336348766952
T4m   <-   0.03577078792447076

# We seem to get blow-up on integration to the L-moments as resort to Monte Carlo integration;
# so, flip to the probability weighted moments.
Beta0 <- integrate(pwmf, 0, 1, para=para, r=0, subdivisions=subdivs, rel.tol=rel.tol)
Beta1 <- integrate(pwmf, 0, 1, para=para, r=1, subdivisions=subdivs, rel.tol=rel.tol)
Beta2 <- integrate(pwmf, 0, 1, para=para, r=2, subdivisions=subdivs, rel.tol=rel.tol)
Beta3 <- integrate(pwmf, 0, 1, para=para, r=3, subdivisions=subdivs, rel.tol=.Machine$double.eps^0.25, stop.on.error=FALSE)
# Error in integrate(pwmf, 0, 1, para = para, r = 3, subdivisions = subdivs,  :
#  roundoff error was detected
tpwm  <- vec2pwm(c(Beta0$value, Beta1$value, Beta2$value, Beta3$value), as.list=TRUE)
#Beta3 <- cubature::cubintegrate(pwmf, 0, 1, para=para, r=3, relTol=.Machine$double.eps^0.25)
tpwm  <- vec2pwm(c(Beta0$value, Beta1$value, Beta2$value, Beta3$integral), as.list=TRUE)
tlmp  <- lmorph(pwm2lmom(tpwm))
print(tlmp$lambdas, 16)
print(tlmp$ratios,  16)
L1p   <- 390.366059577768056
L2p   <- 138.221781851366245
T3p   <- 0.22203050658058662
T4p   <- 0.03574096594047461

L1_3  <- (L1l + L1m + L1p) / 3
L2_3  <- (L2l + L2m + L2p) / 3
T3_3  <- (T3l + T3m + T3p) / 3
T4_3  <- (T4l + T4m + T4p) / 3
print(c(L1_3, L2_3, T3_3, T4_3), 16)
