Fix R test references and make them reproducible

.github/workflows/UpdateRefs.yml

@@ -0,0 +1,48 @@
+name: UpdateRefs
+
+on:
+  schedule:
+    - cron: '00 00 * * *'
+  workflow_dispatch:
+
+jobs:
+  UpdateRefs:
+    runs-on: ubuntu-latest
+    steps:
+        - uses: actions/checkout@v5
+        - uses: r-lib/actions/setup-r@v2
+          with:
+            r-version: '4'
+        - uses: r-lib/actions/setup-renv@v2
+          with:
+            working-directory: 'test/refs'
+        - name: Update renv
+          run: renv::update()
+          shell: Rscript {0}
+          working-directory: test/ref
+        - name: Check for changes of R environment
+          id: check
+          shell: bash
+          run: |
+            output=$(git diff --name-only -- test/ref)
+            if [ "$output" != "" ]; then
+                >&1 echo "The R environment was updated"
+                echo "changed=true" >> "$GITHUB_OUTPUT"
+            else
+                echo "changed=false" >> "$GITHUB_OUTPUT"
+            fi
+        - name: Regenerate references
+          if: steps.check.outputs.changed
+          run: Rscript gendref.R
+          working-directory: test/ref
+        - name: Create pull request
+          if: steps.check.outputs.changed
+          uses: peter-evans/create-pull-request@7
+          with:
+            token: ${{ secrets.DOCUMENTER_KEY }}
+            commit-message: "🤖 Automatic update of R references"
+            title: "🤖 Automatic update of R references"
+            body: |-
+              This pull request updates all packages and references in the `test/ref` directory.
+            delete-branch: true
+            add-paths: test/ref

test/ref/.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

test/ref/continuous/betaprime.R

@@ -25,8 +25,8 @@ BetaPrime <- R6Class("BetaPrime",
                      sqrt((b - 2) / (a * (a + b - 1)))
                  } else { NaN })
         },
-        pdf = function(x, log=FALSE){ dbetapr(x, self$alpha, self$beta, log=log) },
-        cdf = function(x) { pbetapr(x, self$alpha, self$beta) },
-        quan = function(v) { qbetapr(v, self$alpha, self$beta) }
+        pdf = function(x, log=FALSE){ extraDistr::dbetapr(x, self$alpha, self$beta, log=log) },
+        cdf = function(x) { extraDistr::pbetapr(x, self$alpha, self$beta) },
+        quan = function(v) { extraDistr::qbetapr(v, self$alpha, self$beta) }
     )
 )

test/ref/continuous/gamma.R

@@ -31,4 +31,4 @@ Gamma <- R6Class("Gamma",
     )
 )
 
-Erlang = list(new = Gamma$new)
+Erlang = R6Class("Erlang", inherit = Gamma)

test/ref/continuous/generalizedextremevalue.R

@@ -60,8 +60,8 @@ GeneralizedExtremeValue <- R6Class("GeneralizedExtremeValue",
                      entropy = ent)
             }
         },
-        pdf = function(x, log=FALSE) { dgev(x, self$mu, self$sigma, self$xi, log=log) },
-        cdf = function(x) { pgev(x, self$mu, self$sigma, self$xi) },
-        quan = function(v) { qgev(v, self$mu, self$sigma, self$xi) }
+        pdf = function(x, log=FALSE) { extraDistr::dgev(x, self$mu, self$sigma, self$xi, log=log) },
+        cdf = function(x) { extraDistr::pgev(x, self$mu, self$sigma, self$xi) },
+        quan = function(v) { extraDistr::qgev(v, self$mu, self$sigma, self$xi) }
     )
 )

test/ref/continuous/generalizedpareto.R

@@ -46,8 +46,8 @@ GeneralizedPareto <- R6Class("GeneralizedPareto",
                  } else { Inf }
             )
         },
-        pdf = function(x, log=FALSE) { dgpd(x, self$mu, self$sigma, self$xi, log=log) },
-        cdf = function(x) { pgpd(x, self$mu, self$sigma, self$xi) },
-        quan = function(v) { qgpd(v, self$mu, self$sigma, self$xi) }
+        pdf = function(x, log=FALSE) { extraDistr::dgpd(x, self$mu, self$sigma, self$xi, log=log) },
+        cdf = function(x) { extraDistr::pgpd(x, self$mu, self$sigma, self$xi) },
+        quan = function(v) { extraDistr::qgpd(v, self$mu, self$sigma, self$xi) }
     )
 )

test/ref/continuous/gumbel.R

@@ -23,8 +23,8 @@ Gumbel <- R6Class("Gumbel",
                  skewness = 1.13954709940464866,
                  kurtosis = 2.4)
         },
-        pdf = function(x, log=FALSE){ dgumbel(x, self$mu, self$beta, log=log) },
-        cdf = function(x){ pgumbel(x, self$mu, self$beta) },
-        quan = function(v){ qgumbel(v, self$mu, self$beta) }
+        pdf = function(x, log=FALSE){ extraDistr::dgumbel(x, self$mu, self$beta, log=log) },
+        cdf = function(x){ extraDistr::pgumbel(x, self$mu, self$beta) },
+        quan = function(v){ extraDistr::qgumbel(v, self$mu, self$beta) }
     )
 )

test/ref/continuous/inversegamma.R

@@ -29,8 +29,8 @@ InverseGamma <- R6Class("InverseGamma",
                  } else { NaN },
                  entropy = a + log(b) + lgamma(a) - (1 + a) * digamma(a))
         },
-        pdf = function(x, log=FALSE){ dinvgamma(x, self$alpha, self$beta, log=log) },
-        cdf = function(x){ pinvgamma(x, self$alpha, self$beta) },
-        quan = function(v){ qinvgamma(v, self$alpha, self$beta) }
+        pdf = function(x, log=FALSE){ extraDistr::dinvgamma(x, self$alpha, self$beta, log=log) },
+        cdf = function(x){ extraDistr::pinvgamma(x, self$alpha, self$beta) },
+        quan = function(v){ extraDistr::qinvgamma(v, self$alpha, self$beta) }
     )
 )

test/ref/continuous/johnsonsu.R

@@ -1,5 +1,3 @@
-library("ExtDist")
-
 JohnsonSU <- R6Class("JohnsonSU",
     inherit = ContinuousDistribution,
     public = list(names = c("xi", "lambda", "gamma", "delta"),
@@ -16,7 +14,7 @@ JohnsonSU <- R6Class("JohnsonSU",
         supp = function() { c(-Inf, Inf) },
         properties = function() { list() },
         pdf = function(x, log = FALSE) {
-            p <- dJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
+            p <- ExtDist::dJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
             if (log) {
                 result <- log(p)
             } else {
@@ -25,10 +23,10 @@ JohnsonSU <- R6Class("JohnsonSU",
             return(result)
         },
         cdf = function(x) {
-            pJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
+            ExtDist::pJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
         },
         quan = function(x) {
-            qJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
+            ExtDist::qJohnsonSU(x, xi = self$xi, lambda = self$lambda, gamma = self$gamma, delta = self$delta)
         }
     )
 )

test/ref/continuous/kumaraswamy.R

@@ -9,6 +9,6 @@ Kumaraswamy <- R6Class("Kumaraswamy",
                                    },
                                    supp=function() { c(0, 1) },
                                    properties=function() { list() },
-                                   pdf=function(x, log=FALSE) { dkumar(x, self$a, self$b, log=log) },
-                                   cdf=function(x) { pkumar(x, self$a, self$b) },
-                                   quan=function(x) { qkumar(x, self$a, self$b) }))
+                                   pdf=function(x, log=FALSE) { extraDistr::dkumar(x, self$a, self$b, log=log) },
+                                   cdf=function(x) { extraDistr::pkumar(x, self$a, self$b) },
+                                   quan=function(x) { extraDistr::qkumar(x, self$a, self$b) }))

test/ref/continuous/laplace.R

@@ -23,8 +23,8 @@ Laplace <- R6Class("Laplace",
                  kurtosis = 3,
                  entropy = 1 + log(2 * b))
         },
-        pdf = function(x, log=FALSE){ dlaplace(x, self$mu, self$beta, log=log) },
-        cdf = function(x){ plaplace(x, self$mu, self$beta) },
-        quan = function(v){ qlaplace(v, self$mu, self$beta) }
+        pdf = function(x, log=FALSE){ extraDistr::dlaplace(x, self$mu, self$beta, log=log) },
+        cdf = function(x){ extraDistr::plaplace(x, self$mu, self$beta) },
+        quan = function(v){ extraDistr::qlaplace(v, self$mu, self$beta) }
     )
 )

test/ref/continuous/lindley.R

@@ -1,12 +1,10 @@
-library("LindleyR")
-
 Lindley <- R6Class("Lindley",
                    inherit=ContinuousDistribution,
                    public=list(names=c("theta"),
                                theta=NA,
                                initialize=function(theta=1) { self$theta <- theta },
                                supp=function() { c(0, Inf) },
                                properties=function() { list() },
-                               pdf=function(x, log=FALSE) { dlindley(x, self$theta, log=log) },
-                               cdf=function(x) { plindley(x, self$theta) },
-                               quan=function(x) { qlindley(x, self$theta) }))
+                               pdf=function(x, log=FALSE) { new.dist::dLd(x, self$theta, log=log) },
+                               cdf=function(x) { new.dist::pLd(x, self$theta) },
+                               quan=function(x) { new.dist::qLd(x, self$theta) }))

test/ref/continuous/normal.R

@@ -27,8 +27,11 @@ Normal <- R6Class("Normal",
     )
 )
 
-NormalCanon = list(
-    new = function(c1=0, c2=1) {
-        Normal$new(c1/c2, 1/sqrt(c2))
-    }
+NormalCanon = R6Class("NormalCanon",
+    inherit = Normal,
+    public = list(
+        initialize = function(c1=0, c2=1) {
+            super$initialize(c1/c2, 1/sqrt(c2))
+        }
+    )
 )

test/ref/continuous/pareto.R

@@ -30,8 +30,8 @@ Pareto <- R6Class("Pareto",
                  } else { NaN },
                  entropy = (1 + 1 / a) + log(b / a))
         },
-        pdf = function(x, log=FALSE){ dpareto(x, self$alpha, self$beta, log=log) },
-        cdf = function(x){ ppareto(x, self$alpha, self$beta) },
-        quan = function(v){ qpareto(v, self$alpha, self$beta) }
+        pdf = function(x, log=FALSE){ extraDistr::dpareto(x, self$alpha, self$beta, log=log) },
+        cdf = function(x){ extraDistr::ppareto(x, self$alpha, self$beta) },
+        quan = function(v){ extraDistr::qpareto(v, self$alpha, self$beta) }
     )
 )

test/ref/continuous/rayleigh.R

@@ -19,8 +19,8 @@ Rayleigh <- R6Class("Rayleigh",
                  kurtosis = 0.245089300687638,
                  entropy = 0.94203424217079 + log(s))
         },
-        pdf = function(x, log=FALSE) { drayleigh(x, self$sigma, log=log) },
-        cdf = function(x){ prayleigh(x, self$sigma) },
-        quan = function(v){ qrayleigh(v, self$sigma) }
+        pdf = function(x, log=FALSE) { extraDistr::drayleigh(x, self$sigma, log=log) },
+        cdf = function(x){ extraDistr::prayleigh(x, self$sigma) },
+        quan = function(v){ extraDistr::qrayleigh(v, self$sigma) }
     )
 )

test/ref/continuous/studentizedrange.R

@@ -14,6 +14,13 @@ StudentizedRange <- R6Class("StudentizedRange",
             d1 <- self$nu
             k <- self$k
         },
+        pdf = function(x, log=FALSE) {
+            if (log) {
+                ptukey(x, self$k, self$nu, log=TRUE) + log(pracma::fderiv(ptukey, x, n=1, nmeans=self$k, df=self$nu, log=TRUE))
+            } else {
+                pracma::fderiv(ptukey, x, n=1, nmeans=self$k, df=self$nu, log=FALSE)
+            }
+        },
         cdf = function(x) { ptukey(x, self$k, self$nu) },
         quan = function(v) { qtukey(v, self$k, self$nu) }
     )

test/ref/continuous/triangulardist.R

@@ -30,14 +30,17 @@ TriangularDist = R6Class("TriangularDist",
                  kurtosis = -0.6,
                  entropy = 0.5 + log((b - a) / 2))
         },
-        pdf = function(x, log=FALSE) { dtriang(x, self$a, self$b, self$c, log=log) },
-        cdf = function(x) { ptriang(x, self$a, self$b, self$c) },
-        quan = function(v) { qtriang(v, self$a, self$b, self$c) }
+        pdf = function(x, log=FALSE) { extraDistr::dtriang(x, self$a, self$b, self$c, log=log) },
+        cdf = function(x) { extraDistr::ptriang(x, self$a, self$b, self$c) },
+        quan = function(v) { extraDistr::qtriang(v, self$a, self$b, self$c) }
     )
 )
 
-SymTriangularDist = list(
-    new = function(u=0, s=1) {
-        TriangularDist$new(u-s, u+s, u)
-    }
+SymTriangularDist = R6Class("SymTriangularDist",
+    inherit = TriangularDist,
+    public = list(
+        initialize = function(u=0, s=1) {
+            super$initialize(u-s, u+s, u)
+        }
+    )
 )

test/ref/continuous/truncatednormal.R

@@ -13,6 +13,17 @@ TruncatedNormal <- R6Class("TruncatedNormal",
             self$a <- a
             self$b <- b
         },
+        dtype = "Distributions.Truncated{<:Normal}",
+        expr = function() {
+            str <- paste0("truncated(Normal(", self$mu, ", ", self$sigma, ")")
+            if (!is.infinite(self$a)) {
+                str <- paste0(str, ", lower=", self$a)
+            }
+            if (!is.infinite(self$b)) {
+                str <- paste0(str, ", upper=", self$b)
+            }
+            paste0(str, ")")
+        },
         supp = function() { c(self$a, self$b) },
         properties = function() {
             u <- self$mu
@@ -31,8 +42,8 @@ TruncatedNormal <- R6Class("TruncatedNormal",
                  var = s^2 * (1 + v1 - ((pa - pb) / Z)^2),
                  entropy = (log(2*pi) + 1) / 2 + log(s) + log(Z) + v1 / 2)
         },
-        pdf = function(x, log=FALSE) { dtnorm(x, self$mu, self$sigma, self$a, self$b, log=log) },
-        cdf = function(x) { ptnorm(x, self$mu, self$sigma, self$a, self$b) },
-        quan = function(v) { qtnorm(v, self$mu, self$sigma, self$a, self$b) }
+        pdf = function(x, log=FALSE) { extraDistr::dtnorm(x, self$mu, self$sigma, self$a, self$b, log=log) },
+        cdf = function(x) { extraDistr::ptnorm(x, self$mu, self$sigma, self$a, self$b) },
+        quan = function(v) { extraDistr::qtnorm(v, self$mu, self$sigma, self$a, self$b) }
     )
 )

test/ref/continuous_test.lst

@@ -195,11 +195,11 @@ TriangularDist(-4, 14, 3)
 TriangularDist(2, 2000, 500)
 TriangularDist(1, 3, 2)
 
-truncated(Normal(0, 1), lower = -2, upper = 2)
-truncated(Normal(3, 10), lower = 7, upper = 8)
-truncated(Normal(27, 3), lower = 0)
-truncated(Normal(-5, 1), upper = -10)
-truncated(Normal(1.8, 1.2), upper = 0)
+TruncatedNormal(0, 1, -2, 2)
+TruncatedNormal(3, 10, 7, 8)
+TruncatedNormal(27, 3, 0, Inf)
+TruncatedNormal(-5, 1, -Inf, -10)
+TruncatedNormal(1.8, 1.2, -Inf, 0)
 
 Uniform()
 Uniform(0.0, 2.0)